source("/esarchive/scratch/nperez/git/s2dv/R/ProbBins.R")
library(tictoc); library(multiApply)
library(profvis)
# General case, Full Period:
data <- array(1:480, c(member = 10, sdate = 6, ftime = 4, lon = 2))
thr <- c(0.3, 0.6)
quantile = TRUE
len = 'all'
compPeriod = "Full period"
tic()
res <- ProbBins_new(data, len, thr, quantile, compPeriod = compPeriod,
                ncores = 1)
toc()
Enlarge <- s2dverification::Enlarge
library(abind)
tic()
res2 <- ProbBins(data, fcyr = len, thr, quantile, compPeriod = compPeriod,
                posdim = 1, posdates = 2)
toc()
all(res2 == s2dv::Reorder(res, c(3,1,2,4,5)))

# General case, Without fcyr:
compPeriod = "Without fcyr"
tic()
res <- ProbBins_new(data, len, thr, quantile, compPeriod = compPeriod,
                ncores = 8)
toc()
tic()
res2 <- ProbBins(data, fcyr = len, thr, quantile, compPeriod = compPeriod,
                posdim = 1, posdates = 2)
toc()
sum(!is.na(res2)) # empty result and the new version fails
# General case, Without fcyr, working case:
compPeriod = "Without fcyr"
tic()
res <- ProbBins_new(data, len = 1, thr, quantile, compPeriod = compPeriod,
                ncores = 8)
toc()
tic()
res2 <- ProbBins(data, fcyr = 1, thr, quantile, compPeriod = compPeriod,
                posdim = 1, posdates = 2)
toc()
all(res2 == s2dv::Reorder(res, c(3,1,2,4,5)))
# General case, Cross Validation:
compPeriod = "Cross-validation"
tic()
res <- ProbBins_new(data, len = 1, thr, quantile, compPeriod = compPeriod,
                ncores = 8)
toc()
tic()
res2 <- ProbBins(data, fcyr = 1, thr, quantile, compPeriod = compPeriod,
                posdim = 1, posdates = 2)
toc()
all(res2[,,,,,1,1,1] == s2dv::Reorder(res, c(3,1,2,4,5))[,1,,,])



#------------
data <- array(1:10, c(time = 10))
thres <- array(c(3, 6), c(bin = 2))
test1 <- .bin(data, thres)
.bin <- function(data, thres) {
  res <- 1 * (data <= thres[1])
  if (length(thres) > 1) {
    for (i in 2:length(thres)) {
      res <- c(res, 1 * ((data > thres[i - 1]) & (data <= thres[i])))
    }
  }
  res <- c(res, 1 * (data > thres[length(thres)]))
  dim(res) <- c(dim(data), bin = length(thres) + 1)
  res <- s2dv::Reorder(res, c('bin', names(dim(data))))
  return(res)
}
ano  <- array(1:20, c(member = 2, time = 5, posdate = 2))
posdates = 3
posdim = 2
thr = c(0.3, 0.6)
fcyr = 'all'
 nbdim <- length(dim(ano))

  if (nbdim < 7){
    ano <- s2dverification::Enlarge(ano, 7)
  }
  posdim <- setdiff(posdim, posdates)
  nbpos <- length(posdim)
  #permute dimensions in ano
  if (posdates != 1 || posdim != 2) {
    dimnames_backup <- names(dim(ano))
    perm <- c(posdates, posdim, (1:7)[-c(posdates, posdim)])
    ano <- aperm(ano, perm)
    names(dim(ano)) <- dimnames_backup[perm]
    posdates <- 1
    posdim <- 2
  }
  dimano <- dim(ano)
  nsdates <- dimano[1]
  #calculate the number of elements on posdim dimension in ano
  nmemb <- 1
  if (nbpos > 0){
    for (idim in 2:(nbpos+1)){
      nmemb <- nmemb*dimano[idim]
    }
  }

  if (length(fcyr) == 1) {
    if (fcyr == 'all') {
      fcyr <- 1:nsdates
    }
  }
  nfcyr <- length(fcyr)

   fore <- array(ano[fcyr, , , , , , ], dim = c(nfcyr,
                                                 dimano[2:7]))
    # the members and startdates are combined in one dimension
    sample_fore <- array(fore, dim=c(nfcyr*nmemb, dimano[(nbpos+2):7]))
     hind <- ano
      sample <- array(hind, dim=c(nsdates*nmemb, dimano[(nbpos+2):7]))
    
 qum <- apply(sample, seq(2,7-nbpos,1), FUN=quantile,probs=thr,na.rm=TRUE,names=FALSE,type=8)         


qum <- apply(dat, 1, FUN = quantile, probs = c(0.3, 0.6),
            na.rm = TRUE, names = FALSE, type=8)   

   counts <- function (dat, nbthr){
      thr <- dat[1:nbthr]
      data <-  dat[nbthr+1:(length(dat)-nbthr)]
      prob <- array(NA, dim=c(nbthr+1, length(dat)-nbthr))
      prob[1,]=1*(data <= thr[1])
      if(nbthr!=1){
        for (ithr in 2:(nbthr)){
          prob[ithr,]=1*((data > thr[ithr - 1]) & (data <= thr[ithr]))
        }
      }
      prob[nbthr+1,]=1*(data > thr[nbthr])
      return(prob) 
    }

