library(CSTools)
library(multiApply)
library(ClimProjDigas) # Subset function
exp <- lonlat_data$exp$data # dataset:1  member:15  sdate:6   ftime:3   lat:22     lon:53 
obs <- lonlat_data$obs$data # dataset:1  member:1   sdate:6   ftime:3   lat:22     lon:53 
wt_exp <- array(unlist(lapply(6 * 15, function(x) {sample(1:3)})), c(member = 15, sdate = 6, ftime = 3))
wt_obs <- array(unlist(lapply(6, function(x) {sample(1:3)})), c(member = 1, sdate = 6, ftime = 3))  
result <- AdamonAnalogs(exp, obs, wt_exp, wt_obs)
AdamonAnalogs <- function(exp, obs, wt_exp, wt_obs, method = 'rain1',
                          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
  # Reshaping obs:
  ## The dimensions were 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 = wt_obs)
  names(dim(obs))[which(names(dim(obs)) == 'monthly')] <- 'type'

  res <- Apply(list(exp, obs, wt_exp), target_dims = list(c(londim, latdim),
                                                          c(londim, latdim, 'time', 'type'), NULL),
               .analogs, method = method, thres = thres)$output1
}

# Example .analogs:
exp <- array(rnorm(6), c(lon = 2, lat = 3))
obs <- array(rnorm(6*20), c(lon = 2, lat = 3, time = 6, type = 4))
wt_exp = 3
analog <- .analogs(exp, obs, wt_exp)
.analogs <- function(exp, obs, wt_exp, method = 'rain1', 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' = .pttcor, 
                          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)
}
# Example accuracy:
exp_day <- array(rnorm(6), c(lon = 2, lat = 3))
obs_day <- array(rnorm(6), c(lon = 2, lat = 3))
thres = 0.1
.rain1(exp_day, obs_day, thres)
.rain01(exp_day, obs_day, thres)
.pattcor(exp_day, obs_day, thres)
.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)
}

