R/fct_code_r.R

In ssd4mosaic: Web Application for the SSD Module of the MOSAIC Platform

start <- paste0("# This script was generated by MOSAIC, a web application dedicated to
# ecotoxicology. It is available at http://pbil.univ-lyon1.fr/software/mosaic/

# To use this script, it is recommended to consult the reference manual of the
# fitdistrplus package http://cran.r-project.org/web/packages/fitdistrplus/fitdistrplus.pdf

# For any further question, please contact us at mosaic@univ-lyon1.fr
library(ssd4mosaic)

data <- %s

distributions <- %s
logscale <- %s
unit <- '%s'
CI.level <- %s

## model fitting
fits <- get_fits(data, distributions, %s)
lapply(fits, summary)

## bootstrapping
bts <- get_bootstrap(fits)[[1]]

## HCx values
lapply(bts, quantile, probs = c(0.05, 0.1, 0.2, 0.5), CI.level = CI.level)
")

CIplot <- "
## CDF plot with confidence intervals
p <- base_cdf(fits, unit = unit, logscale = logscale)
add_CI_plot(p, bts, logscale, CI.level = CI.level)
"

species_names <- "
## CDF plot with species names
options_plot(fits, unit, logscale, data, use_names = TRUE)
"

color_group <- "
## CDF plot colored by group
options_plot(fits, unit, logscale, data, use_groups = TRUE)
"


#' Generate a script according to user in-app inputs
#'
#' @inheritParams get_fits
#' @param logscale A logical
#' @param unit A character string
#' @param names A logical
#' @param groups A logical
#' @param CI.level A numerical
#'
#' @return A character string containing a R script.
#'
code_r_ssd <- function(data, distributions, censored = FALSE, logscale = TRUE,
                       unit = "arbitrary unit", names = FALSE, groups = FALSE,
                       CI.level = 0.95){

  paste0(
    sprintf(start,
            paste0(utils::capture.output(dput(data)), collapse = "\n"),
            paste0(utils::capture.output(dput(distributions)), collapse = "\n"),
            logscale,
            unit,
            CI.level,
            censored
    ),
    paste0(CIplot,
           if (names){
             species_names
           },
           if (groups){
             color_group
           }
    )

  )
}