plot-univar

## throw RApache errors
## setContentType("text/html")
RApacheOutputErrors(TRUE)               # comment/set to FALSE in stable release

## set working directory
## setwd("/srv/http/univar/")              # for Arch, Fedora/CentOS
setwd("/var/www/univar/")               # for Debian/Ubuntu

## generate plot name here!



## custom distribution functions

## hypergeometric distribution
rHyper <- function(n, white, total, k) {
  rhyper(n, white, total - white, k)
}
dHyper <- function(x, white, total, k) {
  dhyper(x, white, total - white, k)
}
pHyper <- function(q, white, total, k) {
  phyper(q, white, total - white, k)
}

## normal distribution
rNorm <- function(n, mean, var) {
  rnorm(n, mean, sqrt(var))
}
dNorm <- function(x, mean, var) {
  dnorm(x, mean, sqrt(var))
}
pNorm <- function(q, mean, var) {
  pnorm(q, mean, sqrt(var))
}

## discrete uniform distribution
rUnifD <- function(n, min, max) {
  round(runif(n, min, max))
}
dUnifD <- function(x, min, max) {
  round(dunif(x, min, max))
}
pUnifD <- function(q, min, max) {
  round(punif(q, min, max))
}

## form validation function  
formValidate <- function(POST) {

  nms <- names(POST)                    # form input names
  txt_inputs <- c("distname", "disttype", "plottype") # textual form inputs
  num_inputs <- setdiff(nms, txt_inputs)              # numerical form inputs

  re_num <- "^(-|\\+)?([0-9]+(\\.[0-9]+)?|Inf)$" # numeric regexp

  dist_discrete <- c("binom", "geom", "Hyper", "nbinom", "pois", "UnifD") # discrete distributions
  dist_continuous <- c("beta", "cauchy", "chisq", "exp", "f", "gamma", "logis", "lnorm", "Norm", "t", "unif", "weibull") # continuous distributions
  dist_names <- c(dist_discrete, dist_continuous) # supported distributions

  dist_types <- c("r", "d", "p")                                    # random/density/cumulative distribution

  plot_types <- c("p", "l", "o", "b", "h", "s", "boxplot", "hist", "density", "ecdf") # supported plots
  plot_random <- c("boxplot", "hist", "density", "ecdf") # (pseudo)random specific plots

  ## distribution parameters
  dist_params <- list(
                      beta = c("shape1", "shape2"),
                      binom = c("size", "prob"),
                      cauchy = c("location", "scale"),
                      chisq = "df",
                      exp = "rate",
                      f = c("df1", "df2"),
                      gamma = c("shape", "scale"),
                      geom = "prob",
                      Hyper = c("white", "total", "k"),
                      logis = c("location", "scale"),
                      lnorm = c("meanlog", "sdlog"),
                      nbinom = c("size", "prob"),
                      Norm = c("mean", "var"),
                      pois = "lambda",
                      t = "df",
                      UnifD= c("min", "max"),
                      unif = c("min", "max"),
                      weibull = c("shape", "scale")
                      )

  major_param_names <- c("n", dist_params[[POST$distname]]) # get distribution parameters' names
  minor_param_names <- setdiff(num_inputs, major_param_names) # get minor parameters' names
  
  ## check empty inputs
  if (any(sapply(POST, is.null))) {
    stop("Submitted empty inputs!")
  }

  ## check distribution names
  if (!POST$distname %in% dist_names) {
    stop("Unknown distribution!")
  }

  ## check distribution types
  if (!POST$disttype %in% dist_types) {
    stop("Unknown distribution type!")
  }

  ## check plot type
  if (!POST$plottype %in% plot_types) {
    stop("Unknown plot type!")
  }
  ## check distribution type specific plots
  ## boxplot, histogram, density and ecdf not available for pdf/cdf
  if (POST$disttype != "r" & POST$plottype %in% plot_random) {
    stop("Invalid plot type!")
  }

  ## check POST parameters
  args <- c(minor_param_names, major_param_names, txt_inputs) # d/p*** distribution inputs
  ## check for a perfect match
  if (!setequal(nms, args)) {
    stop("Unknown form inputs!")
  }

  ## check numeric
  if (all(sapply(POST[num_inputs], grepl, pattern = re_num))) {
    POST[num_inputs] <- lapply(POST[num_inputs], as.numeric) # convert to numeric
  } else {
    stop("Submitted non-numeric values!")
  }


  ## THIS IS WHERE ACTUALL STUFF HAPPENS ##

  major_param_list <- POST[major_param_names] # major parameters list (distribution parameters with n/x/q)
  minor_param_list <- POST[minor_param_names] # minor parameters list (seed / from,to)
  
  names(major_param_list)[1] <- switch(POST$disttype, d = "x", p = "q", "n") # convert 'n' for d/p*** compatibility
  dname <- paste(POST$disttype, POST$distname, sep = "") # name for r/d/p*** R distribution function
  if (length(minor_param_names)) {
    minor_name <- paste(minor_param_names, minor_param_list, "_", sep = "", collapse = "_")
  } else {
    minor_name <- NULL
  }

  ## generate plot name
  ## <plottype>@<disttype+distname>_<major params>_<minor params>.png
  ## b@dgamma_from0_to20_n100_shape1_scale2.png

  plot_name <- with(POST,
                    paste(
                          paste(plottype, "@", tolower(dname), sep = ""),
                          "_",
                          minor_name,
                          paste(names(major_param_list), major_param_list, sep = "", collapse = "_"),
                          ".png",
                          sep = ""
                          )
                    )
  
  ## generate random var
  if (POST$disttype == "r") {
    set.seed(POST$seed)                 # set random seed (no shit?)
    x <- do.call(dname, major_param_list) # generate (pseudo)random variable
    ## y <- NULL
    ## plot
    genPlot(x, NULL, POST$plottype, plot_name, main = "")
  } else {
    if (POST$distname %in% dist_discrete) {
      x <- 0:POST$n
      major_param_list[[1]] <- x
    } else {
      if (POST$distname == "beta") {
        x <- seq(0, 1, length.out = POST$n) # x = (0, 1)
      } else {
        x <- with(POST, seq(from, to, length.out = POST$n))
      }
      major_param_list[[1]] <- x
    }
    y <- do.call(dname, major_param_list)
    ## plot
    genPlot(x, y, POST$plottype, plot_name, main = "")
  }
}

genPlot <- function(x, y, plot_type, plot_name, ...) {
  fp <- file.path("img", plot_name)     # set file path
  ## don't re-plot the graph
  if (!file.exists(fp)) {
    png(fp)
    switch(plot_type,
           boxplot = boxplot(x, horizontal = TRUE, pch = 19, ...),
           hist = (function() {
             hist(x, pch = 19, ...)
             box()
           })(),
           density = plot(density(x), ...),
           ecdf = plot(ecdf(x), pch = 19, ...),
           plot(x, y, type = plot_type, pch = 19, ...)
           )
    ## subtitle with plot parameters?
    dev.off()
  }
  cat(toJSON(c(plot = fp)))             # return JSON with plot path
}
                    
errFn <- function(e) {
  cat(toJSON(c(error = e$message, plot = ""))) # throw an error
}

tryCatch(formValidate(POST), error = errFn)

## set execution limit
## set sample size limit through options() ??? or hardcode it?