visrutils.R

assign("error_message", "", .GlobalEnv)

#' Check if running in VisR GUI
#'
#' Checks if running from within the VisR
#' @return  Will return \code{TRUE} if the code is running from within VisR.
#' @export
visr.isGUI<-function(){
  return (get0("visr.var.isGUI", ifnotfound = FALSE, envir = .GlobalEnv))
}

if (visr.isGUI()) {
  # https://stat.ethz.ch/R-manual/R-devel/library/base/html/options.html
  options(install.packages.check.source = "no") # "yes" "no"
  options(install.packages.compile.from.source = "never") # "interactive", "never", "always"
  options(pkgType = "both") # "both", "source", "binary", "mac.binary.el-capitan",  "win.binary"
  # interactive() ?
}

visr.getSelectedRows<-function() {
  selected = get0("visr.input.selectedRows", ifnotfound = NULL, envir = .GlobalEnv)
  if (!is.null(selected)) {
    selected <- selected + 1 # VisR is 0-based
  }
  return(selected)
}

visr.setSelectedRows<-function(x) {
  assign("visr.input.selectedRows", x, .GlobalEnv)
}

visr.get <- function(paramName) {
  return(get0(paste0("visr.param.",paramName), ifnotfound = NULL, envir = .GlobalEnv))
}

#' Apply GUI parameters
#'
#' Applies (imports) parameters spcified in the VisR GUI to the R environment.
#' @export
visr.applyParameters <- function() {
  #if (exists("visr.var.message.ignore")) rm(visr.var.message.ignore)
  dummylocalvar<-"dummyvalue"
  if (!visr.isGUI()) {
    print(visr.params)
  }
}

visr.getParams <- function() {
  return (get0("visr.params", ifnotfound = NULL, envir = .GlobalEnv))
}

readline.orig <- base::readline
visr.readline <- function(prompt = "", ...) {
  cat("visr.readline")
  if (!visr.isGUI()) {
    return (readline.orig(prompt, ...))
  } else {
    visr.message(prompt, "prompt")
    return("\n")
  }
}

if (visr.isGUI()) {
    # disable readline when running inside visr

    #unlockBinding("readline", .GlobalEnv)
    #readline <- visr.readline
    assign("readline", visr.readline, .GlobalEnv)
    #assignInNamespace("readline", visr.readline, ns="base")
}


#' Show message dialog
#'
#' Shows a message dialog to the user in VisR.
#' @param msg   Message text to be shown.
#' @param type   Message type. (\code{"error"} or \code{"warning"} or \code{"prompt"})
#' @examples
#' if (any(is.na(visr.input)))
#'     visr.message("There are NA values in the input", type="error")
#' @export
visr.message<-function(msg, type=c("error","warning", "prompt"))
{
  #TODO: replace error_message with visr.var.message
  if (exists("error_message") && is.character(error_message) && nzchar(error_message)) {
    # There is an unhandled error message already. Concatenate this to it
    assign("error_message",
           paste(error_message,"\n", match.arg(type), ": ", msg, sep = ""),
           .GlobalEnv)
  } else {
    assign("error_message",
           paste(match.arg(type),": ", msg, sep = ""),
           .GlobalEnv)
  }

  if (visr.isGUI() && type == "error") {
      stop(msg)
  }

  if (!visr.isGUI() && !exists("visr.var.message.ignore")) {
    print(error_message)
    assign("error_message", "", .GlobalEnv)
    invisible(user_choice<-readline.orig(prompt="(s)top / (i)gnore / ignore (a)ll ? (s/i/a)"))
    if (user_choice == "s") {
      stop("Terminated", call. = FALSE, domain = NA)
    } else if (user_choice == "a") {
      assign("visr.var.message.ignore", TRUE, .GlobalEnv)
    }
  }
}

visr.require <- function(pkg) {
  return (suppressWarnings(require(pkg, character.only = TRUE, quietly = TRUE)))
}

