196 overwrite osd during hitcalling (#199)

* created overwrite method for osd so that bmr == coff and removed unnecessary sql statement from mc5

* removed ow from mc5 method as that is only applied after hitcalling

* added if statement to check for osd_coff_bmr method and to overwrite osd right before hitcalling

* removed bug where loec.coff copied code was left in osd codeblock

* changed osd value to all_onesd to match what is loaded during tcplloaddata

* pivot mc4 dat to long format to fit how tcplfit2 nesting is required

* initialize overwrite_osd value

R/mc5.R

@@ -35,6 +35,8 @@ mc5 <- function(ae, wr = FALSE) {
   gnls_la <- modl_lw <- gnls_lw <- gnls_rmse <- gnls_prob <- actp <- NULL
   modl_ac10 <- model_type <- NULL 
 
+  overwrite_osd <- FALSE
+
   owarn <- getOption("warn")
   options(warn = 1)
   on.exit(options(warn = owarn))
@@ -81,6 +83,14 @@ mc5 <- function(ae, wr = FALSE) {
     loec.mthd = TRUE
     ms <- ms[!mthd=='loec.coff']
   }
+
+  #special case where osd needs to be overwritten
+  if ('osd_coff_bmr' %in% ms$mthd) {
+    overwrite_osd <- TRUE
+    ms_osd_coff_bmr = ms[mthd=='osd_coff_bmr']
+    ms <- ms[!mthd=='osd_coff_bmr']
+  }
+
   ## Extract methods that need to overwrite hitc and hit_val
   ms_overwrite <- ms[grepl("ow_",mthd),]
   ## Extract methods that don't overwrite
@@ -99,19 +109,19 @@ mc5 <- function(ae, wr = FALSE) {
   ## Determine final cutoff
   dat[ , coff := max(coff)]
 
+
   ## Check to see if we are using the v3 schema
   # currently can only use one coff
   if (check_tcpl_db_schema()) {
     cutoff <- max(dat$coff)
-    #can remove this once loading of data is working correctly
-    dat <- tcplQuery(paste0("SELECT  
-    `mc4`.`m4id`,    `mc4`.`aeid`,    `mc4`.`spid`,    `mc4`.`bmad`,    `mc4`.`resp_max`,    `mc4`.`resp_min`,
-    `mc4`.`max_mean`,    `mc4`.`max_mean_conc`,    `mc4`.`min_mean`,    `mc4`.`min_mean_conc`,
-    `mc4`.`max_med`,    `mc4`.`max_med_conc`,    `mc4`.`min_med`,    `mc4`.`min_med_conc`,    
-    `mc4`.`max_med_diff`,    `mc4`.`max_med_diff_conc`,    `mc4`.`conc_max`,    `mc4`.`conc_min`,    `mc4`.`nconc`,
-    `mc4`.`npts`,    `mc4`.`nrep`,    `mc4`.`nmed_gtbl_pos`,    `mc4`.`nmed_gtbl_neg`,
-    `mc4`.`tmpi`,	  `mc4_param`.`model`,    `mc4_param`.`model_param`,    `mc4_param`.`model_val`
-    FROM mc4 inner join mc4_param on mc4.m4id = mc4_param.m4id where mc4.aeid = ",ae,";"))
+
+    # before hitcalling overwrite osd value
+    if(overwrite_osd){
+      exprs <- lapply(mthd_funcs[ms_osd_coff_bmr$mthd], do.call, args = list())
+      fenv <- environment()
+      invisible(rapply(exprs, eval, envir = fenv))
+    }
+
     # if we're using v3 schema we want to tcplfit2
     dat <- tcplHit2(dat, coff = cutoff)
   } else {

R/mc5_mthds.R

@@ -333,6 +333,16 @@ mc5_mthds <- function(ae) {
 	  list(e1, e2, e3, e4)
 
 	}
+
+	,
+
+	osd_coff_bmr = function() {
+
+	  # set the osd param so that bmr == coff
+	  e1 <- bquote(dat[ , all_onesd := coff/1.349 ])
+	  list(e1)
+
+	}
 
   )
 }

R/tcplFit2.R

@@ -61,6 +61,7 @@ tcplFit2 <- function(dat,
 #' @return Data.table with key value pairs of hitcalling parameters
 #' @importFrom dplyr %>% filter group_by summarise left_join inner_join select rowwise mutate pull ungroup
 #' @importFrom tidyr pivot_longer
+#' @importFrom tidyr separate_wider_delim
 #' @importFrom tcplfit2 tcplhit2_core
 tcplHit2 <- function(mc4, coff) {
 
@@ -69,7 +70,10 @@ tcplHit2 <- function(mc4, coff) {
   model <- m4id  <-model_param  <-model_val  <-resp  <- NULL
   params  <-conc  <-bmed  <-onesd  <-df  <-aeid  <- NULL
   fit_method  <-hitcall  <-cutoff  <-top_over_cutoff  <-bmd  <-hit_val <- NULL
-  nested_mc4 <- mc4 %>%
+
+  long_mc4 <- mc4 |> tidyr::pivot_longer(cols = matches("cnst|hill|gnls|poly1|poly2|pow|exp2|exp3|exp4|exp5|all"), names_to = "model", values_to = "model_val") |> tidyr::separate_wider_delim(col = "model",delim = "_", names = c("model","model_param"), too_many = "merge")
+
+  nested_mc4 <- long_mc4 %>%
     filter(model != "all") %>%
     group_by(m4id) %>%
     summarise(params = list(tcplFit2_nest(data.table(model = model, model_param = model_param, model_val = model_val))))
@@ -82,10 +86,10 @@ tcplHit2 <- function(mc4, coff) {
   nested_mc4 <- nested_mc4 %>% left_join(l3_dat %>% group_by(m4id) %>% summarise(conc = list(conc), resp = list(resp)), by = "m4id")
 
   # rejoin the onesd for tcplfit2
-  nested_mc4 <- nested_mc4 %>% inner_join(mc4 %>% filter(model_param == "onesd") %>% select(m4id, onesd = model_val), by = "m4id")
+  nested_mc4 <- nested_mc4 %>% inner_join(long_mc4 %>% filter(model_param == "onesd") %>% select(m4id, onesd = model_val), by = "m4id")
 
   # rejoin for bmed
-  nested_mc4 <- nested_mc4 %>% inner_join(mc4 %>% filter(model_param == "bmed") %>% select(m4id, bmed = model_val), by = "m4id")
+  nested_mc4 <- nested_mc4 %>% inner_join(long_mc4 %>% filter(model_param == "bmed") %>% select(m4id, bmed = model_val), by = "m4id")
 
   # add the cutoff
   # nested_mc4$cutoff <- coff
@@ -115,7 +119,7 @@ tcplHit2 <- function(mc4, coff) {
     dplyr::ungroup()
   res <- res %>% mutate(coff_upper = 1.2 * cutoff, coff_lower = .8 * cutoff)
   res <- res %>%
-    left_join(mc4 %>% select(m4id, conc_min, conc_max) %>% unique(), by = "m4id") %>%
+    left_join(long_mc4 %>% select(m4id, conc_min, conc_max) %>% unique(), by = "m4id") %>%
     mutate(fitc = case_when(
       hitcall >= .9 & abs(top) <= coff_upper & ac50 <= conc_min ~ 36L,
       hitcall >= .9 & abs(top) <= coff_upper & ac50 > conc_min & ac95 < conc_max ~ 37L,
@@ -132,13 +136,13 @@ tcplHit2 <- function(mc4, coff) {
 
   # mc5 table
   mc5 <- res %>%
-    left_join(mc4 %>% select(m4id, aeid) %>% unique(), by = "m4id") %>%
+    left_join(long_mc4 %>% select(m4id, aeid) %>% unique(), by = "m4id") %>%
     select(m4id, aeid, modl = fit_method, hitc = hitcall,fitc, coff = cutoff) %>%
     mutate(model_type = 2)
 
   # mc5 param table
   mc5_param <- res %>%
-    left_join(mc4 %>% select(m4id, aeid) %>% unique(), by = "m4id") %>%
+    left_join(long_mc4 %>% select(m4id, aeid) %>% unique(), by = "m4id") %>%
     select(m4id, aeid, top_over_cutoff:bmd)
   mc5_param <- mc5_param %>%
     tidyr::pivot_longer(cols = top_over_cutoff:bmd, names_to = "hit_param", values_to = "hit_val") %>%