Merge pull request #25 from waldronlab/devel_ga

Suggested a fix in defining study code in the `createStudyTable` function

Author: cmirzayi

R/describe_curation.R

@@ -99,17 +99,39 @@ createTaxonTable <- function(dat, n=10){
 #' createStudyTable(full.dat)
 #' ## kable_styling(kbl(createStudyTable(full.dat))) #for html styling
 
-createStudyTable <-function(dat){
-  studies <- data.frame(Study=paste0(str_extract(dat$Authors, "[A-Za-z]+[:space:]"), dat$Year),
-                        Condition=dat$Condition,
-                        Cases=dat$`Group 1 sample size`,
-                        Controls=dat$`Group 0 sample size`,
-                        `Study Design`=dat$`Study design`)
-  studies %>% group_by(Study) %>% summarize(Condition=first(Condition), 
-                                            Cases=max(Cases),
-                                            Controls=max(Controls), 
-                                            `Study Design`=first(`Study.Design`))
+createStudyTable <- function(bsdb.df, includeAlso = NULL) {
+  # input check
+  if (!is_null(includeAlso)) {
+    if (!all(includeAlso %in% colnames(bsdb.df))) {
+      stop(paste(
+        "The following columns are not found in the input data frame:",
+        paste(includeAlso[!(includeAlso %in% colnames(bsdb.df))], collapse = ", ")
+      ))
+    }
+  }
+  # Core of the change is in how study IDs are generated, see function in 
+  # simple.R. NB: the function also fixes DOI links as side effect, now. 
+  
+  bsdb_with_StudyCodes.df <- .make_unique_study_ID(bsdb.df)
+  
+  # some dplyr-fu to summarize tables, with more recent syntax
+  study_table_fixed <- bsdb_with_StudyCodes.df %>%
+    group_by(`Study code`) %>%
+    reframe(
+      MaxCases = max(`Group 1 sample size`),
+      MaxControls = max(`Group 0 sample size`),
+      across(
+        all_of(
+          c("Study design", "Condition", "PMID", "DOI", "URL", includeAlso)
+        ),
+        .fns = function(x)
+          paste(unique(x), collapse = "; ")
+      ),
+      N_signatures = n()
+    ) %>%
+    relocate(N_signatures, .after = Condition)
 
+  return(study_table_fixed)
 }
 
 globalVariables(

R/simple.R

@@ -74,3 +74,43 @@ getMostFrequentTaxa <- function(dat, n=10, sig.type=c("both", "increased", "decr
     msc.tab <- sort(table(unlist(msc)), decreasing=TRUE)
     head(msc.tab, n=n) 
 }
+
+
+#' Author: Giacomo Antonello
+#' Date: 2025-03-17
+#' 
+#' Description:
+#' 
+#' This function takes a raw bugSigDB input from `bugsigdbr` and generates a 
+#' unique idenfier as curatedMetagenomicsData does: full last name, initial(s) of 
+#' first name(s) and year of publication. Additionally, it checks if there are 
+#' more PMID codes associated with the same ID and adds a .1, .2, for each 
+#' duplication
+#' 
+
+.make_unique_study_ID <- function(bsdb.df){
+  bsdb_with_StudyCode <- bsdb.df %>% 
+    # fix DOIs
+    mutate(
+      DOI =  ifelse(
+        test = startsWith(DOI, "10."),
+        yes = paste0("https://doi.org/", DOI),
+        no = DOI
+      ),
+      # create a basic ID
+      BasicID = paste0(gsub(" ", "", sapply(strsplit(`Authors list`, ", "), "[", 1)), "_", Year)
+    ) %>% 
+    # For each ID found, seach if there are multiple studies
+    group_by(BasicID) %>% 
+    mutate(
+      # this is arbitrary, the point is to make sure you can split overlapping
+      # IDs into one
+      uniqueRank = as.numeric(as.factor(paste(PMID, DOI, URL, `Authors list`))),
+      `Study code` = ifelse(uniqueRank > 1, paste(BasicID, uniqueRank - 1, sep = "."), BasicID)
+    ) %>% 
+    ungroup() %>% 
+    select(- BasicID, - uniqueRank) %>% 
+    relocate(`Study code`) 
+  
+  return(bsdb_with_StudyCode)
+}