In pnolain/popkinr: Shiny applications for pharmacometrics

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
options(knitr.kable.NA = '')
library(pmxploit)
library(tibble)
library(tidyr)
library(dplyr)

run <- params$run
n_estimation <- params$estimation_number

base_info_df <- tibble(ID = run$info$run_id,
                           `CONTROL STREAM` = run$info$control_stream_file,
                           `DATASET` = run$info$dataset_file,
                           `OBSERVATIONS` = run$info$number_of_observations,
                           `INDIVIDUALS` = run$info$number_of_subjects,
                           PROBLEM = run$info$problem,
                           START = format(run$info$start_time, "%d/%m/%Y %H:%M"),
                           DURATION = lubridate::seconds_to_period(run$info$duration))

knitr::kable(gather(base_info_df), caption = "Base info", col.names = c("", ""))

est <- run$estimations[[n_estimation]]

est_df <- tibble(`ESTIMATION STEP` = sprintf("%s of %s", n_estimation, length(run$estimations)),
                     METHOD = est$title,
                     STATUS = ifelse(est$failed, "Failed",
                                     ifelse(!est$minimization,
                                            "No minimization",
                                            ifelse(est$termination_status == 0,
                                                   "Successful",
                                                   "Terminated"))),
                     DURATION = lubridate::seconds_to_period(est$duration),
                     SIGDIGITS = est$significant_digits,
                     EIGENRATIO = est$eigenratio,
                     CORRELATION = est$correlation,
                     OBJ = est$final_ofv,
                     AIC = est$aic,
                     BIC = est$bic)

knitr::kable(gather(est_df), caption = "Estimation info", col.names = c("", ""))

if(!is.null(est$thetas)){
  thetas_df <- est$thetas %>%
    mutate(rse = rse * 100, ci_low = ci_low, ci_up = ci_up) %>% 
    rename(ID = id, THETA = name, Estimate = estimate, SE = se, `RSE (%)` = rse, LO = ci_low, UP = ci_up) %>% 
    arrange(ID)

  knitr::kable(thetas_df, caption = "Fixed effects")
}

if(!is.null(est$omega)){
  omegas_df <- est$omega %>%
    mutate(eta1 = sprintf("%s:%s", eta1, eta2)) %>% 
    mutate(rse = rse * 100, ci_low = ci_low, ci_up = ci_up) %>% 
    select(-eta2) %>% 
    rename(COVARIANCE = eta1, Estimate = estimate, SE = se, `RSE (%)` = rse, LO = ci_low, UP = ci_up) %>% 
    arrange(COVARIANCE)

  knitr::kable(omegas_df, caption = "Random effects covariances")
}

if(!is.null(est$eta_bars)){
  eta_bars_df <- est$eta_bars %>%
    rename(ID = id, ETA = name, ETABAR = value, SE = se, `p-value` = pvalue) %>% 
    arrange(ID) 

  knitr::kable(eta_bars_df, caption = "Empirical Bayes Estimates mean values (ETABAR)")
}

if(!is.null(est$shrinkage)){
  eta_shrink_df <- est$shrinkage %>%
    filter(type != "EPS")  %>%
    spread(type, shrinkage) %>%
    select(parameter, ETA, EBV) %>%
    rename(`ETA shrinkage` = ETA, `EBV shrinkage` = EBV)

  knitr::kable(eta_shrink_df, caption = "Random effects shrinkage")
}

if(!is.null(est$sigma)){
  eps_df <- est$sigma %>% 
    mutate(epsilon1 = sprintf("%s:%s", epsilon1, epsilon2),
           rse = rse * 100) %>% 
    select(-epsilon2) %>% 
    rename(`COVARIANCE` = epsilon1, Estimate = estimate, SE = se, `RSE (%)` = rse, LO = ci_low, UP = ci_up) %>% 
    arrange(COVARIANCE)

  knitr::kable(eps_df, caption = "Residual error terms covariances")
}

if(!is.null(est$shrinkage)){
  eps_shrink_df <- est$shrinkage %>%
    filter(type == "EPS") %>% 
    select(-type) %>% 
    arrange(parameter)

  knitr::kable(eps_shrink_df,  caption = "Residual error terms shrinkage")
}