Merge pull request #334 from USEPA/326-add-zscore-back-into-tcplVarMat

326 add zscore matrix back to tcplVarMat

Author: cthunes

Diff for: R/tcplVarMat.R

@@ -9,10 +9,14 @@
 #' 
 #' @param dsstox_substance_id Integer, chemical ID values to subset on
 #' @param aeid Integer, assay endpoint ID values to subset on
+#' @param std.vars Character, standard set of matrices; use this parameter to 
+#' subset this list
 #' @param add.vars Character, mc4 or mc5 field(s) not included in the standard
 #' list to add additional matrices 
 #' @param flag Integer or Logical of length 1, passed to 
 #' \code{\link{tcplSubsetChid}}
+#' @param cyto.pars List, named list of arguments passed to 
+#' \code{\link{tcplCytoPt}} for z-score matrix
 #' 
 #' @details
 #' The \code{tcplVarMat} function is used to create chemical by assay matrices
@@ -27,9 +31,12 @@
 #'  winning model.
 #'  \item "acc_verbose" -- The ACC for the winning model, with text describing
 #'  some situations.
-#'  \item "mc_hitc" -- The hit-call for the winning model in 
+#'  \item "hitc_mc" -- The hit-call for the winning model in 
 #'  multiple-concentration (mc) screening.
-#'  \item "sc_hitc" -- The hit-call in single concentration (sc) screening.
+#'  \item "hitc_sc" -- The hit-call in single concentration (sc) screening.
+#'  \item "zscore" -- The z-score based on the output from \code{tcplCytoPt}. 
+#'  The formula used for calculating the z-score is 
+#'  \eqn{-(\mathit{ac50} - \mathit{cyto\_pt})/\mathit{global\_mad}}
 #' }
 #' 
 #' \code{tcplVarMat} produces matrices of combined sc-mc output. For the ac50
@@ -57,10 +64,14 @@
 #' 
 #' When more than one sample is included for a chemical/assay pair, 
 #' \code{tcplVarMat} aggregates multiple samples to a chemical level call 
-#' utilizing \code{\link{tcplSubsetChid}}. The input
-#' for the \code{tcplVarMat} 'flag' parameter is passed to the 
-#' \code{tcplSubsetChid} call and used to parse down the data to create the 
-#' matrices.
+#' utilizing \code{\link{tcplSubsetChid}}. The tcplVarMat function calls both 
+#' \code{tcplSubsetChid} and \code{tcplCytoPt} (which separately calls 
+#' \code{tcplSubsetChid}). The input for the \code{tcplVarMat} 'flag' parameter
+#' is passed to the \code{tcplSubsetChid} call and used to parse down the data 
+#' to create the matrices. The \code{tcplSubsetChid} called within \code{tcplCytoPt}
+#' (to parse down the cytotoxicity data used to define the "zscore" matrix) can 
+#' be modified by passing a separate 'flag' element in the list defined by the 
+#' 'cyto.pars' parameter.
 #' 
 #' @return A list of chemical by assay matrices (data.tables) where the 
 #' rows are given by the dsstox_substance_id and corresponding chnm (chemical
@@ -76,6 +87,7 @@
 #' dtxsid <- c("DTXSID4034653", "DTXSID2032683", "DTXSID6032358", 
 #' "DTXSID0032651", "DTXSID8034401")
 #' varmat <- tcplVarMat(aeid = aeids, dsstox_substance_id = dtxsid)
+#' varmat <- tcplVarMat(aeid = aeids, std.vars = c("ac50", "zscore"))
 #' varmat <- tcplVarMat(aeid = aeids, add.vars = c("m4id", "resp_max", "max_med"))
 #' 
 #' ## To save output to file