# Loads a CRAN package. If not already installed, tries to install the package from CRAN.
visr.library<-function (pkg, quiet = F, repos = NULL) {
  if (!quiet)
    visr.logProgress(paste("Loading package:", pkg))
  if (!visr.require(pkg)) {
    if (!quiet)
      visr.logProgress(paste("Installing cran package:", pkg))
    if (is.null(repos))
      repos = "http://cran.us.r-project.org"
    install.packages(pkg, repos = repos, dependencies=TRUE)
    #update.packages(ask = TRUE)
    # adding some delay, since loading the package right after installation may not work.
    numtries=10
    while (numtries > 0 && !visr.require(pkg)) {
      Sys.sleep(0.1)
      numtries=numtries-1
    }

    if (!visr.require(pkg)) {
      visr.message(paste("Unable to load package", pkg))
      if (!quiet)
        visr.logProgress(paste("Failed loading package:", pkg))
    } else {
      if (!quiet) {
        visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
        visr.logProgress("");
      }
    }
  } else {
    if (!quiet) {
      visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
      visr.logProgress("");
    }
  }
}

visr.libraryURL<-function (pkg,url) {
  visr.logProgress(paste("Loading package:", pkg))
  if (!visr.require(pkg)) {
    visr.logProgress(paste("Installing package", pkg,"from", url))
    install.packages(url, repos = NULL, type="source", dependencies=TRUE)
    # adding some delay, since loading the package right after installation may not work.
    numtries=10
    while (numtries > 0 && !visr.require(pkg)) {
      Sys.sleep(0.1)
      numtries=numtries-1
    }

    if (!visr.require(pkg)) {
      visr.message(paste("Unable to load package", pkg))
      visr.logProgress(paste("Failed loading package:", pkg))
    } else {
      visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
      visr.logProgress("");
    }
  } else {
    visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
    visr.logProgress("");
  }

}

visr.librarySource<-function (pkg, url) {
  visr.logProgress(paste("Loading package:", pkg))
  if (!visr.require(pkg)) {
    visr.logProgress(paste("Installing package", pkg,"from", url))
    source(url)
    # adding some delay, since loading the package right after installation may not work.
    numtries=10
    while (numtries > 0 && !visr.require(pkg)) {
      Sys.sleep(0.1)
      numtries=numtries-1
    }

    if (!visr.require(pkg)) {
      visr.message(paste("Unable to load package", pkg))
      visr.logProgress(paste("Failed loading package:", pkg))
    } else {
      visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
      visr.logProgress("");
    }
  } else {
    visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
    visr.logProgress("");
  }
}

visr.libraryGithub<-function (pkg, repo) {
  visr.logProgress(paste("Loading package:", pkg))
  if (!visr.require(pkg)) {
    visr.logProgress(paste("Installing package", pkg,"from github repo: ", repo))
    visr.library("devtools")
    install_github(repo) # https://github.com/cole-trapnell-lab/monocle-release/issues/118

    # adding some delay, since loading the package right after installation may not work.
    numtries=10
    while (numtries > 0 && !visr.require(pkg)) {
      Sys.sleep(0.1)
      numtries=numtries-1
    }

    if (!visr.require(pkg)) {
      visr.message(paste("Unable to load package", pkg))
      visr.logProgress(paste("Failed loading package:", pkg))
    } else {
      visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
      visr.logProgress("");
    }
  } else {
    visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
    visr.logProgress("");
  }
}

#' Load/install app dependent package
#'
#' Loads a bioconductor package. If not already installed, tries to install the package from bioconductor.
#' @param pkg package name
visr.biocLite<-function (pkg) {
  visr.logProgress(paste("Loading bioconductor package:", pkg))
  if (!visr.require(pkg)) {
    visr.logProgress(paste("Installing bioconductor package:", pkg))
    source("http://bioconductor.org/biocLite.R")
    biocLite(pkg,
             suppressUpdates=FALSE,     # suppress automatic updating of all installed packages.
             suppressAutoUpdate=FALSE,  # whether the BiocInstaller package updates itself.
             ask=FALSE)                 # whether to prompt user before installed packages are updated
    numtries=10
    while (numtries > 0 && !visr.require(pkg)) {
      Sys.sleep(0.1)
      numtries=numtries-1
    }

    if (!visr.require(pkg)) {
      visr.message(paste("Unable to load package", pkg))
      visr.logProgress(paste("Failed loading package:", pkg))
    } else {
      visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
      visr.logProgress("");
    }
  } else {
    visr.logProgress(paste(pkg, 'version', packageVersion(pkg)))
    visr.logProgress("");
  }
}

