#Histo2Hindcast <- function(varin, sdatesin, sdatesout, nleadtimesout) {

Histo2Hindcast <- function(varin, sdatesin, sdatesout, nleadtimesout,
                           ftime_dim = NULL, sdate_dim = NULL,
                           freq = 'month', calendar_in = 'leap',
                           calendar_out = calendar_in,
                           leap_fill_method = 'put_NA') {
  # Check var
  if (!is.array(varin) || !is.numeric(varin)) {
    stop("Parameter 'varin' must be a numeric array.")
  }
  
  # Check sdatesin
   if (!is.character(sdatesin) | nchar(sdatesin) != 8) {
     stop("Parameter 'sdatesin' must be a character string in the form 'YYYYMMDD'")
   }
  if (length(sdatesin) != 1) {
   sdatesin <- sdatesin[1]
   warning("Parameter 'sdatesin' has more than one value. Use the first value as start date")
  }
  
  # # Check sdatesout
  if (!is.character(sdatesout) | any(nchar(sdatesout) != 8)) {
    stop(paste0("Parameter 'sdatesout' must be a character vector in the form",
                "c('YYYYMMDD', 'YYYYMMDD', ...)"))
  }
   
  # Check nleadtimesout
  if (!is.numeric(nleadtimesout) | nleadtimesout <= 0 | nleadtimesout %% 1 != 0) {
    stop("Parameter 'nleadtimesout' must be a positive integer.")
  }
  #nleadtimesout <- round(nleadtimesout[1])
  
  # Check ftime_dim
  dims <- dim(varin)
  if (is.null(ftime_dim)) {
    if ('ftime' %in% names(dims)) {
      ftime_dim <- which(names(dims) == 'ftime')
    } else {
      stop("Parameter 'varin' must have dimension named 'ftime' if parameter 'ftime_dim' = NULL.")
    }
  } else if (is.character(ftime_dim)) {
    ftime_dim <- which(names(dims) == ftime_dim)
    if (length(ftime_dim) == 0) {
      stop("Could not find the specified 'ftime_dim' in parameter 'varin' dimension names.")
    }
  } else if (is.numeric(ftime_dim)) {
    if (ftime_dim %% 1 != 0 | ftime_dim <= 0) {
      stop("Parameter 'ftime_dim' must be a positive integer or a character string.")
    }
  }
  
  # Check sdate_dim
  # A 0 will be assigned when the sdate_dim is not present and needs to be added later
  if (is.null(sdate_dim)) {
    if ('sdate' %in% names(dims)) {
      sdate_dim <- which(names(dims) == 'sdate')
    } else {
      sdate_dim <- 0
    }
  } else if (is.character(sdate_dim)) {
    sdate_dim <- which(names(dims) == sdate_dim)
    if (length(sdate_dim) == 0) {
      stop("Could not find the specified 'sdate_dim' in parameter 'varin' dimension names.")
    }
  } else if (!is.numeric(sdate_dim)) {
    if (ftime_dim %% 1 != 0 | ftime_dim <= 0) {
      stop("Parameter 'ftime_dim' must be a positive integer or a character string.")
    }
  }
  
  # Check freq
  if (!('difftime' %in% class(freq))) {
    if (freq == 'min') {
      freq <- as.difftime(1, units = 'mins')
    } else if (freq == 'day') {
      freq <- as.difftime(1, units = 'days')
    } else if (freq %in% c('month', 'year')) {
    } else {
      stop("Parameter 'freq' must be either of the class 'difftime' or one ",
           " of 'month', 'min', 'day', or 'year'.")
    }
  }
  
  # Check calendar_in
  if (!(calendar_in %in% c('leap', 'noleap'))) {
    stop("Parameter 'calendar_in' must be either 'leap' or 'noleap'.")
  }
  
  # Check calendar_out
  if (!(calendar_out %in% c('leap', 'noleap'))) {
    stop("Parameter 'calendar_out' must be either 'leap' or 'noleap'.")
  }
  
  # Check leap_fill_method
  if (!(leap_fill_method %in% c('put_NA', 'copy_28th_feb', 'copy_1st_mar'))) {
    stop(paste0("Parameter 'leap_fill_method' must be one of 'put_NA', ",
                "'copy_28th_feb' or 'copy_1st_mar'."))
  }
  
  # Create the list_of_dates, containing a list of vectors each
  # with the dates of the values of each sdate
  # Create the dates_in, a vector of the dates of the input data
  # Create tolerance according to freq
  dates_seq <- function(from, by, n, calendar = 'leap') {
    
    r <- seq(from, by = by, length.out = n)
    if ((calendar == 'noleap') && (by == as.difftime(1, units = 'days'))) {
      keep_doing <- TRUE
      feb29_indices <- which(format(r, '%m%d') == '0229')
      new_feb29_indices <- feb29_indices
      while (keep_doing) {
        if (length(new_feb29_indices) > 0) {
          new_r <- seq(r[length(r)], by = freq,
                       length.out = 1 + length(new_feb29_indices))[-1]
          new_feb29_indices <- which(format(new_r, '%m%d') == '0229') + length(r)
          r <- c(r, new_r)
          feb29_indices <- c(feb29_indices, new_feb29_indices)
        } else {
          keep_doing <- FALSE
        }
      }
      if (length(feb29_indices) > 0) {
        r <- r[-feb29_indices]
      }
    }
    if (any(is.na(r))) print("HEEEY")
    r
  }
  
  # Monthly series
  # x has to be 'YYYYMMDD'
  # nleadtimesout number of dates to generate
  generate_dates <- function(x, nleadtimesout) {
    syear <- as.integer(substr(as.character(x), 1, 4))
    smonth <- as.integer(substr(as.character(x), 5, 6))
    sday <- as.integer(substr(as.character(x), 7, 8))
    months_seq <- (((1:12 + smonth - 1) - 1) %% 12) + 1
    month_inds <- ((1:nleadtimesout - 1) %% length(months_seq)) + 1
    months_seq <- months_seq[month_inds]
    year_changes <- which(months_seq == 12)
    as.POSIXct(
      sapply(1:nleadtimesout,
             function(y) {
               offset_years <- sum(year_changes < y)
               paste0(syear + offset_years, '-', months_seq[y], '-', sday)
             })
    )
  }
  
  dates_in <- NULL
  if ('difftime' %in% class(freq)) {
    list_of_dates <- lapply(sdatesout,
                            function(x) {
                              dates_seq(x, freq, nleadtimesout, calendar_out)
                            })
    
    dates_in <- dates_seq(sdatesin, freq, dims[ftime_dim], calendar_in)
    tolerance <- 0.5 * freq
    
  } else if (freq == 'month') {

    list_of_dates <- lapply(sdatesout, generate_dates, nleadtimesout)
    dates_in <- generate_dates(sdatesin, dims[ftime_dim])
    tolerance <- as.difftime(15, units = 'days')
    
  } else if (freq == 'year') {
    stop("Feature 'freq = \"year\"' still to be implemented.")
  }
  
  # Work out the dimensions of the output array
  new_dims <- dims
  new_dims[ftime_dim] <- nleadtimesout
  sdate_dim_out <- 0
  if (sdate_dim > 0) {
    new_dims[sdate_dim] <- length(sdatesout)
    sdate_dim_out <- sdate_dim 
  } else {
    new_dims_2 <- NULL
    if (ftime_dim > 1) {
      new_dims_2 <- new_dims[1:(ftime_dim - 1)]
    }
    sdate_dim_out <- length(new_dims_2) + 1
    new_dims_2 <- c(new_dims_2, sdate = length(sdatesout),
                    new_dims[ftime_dim:length(new_dims)])
    new_dims <- new_dims_2
  }
  # Create output array
  var_out <- array(dim = new_dims)
  
  # Populate output array with corresponding values
  for (i in 1:length(sdatesout)) {
    # First select the values to take for each start date
    indices <- as.list(rep(TRUE, length(dims)))
    indices[[ftime_dim]] <- sapply(1:nleadtimesout,
                                   function(x) {
                                     diffs <- abs(dates_in - list_of_dates[[i]][x])
                                     match <- which.min(diffs)
                                     if (diffs[match] <= tolerance) {
                                       match[1]
                                     } else {
                                       NA
                                     }
                                   })
    if (all(is.na(indices[[ftime_dim]]))) {
      value <- rep(NA, nleadtimesout)
    } else {
      value <- do.call('[', c(list(x = varin), indices, list(drop = FALSE)))
    }
    # Fill in 29th februaries if calendar_in == 'noleap' and calendar_out == 'leap'
    if (calendar_in == 'noleap' && calendar_out == 'leap') {
      feb29_indices <- which(format(list_of_dates[[i]], '%m%d') == '0229')
      if (length(feb29_indices) > 0) {
        if (leap_fill_method == 'put_NA') {
          indices_hindcast <- indices
          indices_hindcast[[ftime_dim]] <- feb29_indices
          value <- do.call('[<-', c(list(x = value), indices_hindcast,
                                    list(value = rep(NA, prod(dims[-ftime_dim]) *
                                                       length(feb29_indices)))))
        } else if (leap_fill_method == 'copy_28th_feb') {
          indices_hindcast <- indices
          #if (indices[[ftime_dim]][feb29_indices[1] + 1] - 2 < 1) {
          #  feb29_indices <- feb29_indices[-1]
          #  warning("WARNING: 29th february at the beginning of the ",
          #          "historical series and 'copy_28th_feb' fill method ",
          #          "requested. Filling in with NA instead.")
          #}
          if (length(feb29_indices) > 0) {
            indices[[ftime_dim]] <- indices[[ftime_dim]][feb29_indices - 1]
            feb29_values <- do.call('[', c(list(x = varin), indices, list(drop = FALSE)))
            indices_hindcast[[ftime_dim]] <- feb29_indices
            value <- do.call('[<-', c(list(x = value), indices_hindcast,
                                      list(value = feb29_values)))
          }
        } else if (leap_fill_method == 'copy_1st_mar') {
          indices_hindcast <- indices
          #if (indices[[ftime_dim]][feb29_indices[length(feb29_indices)] - 1] + 2 > 
          #    dims[ftime_dim]) {
          #  feb29_indices <- feb29_indices[-length(feb29_indices)]
          #  warning("WARNING: 29th february at the end of the ",
          #          "historical series and 'copy_1st_mar' fill method ",
          #          "requested. Filling in with NA instead.")
          #}
          if (length(feb29_indices) > 0) {
            indices[[ftime_dim]] <- indices[[ftime_dim]][feb29_indices + 1]
            feb29_values <- do.call('[', c(list(x = varin), indices, list(drop = FALSE)))
            indices_hindcast[[ftime_dim]] <- feb29_indices
            value <- do.call('[<-', c(list(x = value), indices_hindcast,
                                      list(value = feb29_values)))
          }
        }
      }
    }
    
    # Then put into output array
    indices <- as.list(rep(TRUE, length(new_dims)))
    print(sdate_dim_out)
    
    indices[[sdate_dim_out]] <- i
    
    var_out <- do.call('[<-', c(list(x = var_out), indices, list(value = value)))
  }
  
  if (calendar_in == 'leap' && calendar_out == 'noleap') {
    warning("29th february from input have been removed.")
  }
  
  var_out
}
