#' Make a table from HexSimR results
#'
#' \code{make.table} reads the result files generated by HexSimR and compiles a
#' table after having rounded the decimal digits.
#'
#' \code{make.table} can process either descriptive statistics (generated using
#' \code{collate.census}, \code{ranges} or \code{move}) or statistical
#' comparisons generated using \code{SSMD.census}, \code{SSMD.ranges} or
#' \code{SSMD.move}), but only one type of result in any one time. For each run
#' of \code{make.table} a sheet is created as output in a .xls file. If the name
#' of the xls file is kept equal, the new sheet is added to the existing file.
#' \strong{ATTENTION:} If the name of the new sheet is the same of an existing
#' one, the data will be pasted over in the existing sheet, possibly making the
#' results incomprehensible.
#'
#' When processing census data, several files can be passed at once by passing a
#' character vector of length > 1 to \code{fnames}. Note that the extension
#' (.csv) of the file is used to identify whether it was requested to process
#' descriptive statistics generated by movement reports. If you have changed the
#' extensions of the result files, this function may have impredictable results.
#'
#' When more than one scenario is processed, then \code{make.table} assumes
#' that, within each scenario, the result file name is the same. The only
#' exception is when processing the descriptive statistics of census data. In
#' this case, the name of scenario is automatically added to the suffix. In
#' these cases, the suffix of the files has to be passed to \code{fnames} (i.e.
#' \emph{"[ncensus].all.xlsx"}, where \emph{"ncensus"} is the number of the
#' census event, and \emph{".comb.xlsx"} is the standard suffix that HexSimR
#' adds to all files generated with \code{collate.census}.
#'
#' \code{colh} is used to pass the headings of the columns to be processed. It
#' \strong{MUST} be passed as a list, with an element for each file that was
#' passed with \code{fnames}.
#'
#' If \code{SSMD=TRUE} and \code{scenarios="all"}, R may throw an error because
#' the base scenario is included in \code{scenarios} (unless it was manually
#' removed) but it is not present in the result file. When \code{SSMD=TRUE} a
#' character vector has to be passed to \code{scenarios}.
#'
#' When \code{SSMD=TRUE}, currently, only p-values are reported in the table.
#'
#' Note that when \code{SSMD=TRUE}, and the function is pointed to a SSMD
#' comparison of ranges report statistics, the appropriate setting for the time
#' step is \code{time.steps=NULL} (default) because these are already subsetted
#' when the SSMD comparison is done, unless all time steps were kept when
#' calling \code{ranges} or \code{multi.reports}. Also, when this function is
#' used to summarise descriptive statistics from ranges or movement data, this
#' argument must be NULL because there are no time steps in these outputs.
#'
#' By default, the sheet in the xls file takes name "Descriptive" or "SSMD",
#' depending on whether \code{SSMD=FALSE} or \code{SSMD=TRUE} respectively. This
#' behaviour can be altered by passing a character vector to \code{tab.name}.
#'
#'
#' @param fnames The name(s) of the output file(s) to be processed. If more the
#' one scenario is passed, the output file names have to be all equal
#' @param time.steps A numeric vector with the time steps to include. If NULL
#' (default), all time steps are included. See details for more information
#' @param SSMD Whether the data being processed are SSMD comparisons (default:
#' FALSE)
#' @param colh A list with as many elements as the length of fnames. Each
#' element is a character vector with the names of the column headings to be
#' considered for the relative fnames (default: ranges' headings)
#' @param vround The number of digits the variable (e.g. the mean, the p-values)
#' should be rounded to
#' @param sdround If SSMD=FALSE, the number of digits the standard deviation
#' should be rounded to
#' @param table.name The name of the file where to save the table
#' @param tab.name The name of the tab to be saved in the xls file. By default,
#' "Descriptive" or "SSMD", depending on whether \code{SSMD=FALSE} or
#' \code{SSMD=TRUE} respectively.
#' @param save2disk Whether to save to disk the table
#' @param dir.out The directory where to save the table. If NULL (default), the
#' file will be written in the 'Results' folder
#' @inheritParams collate.census
#' @seealso \code{\link{collate.census}}, \code{\link{ranges}},
#' \code{\link{move}}, \code{\link{SSMD.census}}, \code{\link{SSMD.ranges}},
#' \code{\link{SSMD.move}}
#' @import XLConnect
#' @import data.table
#' @return A data.frame (data.table) with the compiled table. If save2disk=TRUE
#' an xls file is also saved to disk.
#' @export
make.table <- function(path.results=NULL, scenarios="all", fnames, SSMD=FALSE,
colh=list(c("GroupSize", "Resources", "nGroups", "ha", "sqkm")),
vround=1, sdround=1, time.steps=NULL, table.name="Tables.xlsx",
tab.name=NULL, save2disk=TRUE,
dir.out=NULL) {
#----------------------------------------------------------------------------#
# Helper functions
#----------------------------------------------------------------------------#
combine <- function(i, data_r, data_sd_r) {
comb <- paste0(data_r[[i]], " (", data_sd_r[[paste0(i, "_sd")]], ")")
return(comb)
}
read_res <- function(scenario, path.results, fname, SSMD, time.steps, colh, vround,
sdround, dir.out) {
nC_fname <- nchar(fname)
ext <- substr(fname, nC_fname - 3, nC_fname)
if(SSMD == FALSE & ext == ".csv") {
tab <- fread(paste(path.results, scenario, fname, sep="/"))
setkey(tab, V1)
data <- tab["Mean", colh, with=FALSE]
data_sd <- tab["Std", colh, with=FALSE]
sds <- paste0(colh, "_sd")
setnames(data_sd, sds)
data <- cbind(data, data_sd)
colh <- make.names(colh)
sds <- make.names(sds)
setnames(data, c(colh, sds))
} else {
if(substr(fname, nC_fname - 8, nC_fname) == "comb.xlsx") {
fname <- paste(scenario, fname, sep=".")
}
wb <- loadWorkbook(paste(path.results,
if(SSMD == FALSE) scenario,
fname,
sep="/"))
if(SSMD == FALSE) {
tab <- data.table(readWorksheet(wb, sheet="means"))
} else {
if(nchar(scenario) > 25) {
scen_short <- substr(scenario, nchar(scenario) - 24, nchar(scenario))
} else {
scen_short <- scenario
}
tab <- data.table(readWorksheet(wb, sheet=paste0("pval_", scen_short)))
}
if(is.null(time.steps)) {
data <- tab[, colh, with=FALSE]
} else {
setkey(tab, Time.Step)
data <- tab[J(time.steps), colh, with=FALSE]
}
if(SSMD == FALSE) {
tab <- data.table(readWorksheet(wb, sheet="sd"))
if(is.null(time.steps)) {
data_sd <- tab[, colh, with=FALSE]
} else {
setkey(tab, Time.Step)
data_sd <- tab[J(time.steps), colh, with=FALSE]
}
sds <- paste0(colh, "_sd")
setnames(data_sd, sds)
data <- cbind(data, data_sd)
}
}
data_r <- data[, lapply(.SD, round, vround), .SDcols=colh]
if(SSMD == FALSE) {
data_r[, (colh) := lapply(colh,
combine, data_r,
data[, lapply(.SD, round, sdround), .SDcols=sds])]
}
data_r[, Scenario := scenario]
if(!is.null(time.steps)) data_r[, TimeStep := time.steps]
setcolorder(data_r, c("Scenario", if(!is.null(time.steps)) "TimeStep", colh))
return(data_r)
}
#----------------------------------------------------------------------------#
txt <- "Please, select the 'Results' folder within the workspace"
if(is.null(path.results)) path.results <- tk_choose.dir(caption = txt)
if(length(scenarios) == 1) {
if(scenarios == "all")
scenarios <- list.dirs(path=path.results, full.names=FALSE, recursive=FALSE)
}
if(is.null(tab.name)) {
if(SSMD) tab.name <- "SSMD" else tab.name <- "descriptive"
}
ldat <- list()
i <- 0
for(fname in fnames) {
i <- i + 1
ldat[[i]] <- lapply(scenarios, read_res, path.results, fname=fname, SSMD,
time.steps, colh[[i]], vround, sdround, dir.out)
ldat[[i]] <- rbindlist(ldat[[i]], use.names=T)
}
data <- do.call(cbind, ldat)
scen_inst <- grep("Scenario", names(data))
if(length(scen_inst) > 1) {
data[, scen_inst[2:length(scen_inst)] := NULL]
}
time_inst <- grep("TimeStep", names(data))
if(length(time_inst) > 1) {
data[, time_inst[2:length(time_inst)] := NULL]
}
if(save2disk == TRUE) {
dir.create(paste(path.results, dir.out, sep="/"), showWarnings=FALSE,
recursive=TRUE)
wb <- loadWorkbook(paste(path.results, dir.out, table.name, sep="/"),
create=TRUE)
createSheet(wb, name=tab.name)
writeWorksheet(wb, data, sheet=tab.name)
saveWorkbook(wb)
}
return(data)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.