# used in tryCatch
visr.internal.handleError <- function(e)
{
  #todo, use a different variable
  assign("error_message", e$message, .GlobalEnv)
}

# used in tryCatch
visr.internal.handleWarning <- function(w)
{
  #todo, use a different variable
  assign("error_message", w$message, .GlobalEnv)
}

visr.rebuildPackages <- function()
{
  #biocLite()
  #Update all/some/none? [a/s/n]:
  #  a
  #Do you want to install from sources the packages which need compilation?
  #y/n: n

  pkgs = installed.packages()
  idx = which(pkgs[,"Built"] != getRversion())
  if (length(idx)) {
    for (pkg in rownames(pkgs[idx,]))
    {
      visr.biocLite(pkg)
    }
  }
}

#' Returns the user home directory.
#' @export
visr.getHomeDir <- function()
{
  if (.Platform$OS.type == "windows") {
    return(Sys.getenv("UserProfile"))
  }
  return(Sys.getenv("HOME"))
}

#' Returns the user library directory
#'
#' This is typically the ~/VisR/RLibs (*nix) or /Users/[username]/VisR/RLibs (windows).
#' Packages are default installed in this directory to ensure write access permission.
#' @export
visr.getHomeLibPath <- function()
{
  return(paste(visr.getHomeDir(),"/VisR/RLibs",sep=""))
}

# Wraps R's print() function (legacy, as previously print() in VisR was causing a SIGPIPE error)
visr.print<-function(msg) {
  #if (!visr.isGUI())
  print(msg)
}


#' Convert names to syntactically valid names.
#'
#' Utility function to convert column names to syntactically valid names by replacing invalid characters with _
#' @param columnnames vector of character column names
#' @export
visr.makeValidNames <- function(columnnames) {
  return (make.names(gsub("[^a-zA-Z0-9_]", "_", columnnames)))
}

#' Read tables with corrected column names
#'
#' Utility function to read tables with corrected column names, as it is sent from VisR to the apps
#' Mainly useful for debugging apps within R studio
#' @param file  path to the tab delimited file
#' @export
visr.readDataTable <-function(file, delim = "\t") {
  t <- read.csv(file, sep = delim, check.names = F)
  colnames(t) <- visr.makeValidNames(colnames(t))
  return (t)
}

#' Write tables to tab-delimited output files
#'
#' Utility function to write tables to tab-delimited output files that correctly open in VisR
#' @param x
#' data table to write
#' @param filename
#' path output filename
#' @param row.names
#' either logical to indicate outputting row names, or a character vector of row names to be written.
visr.writeDataTable <- function(x, filename, row.names = FALSE) {
  if (isTRUE(row.names) || is.character(row.names)) {
    cn <- colnames(x)
    if (is.character(row.names))
      x <- cbind(row.names, x)
    else
      x <- cbind(rownames(x), x)
    colnames(x) <- c("name", cn)
  }
  write.table(x, file = filename, quote = FALSE, sep="\t", row.names = FALSE)
}


#' Sets the log directory.
#'
#' Sets the current log directory where the R output should be diverted to.
#' @param current log directory. "" to go back to logging to console
#' Warning: Don't call this within an app as it is called internatlly by the VisR
visr.internal.setLogDir <- function(logDir) {
  if (TRUE) {
    assign("visr.var.logDir", logDir, .GlobalEnv)
    assign("visr.var.progressFile", paste(logDir, "/progress.txt", sep=""), .GlobalEnv)
    if (!is.null(logDir) && nchar(logDir) > 0) {
      sinkFile <- file(paste(logDir,"/all.txt",sep=""), open = "wt")
      sink(sinkFile)
      sink(sinkFile, type = "message")
      assign("visr.var.sinkFile", sinkFile, .GlobalEnv)
      #print(date())
    } else {
      ## back to the console
      if (sink.number() > 0) {
        #print(date())
        sink(type = "message")
        sink()
        if (exists("visr.var.sinkFile")) {
          close(visr.var.sinkFile)
          rm(visr.var.sinkFile)
        }
      }
    }
  }
}

