#' AdamontAnalog finds analogous days in the reference dataset to experiment data based on
#' weather types
#'
#'@author Paola Marson, \email{paola.marson@meteo.fr} for PROSNOW version
#'@author Lauriane Batté, \email{lauriane.batte@meteo.fr} for CSTools adaptation
#'
#'@param exp experiment data, can be output from quantile correction
#'@param wt corresponding weather types (same dimensions as exp but lat/lon)
#'@param obs reference data, lat/lon dimensions need to be the same as exp
#'@param wt_obs corresponding weather types (same dimensions as obs but lat/lon)
#'@param method string indicating the method used for analog definition
#'       Currently coded are pattcorr: pattern correlation
#'	                     rain1 (for precip patterns): rain occurrence consistency
#'			     rain01 (for precip patterns): rain occurrence/non occurrence consistency
#'@param thres real number indicating the threshold to define rain occurrence/non occurrence in rain(0)1
#'
#'@import CSTools, multiApply, ClimProjDiags


AdamontAnalog <-  function(exp, obs, wt_exp, wt_obs, method = 'pattcorr', thres = NULL,search_obsdims = c('member', 'sdate', 'ftime'), londim = 'lon', latdim = 'lat') { 
  # exp: lat, lon, sdate, ftime, member
  # obs: lat, lon, dims for searching 'sdate' 'ftime'...
  # wt_exp: sdate, ftime, member 
  # wt_obs: the dims for searching
  # ADD TESTS: IF METHOD=PATTCORR, THRES=NULL IS FINE, IF NOT, THRES IS NEEDED!

  # Position of lat/lon dimensions in exp data
  poslatexp <- which(names(dim(exp)) == latdim)
  poslonexp <- which(names(dim(exp)) == londim)
  # Reshaping obs:
  ## The dimensions where to search in a single dim
  if (length(search_obsdims) > 1) {
    for (i in 1:(length(search_obsdims) - 1)) {
      obs <- MergeDims(obs, search_obsdims[i:(i + 1)], rename = search_obsdims[i + 1])
      wt_obs <- MergeDims(wt_obs, search_obsdims[i:(i + 1)], rename = search_obsdims[i + 1])
    }
  }
  names(dim(obs))[which(names(dim(obs)) == search_obsdims[length(search_obsdims)])] <- 'time'  
  names(dim(wt_obs))[which(names(dim(wt_obs)) == search_obsdims[length(search_obsdims)])] <- 'time' 
  # Split 'time' dim in weather types
  obs <- SplitDim(obs, split_dim = 'time', indices = as.vector(wt_obs), new_dim_name='type')

  analog_vals <- Apply(list(exp, obs, wt_exp), target_dims = list(c(londim, latdim),
                                                          c(londim, latdim, 'time', 'type'), NULL),
               .analogs, method = method, thres = thres)$output1
  
  # Reshaping output:
  analog_vals <- Subset(analog_vals,along='type',indices=1,drop='selected')
  poslat <- which(names(dim(analog_vals)) == latdim)
  poslon <- which(names(dim(analog_vals)) == londim)
  postime <- which(names(dim(analog_vals)) == 'time') # Dimension with N analogs
  pos <- 1:length(dim(analog_vals))
  if (poslatexp > poslonexp){
      analog_vals <- aperm(analog_vals,c(pos[-c(poslon,poslat,postime)],postime,poslon,poslat))
  } else {
      analog_vals <- aperm(analog_vals,c(pos[-c(poslon,poslat,postime)],postime,poslat,poslon))
  }
  # Renaming 'time' dim to 'analog'
  names(dim(analog_vals))[which(names(dim(analog_vals)) == 'time')] <- 'analog' 
  return(analog_vals)
}


.analogs <- function(exp, obs, wt_exp, method = 'pattcorr', thres = NULL, 
                     londimexp = 'lon', latdimexp = 'lat', londimobs = 'lon', latdimobs = 'lat') {
  # exp: lon, lat
  # obs: lon, lat, time, wt
  # wt_exp: wt single scalar
  	
  search_analog <- switch(method, 'rain1' = .rain1, 'rain01' = .rain01, 
                          'pattcorr' = .pattcor, 
                          stop(paste0("Adamont Analog function supports methods ",
                                      "'rain1', 'rain01', 'pattcorr' only")))

  obs <- Subset(obs, along = 'type', indices = wt_exp)
  accuracy <- Apply(list(exp, obs), target_dims = list(c(londimexp, latdimexp),
                                                       c(londimobs, latdimobs)),
                    search_analog, thres = thres)$output1
  obs <- Subset(obs, along = 'time', indices = order(accuracy, decreasing = TRUE)[1:5])
  return(obs)
}

.rain1 <- function(exp_day, obs_day, thres) {
  accuracy <- sum((obs_day >= thres) * (exp_day >= thres))
  return(accuracy)
}
.rain01 <- function(exp_day, obs_day, thres) {
  accuracy <- sum(diag(table((obs_day >= thres),(exp_day >= thres))))
  return(accuracy)
}
.pattcor <- function(exp_day, obs_day, thres = NULL) {
  accuracy <- cor(as.vector(obs_day),as.vector(exp_day))
  return(accuracy)
}


