In qPharmetra/PMDatR: Pharmacometric Data Management in R

library(knitr)
library(dplyr)
library(methods)
library(ggplot2)
library(Hmisc)
library(PMDatR)

opts_chunk$set(error=TRUE, echo=F, fig.width=10, fig.height = 7)
knit_hooks$set(error = function(x, options) print(PMDatR:::reinterpret_errors(x)))
knit_hooks$set(warning = function(x,options)print(PMDatR:::reinterpret_errors(x)))

Initialization

flagOK = F
settingsYAML=list()
if(params$settings_file!=""){
  settingsYAML = PMDatR:::load_yaml_file(params$settings_file)
  base_name = tools::file_path_sans_ext(basename(params$settings_file))
  func_file = paste0(base_name, "_funcs.r")
  db.file = paste0(base_name, ".database.csv")
  nm.file = paste0(base_name, ".csv")

  if(file.exists(db.file)) db.df = read.csv(db.file)
  if(file.exists(nm.file)) nm.df = read.csv(nm.file, na.strings = ".")
}
DSet=settingsYAML$Diagnostics

Load settings file: r params$settings_file

Load data: r db.file

if(!exists("db.df")){
  cat("#### ERROR PM1: Database file not found. Check for errors in the process_settings and merge_data files.")
  knitr::knit_exit()
}

IDcol = DSet$IDColumn
if(PMDatR:::is.empty.yaml(IDcol)){
  # look for id-like columns
  potids = c("subjid","subj","usubjid","patient","id","nmid","xid")
  # find possible IDcols in order
  cols = potids[potids %in% tolower(names(db.df))]
  IDcol = cols[1]
  if(is.na(IDcol)){
    cat("#### ERROR PM2: Cannot identify ID Column.  Please set IDColumn in settings.")
    knitr::knit_exit()    
  }
}

cat(sprintf("ID column identified as: %s\n\n", IDcol))

Error Detection

nodoses = find_subjects_no_dosing(db.df, IDcol)
noobs = find_subjects_no_obs(db.df, IDcol)



if(nrow(nodoses)>0){
  cat(sprintf("Subjects with no dosing records: %s\n\n", paste(nodoses[["IDcol"]],collapse=", ")))
} else{
  cat("No subjects without doses\n\n")
}

if(nrow(noobs)>0){
  cat(sprintf("Subjects with no observation records: %s\n\n", paste(noobs[["IDcol"]],collapse=", ")))
} else{
  cat("No subjects without observations\n\n")
}

if(DSet$CheckPlacebo){
  placeboerr = find_subjects_placebo_obs(db.df, DSet$PlaceboCriteria, DSet$ObservationCriteria, IDcol)
  if(nrow(placeboerr)>0){
    cat(sprintf("Placebo subjects with non-zero observations: %s\n\n", paste(placeboerr[["IDcol"]],collapse=", ")))
  } else{
    cat("No placebo subjects with observations\n\n")
  }
}

Tables

Table summary for DV and for AMT.

if(DSet$DVreconcile){
  table_dv(.data = db.df, DSet$DVreconcileStrata)$tab %>% kable
} else cat("skipped")

Table summary for Time variables.

if(DSet$TimeSummary){
  table_time(.data = db.df, DSet$TimeSummaryStrata)$tab %>% kable
} else cat("skipped")

Summary of Data Variables

if(DSet$VarSummary)
{
  # continuous summary
  sig = function(x, signifs=4, fmt=paste0("%.",signifs,"g")) sprintf(fmt, x)
  conDataFun = function(x){c(mean=sig(mean(x)), sd=sig(sd(x)), median=sig(median(x)), 
                             range=paste(sig(range(x)), collapse=" -- "))}
  catDataFun = function(x){
    x=table(x)
    setNames(sprintf("%g (%.4g%%)", x, x/sum(x)*100),names(x))}

  #get first non-NA value for each subject
  first.not.na = function(x) Find(function(x){!is.na(x)},x)
  x.df = db.df %>% group_by_(.dots=IDcol) %>% summarise_each(funs(first.not.na))

  # summarise over subjects
  summary_table(x.df, cols=DSet$VarSummaryColumns, grouping=DSet$VarSummaryGroups,conFn=conDataFun,catFn=catDataFun) %>% kable("markdown")
} else cat("skipped")

Outlier detection

Table of outliers by time cuts and/or strata

if(DSet$Outliers)
{
  table_outlier_byCuts(db.df, strata= DSet$OutliersStrata, idv=DSet$OutlierBinning)$tab %>% kable
} else cat("skipped")

Plot outliers by time cuts and/or strata

if(DSet$Outliers)
{
  plot_outlier_byCuts(db.df, strata= DSet$OutliersStrata, idv=DSet$OutlierBinning)
} else cat("skipped")

Plots

Covariate Plots

if(DSet$VarSummary)
{

  plist=covariate_plots(db.df %>% group_by_(.dots=IDcol) %>% summarise_each(funs(first.not.na)), 
                        cols=DSet$VarSummaryColumns,
                        grouping=DSet$VarSummaryGroups)
  for (i in seq_along(plist)) print(plist[[i]])
} else cat("skipped")

spaghetti plots

if(DSet$SpaghettiPlots){
  plist= plot_spaghetti(db.df,idv="TAD,TIME", 
                              grouping=DSet$DVPlotsGrouping,
                              strata=DSet$DVPlotsStrata,
                              logY = DSet$DVPlotslogY,
                              ID=IDcol)
  for (i in seq_along(plist)) print(plist[[i]])
} else cat("skipped")

individual plots

Individual plots . Grey points and lines for DV, red points for doses. Plots that would have all missing data are dropped.

r ifelse(DSet$ShowADDL,"Vertical lines show dosing. Long-dash is original dose record. Short-dash is imputed ADDL record. Solid is expanded from ADDL record","")

if(DSet$IndPlots){
  len=1
  x=unique(db.df[[IDcol]])
  pages = split(x, ceiling(seq_along(x)/len))

  #convert character to factor (to preserve scales across plots) and remove non-finite DV
  plot.df = db.df %>% mutate_if(is.character,as.factor) %>% filter(is.finite(DV))

  for(id in x){
    pind.df = plot.df %>% filter_(sprintf("%s == '%s'", IDcol, id))
    if(nrow(pind.df)>0){
      plist = pind.df %>%
        plot_individual(idv=DSet$DVPlotsXaxis, grouping=DSet$DVPlotsGrouping,
                        strata=DSet$DVPlotsStrata, logY = DSet$DVPlotslogY, showADDL=DSet$ShowADDL, IDcol)
    } else{
      cat(sprintf("Subject %s has no finite observations.  Skipping individual plot.", id))
    }
    for (i in seq_along(plist)) print(plist[[i]])
  }
} else cat("skipped")

qPharmetra/PMDatR documentation built on April 7, 2024, 5:42 p.m.