#' Logs the current progress of the app execution.
#' @param  message      message to be shown (e.g. the current action being performed)
#' @param  percentage   the current progress percentage of the app (if known)
#' @examples
#' visr.logProgress("Normalizing the input", 0.8)
#' @export
visr.logProgress <- function(message, percentage = -1)
{
  if (exists("visr.var.progressFile")) {
    cat(paste(percentage, message, sep="\t"), file=visr.var.progressFile, append=TRUE, sep = "\n")
  } else {
    if (message != "")
      print(message)
  }
}

#' safely shuts down a graphcis device specified by a character name
#' @param devName device name (character)
#' @return Logical, true if and only the device was found and shut down
visr.internal.dev_off_safe <- function(devName) {
  if (!is.character(devName))
    return(FALSE)
  devValue <- get0(devName, envir = .GlobalEnv)
  if (!is.null(devValue) && !identical(devValue, 1)) {
    dev.off(devValue)
    rm(list=devName, envir = .GlobalEnv)
    return(TRUE)
  }
  return(FALSE)
}

#' safely sets the current graphcis device to the device specified by a character name
#' @param devName device name (character)
#' @return Logical, true if and only the device was found
visr.internal.dev_set_safe <- function(devName) {
  if (!is.character(devName))
    return(FALSE)

  devValue <- get0(devName, envir = .GlobalEnv)
  if (!is.null(devValue) && !identical(devValue, 1) && devValue %in% dev.list()) {
    dev.set(devValue)
    return(TRUE)
  }
  return(FALSE)
}


#' Prints the session info and installed packages (useful for diagnosis)
#' @export
visr.printSessionInfo <- function() {
  cat("\nsessionInfo()\n")
  print(sessionInfo())

  cat("\n.libPaths()\n")
  print(.libPaths())

  cat("\ninstalled.packages()\n")
  ip <- as.data.frame(installed.packages()[,c(1,3:4)])
  rownames(ip) <- NULL
  ip <- ip[is.na(ip$Priority),1:2,drop=FALSE]
  print(ip, row.names=FALSE)

  cat("\ncapabilities()\n")
  print(capabilities())
}

###############################################
#                  visr.app
#
# functions to create an app json file in R
###############################################

assign("visr.var.appJSON", "", .GlobalEnv)
assign("visr.var.definedCategory", FALSE, .GlobalEnv)
assign("visr.var.definedParam", FALSE, .GlobalEnv)

# indents all lines of a string where lines are separated by \n
visr.internal.indent <- function(txt, indents=2) {
  spaces <- paste(rep(" ", indents), collapse="")
  paste(spaces, gsub("\n", paste("\n", spaces, sep=""), txt), sep="")
}

# appends @param(txt) to the current json output
visr.internal.appendJSON <- function(txt) {
  assign("visr.var.appJSON", paste(visr.var.appJSON, txt, sep=""), .GlobalEnv)
}

#' Start app definition
#'
#' Starts definition of parameters for an R app.
#' @param  name app name
#' @param  info  app info shown as tooltip
#' @param  input.type input type of the app. "dragAndDrop" if requires a data node to be drag and dropped. "none" otherwise.
#' @param  debugdata  debug dataframe to be used when debuggin the app in R / RStudio
#' @examples
#' visr.app.start("kmeans", info="kmeans clustering")
#' visr.app.start("kmeans", debugdata = iris) # will assign visr.input <- iris in debug mode
#' @export
visr.app.start <- function(name, info = "", input.type=c("none", "dragAndDrop"), instructions = "", debugdata = NULL) {
  if (visr.isGUI())
    return()

  input.type <- match.arg(input.type)

  assign("visr.var.appJSON",
         paste('{\n  "label": "', name,
               '",\n  "info": "', gsub('"', '\\\\"', gsub('\n', '\\\\n', info)),
               '",\n  "instructions": "', gsub('"', '\\\\"', gsub('\n', '\\\\n', instructions)),
               '",\n  "input": "', input.type,
               '",\n  "categories":[', sep=''), .GlobalEnv)
  assign("visr.var.definedCategory", FALSE, .GlobalEnv)
  assign("visr.var.definedParam", FALSE, .GlobalEnv)

  assign("visr.input", debugdata, .GlobalEnv)
  assign("input_table", debugdata, .GlobalEnv)
  assign("visr.params", list(), .GlobalEnv)
}

