List of 1+
 $ use_common_sense: TRUE
 ...

List of 2+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...)
 ...

List of 2+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get
 ...

List of 2+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get |> apply
 ...

List of 2+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get |> apply |> assert
 ...

List of 3+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get |> apply |> assert
 $ data_management: List of 3+
  ..$ encrypt: List of 2
  .. ..$ in_transit: TRUE
  .. ..$ at_rest: TRUE
  ..$ document: TRUE
  ..$ PHI: identify()
  .. ..
 ...

List of 4+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get |> apply |> assert
 $ data_management: List of 3+
  ..$ encrypt: List of 2
  .. ..$ in_transit: TRUE
  .. ..$ at_rest: TRUE
  ..$ document: TRUE
  ..$ PHI: identify()
  .. ..
  $ vendor_management: List of 3+
  ..$ cannot_live_without: TRUE
  ..$ security_assessment: TRUE
  ..$ BAA: TRUE
  .. ..
 ...

List of 5+
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get |> apply |> assert
 $ data_management: List of 3+
  ..$ encrypt: List of 2
  .. ..$ in_transit: TRUE
  .. ..$ at_rest: TRUE
  ..$ document: TRUE
  ..$ PHI: identify()
  .. ..
  $ vendor_management: List of 3+
  ..$ cannot_live_without: TRUE
  ..$ security_assessment: TRUE
  ..$ BAA: TRUE
  .. ..
 $ code_review: TRUE
 ...

List of Inf
 $ use_common_sense: TRUE
 $ policies: function(...) search(...) |> get |> apply |> assert
 $ data_management: List of 3+
  ..$ encrypt: List of 2
  .. ..$ in_transit: TRUE
  .. ..$ at_rest: TRUE
  ..$ document: TRUE
  ..$ PHI: identify()
  .. ..
  $ vendor_management: List of 3+
  ..$ cannot_live_without: TRUE
  ..$ security_assessment: TRUE
  ..$ BAA: TRUE
  .. ..
 $ code_review: TRUE
 $ unit_tests: TRUE
 $ integration_tests: TRUE
 $ code_coverage_tests: TRUE
 ...

function(text, language = translate_get_language()) {

    if (!language %in% translation_languages()) {
        stop(paste('Unknown language:', shQuote(language)))
    }

    if (language == 'en') {
        translation <- text
    } else {
        translation <- translations[[language]][[text, exact = TRUE]]
    }

    if (is.null(translation) || translation == '') {
        stop(paste('Missing translation of', shQuote(text),
                   'in language', shQuote(language)))
    }

    translation

}
<environment: namespace:rx.studio>

function(language, folder = system.file('i18n', package = 'rx.studio')) {

    po <- readLines(file.path(folder, paste(language, 'po', sep = '.')))

    getlines <- function(prefix) {
        sub(paste0('^', prefix, ' "(.*)"$'), '\\1',
            grep(paste0('^', prefix, ' '), po, value = TRUE))
    }

    msgids <- getlines('msgid')[-1]
    msgstrs <- getlines('msgstr')[-1]

    if (language == 'en') {
        msgstrs <- msgids
    }

    as.list(setNames(msgstrs, msgids))

}
<environment: namespace:rx.studio>

translations <- list2env(list(default = 'en'), parent = emptyenv())

#' List supported translations
#' @return character vector of language codes
#' @export
translation_languages <- function() {
    files <- list.files(system.file('i18n', package = 'rx.studio'), pattern = '.po$')
    assign('languages', sub('.po', '', basename(files)), envir = translations)
    translations$languages
}

#' Cache all translations
#' @return variables in the \code{translations} environment of the package
#' @export
translations_read <- function() {
    for (language in translation_languages()) {
        assign(language,
               as.environment(translation_read(language)),
               envir = translations)
    }
}

## based on tools::xgettext
find_strings <- function(e) {
    if (is.call(e) && is.name(e[[1L]]) && (as.character(e[[1L]]) == 'translatable')) {
        ## extract text to be translated and comment to be passed to the translator
        text <- eval(e[[2]])
        if (!is.null(text) && test_string(text)) {
            log_trace(skip_formatter(paste('Text to translate:', as.character(text))))
            comment <- ifelse(length(e) > 2, eval(e[[3]]), NA_character_)
            strings <<- c(strings, list(list(text = text, comment = comment)))
        }
    } else {
        if (is.recursive(e)) {
            for (i in seq_along(e)) {
                Recall(e[[i]])
            }
        }
    }
}

