#' 
#' @title Creates 1-dimensional contingency tables - potentially disclosive data are suppressed
#' @description The functionds.table1d is a client-side wrapper function. It calls the server-side subfunction
#'table1d.ds to generate 1-dimensional tables for all data sources. Valid (non-disclosive) data are defined
#' as data from sources where no table cells have counts between 1 and 4 (the upper value [4] can in principle be changed but only by
#' rewriting the underlying function - it cannot be changed by a standard DataSHIELD user). If the count in any cell
#' in the table produced by a given data source IS invalid, that cell count is changed to "-1" and the name of the category in
#' which it falls is changed to "-9". Each source is flagged as having only valid data, or at least some invalid data.
#' The functionds.table1d prints out tables of study against xvect category detailing: counts; column percents; row percents; 
#' and global percents. The final column represents all valid studies combined. Missing data are treated as na.action=na.omit (default for table function), if missing data are to be treated as
#' a separate and visible category, the variable should first be transformed to convert NAs to the a new value.
#' @param datasources a list of opal object(s) obtained after login in to opal servers;
#' these objects hold also the data assign to R, as \code{dataframe}, from opal datasources. 
#' @param xvect a numerical vector with discrete values - usually a factor
#' as well as the tables representing only the valid data. If TRUE then only outputs the valid data.
#' @param type a character which represent the type of graph to display. 
#' If \code{type} is set to 'combine', a histogram that merges the single 
#' plot is displayed. Each histogram is plotted separately if If \code{type} 
#' is set to 'split'.
#' @return A list object (eg. named out.obj) containing the following items:
#' \item{OPALS.DATA.OVERVIEW}{For each study contains $study.name (ie name of study), $is.table.valid (TRUE if all cells valid otherwise FALSE),
#' $safe.table (the safe contingency table that contains all cells if all are valid, but otherwise obscures invalid cells
#' by outputting a cell count of "-1" and making the two category indicators for that cell = "-9". In other words
#' OPALS.DATA.OVERVIEW provides the information generated by the server side subfunctiontable1d.ds on its own.}
#' \item{VALIDITY.WARNING - IF NEEDED}{Either reports that all studies are valid, or else lists the studies that
#' contain at least one cell that is invalid, or else reports "NO STUDIES HAVE VALID DATA - SO NO ATTEMPT TO COMBINE"}
#' \item{TABLES.VALID.DATA.COUNTS}{Cell counts, for each study separately and for all valid studies combined}
#' \item{TABLES.VALID.DATA.COLUMN.PERCENTS}{Column percents, for each study separately and for all valid studies combined}
#' \item{TABLES.VALID.DATA.ROW.PERCENTS}{Row percents, for each study separately and for all valid studies combined}
#' \item{TABLES.VALID.DATA.GLOBAL.PERCENTS}{Global percents, for each study separately and for all valid studies combined}
#' @author Burton, P.; Gaye, A.
#' @export
#' @examples 
#' {
#' # load the file that contains the login details
#' data(logindata)
#' 
#' # login and assign the required variables to R
#' myvar  <-  list("DIS_CVA","LAB_HDL")
#' opals  <-  datashield.login(logins=logindata,assign=TRUE,variables=myvar)
#' 
#' # Example 1: generate a one dimensional table, outputting combined contingency tables
#' ds.table1d(datasources=opals, xvect=quote(D$DIS_CVA))
#' 
#' # Example 2: generate a one dimensional table, outputting study specific contingency tables
#' ds.table1d(datasources=opals, xvect=quote(D$DIS_CVA), type="split")
#' 
#' # Example 3: generate a one dimensional table, outputting study specific contingency tables for study 1 and 2
#' ds.table1d(datasources=opals[1:2], xvect=quote(D$DIS_CVA), type="split")
#'  
#' # Example 4: generate a one dimensional table, outputting study specific and combined contingency tables, see what happens if
#' # you try to tabulate a quantitative variable with unique values for many individuals. The standard \code{table} function in R would print out
#' # all observed 'values' as category names in ascending order with a count (generally 1) for each unique number, butds.table1d prints
#' # out all values where there are between 1 and 4 observations as -1 and gives the category name -9. It is only when the count is 
#' # 5 or more that the actual value can be observed, and then it is non-disclosive 
#' ds.table1d(datasources=opals, xvect=quote(D$LAB_HDL)) 
#' }
#'
ds.table1d <- function(datasources=NULL, xvect=NULL, type="combine")
{ 
  # stop process and display error message if no 'opals' or input numerical vector is provided
  if(is.null(datasources)){
    message(" ALERT!")
    message(" No valid opal object(s) provided.")
    message(" Make sure you are logged in to valid opal server(s).")
    stop(" End of process!", call.=FALSE)
  }
  
  if(is.null(xvect)){
    message(" ALERT!")
    message(" Please provide a valid numeric vector")
    stop(" End of process!", call.=FALSE)
  }
  
  # get the name of the input numerical variable
  # the input variable might be given as column table (i.e. D$xvect)
  # or just as a vector not attached to a table (i.e. xvect)
  # we have to make sure the function deals with each case
  inputterms <- unlist(strsplit(deparse(xvect), "\\$", perl=TRUE))
  if(length(inputterms) > 1){
    variable <- strsplit(deparse(xvect), "\\$", perl=TRUE)[[1]][2]
  }else{
    variable <- deparse(xvect)
  }
  
  # call the function that checks the variables are available and not empty
  vars2check  <-  list(xvect)
  datasources  <-  ds.checkvar(datasources, vars2check)
  
  # names of the studies 
  opals.names <- names(datasources)
  
  # call the server side function that produces a 1-dimensional table for each study
  cally <- call("table1d.ds", xvect)
  server.func.output <- datashield.aggregate(datasources, cally)
  
  # verify that all the studies are not invalid i.e. all studies have input factor variable with counts > 0 and < 
  validity.checks <- dsbaseclient:::table1dhelper1(server.func.output)
  zero.studies.valid <- validity.checks$zero.studies.valid
  num.valid.tables <- validity.checks$num.valid.tables
  
  # call the internal function that processes the ouput of the server side function
  helper4out  <- dsbaseclient:::table1dhelper4(server.func.output)

  # return the right output depending what the user specified: 'combine' or 'split' analysis
  if(type=="combine"){
    if(zero.studies.valid){
      output1 <- helper4out$VALIDITY.WARNING
      return(list("VALIDITY.WARNING"=output1))
    }else{
      output1 <- helper4out$TABLE.VALID.DATA.COUNTS
      output2 <- helper4out$TABLE.VALID.DATA.COLUMN.PERCENTS
      output3 <- helper4out$TABLE.VALID.DATA.ROW.PERCENTS
      output4 <- helper4out$TABLE.VALID.DATA.GLOBAL.PERCENTS
      output5 <- helper4out$VALIDITY.WARNING
      outnames <- c(paste("TOTAL.VALID.DATA.COUNTS for variable ", variable,sep=""),
                    paste("TOTAL.VALID.DATA.COLUMN.PERCENTS for variable ", variable,sep=""),
                    paste("TOTAL.VALID.DATA.ROW.PERCENTS for variable ", variable,sep=""),
                    paste("TOTAL.VALID.DATA.GLOBAL.PERCENTS for variable ", variable,sep=""),
                    "VALIDITY.WARNING")   
      obj2return <- list(output1,output2,output3,output4,output5)
      names(obj2return) <- outnames
      return(obj2return)
    }    
  }else{
    if(type=="split"){
      if(zero.studies.valid){
        # we do not want to return the 'safe.table' here as if the input variable is a continuous 
        # variable, the 'safe.table' will fill up the screen and mask mask the rest of the output. 
        # So here we remove the 'safe.tables' from the ouput 'OPALS.DATA.OVERVIEW'.
        xx <- which(names(helper4out$OPALS.DATA.OVERVIEW) == "safe.table")
        output1 <- helper4out$OPALS.DATA.OVERVIEW[-c(xx)]
        output2 <- "NO STUDIES HAVE VALID DATA!"
        return(list("OPALS.DATA.OVERVIEW"=output1,"VALIDITY.WARNING"=output2))
      }else{
        outnames <- c("OPALS.DATA.OVERVIEW",
                      paste("TABLE.VALID.DATA.COUNTS for variable ", variable,sep=""),
                      paste("TABLE.VALID.DATA.COLUMN.PERCENTS for variable ", variable,sep=""),
                      paste("TABLE.VALID.DATA.ROW.PERCENTS for variable ", variable,sep=""),
                      paste("TABLE.VALID.DATA.GLOBAL.PERCENTS for variable ", variable,sep=""),
                      "VALIDITY.WARNING") 
        if(num.valid.tables > 1){
          numcols2output <- num.valid.tables
          output1 <- helper4out$OPALS.DATA.OVERVIEW
          output2 <- helper4out$TABLE.VALID.DATA.COUNTS[,1:numcols2output]
          output3 <- helper4out$TABLE.VALID.DATA.COLUMN.PERCENTS[,1:numcols2output]
          output4 <- helper4out$TABLE.VALID.DATA.ROW.PERCENTS[,1:numcols2output]
          output5 <- helper4out$TABLE.VALID.DATA.GLOBAL.PERCENTS[,1:numcols2output]
          output6 <- helper4out$VALIDITY.WARNING
          obj2return <- list(output1,output2,output3,output4,output5,output6)
        }
        if(num.valid.tables == 1){
          numcols2output <- 1
          colslabels <- colnames(helper4out$TABLE.VALID.DATA.COUNTS)[1]
          output1 <- helper4out$OPALS.DATA.OVERVIEW
          output2 <- as.data.frame(helper4out$TABLE.VALID.DATA.COUNTS[,1:numcols2output])
          colnames(output2) <- colslabels
          output3 <- as.data.frame(helper4out$TABLE.VALID.DATA.COLUMN.PERCENTS[,1:numcols2output])
          colnames(output3) <- colslabels
          output4 <- as.data.frame(helper4out$TABLE.VALID.DATA.ROW.PERCENTS[,1:numcols2output])
          colnames(output4) <- colslabels
          output5 <- as.data.frame(helper4out$TABLE.VALID.DATA.GLOBAL.PERCENTS[,1:numcols2output])
          colnames(output5) <- colslabels
          output6 <- helper4out$VALIDITY.WARNING 
          obj2return <- list(output1,output2,output3,output4,output5,output6)
        }
        names(obj2return) <- outnames
        return(obj2return)         
      }
    }else{
      stop('Function argument "type" has to be either "combine" or "split"')
    }
  }
}
