#' 
#' @title Creates 2-dimensional contingency tables - potentially disclosive data are suppressed
#' @description The function ds.table2d is a client-side wrapper function. It calls the server-side subfunction
#' table2d.ds to generate 2-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 two categories
#' that correspond to it are both changed to "-9". Each source is flagged as having only valid data, or at least some invalid data.
#' The function ds.table2d prints out counts, column percents, row percents, global percents and a chi-squared test
#' for homogeneity on (nc-1)*(nr-1) degrees of freedom where nc is the number of columns and nr is the number of rows.
#' These calaculations are done separately for each source and, in addition, all valid sources are combined to produce a single overarching 
#' contingency for all valid data collectively. 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
#' @param yvect a numerical vector with discrete values - usually a factor
#' @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 containing the following items (depending on the type of analysis specified -'combined' or 'split- some of these
#' items may not be returned): 
#' \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 subfunction table2d.ds on its own.}
#' \item{ALL.VALID.TABLES.BY.STUDY}{Counts, column percents, row percents and global percents for each study
#' separately (if separate.and.combined.studies=TRUE) and for all valid studies combined}
#' \item{CHI2.TESTS.FOR.HOMOGENEITY}{Chi-squared test for homogeneity, for each study
#' separately (if separate.and.combined.studies=TRUE) and for all valid studies combined}
#' \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}{If all.output.configurations=TRUE, cell counts, for each study
#' separately and for all valid studies combined}
#' \item{TABLES.VALID.DATA.COLUMN.PERCENTS}{If all.output.configurations=TRUE, column percents, for each study
#' separately and for all valid studies combined}
#' \item{TABLES.VALID.DATA.ROW.PERCENTS}{If all.output.configurations=TRUE, row percents, for each study
#' separately and for all valid studies combined}
#' \item{TABLES.VALID.DATA.GLOBAL.PERCENTS}{If all.output.configurations=TRUE, 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_DIAB", "DIS_CVA", "GENDER", "LAB_HDL")
#' opals  <-  datashield.login(logins=logindata,assign=TRUE,variables=myvar)
#' 
#' # Example 1: generate a two dimensional table, outputting combined contingency tables - default behaviour
#' ds.table2d(datasources=opals, xvect=quote(D$DIS_DIAB), yvect=quote(D$GENDER))
#' 
#' # Example 2: generate a two dimensional table, outputting study specific contingency tables
#' ds.table2d(datasources=opals, xvect=quote(D$DIS_DIAB), yvect=quote(D$GENDER), type="split")
#' 
#' # Example 3: generate a two dimensional table, outputting study specific contingency tables for the first two studies
#' ds.table2d(datasources=opals[1:2], quote(D$DIS_DIAB), quote(D$GENDER), type="split")
#' 
#' # Example 4: generate a two dimensional table, outputting combined contingency tables (in this case some studies are invalid)
#' ds.table2d(datasources=opals, quote(D$DIS_CVA), quote(D$GENDER))
#' 
#' # Example 5: generate a two dimensional table, outputting study specific contingency tables (in this case some studies are invalid)
#' ds.table2d(datasources=opals, quote(D$DIS_CVA), quote(D$GENDER), type="split")