## extract terms from package source, templats, reports etc.
lapply(list.files(pattern = '.R$', full.names = TRUE), find_strings)

on: pull_request

name: Repository tools
jobs:
  all-translated:
    runs-on: ubuntu-latest
    steps:
      - uses: actions/checkout@v2
      - uses: aws-actions/configure-aws-credentials@v1
      - uses: aws-actions/amazon-ecr-login@v1
      - name: Pull prod Docker image from Amazon ECR
        run: docker pull $ECR_REGISTRY/r-api-base
      - name: Build test Docker image locally
        run: docker build --file inst/docker/r-api/Dockerfile -t test .
      - name: all translation terms extracted
        run: library(rx.studio); assert_translatable_extracted('/R')
        shell: docker run --rm --init -v /home:/home -w /R test Rscript {0}
      - name: all English terms are translated
        run: quit(save='no', status=sum(as.data.frame(testthat::test_file('inst/tests/testthat/test-translate.R'))$failed))
        shell: docker run --rm --init -v /home:/home -w /R test Rscript {0}

library(logger)
log_threshold(DEBUG)
log_info('Script starting up...')
#> INFO [2018-20-11 22:49:36] Script starting up...

pkgs <- available.packages()
log_info('There are {nrow(pkgs)} R packages hosted on CRAN!')
#> INFO [2018-20-11 22:49:37] There are 13433 R packages hosted on CRAN!

for (letter in letters) {
    lpkgs <- sum(grepl(letter, pkgs[, 'Package'], ignore.case = TRUE))
    log_level(if (lpkgs < 5000) TRACE else DEBUG,
              '{lpkgs} R packages including the {shQuote(letter)} letter')
}
#> DEBUG [2018-20-11 22:49:38] 6300 R packages including the 'a' letter
#> DEBUG [2018-20-11 22:49:38] 6772 R packages including the 'e' letter
#> DEBUG [2018-20-11 22:49:38] 5412 R packages including the 'i' letter
#> DEBUG [2018-20-11 22:49:38] 7014 R packages including the 'r' letter
#> DEBUG [2018-20-11 22:49:38] 6402 R packages including the 's' letter
#> DEBUG [2018-20-11 22:49:38] 5864 R packages including the 't' letter