#' End app definition
#'
#' Finishes the current apps parameter definition.
#' @param printjson     whether to print the generated json file to console
#' @param writefile     whether to write the generated json to a file
#' @param filename      path to the filename to write the json to. If not specified and
#'                      writefile is TRUE, a json file is generated from the caller
#'                      source file path by replacing .R with .json
#' @export
visr.app.end <- function(printjson = TRUE, writefile = TRUE, filename = NULL) { # preview=FALSE
  if (visr.isGUI())
    return()

  if (visr.var.definedCategory)
    visr.internal.appendJSON('\n    }\n  }')

  visr.internal.appendJSON(']\n}')

  if (printjson) {
    cat(visr.var.appJSON)
  }

  if (writefile) {
    if (is.null(filename)) {
      # auto generate the json file name from the R source filename
      srcfilename <- parent.frame(3)$ofile
      if (!is.null(srcfilename))
        filename <- paste(dirname(srcfilename), "/", gsub("\\.R", ".json", basename(srcfilename)), sep="")
    }

    if (!is.null(filename)) {
      print(paste("Writing app parameter description to", filename))
      write(visr.var.appJSON, file=filename)
    } else {
      warning("Could not write the json file as filename parameter is not specified and could not be inferred from source R file.")
    }
  }
}

#' Start category
#'
#' Starts a new category of parameters for the app
#' @param label   category label to be shown in VisR
#' @param info    additional information about category shown as tooltip
#' @param collapsed whether the category should be initially shown in collapsed (minimized) mode
#' @examples
#' visr.category("clustering parameters")
#' @export
visr.category <- function(label, info = "", collapsed = FALSE, active.condition = NULL) {
  if (visr.isGUI())
    return()

  if (visr.var.definedCategory)
    visr.internal.appendJSON('\n    }\n  },\n')

  if (!is.null(active.condition))
    eval(parse(text=active.condition)) # to make sure it is valid

  visr.internal.appendJSON(paste('  {\n',
                                 '    "label": "', gsub('"', '\\\\"', label), '",\n',
                                 '    "info": "', gsub('"', '\\\\"', gsub('\n', '\\\\n', info)), '",\n',
                                 '    "collapsed": ', ifelse(collapsed, "true", "false"), ',\n',
                                 if (is.null(active.condition)) {''} else {paste(
                                 '    "active-condition": "', active.condition, '",\n', sep='')},
                                 '    "variables": {\n', sep=""))
  assign("visr.var.definedCategory", TRUE, .GlobalEnv)
  assign("visr.var.definedParam", FALSE, .GlobalEnv)
}
visr.app.category <- visr.category

visr.app.paramNamePrefix = "visr.param."

#' Set parameter name prefix
#'
#' Sets the prefix that is added to parameter name when using visr.param()
#'
#' @param prefix    the name prefix
visr.app.setParamNamePrefix <- function(prefix = "visr.param.") {
  assign("visr.app.paramNamePrefix", prefix, .GlobalEnv)
}