#' # Example 6: generate a two 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 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, but ds.table2d 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.table2d(datasources=opals, quote(D$GENDER), quote(D$LAB_HDL))
#' ds.table2d(datasources=opals, quote(D$GENDER), quote(D$LAB_HDL), type="split")
#' }
#' 
ds.table2d <- function(datasources=NULL, xvect=NULL, yvect=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! 1st input vector is missing")
    message(" Please provide a valid numeric vector")
    stop(" End of process!", call.=FALSE)
  }
  
  if(is.null(yvect)){
    message(" ALERT! 2nd input vector is missing")
    message(" Please provide a valid numeric vector")
    stop(" End of process!", call.=FALSE)
  }
  
  # get the name of the input numerical variables
  # 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
  inputterms1 <- unlist(strsplit(deparse(xvect), "\\$", perl=TRUE))
  inputterms2 <- unlist(strsplit(deparse(yvect), "\\$", perl=TRUE))
  if(length(inputterms1) > 1){
    var.name.1 <- strsplit(deparse(xvect), "\\$", perl=TRUE)[[1]][2]
  }else{
    var.name.1 <- deparse(xvect)
  }
  if(length(inputterms2) > 1){
    var.name.2 <- strsplit(deparse(yvect), "\\$", perl=TRUE)[[1]][2]
  }else{
    var.name.2 <- deparse(yvect)   
  }
  
  # call the function that checks the variables are available and not empty
  vars2check  <-  list(xvect, yvect)
  datasources  <-  ds.checkvar(datasources, vars2check)
  
  # names of the studies 
  opals.names <- names(datasources)
  
  # number of studies to analyse
  numsources <- length(datasources)
  
 # call the server side function that produces a 2-dimensional table for each study
  cally <- call("table2d.ds", xvect, yvect)
  server.func.output <- datashield.aggregate(datasources, cally)  

  # call the 1st helper script to carry out validity checks on the study specific tables
  # returned by the 'table2d.ds'
  helper1out <- dsbaseclient:::table2dhelper1(server.func.output, var.name.1, var.name.2)
  zero.studies.valid <- helper1out$zero.studies.valid
  num.valid.studies <- helper1out$num.valid.tables
  opals.valid.id <- helper1out$opals.valid.id
  
  # call the 4th helper script to generate the final output
  # this function calls the helper 1, 2 and 3 functions that
  # generate all the key elements required to produce the final output
  helper4out <- dsbaseclient:::table2dhelper4(server.func.output, var.name.1, var.name.2)
  
  # return the right output depending what the user specified: 'combine' or 'split' analysis
  if(type=="combine"){
    # if the user specifies 'combined' analysis we output all the combines outputs but NOT the study specific outputs
    if(zero.studies.valid){
      output1 <- helper4out$VALIDITY.WARNING
      return(list("VALIDITY.WARNING"=output1))
    }else{
      output1 <- helper4out$TABLES.VALID.DATA.COUNTS
      output2 <- helper4out$TABLES.VALID.DATA.COLUMN.PERCENTS
      output3 <- helper4out$TABLES.VALID.DATA.ROW.PERCENTS
      output4 <- helper4out$TABLES.VALID.DATA.GLOBAL.PERCENTS
      output5 <- helper4out$CHI2.TESTS.FOR.HOMOGENEITY
      output6 <- helper4out$VALIDITY.WARNING
      
      # combined ouput is returned only if all the studies are valid
      outnames <- c(paste("COMBINED.VALID.DATA.COUNTS--",var.name.1," (rows) V ",var.name.2," (cols) ",sep=""),
                    paste("COMBINED.VALID.DATA.COLUMN.PERCENTS--",var.name.1," (rows) V ",var.name.2," (cols) ",sep=""),
                    paste("COMBINED.VALID.DATA.ROW.PERCENTS--",var.name.1," (rows) V ",var.name.2," (cols) ",sep=""),
                    paste("COMBINED.VALID.DATA.GLOBAL.PERCENTS--",var.name.1," (rows) V ",var.name.2," (cols) ",sep=""),
                    "CHI2.TESTS.FOR.HOMOGENEITY","VALIDITY.WARNING")    
      if(num.valid.studies==numsources){
        obj2return <- list(output1[,,numsources+1],output2[,,numsources+1],output3[,,numsources+1],
                           output4[,,numsources+1],output5,output6)
        
        names(obj2return) <- outnames
        return(obj2return)  
      }else{
        output1 <- helper4out$TABLES.VALID.DATA.COUNTS[,,num.valid.studies+1]
        output2 <- helper4out$TABLES.VALID.DATA.COLUMN.PERCENTS[,,num.valid.studies+1]
        output3 <- helper4out$TABLES.VALID.DATA.ROW.PERCENTS[,,num.valid.studies+1]
        output4 <- helper4out$TABLES.VALID.DATA.GLOBAL.PERCENTS[,,num.valid.studies+1]
        obj2return <- list(output1,output2,output3,output4,output5,output6)
        names(obj2return) <- outnames        
        return(obj2return)  
      }
    }
  }else{
     # if the user specifies 'split' analysis we output all the study specific outputs but NOT the combines outputs
    if(type=="split"){
      
      output1 <- helper4out$OPALS.DATA.OVERVIEW
      output2 <- helper4out$ALL.VALID.TABLES.BY.STUDY[,,,1:num.valid.studies]
      output3 <- helper4out$VALIDITY.WARNING  
      output4 <- helper4out$CHI2.TESTS.FOR.HOMOGENEITY
      
      if(zero.studies.valid){
        warning("NO STUDIES HAVE VALID DATA FOR '", var.name.1, "' OR '", var.name.2, "'", immediate.=TRUE, call.=FALSE)
        warning("NO ATTEMPT TO TABULATE INDIVIDUAL STUDIES", immediate.=TRUE, call.=FALSE)
      }else{
        if(num.valid.studies==numsources){
          return(list("OPALS.DATA.OVERVIEW"=output1, "ALL.VALID.TABLES.BY.STUDY"=output2, "VALIDITY.WARNING"=output3,
                      "CHI2.TESTS.FOR.HOMOGENEITY"=output4))
        }else{
          # amend the 'dimnames' to include only study names since we exclude 'combined' result in the line above
          dnames <- dimnames(output2)
          valid.studies.names <- opals.names[which(opals.valid.id==1)]
          for(i in 1:num.valid.studies){
            for(j in 1:4){
              dnames[3][[1]][j] <- paste(dnames[3][[1]][j], "--",valid.studies.names[i], sep="")
            }
          }
          dimnames(output2) <- dnames
          return(list("OPALS.DATA.OVERVIEW"=output1, "ALL.VALID.TABLES.BY.STUDY"=output2, "VALIDITY.WARNING"=output3,
                      "CHI2.TESTS.FOR.HOMOGENEITY"=output4))
        }
      }
    }else{
      stop('Function argument "type" has to be either "combine" or "split"')
    }
  }
} 