@@ -92,10 +104,12 @@
 
 tcplVarMat <- function(dsstox_substance_id = NULL,
                        aeid = NULL,
+                       std.vars = c("ac50", "ac50_verbose", "acc", "acc_verbose", "hitc_mc", "hitc_sc", "zscore"),
                        add.vars = NULL,
-                       flag = TRUE) {
+                       flag = TRUE,
+                       cyto.pars = list()) {
   #variable binding
-  hitc <- aenm <- chnm <- NULL
+  hitc <- aenm <- chnm <- zscore <- chid <- cyto_pt <- global_mad <- actc <- ac50 <- NULL
 
   # check input
   if (!is.null(aeid) & !is.vector(aeid)) stop("'aeid' must be a vector.")
@@ -107,9 +121,7 @@ tcplVarMat <- function(dsstox_substance_id = NULL,
 
   if (!all(add.vars %in% valid_var)) stop("Invald add.vars value(s).")
 
-  ac50str = ifelse(check_tcpl_db_schema(),"ac50","modl_ga")
-  
-  std.vars <- c(ac50str, paste0(ac50str, "_verbose"), "acc", "acc_verbose", "hitc", "hitc.y")
+  std.vars[std.vars == "ac50"] = ifelse(check_tcpl_db_schema(),"ac50","modl_ga")
   vars <- c(std.vars, add.vars)
 
   ## Load all possibilities to create matrix dimensions
@@ -157,8 +169,15 @@ tcplVarMat <- function(dsstox_substance_id = NULL,
   # subset to one sample per chemical
   mc5 <- tcplSubsetChid(dat = mc5, flag = flag)    
 
+  # run tcplCytoPt
+  if (is.null(cyto.pars)) cyto.pars <- list()
+  zdst <- do.call(what = tcplCytoPt, args = cyto.pars)
+  mc5 <- merge(zdst[, list(chid,cyto_pt,global_mad)], mc5, by = "chid")
+  mc5[actc == TRUE, zscore := -(log10(ac50) - cyto_pt)/global_mad]
+  mc5[actc == FALSE, zscore := NA]
+  
   # build matrices
-  mc5 <- mc5[hitc %in% c(0,-1), c("ac50", "acc") := 1e6]
+  mc5 <- mc5[actc == FALSE, c("ac50", "acc") := 1e6]
   long_sc2 <- sc2 |> group_by(dsstox_substance_id,aenm,chnm)
   if (nrow(long_sc2) > 0) {
     long_sc2 <- long_sc2 |> summarise(hitc = max(hitc)) |> filter(!is.na(dsstox_substance_id))
@@ -169,9 +188,11 @@ tcplVarMat <- function(dsstox_substance_id = NULL,
       var <- sub("_verbose", "", var)
       verbose = TRUE
     }
+    mc_var <- sub("\\_mc|\\_sc", "", var)
+    if (!mc_var %in% colnames(mc5)) stop(paste(mc_var, "is not a valid column in mc4 or mc5."))
     long_mc5 <- mc5 |> group_by(dsstox_substance_id,aenm,chnm) |> 
-      summarise(across(all_of(sub("\\.y", "", var)), mean)) |> filter(!is.na(dsstox_substance_id))
-    long_all <- long_mc5 |> full_join(long_sc2, by = c("dsstox_substance_id","aenm", "chnm"))
+      summarise(across(all_of(mc_var), mean)) |> filter(!is.na(dsstox_substance_id))
+    long_all <- long_mc5 |> full_join(long_sc2, suffix = c("_mc", "_sc"), by = c("dsstox_substance_id","aenm", "chnm"))
     long_res <- if (substr(var, 1, 2) == "ac") long_all |> 
       mutate("{var}" := case_when(is.na(get(var)) && hitc == 0 ~ 1e8, 
                                   is.na(get(var)) && hitc == 1 ~ 1e7, 
@@ -188,7 +209,7 @@ tcplVarMat <- function(dsstox_substance_id = NULL,
 
   mat_list <- lapply(vars, build_matrix)
 
-  names(mat_list) = c("ac50", "ac50_verbose", "acc", "acc_verbose", "mc_hitc", "sc_hitc", add.vars)
+  names(mat_list) <- vars
 
   mat_list