#' Add app parameter
#'
#' Adds a new parameter to the curent app.
#'
#' @param name    Parameter name. will be appended to "visr.param." to create
#'                the full variable name in R.
#' @param label   The label for the parameter's GUI control.
#'                Will use variable name if not specified (NULL).
#' @param info    Additional information about parameter.
#'                Will be shown as tooltip in VisR.
#' @param type    Parameter type
#' @param default Initial default value for the parameter.
#' @param min     Minimum value for numerical type parameters
#'                (\code{"int"}, \code{"range-int"}, \code{"double"}, \code{"range-double"})
#' @param max     Maximum value for numerical type parameters
#'                (\code{"int"}, \code{"range-int"}, \code{"double"}, \code{"range-double"})
#' @param items   Specify a vector of items for a \code{"string"} or \code{"multi-string"} variable to select from.
#' @param item.labels Specify a vector of items to be used as the labels for \code{items} argument.
#' @param filename.mode  Specify the file dialog mode
#'                (file load, file save or directory) for a
#'                \code{"filename"} type parameter
#' @param active.condition  A logical expression to control when this parameter will be visible.
#'                    e.g. visr.param("title_font", active.condition = "visr.param.title != ''")
#' @param options     various options to control the specific behaviors of the parameters.
#'                    Should be specified in the form of "option1=value, option2=value, ..."
#'                    Current defined options:
#'                    "importRowNames" for type="output-table": if importRowNames=false, row names won't be imported. default is true.
#' @param debugvalue  The value to be assigned to the R variable in debug mode.
#'                    Useful for unit testing.
#'
#'
#' @details
#' For parameter type of "multi-color" the default should be in the form of "PaletteName" or "PaletteName  ColorCount".
#' PaletteName is a color brewer palette name which can be found by display.brewer.all() of "RColorBrewer" package.
#' (http://www.sthda.com/english/wiki/colors-in-r#using-rcolorbrewer-palettes)
#'
#'
#' @examples
#' visr.param("k", type = "integer") # specify type
#' visr.param("k", default = 3L) # will infer type from default value
#' visr.param("k", label = "number of clusters")  # explicitly specify label
#' visr.param("title") # no type or default value: treated as a "string" type
#' visr.param("algorithm", items = c("Hartigan-Wong", "Lloyd", "Forgy", "MacQueen"), active.condition="visr.param.k > 1")
#' visr.param("columns", type = "multi-column-numerical")
#' visr.param("output.clusterid", type = "output-column") # column appended to input table
#' @export
visr.param <- function(name, label, info,
                       type = c("string", "character",
                                "int", "integer", "double",
                                "range-int", "range-double",
                                "boolean", "logical", "multi-string",
                                "column", "multi-column",
                                "column-numerical", "multi-column-numerical",
                                "color", "multi-color", "filename",
                                "output-column", "output-multi-column", "output-table"),
                       default, min, max,
                       items, item.labels,
                       filename.mode = c("load", "save", "dir"),
                       active.condition,
                       options,
                       debugvalue) {
  if (visr.isGUI()) # don't generate parameters when running within VisR
    return()

  paramname = paste0(visr.app.paramNamePrefix, name) #full parameter name

  if (missing(default) && !missing(min) && !missing(max) && !missing(type) &&
      (type == 'range-int' || type == 'range-double'))
    default <- c(min, max)

  if (missing(default) && !missing(min)) # guess default from min
    default <- min

  if (missing(default) && !missing(max)) # guess default from max
    default <- max

  if (missing(type) && !missing(default)) { # try to guess type from default
    #guess type from the default value
    if (is.numeric(default) && is.integer(default)) {
      if (length(default) == 2)
        type <- "range-int"
      else
        type <- "int"
    } else if (is.numeric(default)) {
      if (length(default) == 2)
        type <- "range-double"
      else
        type <- "double"
    } else if (is.logical(default)) {
      type <- "boolean"
    }
  }
  type <- match.arg(type)

  type <- if (type == "character") {"string"} else {type}
  type <- if (type == "logical") {"boolean"} else {type}
  type <- if (type == "integer") {"int"} else {type}

  if (!missing(min) && !is.numeric(min))
    stop("argument min should be numeric")

  if (!missing(max) && !is.numeric(max))
    stop("argument max should be numeric")

  if (type == "filename") {
    filename.mode <- match.arg(filename.mode)
  } else {
    if (!missing(filename.mode)) {
      warning("filename.mode is ignored when type != 'filename'")
    }
  }

  # check that type matches default
  if (!missing(default)) {
    defaultNotInItems <- !missing(items) && !(default %in% items)
    if (((type=="int" || type=="range-int" || type=="double" || type=="range-double") && !is.numeric(default) && defaultNotInItems) ||
          ( type=="boolean" && !is.logical(default)) ||
          ( type=="string" && !is.character(default)))
      stop ("default value does not match the type")

    if (type == "color") {
      default <- paste('#', paste(as.hexmode(col2rgb(default)), collapse=""), '', sep='')
      #if (length(default) > 1) default <- apply(as.character(as.hexmode(col2rgb(default))), 2, paste, collapse="")
    }
  }

  # try to guess a debug value from the other properties
  if (missing(debugvalue)) {
    if (!missing(default)) {
      debugvalue <- default
    } else if (!missing(items)) {
      debugvalue <- items[1]
    } else if (type == "column" && !is.null(visr.input)) {
      debugvalue <- colnames(visr.input)[1]
    } else if (type == "column-numerical" && !is.null(visr.input)) {
      debugvalue <- colnames(visr.input)[which(sapply(visr.input, is.numeric))][1]
    } else if (type == "multi-column" && !is.null(visr.input)) {
      debugvalue <- colnames(visr.input)
    } else if (type == "multi-column-numerical" && !is.null(visr.input)) {
      debugvalue <- colnames(visr.input)[which(sapply(visr.input, is.numeric))]
    } else if (type == "multi-color") {
      debugvalue <- "#d73027,#fc8d59,#fee090,#ffffbf,#e0f3f8,#91bfdb,#4575b4"
    } else if (type == "int") {
      debugvalue = if (!missing(min)) min else 0L
    } else if (type == "double") {
      debugvalue = if (!missing(min)) min else 0
    } else if (type == "range-int") {
      debugvalue = if (!missing(min) && !missing(max)) c(min, max) else c(0L, 10L)
    } else if (type == "range-double") {
      debugvalue = if (!missing(min) && !missing(max)) c(min, max) else c(0, 1)
    } else if (type == "boolean") {
      debugvalue = F
    } else {
      debugvalue = ''
    }
  }

  assign(paramname, debugvalue, envir = .GlobalEnv)
  if (!is.null(debugvalue))
    visr.params[[paramname]] <<- debugvalue
  else
    visr.params[paramname] <<- list(NULL)

  default.ischar <- !missing(default) && is.character(default)

  if (type == "boolean" && !missing(default))
    default <- tolower(default) # TRUE -> "true"

  if (!missing(active.condition))
    eval(parse(text=active.condition)) # evaluate to make sure it is valid

  properties <- c(
    if (!missing(label))    {paste('"label": ',   gsub('"', '\\\\"', label),    '', sep='"')} else {NULL},
    if (!missing(info))     {paste('"info": ',    gsub('"', '\\\\"', gsub('\n', '\\\\n', info)),     '', sep='"')} else {NULL},
    if (!missing(type))     {paste('"type": ',    type,     '', sep='"')} else {NULL},
    if (!missing(default))  {
      if (length(default) == 1)
        paste('"default": ', default , '', sep = ifelse(default.ischar, '"', ''))
      else
        paste0('"default": ', paste0('[', paste('', default,       '', sep = ifelse(default.ischar, '"', ''), collapse=", ") ,"]")) # range-int, range-double or multi-string
    } else {NULL},
    if (!missing(min))      {paste('"min": ',     min,          sep='')} else {NULL},
    if (!missing(max))      {paste('"max": ',     max,          sep='')} else {NULL},
    if (!missing(items))       {paste0('"items": ',       paste0('[', paste('"', items,       '"', sep="", collapse=", ") ,"]"))} else {NULL},
    if (!missing(item.labels)) {paste0('"item-labels": ', paste0('[', paste('"', item.labels, '"', sep="", collapse=", ") ,"]"))} else {NULL},
    if (!missing(filename.mode)) {paste('"filename.mode": ', filename.mode, '', sep='"')} else {NULL},
    if (!missing(active.condition))     {paste('"active-condition": ',    active.condition,     '', sep='"')} else {NULL},
    if (!missing(options))     {paste('"options": ',    options,     '', sep='"')} else {NULL}
  )

  #properties <- properties[which(!is.na(properties))]

  jsonstr <- paste(
    paste('"', paramname,'": {\n', sep=''),
    visr.internal.indent(paste(properties, collapse = ",\n")),
    '\n}', sep=''
  )

  if (!visr.var.definedCategory)
    visr.category(label="")

  if (visr.var.definedParam)
    visr.internal.appendJSON(",\n")

  visr.internal.appendJSON(visr.internal.indent(jsonstr, 6))
  assign("visr.var.definedParam", TRUE, .GlobalEnv)
}