#' List of changes affecting simulation outputs
#'
#' Each item is a \code{list} with the below required fields:
#' \itemize{
#'   \item \code{release} semver change that can be \code{init}, \code{patch}, \code{minor} or \code{major}
#'   \item \code{date} date of change
#'   \item \code{scope} list of affected drugs, methods and targets
#'   \item \code{description} One-line description of the change.
#' }
#' @keywords internal
CHANGELOG <- list(
  list(
    release = 'init',
    date = as.Date('2020-09-05'),
    scope = list(drugs = c('cefepime'), methods = c('cfr', 'pta', 'emp', 'bay'), targets = c('fcmin_mic_ratio', 'ftime_above_mic'))),
  list(
    release = 'major',
    date = as.Date('2020-09-07'),
    scope = list(drugs = c('cefepime'), methods = c('pta'), targets = c('fcmin_mic_ratio', 'ftime_above_mic')),
    description = 'Enable multiple dosing regimens.'),
  ...

# ...

id_token <- sub('^Bearer ', '', req$HTTP_AUTHORIZATION)

firebase_admin <- reticulate::import(module = 'firebase_admin')
app <- firebase_admin$initialize_app()
on.exit(firebase_admin$delete_app(app))

user <- firebase_admin$auth$verify_id_token(id_token)

log_debug(
    event = 'authenticated',
    client_id = req$client_id,
    user_uid = user$user_uid,
    user_oid = user$user_oid,
    user_subscription_plan = user$user_subscription_plan,
    user_allow_phi = user$user_allow_phi,
    language = headers[['accept-language']])

# ...

template <- read_template(path)
env <- validate_template_inputs(template, ...)

## capture stderr in forked process
fork_std_err_con <- rawConnection(raw(0), 'r+')
on.exit(try(close(fork_std_err_con), silent = TRUE), add = TRUE)

log_trace(step = 'Evaluating template')
report <- tryCatch(suppressMessages(suppressWarnings(
    eval_safe(
        Pandoc.brew(text = template$body, envir = env, output = '/dev/null'),
        std_err = fork_std_err_con))),
    error = function(e) {
        msg <- paste(rawToChar(rawConnectionValue(fork_std_err_con)), collapse = '')
        if (length(msg) == 0 || msg == '') {
            msg <- e$message
        }
        stop(msg)
    })

s3_upload_file(tarfile, file.path(CONSTANTS$infra$s3$buckets$simulations, env$request_id))

$type
[1] "string"

$id
[1] "PATID"

$label
[1] "Patient Identifier"

$description
[1] "User-provided free text (such as patient id, name or alias) to identify related simulations."

$fieldset
[1] "Patient Information"

$default
[1] "Anonymous"

$phi
[1] TRUE

$type
[1] "enum"

$length
[1] 1

$id
[1] "MODEL"

$label
[1] "Model for population of interest"

$description
[1] "Pharmacokinetic model to be used for specific patient type during simulations"

$fieldset
[1] "Model Parameters"

$labels
[1] "General Ward" "ICU"

#' Make it easy to reference a factor's possible level and fail on not existing label
#' @export
#' @examples
#' MODEL <- factor(levels = c('ICU', 'General Ward'))
#'
#' MODEL$ICU
#' # [1] ICU
#'
#' MODEL$foobar
#' # Error: Unkonwn category of 'MODEL', should be one of 'ICU', 'General Ward'
`$.factor` <- function(object, key) {
    if (!key %in% levels(object)) {
        stop(sprintf(
            'Unknown category of %s, should be one of %s',
            shQuote(deparse(substitute(object))),
            paste(shQuote(levels(object)), collapse = ', ')
        ))
    }
    key
}

list2env(methods = list(
    'bayesian' = list(
        id = 'bay',
        title = translatable( 'Bayesian adaptive dosing', 'OK to leave untranslated if there is no standard translation in the local scientific language.'), # nolint
        description = translatable('Estimate the pharmacokinetic parameters of the patient from past concentrations and creatinine levels with Bayesian inverse modeling, then use that information to predict the steady state concentrations for multiple dosing regimens and select the optimal one, with regard to the target pharmacodynamic index.', 'Helper text shown in web app to users describing what the Bayesian adaptive dosing method does.'), # nolint
        output_ids = c(
            'plot_simconc_ss',
            'excerpt_separator',
            'display_messages',
            'table_patient_params',
            'table_model_params',
            'plot_target_param_ss',
            'plot_regimens_aucpermic',
            'plot_regimens_pctabovemic',
            'plot_regimens_cmin_cmax',
            'plot_regimens_toxicity',
            'table_pk_params'
        )
    )
)

#' Calculate Lean Body Weight (LBW)
#'
#' @param sex SEX input
#' @inheritParams calc_bmi
#' @return LBW (kg)
#' @references Janmahasatian, Sarayut et al. "Quantification of lean bodyweight."
#' Clinical pharmacokinetics vol. 44,10 (2005): 1051-65. \url{https://doi.org/10.2165/00003088-200544100-00004}
#' @export
#' @importFrom data.table fcase
calc_lbw <- function(sex, height, weight) {
    # check args
    assert_sex(sex)
    # main
    mweight <- 9270 * weight
    bmi <- calc_bmi(height, weight)
    # return
    fcase(
        sex == sex$Male,   mweight / (6680 + 216 * bmi),
        sex == sex$Female, mweight / (8780 + 244 * bmi)
    )
}

#' Calculate 24 hour AUC (via trapezoidal rule), Cmin (as last concentration) and Cmax
#' for a single dosing interval (i.e. a single dose at the beginning of the interval)
#'
#' @param d data.table with concentration data
#' @return data.table with AUC, Cmin & Cmax
#' @export
#' @importFrom checkmate assert_data_table assert_names
#' @importFrom data.table data.table := .N
#' @examples
#' calc_auc_cmin_cmax(data.table::data.table(N = c(rep(1, 10), rep(2, 10)), y = 1:20))
calc_auc_cmin_cmax <- function(d) {
    # silence "no visible global function/variable definition" R CMD check
    `.` <- y <- N <- NULL
    # check args
    assert_data_table(d, any.missing = FALSE)
    dvars <- c("N", "y")
    assert_names(names(d), must.include = dvars)
    # return
    d[, .(auc = (sum(y) - (y[1] + y[.N]) / 2) * 24 / max(.N - 1, 1), cmin = y[.N], cmax = max(y)), by = N]
}