R/importHTTKDataModule.R

In ScitoVation/plethem: Population Life Course Exposure to Health Effects Modeling

#' UI for importing data from HTTK
#' @description UI function for the shiny module called by the rapidPBPK Exposure UI.
#' This will never be called directly by the user.
#' @param namespace namespace for the module
#' @import httk
#' @import miniUI
#' @export
importHTTKDataUI <- function(namespace){
  shinyjs::useShinyjs()
  ns <- NS(namespace)
  httk_chem <- httk::chem.physical_and_invitro.data$CAS
  names(httk_chem)<- httk::chem.physical_and_invitro.data$Compound
  showModal(
    modalDialog(title = "Select Chemicals",size = "l",
                selectInput(ns("org"),"Select Organism Data to Import",
                            choices=c("Human","Rat"),selected ="Human"),
                multiInput(ns("chems"),"Chemicals to Import",choices = httk_chem),
                footer = tagList(
                  actionButton(ns("import"),"Import"),
                  modalButton("Dismiss")
                  )
                )
    )
  return(NULL)
}

#'Server function for importing HTTK data
#' @description This is the server function for the importHTTKData module. This is not to be called by the user.
#' @param input input object from the UI
#' @param output output object with results
#' @param session session from which this module is called
#' @export
importHTTKData <- function(input,output,session){
  returnValues <- reactiveValues()
  returnValues$retdata <- c("No","",0)
  ns <- session$ns
  id_name <- "chemid"
  set_table_name <- "ChemicalSet"
  vals_table_name <- "Chemical"
  dataset <- httk::chem.physical_and_invitro.data
  # get the current ID for the parameter set from project database
  query <- sprintf("SELECT %s FROM %s ;",id_name,set_table_name)
  id_list <- projectDbSelect(query)
  
  if (length(id_list[[id_name]])==0){
    id_num = 1
  }else{
    id_num = max(id_list[[id_name]])+1
  }
  
  observeEvent(input$import,{
    selected_list <- input$chems
    org <- input$org
    for (each_cas in selected_list){
      
      dataidx <- which(dataset$CAS == each_cas)
      name <- dataset$Compound[dataidx]
      descrp <-"Imported From HTTK"
      query <- sprintf("INSERT INTO %s (%s, name, descrp,cas) VALUES (%d, '%s' , '%s','%s' );",
                       set_table_name,
                       id_name,
                       id_num,
                       name,
                       descrp,
                       each_cas)
      projectDbUpdate(query)
      fupls <- dataset[[paste0(org,".Funbound.plasma")]][dataidx]
      fupls <- ifelse(is.null(fupls),1,fupls)
      Clint <- dataset[[paste0(org,".Clint")]][dataidx]
      Clint <- ifelse(is.null(Clint),0,Clint)
      Clmetabolismc <- calc_hepatic_clearance(chem.cas = each_cas)
      data2write <- list("Clmetabolismc"=ifelse(is.null(Clmetabolismc),0,Clmetabolismc),
                         "Funbound.plasma"=fupls,
                         "MW"=dataset$MW[dataidx],
                         "Clint"=Clint,
                         "LogP"=dataset$logP[dataidx],
                         "LogPwa"= ifelse(is.na(dataset$logPwa[dataidx]),0,dataset$logPwa[dataidx]),
                         "LogMA"=ifelse(is.na(dataset$logMA[dataidx]),0,dataset$logMA[dataidx]),
                         "pKa_Accept"= ifelse(is.na(dataset$pKa_Accept[dataidx]),0,dataset$pKa_Accept[dataidx]),
                         "pKa_Donor"=ifelse(is.na(dataset$pKa_Donor[dataidx]),0,dataset$pKa_Donor[dataidx]),
                         "Corg"=org )
      
      var_names <- names(data2write)

      vals <- paste0("'",as.character(data2write),"'")

      all_values_string <- paste(paste0(sprintf('(%d,',id_num),
                                        sprintf("'%s'",var_names),
                                        ',',vals,')'),
                                 collapse = ", ")
      write_col_names <- sprintf("%s, param, value",id_name)
      query <- sprintf("INSERT INTO %s (%s) VALUES %s ;",
                       vals_table_name,
                       write_col_names,
                       all_values_string)
      
      projectDbUpdate(query)
      
      id_num <- id_num+1
      
      
    }
    #print(selected_list)
    removeModal()
  })
  returnValues$retdata<- eventReactive(input$import,{return(c("Yes","chem",1))})
}