visr.app.param <- visr.param


#' Unit test
visr.internal.test.param <- function() {
  visr.app.start("test-app", info="A test app", debugdata = iris)
  visr.app.param("test-minimal")
  visr.app.param("test-auto-int", default = 2L)
  visr.app.param("test-auto-double", default = 0.5)
  visr.app.param("test-auto-bool", default = FALSE)
  visr.app.category("group2", "info for group2")
  #visr.param("test-mismatch", type="char", default=2)
  visr.app.param("test-color", label="foreground", info="foreground color", type="color", default = "yellow")
  visr.app.param("test-min-max", default=3, min=1, max=10)
  visr.app.param("test-filename", type="filename", filename.mode = "load")
  visr.app.param("test-items", items = c("i1","i2","i3"))
  visr.app.param("test-item-labels", items = c("i1","i2","i3"),
             item.labels = c("item 1","item 2","item 3"))
  visr.app.end(printjson=TRUE, filename="~/testapp.json")
  #cat(visr.var.appJSON)
}


#' Creates a list of strings from a comma or space separated string
#'
#' Creates a list of strings from a comma or space separated string
visr.util.split_comma_string <- function(comma_separated_string) {
  return (strsplit(comma_separated_string, split = "[ ]*[,| ]+[ ]*")[[1]])
}

