inst/doc/FupRED_vignette.R

params <-
list(css = "css/rmdformats.css")

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.align = 'center'
)

## ----echo = FALSE, out.width = "100%", fig.cap = "Fig 1: f~up~ RED experimental set up", fig.topcaption = TRUE, fig.align = "center"----
knitr::include_graphics("img/fupRED_diagram.png")

## ----setup, message = FALSE, warning = FALSE----------------------------------
# Primary package
library(invitroTKstats)
# Data manipulation package
library(dplyr)
# Table formatting package 
library(flextable)

## ----Load example data--------------------------------------------------------
# Load example fup RED data 
data("fup-red-example")

## ----echo = FALSE, warning = FALSE--------------------------------------------
head(fup_red_L0, n = 3) %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_table_properties(
    opts_html = list(
      scroll = list(
        
      )
    )
  ) %>% 
  set_caption(caption = "Table 1: Level 0 data", 
              align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "all") %>% 
  theme_vanilla()

## ----required cols, echo = FALSE----------------------------------------------
# Create table of required arguments for Level 1 

req_cols <- data.frame(matrix(nrow = 31, ncol = 5))
vars <- c("Argument", "Default", "Required in L0?", "Corresp. single-entry Argument", "Descr.")
colnames(req_cols) <- vars

# Argument names 
arguments <- c("FILENAME", "data.in", "sample.col", "date.col", "compound.col", "dtxsid.col", 
               "lab.compound.col", "type.col", "cal.col", "dilution.col", "time.col", 
               "istd.col", "istd.name.col", "istd.conc.col", "test.nominal.conc.col", 
               "plasma.percent.col", "test.conc.col", "area.col",
               "biological.replicates.col", "technical.replicates.col",
               "analysis.method.col", "analysis.instrument.col", 
               "analysis.parameters.col", "note.col", "level0.file.col", 
               "level0.sheet.col", "output.res", "save.bad.types", "sig.figs", 
               "INPUT.DIR", "OUTPUT.DIR")
req_cols[,"Argument"] <- arguments 

# Default arguments 
defaults <- c("MYDATA", NA, "Lab.Sample.Name", "Date", "Compound.Name", "DTXSID",
              "Lab.Compound.Name", "Sample.Type", "Cal", "Dilution.Factor", 
              "Time", "ISTD.Area", "ISTD.Name", "ISTD.Conc", "Test.Target.Conc", 
              "Plasma.Percent", "Test.Compound.Conc", "Area", "Biological.Replicates", 
              "Technical.Replicates", "Analysis.Method", "Analysis.Instrument", 
              "Analysis.Parameters", "Note", "Level0.File", "Level0.Sheet", 
              FALSE, FALSE, 5, NA, NA)
req_cols[,"Default"] <- defaults

# Argument required in L0? 
req_cols <- req_cols %>% 
  mutate("Required in L0?" = case_when(
    Argument %in% c("sample.col", "compound.col", "dtxsid.col", "lab.compound.col", 
                    "type.col", "istd.col", "area.col") ~ "Y",
    Argument %in% c("FILENAME", "data.in", "output.res", "save.bad.types", "sig.figs", 
                    "INPUT.DIR", "OUTPUT.DIR") ~ "N/A",
    .default = "N"
  ))

# Corresponding single-entry Argument 
req_cols <- req_cols %>% 
  mutate("Corresp. single-entry Argument" = ifelse(.data[[vars[3]]] == "N" & .data[[vars[[1]]]] != "note.col",
                                                   gsub(".col", "", Argument), NA))

# Brief description 
description <- c("Output and input filename",
                 "Level 0 data frame", 
                 "Lab sample name", 
                 "Lab measurement date", 
                 "Formal test compound name", 
                 "EPA's DSSTox Structure ID", 
                 "Lab test compound name (abbr.)", 
                 "Sample type (Blank/Plasma/PBS/T0/Stability/EC_acceptor/EC_donor/CC)",
                 "MS calibration", 
                 "Number of times sample was diluted",
                 "Incubation time", 
                 "Internal standard peak area", 
                 "Internal standard name", 
                 "Internal standard concentration", 
                 "Initial chemical concentration",
                 "% of the physiological plasma concentration",
                 "Standard test chemical concentration",
                 "Target analyte peak area", 
                 "Replicates with the same analyte", 
                 "Repeated measurements from one sample",
                 "Analytical chemistry analysis method",
                 "Analytical chemistry analysis instrument", 
                 "Analytical chemistry analysis parameters", 
                 "Additional notes", 
                 "Raw data filename", 
                 "Raw data sheet name", 
                 "Export results (TSV)?",
                 "Export bad data (TSV)?",
                 "Number of significant figures", 
                 "Input directory of Level 0 file", 
                 "Export directory to save Level 1 files")
req_cols[,"Descr."] <- description

## ----echo = FALSE, warning = FALSE--------------------------------------------
req_cols %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_table_properties(
    opts_html = list(
      scroll = list(
        height = 200
      )
    )
  ) %>% 
  set_caption(caption = "Table 2: Level 1 `format_fup_red` function arguments", align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "all") %>% 
  theme_vanilla()

## ----L1 processing------------------------------------------------------------
fup_red_L1_curated <- format_fup_red(FILENAME = "Fup_RED_vignette",
                                     data.in = fup_red_L0, 
                                     # columns present in L0 data 
                                     sample.col = "Sample",
                                     compound.col = "Compound", 
                                     lab.compound.col = "Lab.Compound.ID",
                                     istd.col = "ISTD.Peak.Area", 
                                     test.conc.col = "Compound.Conc",
                                     area.col = "Peak.Area",
                                     technical.replicates.col = "Replicate",
                                     note.col = NULL,
                                     # columns not present in L0 data
                                     cal = 1, 
                                     istd.conc = 0.01, 
                                     test.nominal.conc = 10,
                                     plasma.percent = 100,
                                     biological.replicates = 1,
                                     analysis.method = "LCMS",
                                     analysis.instrument = "Waters ACQUITY I-Class UHPLC - Xevo TQ-S uTQMS",
                                     analysis.parameters = "RT",
                                     # don't export output TSV file 
                                     output.res = FALSE
                                     )

