Merge pull request #13 from acornamr/dev

v2.5.4

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: acorn
 Type: Package
 Title: A Dashboard for ACORN AMR Data
-Version: 2.5.3
+Version: 2.5.4
 Authors@R: c(person(given = "Olivier", family = "Celhay", 
                 email = "[email protected]", 
                 role = c("aut", "cre"), comment = c(ORCID = "https://orcid.org/0000-0002-2971-9110")),
@@ -38,6 +38,7 @@ Imports:
     shiny.i18n,
     shinyjs,
     shinyWidgets,
+    tictoc,
     tidyverse,
     writexl
 RoxygenNote: 7.2.0

R/run_app.R

@@ -8,7 +8,7 @@
 #' @export
 #'
 #' @import aws.s3 bslib ComplexUpset curl DBI DT flexdashboard glue highcharter lubridate markdown openssl readr readxl
-#' REDCapR rmarkdown RSQLite rvest shiny shiny.i18n shinyjs shinyWidgets tidyverse writexl
+#' REDCapR rmarkdown RSQLite rvest shiny shiny.i18n shinyjs shinyWidgets tictoc tidyverse writexl
 
 run_app <- function(options = list()) {
   app_directory <- system.file("acorn", package = "acorn")

inst/acorn/app.R

@@ -8,6 +8,7 @@ ui <- page(
   usei18n(i18n),  # for translation
   shinyjs::useShinyjs(),
   page_navbar(
+    theme = acorn_theme,
     title = a(img(src = "logo_acorn.png", style = "height: 45px; position: relative;")),
     id = "tabs",
     selected = "welcome",
@@ -1156,9 +1157,7 @@ server <- function(input, output, session) {
     redcap_F02F01              = list(status = "hidden", msg = ""),
     redcap_F03F01              = list(status = "hidden", msg = ""),
     redcap_multiple_F02        = list(status = "hidden", msg = ""),
-    redcap_consistent_outcomes = list(status = "hidden", msg = ""),
     redcap_missing_acorn_id    = list(status = "hidden", msg = ""),
-    redcap_age_category        = list(status = "hidden", msg = ""),
     redcap_hai_status          = list(status = "hidden", msg = ""),
 
     linkage_caseB  = list(status = "hidden", msg = ""),
@@ -1343,7 +1342,7 @@ server <- function(input, output, session) {
           unlist()
         acorn_dates <- as.vector(dta[names(dta) == 'Contents.LastModified'])
         ord_acorn_dates <- order(as.POSIXct(acorn_dates))
-        acorn_files <- rev(tail(as.vector(dta[names(dta) == 'Contents.Key'])[ord_acorn_dates], 20))  # 20 because of .acorn_non_anonymised
+        acorn_files <- rev(tail(as.vector(dta[names(dta) == 'Contents.Key'])[ord_acorn_dates], 10))
 
         if(! is.null(acorn_files)) { acorn_files <- acorn_files[endsWith(acorn_files, ".acorn")] }
         if(! is.null(acorn_files)) { updatePickerInput(session, 'acorn_files_server', choices = acorn_files, selected = acorn_files[1]) }
@@ -1475,9 +1474,7 @@ server <- function(input, output, session) {
       ifelse(any(c(checklist_status$redcap_F04F01$status,
                    checklist_status$redcap_F03F02$status,
                    checklist_status$redcap_F02F01$status,
-                   checklist_status$redcap_F03F01$status,
-                   checklist_status$redcap_consistent_outcomes$status,
-                   checklist_status$redcap_age_category$status) == "ko"),
+                   checklist_status$redcap_F03F01$status) == "ko"),
              {
                checklist_status$redcap_f01f05_dta <- list(status = "ko", msg = i18n$t("Critical errors with clinical data."))
                showNotification(i18n$t("There is a critical issue with clinical data. The issue should be fixed in REDCap."), type = "error", duration = NULL)
@@ -1563,12 +1560,29 @@ server <- function(input, output, session) {
     )
 
     notify(i18n$t("Processing lab data."), id = id)
+    tictoc::tic("03_map_variables.R")
     source("./www/R/data/03_map_variables.R", local = TRUE)
+    tictoc::toc()
+
+    tictoc::tic("04_map_specimens.R")
     source("./www/R/data/04_map_specimens.R", local = TRUE)
+    tictoc::toc()
+
+    tictoc::tic("05_map_organisms.R")
     source("./www/R/data/05_map_organisms.R", local = TRUE)
+    tictoc::toc()
+
+    tictoc::tic("06_make_ast_group.R")
     source("./www/R/data/06_make_ast_group.R", local = TRUE)
+    tictoc::toc()
+
+    tictoc::tic("07_ast_interpretation.R")
     source("./www/R/data/07_ast_interpretation.R", local = TRUE)
+    tictoc::toc()
+
+    tictoc::tic("08_ast_interpretation_nonstandard.R")
     source("./www/R/data/08_ast_interpretation_nonstandard.R", local = TRUE)
+    tictoc::toc()
 
     lab_dta(amr)
 
@@ -1733,28 +1747,6 @@ server <- function(input, output, session) {
                   data_dictionary = data_dictionary())
     save(acorn, file = file)
 
-    aws.s3::put_object(file = file,
-                       object = name_file,
-                       bucket = acorn_cred()$aws_bucket,
-                       key =  acorn_cred()$aws_key,
-                       secret = acorn_cred()$aws_secret,
-                       region = acorn_cred()$aws_region)
-
-    ## Non anonymised data ----
-    name_file <- glue("{input$name_file_server}.acorn_non_anonymised")
-    file <- file.path(tempdir(), name_file)
-    acorn <- list(about = about,
-                  meta = meta(), 
-                  redcap_f01f05_dta = redcap_f01f05_dta(), 
-                  redcap_hai_dta = redcap_hai_dta(), 
-                  lab_dta = lab_dta() %>% filter(specid %in% acorn_dta()$specid),
-                  acorn_dta = acorn_dta(), 
-                  tables_dictionary = tables_dictionary(),
-                  corresp_org_antibio = corresp_org_antibio(), 
-                  lab_code = lab_code(), 
-                  data_dictionary = data_dictionary())
-    save(acorn, file = file)
-
     aws.s3::put_object(file = file,
                        object = name_file,
                        bucket = acorn_cred()$aws_bucket,

inst/acorn/www/R/data/02_process_redcap_f01f05.R

@@ -428,19 +428,16 @@ ifelse(nrow(test) == 0,
                                                   tibble(issue = "Multiple F02 with identical ACORN ID, admission date, and episode enrolment date.", local_id = test$patient_id, redcap_id = test$redcap_id, acorn_id = test$acorn_id))
        })
 
-
-# Create episode_count for enrolment log. ----
-infection <- infection |> group_by(episode_id) |> mutate(episode_count = row_number()) |> ungroup()
-
-# Flag if Day28 is not "Dead" and clinical outcome is "Dead". ----
-test <- infection %>% filter(ho_discharge_status == "Dead", d28_status != "Dead")
-ifelse(nrow(test) == 0, 
-       { checklist_status$redcap_consistent_outcomes <- list(status = "okay", msg = i18n$t("Clinical and day-28 outcomes are consistent.")) },
-       {
-         checklist_status$redcap_consistent_outcomes <- list(status = "warning", msg = i18n$t("Clinical and day-28 outcomes aren't consistent for some dead patients."))
-         checklist_status$log_errors <- bind_rows(checklist_status$log_errors, 
-                                                  tibble(issue = "Clinical and day-28 outcomes not consistent", local_id = test$patient_id, redcap_id = test$redcap_id, acorn_id = test$acorn_id))
-       })
+# Give a count of the episodes for a given patient and date of admission.
+infection <- infection |> 
+  group_by(
+    patient_id, 
+    date_admission
+  ) |> 
+  mutate(
+    episode_count = 1:n()
+  ) |> 
+  ungroup()
 
 # Delete records that have a missing acornid. ----
 test <- infection %>% filter(is.na(acorn_id))
@@ -472,20 +469,6 @@ infection <- infection %>% mutate(age_category_calc = case_when(
 
 infection$age_category[is.na(infection$age_category)] <- infection$age_category_calc[is.na(infection$age_category)]
 
-# Test that "Calculated age is consistent with 'Age Category'". ----
-test <- bind_rows(infection %>% filter(age_category == "Adult", age_year < 18),
-                  infection %>% filter(age_category == "Child", age_year > 17 | age_day <= 28),
-                  infection %>% filter(age_category == "Neonate", age_day > 28))
-
-ifelse(nrow(test) == 0, 
-       { checklist_status$redcap_age_category <- list(status = "okay", msg = i18n$t("Calculated age is consistent with 'Age Category'")) },
-       { 
-         checklist_status$redcap_age_category <- list(status = "warning", msg = i18n$t("Calculated age isn't always consistent with 'Age Category'"))
-         checklist_status$log_errors <- bind_rows(checklist_status$log_errors, 
-                                                  tibble(issue = "Calculated age not consistent with 'Age Category'", local_id = test$patient_id, redcap_id = test$redcap_id, acorn_id = test$acorn_id))
-       })
-
-
 # Define Clinical Severity, qSOFA score. ----
 equal_yes <- function(x) replace_na(x, "No") == "Yes"
 

inst/acorn/www/R/data/07_ast_interpretation.R

@@ -1,27 +1,38 @@
 message("07_ast_interpretation.R")
-
+tictoc::tic("07_ast_interpretation.R: Part 1.1")
 # Combine into a single data.frame
 ast.codes <- rbind(lab_code$ast.aci, lab_code$ast.col, lab_code$ast.ent, lab_code$ast.hin, lab_code$ast.ngo, lab_code$ast.nmen, lab_code$ast.pae, lab_code$ast.sal, lab_code$ast.sau, lab_code$ast.shi, lab_code$ast.spn)
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 1.2")
 # Add Etest rows into ast.codes (not included in ast.codes since breakpoints are same as for other MIC, but they have unique codes in WHONET)
 ast.codes.e <- subset(ast.codes, subset = (ast.codes$TESTMETHOD == "MIC"))
 ast.codes.e$WHON5_TEST <- gsub("_NM", "_NE", ast.codes.e$WHON5_TEST)
 ast.codes.e$WHON5_TEST <- gsub("_EM", "_EE", ast.codes.e$WHON5_TEST)
 ast.codes <- rbind(ast.codes, ast.codes.e)
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 1.3")
 # Make a link variable (link, to link AST breakpoints to amr data)
 ast.codes$link <- paste(ast.codes$ACORN_AST_ORGGROUP, ast.codes$WHON5_TEST, sep = ".")
 
 # Reshape amr data.frame to long and then make the same link variable (link)
-amr.l <- gather(amr, WHON5_TEST, result, (contains("_" ))) # Only ast variable names include "_"
+# Only ast variable names include "_"
+amr.l <- amr |> 
+  tidyr::pivot_longer(
+    contains("_"),
+    names_to = "WHON5_TEST",
+    values_to = "result"
+  )
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 1.4")
 amr.l <- subset(amr.l, subset = (!is.na(result) & !is.na(ast.group))) # Keep only isolateids with valid AST results
 
 if(nrow(amr.l) == 0) {
   showNotification(i18n$t("There are no isolate with valid AST results. Please contact ACORN support."),
                    duration = 15, type = "error", closeButton = FALSE, session = session)
   Sys.sleep(15)
 }
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 2")
 amr.l$link <- paste(amr.l$ast.group, amr.l$WHON5_TEST, sep = ".")
 amr.l <- subset(amr.l, select = c(isolateid, result, link))
 
@@ -50,7 +61,8 @@ amr.l.int$ast.cat[amr.l.int$GUIDELINES == "EUCAST" & amr.l.int$TESTMETHOD == "MI
 amr.l.int$ast.cat[amr.l.int$result == 110011] <- "S"
 amr.l.int$ast.cat[amr.l.int$result == 220022] <- "I"
 amr.l.int$ast.cat[amr.l.int$result == 330033] <- "R"
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 3")
 # Summarise the Disk, MIC, Etest results for each antibiotic (use WHONET formula of Etest > MIC > Disk if >1 method): one row per isolate
 # Add in amr.var$abxname.cat (E, M, D) to amr.l.int
 amr.l.int <- left_join(amr.l.int, 
@@ -67,7 +79,8 @@ amr.l.int$ast.cat[amr.l.int$ast.cat == "I"] <- 2
 amr.l.int$ast.cat[amr.l.int$ast.cat == "S"] <- 1
 amr.l.int$ast.cat[is.na(amr.l.int$ast.cat)] <- 0 # Important for the next part, otherwise NA > 3 and everything recoded as NA
 amr.l.int$ast.cat <- as.numeric(amr.l.int$ast.cat)
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 4")
 # Make a variable for the result of each test cat (abx.cat.result, if both CLSI and EUCAST for disk/mic/etst then the most resistant result will be taken)
 tmp.ast <- amr.l.int %>%
   group_by(isolateid.abxname.cat) %>%
@@ -93,7 +106,8 @@ tmp.ast1 <- tmp.ast %>%
 tmp.ast1 <- as.data.frame(tmp.ast1)
 names(tmp.ast1) <- c("isolateid.abxname", "cat.shortnum.max")
 tmp.ast2 <- left_join(tmp.ast, tmp.ast1, by = "isolateid.abxname")
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 5")
 # Change numeric values back to characters for AST test categories (E == 3, M == 2, D == 1)
 tmp.ast2$cat.shortnum[tmp.ast2$cat.shortnum == 1] <- "D"
 tmp.ast2$cat.shortnum[tmp.ast2$cat.shortnum == 2] <- "M"
@@ -113,9 +127,15 @@ tmp.ast3$abx.cat.result[tmp.ast3$abx.cat.result == 3] <- "R"
 tmp.ast3$abx.cat.result[tmp.ast3$abx.cat.result == 2] <- "I"
 tmp.ast3$abx.cat.result[tmp.ast3$abx.cat.result == 1] <- "S"
 tmp.ast3$abx.cat.result[tmp.ast3$abx.cat.result == 0] <- NA
-
+tictoc::toc()
+tictoc::tic("07_ast_interpretation.R: Part 6")
 # Convert AST data.frame from long back to wide format
-ast.final <- spread(tmp.ast3, abxname, abx.cat.result) # Make individual variables for each antibiotic (WHONET codes)
+# Make individual variables for each antibiotic (WHONET codes)
+ast.final <- tmp.ast3 |> 
+  pivot_wider(
+    names_from = "abxname", 
+    values_from = "abx.cat.result"
+  )
 
 # Merge categorised AST data back into amr.raw data.frame (defined in 05_make_ast_group.R)
 amr <- left_join(amr.raw, ast.final, by = "isolateid")
@@ -136,4 +156,5 @@ amr <- bind_rows(tmp.amr2 %>% mutate_all(as.character),
   mutate(specdate = parse_date_time(specdate, c("dmY", "Ymd", "dbY", "Ymd HMS")),
          spectype.whonet = as.numeric(spectype.whonet),
          specid.acorn = as.numeric(specid.acorn ),
-         orgnum.acorn = as.numeric(orgnum.acorn))
+         orgnum.acorn = as.numeric(orgnum.acorn))
+tictoc::toc()

inst/acorn/www/R/functions/icon.R

@@ -0,0 +1,6 @@
+# Remove the warning message when using shiny::icon():
+# This Font Awesome icon ('cog') does not exist:
+#  * if providing a custom `html_dependency` these `name` checks can 
+# be deactivated with `verify_fa = FALSE`
+
+icon <- function(...)  shiny::icon(..., verify_fa = FALSE)

inst/acorn/www/R/outputs/checklist_status.R

@@ -9,9 +9,7 @@ output$checklist_qc_clinical <- renderText({
                                            "redcap_F02F01",
                                            "redcap_F03F01",
                                            "redcap_multiple_F02",
-                                           "redcap_consistent_outcomes",
                                            "redcap_missing_acorn_id",
-                                           "redcap_age_category",
                                            "redcap_hai_status",
                                            "redcap_f01f05_dta"))
 })

inst/acorn/www/R/outputs/header_nb_boxes.R

@@ -65,8 +65,10 @@ output$nb_isolates_growth <- renderText({
 
 output$nb_isolates_target <- renderText({
   req(acorn_dta())
-  nb_isolates <- acorn_dta_filter() %>% 
-    fun_filter_target_pathogens() %>% 
+
+  nb_isolates <- acorn_dta_filter() |> 
+    fun_deduplication(method = input$deduplication_method) |> 
+    fun_filter_target_pathogens() |> 
     nrow()
 
   as.character(

inst/acorn/www/R/startup.R

@@ -1,4 +1,4 @@
-app_version <- "2.5.3"  # Make sure that the app version is identical in DESCRIPTION
+app_version <- "2.5.4"  # Make sure that the app version is identical in DESCRIPTION
 session_start_time <- format(Sys.time(), "%Y-%m-%d_%HH%M")
 
 # IMPORTANT: ensure that there is a match between the calls below and:

misc/create_encrypted_credentials.R

@@ -4,13 +4,13 @@ library(readxl)
 library(tidyverse)
 rm(list = ls())
 
-all_cred <- readxl::read_excel("/Users/olivier/Documents/Projets/ACORN/Data/ACORN2_cred.xlsx", sheet = "cred") |>  
+creds <- readxl::read_excel("/Users/olivier/Documents/Projets/ACORN/Data/ACORN2_cred.xlsx", sheet = "cred") |>  
   filter(!is.na(site)) |> 
-  filter(user != "demo")
+  filter(user == "user")
 
 
-for (i in 1:nrow(all_cred)) {
-  user <- all_cred[i, ]
+for (i in 1:nrow(creds)) {
+  user <- creds[i, ]
 
   cred <- serialize(
     object = list(site = user$site,