#' Creates a gradient color scale
#'
#' Creates a gradient color scale to be used by ggplots from a string of color values
#'
#' @param colorsString    String of comma separted color values. e.g. "#d73027,#fc8d59,#fee090,#ffffbf,#e0f3f8,#91bfdb,#4575b4"
#'
#' @param label           The name of the scale. Used as axis or legend title.
#'                        If NULL, the default, the name of the scale is taken from the first mapping used for that aesthetic.
visr.util.scale_color_gradient <- function(colorsString, label = waiver()) {
  colorsVec <- visr.util.split_comma_string(colorsString)
  return (scale_colour_gradientn(colours = colorsVec, name = label))
}

#' Creates a fill color scale
#'
#' Creates a fill color scale to be used by ggplots from a string of color values
#'
#' @param colorsString    String of comma separted color values. e.g. "#d73027,#fc8d59,#fee090,#ffffbf,#e0f3f8,#91bfdb,#4575b4"
#'
#' @param label           The name of the scale. Used as axis or legend title.
#'                        If NULL, the default, the name of the scale is taken from the first mapping used for that aesthetic.
visr.util.scale_fill_gradientn <- function(colorsString, label = waiver()) {
  colorsVec <- visr.util.split_comma_string(colorsString)
  return (scale_fill_gradientn(colours = colorsVec, name = label))
}

# just a palette of 25 colors (https://stackoverflow.com/a/9568659/8371761)
visr.var.customPalette25 <- c(
  "black", "dodgerblue2","#E31A1C", # red
  "green4",
  "#6A3D9A", # purple
  "#FF7F00", # orange
  "gold1", "skyblue2","#FB9A99", # lt pink
  "palegreen2",
  "#CAB2D6", # lt purple
  "#FDBF6F", # lt orange
  "gray70", "khaki2",
  "maroon","orchid1","deeppink1","blue1","steelblue4",
  "darkturquoise","green1","yellow4","yellow3",
  "darkorange4","brown"
)


todo_things_to_try <- function() {
    gc()
    gcinfo(TRUE)
    .dynLibs()
    library.dynam()
    getLoadedDLLs()

    warnings()
    tail(warnings(), 2)
    last.warning()

    #package: R.utils
    setTimeLimit()
    withTimeout(expr)
}

visr.library("assertthat", quiet = T)

#' Utility function
#' TODO
#'
visr.assert_that <- function(..., env = parent.frame(), msg = NULL) {
  if (visr.isGUI()) {
    res <- assertthat::see_if(..., env = env, msg = msg)
    if (res)
      return(TRUE)
    visr.message(attr(res, "msg"))
  } else {
    return (assertthat::assert_that(..., env = env, msg = msg))
  }
}

#' Utility function
#' TODO
#'
visr.assert_file_exists <- function(filename, parameterName) {
  visr.assert_that(!is.null(filename), msg = paste0("Parameter '", parameterName, "' is not specified"))
  visr.assert_that(filename != "", msg = paste0("Parameter '", parameterName, "' is not specified"))
  visr.assert_that(file.exists(filename), msg = paste0("Unable to find the path '", filename, "'"))
  return(TRUE)
}