diff --git a/.DS_Store b/.DS_Store index 65ffb38c..d9b464d9 100644 Binary files a/.DS_Store and b/.DS_Store differ diff --git a/R/mod_dataUpload.R b/R/mod_dataUpload.R index b1eac7c0..db8dad93 100755 --- a/R/mod_dataUpload.R +++ b/R/mod_dataUpload.R @@ -1,179 +1,181 @@ -#' The dataUpload UI -#' provides the interface for uploading ADSL data -#' and a table overview of the uploaded file -#' -#' @description A shiny Module. -#' -#' @return a shiny \code{\link[shiny]{tagList}} -#' containing the filter ui -#' -#' @param id Internal parameters for {shiny}. -#' -#' @import shiny -#' -mod_dataUpload_ui <- function(id){ - ns <- shiny::NS(id) - tagList( - h1("Data Upload/Preview", align = "center"), - br(), br(), br(), - actionButton(ns("pilot"), "Use CDISC Pilot Data"), - fluidRow( - style = "padding: 20px", - column(3, - wellPanel( - div(style="display: inline-block; ",h3("Data upload")), - div(style="display: inline-block; float:right;",mod_dataComplyRules_ui("dataComplyRules_ui_1")), - HTML("
ADSL file is mandatory & BDS/ OCCDS files are optional"), - fileInput(ns("file"), "Upload sas7bdat files",accept = c(".sas7bdat"), multiple = TRUE), - uiOutput(ns("radio_test")) - ) - ), - column(6, - fluidRow( - wellPanel( - span(textOutput(ns("multi_studies")), style="color:red;font-size:20px"), - uiOutput(ns("datapreview_header")), - div(DT::dataTableOutput(ns("data_preview")), style = "font-size: 75%") - ) - ) - ) - ) - ) -} - - -#' dataUpload Server Function stores -#' the uploaded data as a list and -#' is exported to be used in other modules -#' -#' @param input,output,session -#' Internal parameters for {shiny}. -#' -#' @return a list of dataframes -#' \code{dd$dataframe} -#' to be used in other modules -#' -#' @import shiny -#' @importFrom haven zap_formats -#' @importFrom haven read_sas -#' @importFrom stringr str_remove -#' -mod_dataUpload_server <- function(input, output, session){ - ns <- session$ns - - # initiate reactive values - list of uploaded data files - # standard to imitate output of detectStandard.R - dd <- reactiveValues() - - # modify reactive values when data is uploaded - observeEvent(input$file, { - - data_list <- list() - - ## data list - for (i in 1:nrow(input$file)){ - if(length(grep(".sas7bdat", input$file$name[i], ignore.case = TRUE)) > 0){ - data_list[[i]] <- haven::zap_formats(haven::read_sas(input$file$datapath[i])) - }else{ - data_list[[i]] <- NULL - } - } - - # names - names(data_list) <- toupper(stringr::str_remove(input$file$name, ".sas7bdat")) - - - - # run that list of dfs through the data compliance module, replacing list with those that comply - dl_comply <- callModule(mod_dataComply_server, - id = NULL, #"dataComply_ui_1", - datalist = reactive(data_list)) - - if(length(names(dl_comply)) > 0){ - # append to existing reactiveValues list - dd$data <- c(dd$data, dl_comply) # dl_comply # - } - - # set dd$current to FALSE for previous & TRUE for current uploads - dd$current <- c(rep(FALSE, length(dd$current)), rep(TRUE, length(data_list))) - - }) - - - - ### make a reactive combining dd$data & standard - data_choices <- reactive({ - req(dd$data) - #req(dd$standard) - - choices <- list() - for (i in 1:length(dd$data)){ - choices[[i]] <- names(dd$data)[i] - } - - return(choices) - }) - - - - observeEvent(dd$data, { - req(data_choices()) - - vals <- data_choices() - names(vals) <- NULL - names <- data_choices() - prev_sel <- lapply(reactiveValuesToList(input), unclass)$select_file # retain previous selection - - output$radio_test <- renderUI( - radioButtons(session$ns("select_file"), label = "Inspect Uploaded Data", - choiceNames = names, choiceValues = vals, selected = prev_sel)) - - }) - - # get selected dataset when selection changes - data_selected <- eventReactive(input$select_file, { - isolate({index <- which(names(dd$data)==input$select_file)[1]}) - dd$data[[index]] - }) - - studies <- reactive({ - unique(unlist(lapply(dd$data, `[[`, "STUDYID"))) - }) - - output$multi_studies <- renderText({ - req(length(studies()) > 1) - paste0("Warning: data uploaded from multiple studies: ", paste(studies(), collapse = " & ")) - }) - - # upon a dataset being uploaded and selected, generate data preview - output$datapreview_header <- renderUI({ - data_selected() - isolate(data_name <- input$select_file) - h3(paste("Data Preview for", data_name)) - }) - - output$data_preview <- DT::renderDataTable({ - DT::datatable(data = data_selected(), - style="default", - class="compact", - extensions = "Scroller", options = list(scrollY=400, scrollX=TRUE)) - }) - - observeEvent( input$pilot, { - - shinyjs::disable(id = "file") - - dd$data <- list( - ADSL = adsl, - ADVS = advs, - ADAE = adae, - ADLBC = adlbc - ) - - shinyjs::hide(id = "pilot") - }) - - - ### return all data - return(reactive(dd$data)) +#' The dataUpload UI +#' provides the interface for uploading ADSL data +#' and a table overview of the uploaded file +#' +#' @description A shiny Module. +#' +#' @return a shiny \code{\link[shiny]{tagList}} +#' containing the filter ui +#' +#' @param id Internal parameters for {shiny}. +#' +#' @import shiny +#' +mod_dataUpload_ui <- function(id){ + ns <- shiny::NS(id) + tagList( + h1("Data Upload/Preview", align = "center"), + br(), br(), br(), + actionButton(ns("pilot"), "Use CDISC Pilot Data"), + fluidRow( + style = "padding: 20px", + column(3, + wellPanel( + div(style="display: inline-block; ",h3("Data upload")), + div(style="display: inline-block; float:right;",mod_dataComplyRules_ui("dataComplyRules_ui_1")), + HTML("
ADSL file is mandatory & BDS/ OCCDS files are optional"), + fileInput(ns("file"), "Upload sas7bdat files",accept = c(".sas7bdat"), multiple = TRUE), + uiOutput(ns("radio_test")) + ) + ), + column(6, + fluidRow( + wellPanel( + span(textOutput(ns("multi_studies")), style="color:red;font-size:20px"), + uiOutput(ns("datapreview_header")), + div(DT::dataTableOutput(ns("data_preview")), style = "font-size: 75%") + ) + ) + ) + ) + ) +} + + +#' dataUpload Server Function stores +#' the uploaded data as a list and +#' is exported to be used in other modules +#' +#' @param input,output,session +#' Internal parameters for {shiny}. +#' +#' @return a list of dataframes +#' \code{dd$dataframe} +#' to be used in other modules +#' +#' @import shiny +#' @importFrom haven zap_formats +#' @importFrom haven read_sas +#' @importFrom stringr str_remove +#' +mod_dataUpload_server <- function(input, output, session){ + ns <- session$ns + + # initiate reactive values - list of uploaded data files + # standard to imitate output of detectStandard.R + dd <- reactiveValues() + + # modify reactive values when data is uploaded + observeEvent(input$file, { + + data_list <- list() + + ## data list + for (i in 1:nrow(input$file)){ + if(length(grep(".sas7bdat", input$file$name[i], ignore.case = TRUE)) > 0){ + data_list[[i]] <- haven::zap_formats(haven::read_sas(input$file$datapath[i])) %>% + dplyr::mutate(dplyr::across(.cols = where(is.character), + .fns = na_if, y = "")) + }else{ + data_list[[i]] <- NULL + } + } + + # names + names(data_list) <- toupper(stringr::str_remove(input$file$name, ".sas7bdat")) + + + + # run that list of dfs through the data compliance module, replacing list with those that comply + dl_comply <- callModule(mod_dataComply_server, + id = NULL, #"dataComply_ui_1", + datalist = reactive(data_list)) + + if(length(names(dl_comply)) > 0){ + # append to existing reactiveValues list + dd$data <- c(dd$data, dl_comply) # dl_comply # + } + + # set dd$current to FALSE for previous & TRUE for current uploads + dd$current <- c(rep(FALSE, length(dd$current)), rep(TRUE, length(data_list))) + + }) + + + + ### make a reactive combining dd$data & standard + data_choices <- reactive({ + req(dd$data) + #req(dd$standard) + + choices <- list() + for (i in 1:length(dd$data)){ + choices[[i]] <- names(dd$data)[i] + } + + return(choices) + }) + + + + observeEvent(dd$data, { + req(data_choices()) + + vals <- data_choices() + names(vals) <- NULL + names <- data_choices() + prev_sel <- lapply(reactiveValuesToList(input), unclass)$select_file # retain previous selection + + output$radio_test <- renderUI( + radioButtons(session$ns("select_file"), label = "Inspect Uploaded Data", + choiceNames = names, choiceValues = vals, selected = prev_sel)) + + }) + + # get selected dataset when selection changes + data_selected <- eventReactive(input$select_file, { + isolate({index <- which(names(dd$data)==input$select_file)[1]}) + dd$data[[index]] + }) + + studies <- reactive({ + unique(unlist(lapply(dd$data, `[[`, "STUDYID"))) + }) + + output$multi_studies <- renderText({ + req(length(studies()) > 1) + paste0("Warning: data uploaded from multiple studies: ", paste(studies(), collapse = " & ")) + }) + + # upon a dataset being uploaded and selected, generate data preview + output$datapreview_header <- renderUI({ + data_selected() + isolate(data_name <- input$select_file) + h3(paste("Data Preview for", data_name)) + }) + + output$data_preview <- DT::renderDataTable({ + DT::datatable(data = data_selected(), + style="default", + class="compact", + extensions = "Scroller", options = list(scrollY=400, scrollX=TRUE)) + }) + + observeEvent( input$pilot, { + + shinyjs::disable(id = "file") + + dd$data <- list( + ADSL = adsl, + ADVS = advs, + ADAE = adae, + ADLBC = adlbc + ) + + shinyjs::hide(id = "pilot") + }) + + + ### return all data + return(reactive(dd$data)) } \ No newline at end of file diff --git a/data-raw/adae.R b/data-raw/adae.R index c39dcece..d4ee43a3 100755 --- a/data-raw/adae.R +++ b/data-raw/adae.R @@ -1,4 +1,6 @@ -## code to prepare `adae` dataset goes here -adae <- haven::read_xpt("data-raw/adae.xpt") - -usethis::use_data(adae, overwrite = TRUE) +## code to prepare `adae` dataset goes here +adae <- haven::read_xpt("data-raw/adae.xpt") %>% + dplyr::mutate(dplyr::across(.cols = where(is.character), + .fns = na_if, y = "")) + +usethis::use_data(adae, overwrite = TRUE) diff --git a/data-raw/adlbc.R b/data-raw/adlbc.R index f0c66179..013c7908 100755 --- a/data-raw/adlbc.R +++ b/data-raw/adlbc.R @@ -1,27 +1,29 @@ -## code to prepare `adlbc` dataset goes here -adlbc <- haven::read_xpt("data-raw/adlbc.xpt") - -# The analysis Date Variable is way off in the future, it's not even remotely -# close to occuring wtihin the confines of the study, so we're adjusting the -# ADT variable to be withing the treatment exposure start and end - -# lab timeline -min_lb <- min(adlbc$ADT) -max_lb <- max(adlbc$ADT) -lb_dur <- max_lb - min_lb # duartion - -# Treatment timeline -min_trt <- min(adsl$TRTSDT) -max_trt <- max(adsl$TRTEDT) -trt_dur <- max_trt - min_trt # duration - -# creating a move variable, which tracks how many days have elapsed between the -# start of the trt and start of lab's drawn, plus the difference in duration -# days -move = min_lb - min_trt + (lb_dur - trt_dur) - -# Subtract the 'move' var's days, overwriting ADT -adlbc <- adlbc %>% - mutate(ADT = ADT - move ) - -usethis::use_data(adlbc, overwrite = TRUE) +## code to prepare `adlbc` dataset goes here +adlbc <- haven::read_xpt("data-raw/adlbc.xpt") + +# The analysis Date Variable is way off in the future, it's not even remotely +# close to occuring wtihin the confines of the study, so we're adjusting the +# ADT variable to be withing the treatment exposure start and end + +# lab timeline +min_lb <- min(adlbc$ADT) +max_lb <- max(adlbc$ADT) +lb_dur <- max_lb - min_lb # duartion + +# Treatment timeline +min_trt <- min(adsl$TRTSDT) +max_trt <- max(adsl$TRTEDT) +trt_dur <- max_trt - min_trt # duration + +# creating a move variable, which tracks how many days have elapsed between the +# start of the trt and start of lab's drawn, plus the difference in duration +# days +move = min_lb - min_trt + (lb_dur - trt_dur) + +# Subtract the 'move' var's days, overwriting ADT +adlbc <- adlbc %>% + mutate(ADT = ADT - move ) %>% + dplyr::mutate(dplyr::across(.cols = where(is.character), + .fns = na_if, y = "")) + +usethis::use_data(adlbc, overwrite = TRUE) diff --git a/data-raw/adsl.R b/data-raw/adsl.R index 113652b9..4cc53b7a 100755 --- a/data-raw/adsl.R +++ b/data-raw/adsl.R @@ -1,4 +1,6 @@ -## code to prepare `adsl` dataset goes here -adsl <- haven::read_xpt("data-raw/adsl.xpt") - -usethis::use_data(adsl, overwrite = TRUE) +## code to prepare `adsl` dataset goes here +adsl <- haven::read_xpt("data-raw/adsl.xpt") %>% + dplyr::mutate(dplyr::across(.cols = where(is.character), + .fns = na_if, y = "")) + +usethis::use_data(adsl, overwrite = TRUE) diff --git a/data-raw/advs.R b/data-raw/advs.R index 4afe606e..9b4c9b62 100755 --- a/data-raw/advs.R +++ b/data-raw/advs.R @@ -1,4 +1,6 @@ -## code to prepare `adtte` dataset goes here -advs <- haven::read_xpt("data-raw/advs.xpt") - -usethis::use_data(advs, overwrite = TRUE) +## code to prepare `adtte` dataset goes here +advs <- haven::read_xpt("data-raw/advs.xpt") %>% + dplyr::mutate(dplyr::across(.cols = where(is.character), + .fns = na_if, y = "")) + +usethis::use_data(advs, overwrite = TRUE) diff --git a/man/.DS_Store b/man/.DS_Store index 25817406..a08500c5 100644 Binary files a/man/.DS_Store and b/man/.DS_Store differ