# err: error range around mean, median and clim
# perc: probability threshold to decide if a event is forecasted
# perc_lim: TRUE use perc to compute the error limits. If false, use the error.
Contingency <- function(exp, obs, err = 1,
                        method = 'mean',
                        prob = 0.6, perc_lim = TRUE,
                        sdate_dim = 'syear', memb_dim = 'ensemble',
                        years = 1993:2016, plot = FALSE,
                        ncores = 1) {
  if (method != 'climatology') {
    result <- Apply(list(exp, obs),
                    target_dims = list(memb_dim, NULL),
                    fun = contingency, perc_lim = perc_lim,
                    err = err, prob = prob, method = method,
                    ncores = ncores)
  } else {
    #obs_clim <- InsertDim(obs, len = dim(obs)[sdate_dim],
    #                      pos = 1, name = 'cross')
    result <- Apply(list(obs, obs),
                    target_dims = list(sdate_dim, NULL),
                    fun = contingency, method = 'clim',
                    perc_lim = perc_lim,
                    err = err, prob = prob,
                    ncores = ncores)
  } 
  total <- Apply(list(result$hit, result$falseA,
                        result$miss, result$correctR),
                   target_dims = sdate_dim,
                   fun = function(a,b,c,d) {
                          list(hit = sum(a), falseA = sum(b),
                               miss = sum(c), correctR = sum(d))},
                   ncores = ncores)
  metrics <- Apply(total, target_dims = NULL,
                   function (a, b, c, d, n_obs) {
                   list(bias_score = (a + b)/(a + c),
                      hit_rate = a/(a + c),
                      fa_rate = b/(a + b),
                      accuracy = (a + d)/n_obs)},
                   n_obs = dim(obs)[sdate_dim], ncores = ncores)



return(list(prediction = list(deterministic = result$ens_ref,
                              sup_lim = result$sup,
                              inf_lim = result$inf),
            probs = list(lowercat = result$prob_lowercat, 
                         cat = result$prob_cat,
                         uppercat = result$prob_uppercat),
            scores = total,
            metrics = metrics))
}
#r <- 1
#if(r == 3) {
#  if (plot) {
#    png(paste0("../hist/hist_SEAS51_tas_s", years[year], "ftime1.png"),
#        width = 700, height = 700)
#    hist(exp[year,], main = paste("sdate:", years[year]),
#         xlab = "tas (C)", ylim = c(0, 16), xlim = c(1,9),
#         breaks = seq(1,9, 1))
#         points(obs[year], 0.7, col = 'red', cex = 4)
#    points(obs[year], 0.7, col = 'red', cex = 4, pch = 3)
#    abline(v = clim, col = 'purple', lwd = 2, lty = 2)
#    abline(v = mean(exp[year,]), col = 'darkblue', lwd = 2, lty = 2)
#    abline(v = median(exp[year,]), col = 'green', lwd = 2, lty = 2)
#    legend('topleft', c(paste('Mean', round(mean(exp[year,]),2)),
#                      paste('Median', round(median(exp[year,]),2)),
#                      paste('Clim', round(clim, 2)),
#                      'Individual members',
#                      paste('Obs', round(obs[year], 2))),
#           bty = 'n', lty = c(2,2,2,NA,1),
#           col = c('darkblue', 'green', 'purple', 'black', 'red'),
#           pch = c(NA, NA, NA, 1, 1))
#    points(exp[year,], y = rep(1,25))
#    text(8.5, 15, paste("+/- 1 Mean", round(perc_mean, 1), "%")) 
#    text(8.5, 14, paste("+/- 1 Median", round(perc_median, 1), "%"))
#    text(8.5, 13, paste("+/- 1 Clim", round(perc_clim, 1), "%"))
#    dev.off()
#  }
#
#}

contingency <- function(exp, obs, method = 'mean',
                        perc_lim = T, err = 1, prob = 0.6) {
# exp [ensemble]
# obs # 1 number
n_ens <- length(exp)
   if (method == 'mean') {
     ens_ref <- mean(exp)
   } else if (method == 'median') {
     ens_ref <- median(exp) 
   } else if (method == 'clim') {
     # cross validation: leave out the observation to compute the clim
     ens_ref <- mean(exp[-which(exp == obs)[1]])
   } else {
     stop("Unknown method")
   }
    if (!perc_lim) {
      sup <- ens_ref + err
      inf <- ens_ref - err
    } else {
      nevents <- ceiling(n_ens * prob)
      pos <- sapply(sort(abs(exp - ens_ref))[1:nevents],
                    function(x) { which(x == abs(exp - ens_ref))})
      if (is.list(pos)) { pos <- unlist(pos)}
      sup <- max(exp[pos])
      inf <- min(exp[pos])
    }
    # target category:
    nmemb <- length(which(exp >= inf & exp <= sup))
    perc <- nmemb * 100 / n_ens
    
    # lower category:
    cat_low <- length(which(exp < inf)) * 100 / n_ens
    # upper category:
    cat_up <- length(which(exp > sup)) * 100 / n_ens

    score <- ifelse(obs >= inf & obs <= sup, 1, 0)
    if (!perc_lim) {
      hit <- ifelse(perc >= prob * 100 & score == 1, 1, 0)
      falseA <- ifelse(perc >= prob * 100 & score == 0, 1, 0)
      miss <- ifelse(perc < prob * 100 & score == 1, 1, 0)
      correctR <- ifelse(perc < prob * 100 & score == 0, 1, 0)
    } else {
      hit <- ifelse(sup - inf < err * 2 & score == 1, 1, 0)
      falseA <- ifelse(sup - inf < err * 2 & score == 0, 1, 0)
      miss <- ifelse(sup - inf >= err * 2 & score == 1, 1, 0)
      correctR <-ifelse(sup - inf >= err * 2 & score == 0, 1, 0)
    }
  return(list(ens_ref = ens_ref, sup = sup, inf = inf,
              prob_lowercat = cat_low, prob_cat = perc, prob_uppercat = cat_up,
              score = score,
              hit = hit, falseA = falseA, miss = miss,
              correctR = correctR))
}

 




#saveRDS(list(biases = biases, pvals = pvals), file = 'bias_results.RDS')