## ----echo = FALSE-------------------------------------------------------------
fup_red_L0 %>% 
  filter(!Sample.Type %in% c("Plasma", "PBS", "T0", "Plasma.Blank", "NoPlasma.Blank","CC", "Stability", "EC_donor", "EC_acceptor")) %>% 
  head(n = 5) %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>%
  autofit() %>%
  set_table_properties(
    opts_html = list(
      scroll = list(
        height = 200
      )
    )
  ) %>% 
  set_caption(caption = "Table 3: Subset of removed samples",
              align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "all") %>% 
  theme_vanilla()

## ----eval = FALSE-------------------------------------------------------------
# # All the samples of an inappropriate sample type
# excluded <- fup_red_L0 %>%
#   filter(!Sample.Type %in% c("Plasma", "PBS", "T0", "Plasma.Blank", "NoPlasma.Blank","CC", "Stability", "EC_acceptor", "EC_donor"))
# 
# # Exclude based on Sample and DTXSID
# X <- c(excluded$Sample)
# names(X) <- paste(excluded$Sample, excluded$DTXSID, sep = "+")
# Y <- c(excluded$DTXSID)
# 
# # Find samples in L1 data frame with matching sample name (X) and DTXSID (Y)
# matches <- as.data.frame(t(mapply(function(X,Y)
#   {subset(fup_red_L1_curated, Lab.Sample.Name == X & DTXSID == Y)},
#   X, Y, USE.NAMES = T)))
# 
# matches
# 
# # Check that no matches were returned for each sample in `excluded`
# check <- rep(1, nrow(matches))
# names(check) <- rownames(matches)
# for (name in rownames(matches)){
#   # If no matches were found, each element of check should evaluate to 0
#   check[name] <- sum(sapply(c(1:ncol(matches)),
#                             function(X){length(matches[1,X][[1]])}))
# }
# 
# # Verify that each sample in `excluded` had no matches
# check
# 
# # If no matches, should evaluate to 0
# sum(check)

## ----echo = FALSE-------------------------------------------------------------
fup_red_L1_curated %>% 
  head(n = 3) %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_table_properties(
    opts_html = list(
      scroll = list(
      )
    )
  ) %>% 
  set_caption(caption = "Table 4: Level 1 data", 
              align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "all") %>% 
  theme_vanilla()

## ----L2 processing exclusion--------------------------------------------------
# Use verification data from loaded in `fup_red_L2` data frame 
exclusion <- fup_red_L2 %>% 
  filter(Verified != "Y") %>% 
  mutate("Variables" = "Lab.Sample.Name|DTXSID") %>% 
  mutate("Values" = paste(Lab.Sample.Name, DTXSID, sep = "|")) %>% 
  mutate("Message" = Verified) %>% 
  select(Variables, Values, Message)

## ----echo = FALSE-------------------------------------------------------------
exclusion %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_table_properties(
    opts_html = list(
      scroll = list(
        height = 200
      )
      )
  ) %>% 
  set_caption(caption = "Table 5: Exclusion data frame",
              align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "all") %>% 
  theme_vanilla()

## -----------------------------------------------------------------------------
fup_red_L2_curated <- sample_verification(FILENAME = "Fup_RED_vignette",
                                          data.in = fup_red_L1_curated,
                                          assay = "fup-RED",
                                          # don't export output TSV file
                                          output.res = FALSE)

## ----echo = FALSE-------------------------------------------------------------
fup_red_L2_curated %>% 
  head(n = 3) %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_table_properties(
    opts_html = list(
      scroll = list()
      )
  ) %>% 
  set_caption("Table 6: Level 2 data", align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "body") %>% 
  theme_vanilla()

## -----------------------------------------------------------------------------
fup_red_L3_curated <- calc_fup_red_point(FILENAME = "Fup_RED_vignette",
                                         data.in = fup_red_L2_curated, 
                                         # don't export output TSV file
                                         output.res = FALSE)

## ----echo = FALSE-------------------------------------------------------------
fup_red_L3_curated %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_caption("Table 7: Level 3 data", align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "body") %>% 
  theme_vanilla()

## ----L4 processing, message = FALSE, eval = FALSE-----------------------------
# fup_red_L4_curated <- calc_fup_red(FILENAME = "Fup_RED_vignette",
#                                    data.in = fup_red_L2_curated,
#                                    JAGS.PATH = runjags::findjags()
#                                    )

## ----echo = FALSE-------------------------------------------------------------
fup_red_L4_curated <- fup_red_L4

## ----echo = FALSE, eval = TRUE------------------------------------------------
fup_red_L4_curated %>% 
  flextable() %>% 
  bg(bg = "#DDDDDD", part = "header") %>% 
  autofit() %>% 
  set_table_properties(
    opts_html = list(
      scroll = list(
      )
      )
  ) %>% 
  set_caption(caption = "Table 8: Level 4 data",
              align_with_table = FALSE) %>% 
  fontsize(size = 10, part = "all") %>% 
  theme_vanilla()

Try the invitroTKstats package in your browser

Any scripts or data that you put into this service are public.

invitroTKstats documentation built on Aug. 23, 2025, 9:08 a.m.