library(s2dv)
library(rbenchmark)
library(compiler)
library(multiApply)

.Regression <- cmpfun(s2dv:::.Regression)
Regression <- function(datay, datax, reg_dim = 'sdate', formula = y ~ x, 
                       pval = TRUE, conf = TRUE, conf.lev = 0.95,
                       na.action = na.omit, ncores = NULL) {

  # Check inputs 
  ## datay and datax
  if (is.null(datay) | is.null(datax)) {
    stop("Parameter 'datay' and 'datax' cannot be NULL.")
  }
  if (!is.numeric(datay) | !is.numeric(datax)) {
    stop("Parameter 'datay' and 'datax' must be a numeric array.")
  }
#  if (is.null(dim(datay)) | is.null(dim(datax))) {
#    stop("Parameter 'datay' and 'datax' must be at least one dimension 'reg_dim'.")
#  }
  if (is.null(dim(datay))) {  #is vector
    dim(datay) <- c(length(datay))
    names(dim(datay)) <- reg_dim
  }
  if (is.null(dim(datax))) {  #is vector
    dim(datax) <- c(length(datax))
    names(dim(datax)) <- reg_dim
  }
  if(any(is.null(names(dim(datay))))| any(nchar(names(dim(datay))) == 0) |
     any(is.null(names(dim(datax))))| any(nchar(names(dim(datax))) == 0)) {
    stop("Parameter 'datay' and 'datax' must have dimension names.")
  }
  if(!all(names(dim(datay)) %in% names(dim(datax))) | 
     !all(names(dim(datax)) %in% names(dim(datay)))) {
    stop("Parameter 'datay' and 'datax' must have same dimension name")
  }
  name_datay <- sort(names(dim(datay)))
  name_datax <- sort(names(dim(datax)))
  if(!all(dim(datay)[name_datay] == dim(datax)[name_datax])) {
    stop("Parameter 'datay' and 'datax' must have same length of all dimensions.")
  }
  ## reg_dim
  if (!is.character(reg_dim) | length(reg_dim) > 1) {
    stop("Parameter 'reg_dim' must be a character string.")
  }
  if (!reg_dim %in% names(dim(datay)) | !reg_dim %in% names(dim(datax))) {
    stop("Parameter 'reg_dim' is not found in 'datay' or 'datax' dimension.")
  }
  ## formula
  if (class(formula) != 'formula') {
    stop("Parameter 'formula' must the an object of class 'formula'.")
  }
  ## pval
  if (!is.logical(pval) | length(pval) > 1) {
    stop("Parameter 'pval' must be one logical value.")
  }
  ## conf
  if (!is.logical(conf) | length(conf) > 1) {
    stop("Parameter 'conf' must be one logical value.")
  }
  ##conf.lev
  if (!is.numeric(conf.lev) | conf.lev < 0 | conf.lev > 1 | length(conf.lev) > 1) {
    stop("Parameter 'conf.lev' must be a numeric number between 0 and 1.")
  }
  ## na.action
  if (!is.function(na.action) & !is.numeric(na.action)) {
      stop(paste0("Parameter 'na.action' must be a function for NA values or ",
                  "a numeric indicating the number of NA values allowed ",
                  "before returning NA."))
  }
  if (is.numeric(na.action)) {
    if (any(na.action %% 1 != 0) | any(na.action < 0) | length(na.action) > 1) {
      stop(paste0("Parameter 'na.action' must be a function for NA values or ",
                  "a numeric indicating the number of NA values allowed ",
                  "before returning NA."))
    }
  }
  ## ncores
  if (!is.null(ncores)) {
    if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores < 0 |
      length(ncores) > 1) {
      stop("Parameter 'ncores' must be a positive integer.")
    }
  } 

  ###############################
  # Sort dimension
  name_datay <- names(dim(datay))
  name_datax <- names(dim(datax))
  order_datax <- match(name_datay, name_datax)
  datax <- Reorder(datax, order_datax)


  ###############################
  # Calculate Regression
    if (conf & pval) {
    output_dims <- list(regression = 'stats', conf.lower = 'stats',
                        conf.upper = 'stats', p.val = NULL, filtered = reg_dim)
  } else if (conf & !pval) {
    output_dims <- list(regression = 'stats', conf.lower = 'stats',
                        conf.upper = 'stats', filtered = reg_dim)
  } else if (!conf & pval) {
    output_dims <- list(regression = 'stats',
                        p.val = NULL, filtered = reg_dim)
  } else if (!conf & !pval) {
    output_dims <- list(regression = 'stats', filtered = reg_dim)
  }
  
  res <- Apply(list(datay, datax), 
               target_dims = reg_dim, 
               output_dims = output_dims,
               fun = .Regression, 
               formula = formula, pval = pval, conf = conf,
               conf.lev = conf.lev, na.action = na.action, 
               ncores = ncores)

  return(invisible(res))
}
Comp_Regression <- cmpfun(s2dv::Regression)
Comp_Regression_s2dverification <- cmpfun(s2dverification::Regression)
# Test:
enableJIT(0)
benchmark("s2dverification::Regression" = {
            datax <- CSTools::lonlat_data$obs$data
            datay <- s2dverification::Subset(CSTools::lonlat_data$exp$data,
                                             along = 'member', 1)
            res_Regression <- s2dverification::Regression(datay, datax)
          },
          "Comp_s2dverification::Regression" = {
            datax <- CSTools::lonlat_data$obs$data
            datay <- s2dverification::Subset(CSTools::lonlat_data$exp$data,
                                             along = 'member', 1)
            res_Regression <- Comp_Regression_s2dverification(datay, datax)
          },
          "s2dv::Regression" = {
            datax <- CSTools::lonlat_data$obs$data
            datay <- s2dverification::Subset(CSTools::lonlat_data$exp$data,
                                             along = 'member', 1)
            res_Regression <- s2dv::Regression(datay, datax, conf.lev = 0.9)
          },
          "s2dv:_Comp_.Regression" = {
            datax <- CSTools::lonlat_data$obs$data
            datay <- s2dverification::Subset(CSTools::lonlat_data$exp$data,
                                             along = 'member', 1)
            res_Regression <- Regression(datay, datax, conf.lev = 0.9)
          },
          "s2dv::Comp_Regression" = {
            datax <- CSTools::lonlat_data$obs$data
            datay <- s2dverification::Subset(CSTools::lonlat_data$exp$data,
                                             along = 'member', 1)
            res_Regression <- Comp_Regression(datay, datax,
                                                      conf.lev = 0.9)
          },

          replications = 10,
          columns = c("test", "replications", "elapsed",
                      "relative", "user.self", "sys.self"))


