From 1c4650e4283af0366f84c101c010ea0d32bc7434 Mon Sep 17 00:00:00 2001 From: "clayton.strauch@pnnl.gov" Date: Wed, 31 May 2023 12:36:46 -0500 Subject: [PATCH 1/8] Removed dependency on datadr package by converting ddo objects to lists; began updating relevant tests --- R/divideByGroup.R | 42 ++++++++++++++++++++++----- R/divideBySample.R | 21 ++++++++------ R/summarizeGroups.R | 8 ++--- tests/testthat/test_divideByGroup.R | 4 +-- tests/testthat/test_divideBySample.R | 4 +-- tests/testthat/test_summarizeGroups.R | 10 +++---- 6 files changed, 59 insertions(+), 30 deletions(-) diff --git a/R/divideByGroup.R b/R/divideByGroup.R index e4c9766..b64b83d 100644 --- a/R/divideByGroup.R +++ b/R/divideByGroup.R @@ -11,26 +11,52 @@ #' @seealso \code{\link[datadr:ddo]{ddo}} #' @export divideByGroup <- function(ftmsObj) { - require(datadr) sample.colname <- getFDataColName(ftmsObj) samples <- as.character(ftmsObj$f_data[, sample.colname]) groupDF <- getGroupDF(ftmsObj) if (is.null(groupDF)) stop("This object does not have group designation information") - + edata_nonsample_cols <- setdiff(colnames(ftmsObj$e_data), samples) result <- lapply(unique(groupDF$Group), function(group_name) { - + val <- subset(ftmsObj, groups=group_name) - # datadr attributes: attr(val, "split") <- data.frame(Group=group_name, stringsAsFactors = FALSE) colnames(attr(val, "split")) <- "Group" - key <- paste0("Group=", group_name) - return(kvPair(key, val)) + return(val) }) - result <- ddo(result) + result_names <- lapply(unique(groupDF$Group), function(group_name) { + paste0("Group=", group_name) + }) + names(result) <- result_names + return(result) -} \ No newline at end of file +} + +# divideByGroup <- function(ftmsObj) { +# require(datadr) +# sample.colname <- getFDataColName(ftmsObj) +# samples <- as.character(ftmsObj$f_data[, sample.colname]) +# groupDF <- getGroupDF(ftmsObj) +# if (is.null(groupDF)) stop("This object does not have group designation information") +# +# edata_nonsample_cols <- setdiff(colnames(ftmsObj$e_data), samples) +# +# result <- lapply(unique(groupDF$Group), function(group_name) { +# +# val <- subset(ftmsObj, groups=group_name) +# +# # datadr attributes: +# attr(val, "split") <- data.frame(Group=group_name, stringsAsFactors = FALSE) +# colnames(attr(val, "split")) <- "Group" +# +# key <- paste0("Group=", group_name) +# return(kvPair(key, val)) +# }) +# +# result <- ddo(result) +# return(result) +# } \ No newline at end of file diff --git a/R/divideBySample.R b/R/divideBySample.R index fceb3f5..bbbe396 100644 --- a/R/divideBySample.R +++ b/R/divideBySample.R @@ -9,27 +9,30 @@ #' to a single sample #' @seealso \code{\link[datadr:ddo]{ddo}} #' @export + divideBySample <- function(ftmsObj) { + if (!inherits(ftmsObj, "ftmsData")) stop("Not an ftmsData object") - require(datadr) + sample.colname <- getFDataColName(ftmsObj) samples <- as.character(ftmsObj$f_data[, sample.colname]) edata_nonsample_cols <- setdiff(colnames(ftmsObj$e_data), samples) result <- lapply(samples, function(ss) { - + val <- subset(ftmsObj, samples=ss) - # datadr attributes attr(val, "split") <- data.frame(Sample=ss, stringsAsFactors = FALSE) colnames(attr(val, "split")) <- sample.colname - key <- paste0(sample.colname, "=", ss) - return(kvPair(key, val)) + return(val) }) - - result <- ddo(result) + + result_names <- lapply(samples, function(ss) { + paste0(sample.colname, "=", ss) + }) + names(result) <- result_names + return(result) -} - +} \ No newline at end of file diff --git a/R/summarizeGroups.R b/R/summarizeGroups.R index 1712565..8ecd8e6 100644 --- a/R/summarizeGroups.R +++ b/R/summarizeGroups.R @@ -31,7 +31,7 @@ #' summary2 <- summarizeGroups(groupDdo, summary_functions=c("n_present", "prop_present")) summarizeGroups <- function(ftmsObj, summary_functions) { require(datadr) - if (!(inherits(ftmsObj, "peakData") | !inherits(ftmsObj, "compoundData")) & !inherits(ftmsObj, "ddo") ) + if (!(inherits(ftmsObj, "peakData") | !inherits(ftmsObj, "compoundData")) & !inherits(ftmsObj, "list") ) stop("ftmsObj must be of type peakData, compoundData, or a ddo containing those objects") if (inherits(ftmsObj, "groupSummary") | inherits(ftmsObj, "groupComparison") | inherits(ftmsObj, "comparisonSummary")) stop("ftmsObj cannot be a groupSummary, groupComparison or comparisonSummary object") @@ -39,10 +39,10 @@ summarizeGroups <- function(ftmsObj, summary_functions) { if (is.vector(summary_functions)) summary_functions <- as.list(summary_functions) if (!is.list(summary_functions)) stop("summary_function must be a list") - if (inherits(ftmsObj, "ddo")) { - res <- drPersist(addTransform(ftmsObj, function(v) { + if (inherits(ftmsObj, "list")) { + res <- lapply(ftmsObj, function(v) { ftmsRanalysis:::.summarizeGroupsInternal(v, summary_functions) - })) + }) } else { res <- .summarizeGroupsInternal(ftmsObj, summary_functions) } diff --git a/tests/testthat/test_divideByGroup.R b/tests/testthat/test_divideByGroup.R index 4cb65bf..30c2375 100644 --- a/tests/testthat/test_divideByGroup.R +++ b/tests/testthat/test_divideByGroup.R @@ -17,12 +17,12 @@ test_that("basic tests on divideByGroup", { groupDdo <- divideByGroup(ftmsObj = exampleProcessedPeakData) expect_equal(length(groupDdo), length(groups)) - expect_true(inherits(groupDdo, "ddo")) + expect_true(inherits(groupDdo, "list")) ## test one subset i <- 2 grp_samples <- dplyr::filter(getGroupDF(exampleProcessedPeakData), Group==groups[i])[, getFDataColName(exampleProcessedPeakData)] - val <- groupDdo[[paste0("Group=", groups[i])]]$value + val <- groupDdo[[paste0("Group=", groups[i])]] testCompareAttributes(val, exampleProcessedPeakData, c("group_DF", "split", "valence_DF")) diff --git a/tests/testthat/test_divideBySample.R b/tests/testthat/test_divideBySample.R index 6826377..64d00c7 100644 --- a/tests/testthat/test_divideBySample.R +++ b/tests/testthat/test_divideBySample.R @@ -13,11 +13,11 @@ test_that("basic tests on divideBySample", { sampleDdo <- divideBySample(ftmsObj = exampleProcessedPeakData) expect_equal(length(sampleDdo), length(samples)) - expect_true(inherits(sampleDdo, "ddo")) + expect_true(inherits(sampleDdo, "list")) ## test one subset i <- 2 - val <- sampleDdo[[paste0("SampleID=", samples[i])]]$value + val <- sampleDdo[[paste0("SampleID=", samples[i])]] testCompareAttributes(val, exampleProcessedPeakData, c("group_DF", "split", "valence_DF")) diff --git a/tests/testthat/test_summarizeGroups.R b/tests/testthat/test_summarizeGroups.R index 42263eb..d41df79 100644 --- a/tests/testthat/test_summarizeGroups.R +++ b/tests/testthat/test_summarizeGroups.R @@ -62,14 +62,14 @@ test_that("test summarizeGroups function on a ddo", { grpSummaryDdo <- summarizeGroups(peakByGroup, summary_functions=c("n_present", "prop_present")) - expect_true(inherits(grpSummaryDdo, "ddo")) + expect_true(inherits(grpSummaryDdo, "list")) expect_true(length(grpSummaryDdo) == length(grpNames)) - expect_true(all(paste0("Group=", grpNames) %in% unlist(getKeys(grpSummaryDdo)))) + expect_true(all(paste0("Group=", grpNames) %in% names(grpSummaryDdo))) - grp2 <- grpSummaryDdo[[2]]$value + grp2 <- grpSummaryDdo[[2]] expect_true(inherits(grp2, "peakData")) expect_true(inherits(grp2, "groupSummary")) - expect_true(all(paste0(getSplitVar(grp2, "Group"), "_", c("n_present", "prop_present")) %in% colnames(grp2$e_data))) - expect_true(all(paste0(getSplitVar(grp2, "Group"), "_", c("n_present", "prop_present")) %in% grp2$f_data$Group_Summary_Column)) + expect_true(all(paste0(attr(grp2, "group_DF")$Group, "_", c("n_present", "prop_present")) %in% colnames(grp2$e_data))) + expect_true(all(paste0(attr(grp2, "group_DF")$Group, "_", c("n_present", "prop_present")) %in% grp2$f_data$Group_Summary_Column)) }) \ No newline at end of file From 1f04048cf394f51d85cbe144b6977f4efe04f381 Mon Sep 17 00:00:00 2001 From: "clayton.strauch@pnnl.gov" Date: Wed, 7 Jun 2023 10:40:57 -0500 Subject: [PATCH 2/8] Updated divideByGroupComparisons function by changing ddo structure to list. Updated associated tests. Fixed a typo from divideByGroup --- R/divideByGroup.R | 27 +------------------ R/divideByGroupComparisons.R | 17 +++++++++--- .../testthat/test_divideByGroupComparisons.R | 12 ++++----- 3 files changed, 20 insertions(+), 36 deletions(-) diff --git a/R/divideByGroup.R b/R/divideByGroup.R index b64b83d..4e3b067 100644 --- a/R/divideByGroup.R +++ b/R/divideByGroup.R @@ -34,29 +34,4 @@ divideByGroup <- function(ftmsObj) { names(result) <- result_names return(result) -} - -# divideByGroup <- function(ftmsObj) { -# require(datadr) -# sample.colname <- getFDataColName(ftmsObj) -# samples <- as.character(ftmsObj$f_data[, sample.colname]) -# groupDF <- getGroupDF(ftmsObj) -# if (is.null(groupDF)) stop("This object does not have group designation information") -# -# edata_nonsample_cols <- setdiff(colnames(ftmsObj$e_data), samples) -# -# result <- lapply(unique(groupDF$Group), function(group_name) { -# -# val <- subset(ftmsObj, groups=group_name) -# -# # datadr attributes: -# attr(val, "split") <- data.frame(Group=group_name, stringsAsFactors = FALSE) -# colnames(attr(val, "split")) <- "Group" -# -# key <- paste0("Group=", group_name) -# return(kvPair(key, val)) -# }) -# -# result <- ddo(result) -# return(result) -# } \ No newline at end of file +} \ No newline at end of file diff --git a/R/divideByGroupComparisons.R b/R/divideByGroupComparisons.R index c6112b0..5bfb782 100644 --- a/R/divideByGroupComparisons.R +++ b/R/divideByGroupComparisons.R @@ -11,14 +11,13 @@ #' data from just two groups. #' @export divideByGroupComparisons <- function(ftmsObj, comparisons, control=NULL) { + if (missing(ftmsObj)) stop("ftmsObj is missing") if (missing(comparisons)) stop("comparisons is missing") if (!inherits(ftmsObj, "ftmsData")) stop("ftmsObj must be of type ftmsData") # if (!is.matrix(comparisons) & !is.data.frame(comparisons)) stop("comparisons must be either a matrix or a data frame") if (missing(comparisons)) stop("comparisons is missing") - require(datadr) - fdata.colname <- getFDataColName(ftmsObj) groupDF <- ftmsRanalysis:::getGroupDF(ftmsObj) @@ -35,6 +34,7 @@ divideByGroupComparisons <- function(ftmsObj, comparisons, control=NULL) { samples <- unique(as.character(ftmsObj$f_data[, fdata.colname])) edata_nonsample_cols <- setdiff(colnames(ftmsObj$e_data), groups) + # lapply over each col in matrix and return list of subset data result <- lapply(1:ncol(compMatrix), function(i) { grp.names <- compMatrix[,i] @@ -45,10 +45,19 @@ divideByGroupComparisons <- function(ftmsObj, comparisons, control=NULL) { attr(val, "split") <- data.frame(Group_Comparison=comp_name, stringsAsFactors = FALSE) colnames(attr(val, "split")) <- "Group_Comparison" + return(val) + }) + + # Loop over cols of matrix and create vector of names for results above + result_names <- lapply(1:ncol(compMatrix), function(i) { + grp.names <- compMatrix[,i] + comp_name <- paste(grp.names, collapse=" vs ") key <- paste0("Group_Comparison=", comp_name) - return(kvPair(key, val)) + return(key) }) - result <- ddo(result) + + names(result) <- result_names + attr(result, "e_meta") <- ftmsObj$e_meta return(result) } \ No newline at end of file diff --git a/tests/testthat/test_divideByGroupComparisons.R b/tests/testthat/test_divideByGroupComparisons.R index 9733199..ef060f1 100644 --- a/tests/testthat/test_divideByGroupComparisons.R +++ b/tests/testthat/test_divideByGroupComparisons.R @@ -10,11 +10,11 @@ test_that("basic tests on divideByGroupComparisons with all comparisons", { grpComp <- divideByGroupComparisons(exampleProcessedPeakData, comparisons="all") - expect_true(inherits(grpComp, "ddo")) + expect_true(inherits(grpComp, "list")) expect_true(length(grpComp) == ncol(comparisons)) i <- 3 - testSubset <- grpComp[[i]]$value + testSubset <- grpComp[[i]] expect_true(inherits(testSubset, "groupComparison")) grps <- comparisons[,i] @@ -35,14 +35,14 @@ test_that("divideByGroupComparisons works without a groupDF", { grpComp <- divideByGroupComparisons(examplePeakData, comparisons="control", control="EM0061_sample") - expect_true(inherits(grpComp, "ddo")) + expect_true(inherits(grpComp, "list")) expect_true(length(grpComp) == ncol(comparisons)) n_samples <- length(unique(examplePeakData$f_data[, getFDataColName(examplePeakData)])) expect_true(length(grpComp) == n_samples-1) i <- 5 - testSubset <- grpComp[[i]]$value + testSubset <- grpComp[[i]] expect_true(inherits(testSubset, "groupComparison")) grps <- comparisons[,i] @@ -64,11 +64,11 @@ test_that("divideByGroupComparisons with one-factor comparisons", { grpComp <- divideByGroupComparisons(exampleProcessedPeakData, comparisons="one-factor") - expect_true(inherits(grpComp, "ddo")) + expect_true(inherits(grpComp, "list")) expect_true(length(grpComp) == ncol(comparisons)) i <- 3 - testSubset <- grpComp[[i]]$value + testSubset <- grpComp[[i]] expect_true(inherits(testSubset, "groupComparison")) grps <- comparisons[,i] From e86c4bf5e49bdf3f37e20a877ff83425f81af946 Mon Sep 17 00:00:00 2001 From: "clayton.strauch@pnnl.gov" Date: Wed, 7 Jun 2023 10:42:47 -0500 Subject: [PATCH 3/8] Updated functions to work with new list structure after removing datadr DDO structure. Updated associated tests. --- R/concat.R | 16 ++++++---------- R/summarizeGroupComparisons.R | 8 ++++---- tests/testthat/test_concat.R | 20 ++++++++++---------- tests/testthat/test_summarizeComparisons.R | 14 +++++++------- 4 files changed, 27 insertions(+), 31 deletions(-) diff --git a/R/concat.R b/R/concat.R index 54d20d4..159a3ee 100644 --- a/R/concat.R +++ b/R/concat.R @@ -26,22 +26,18 @@ #' allGrpDdo <-concat(grpDdo1, grpDdo2) #' grpSummaries <- summarizeGroups(allGrpDdo, c("n_present", "prop_present")) concat <- function(...) { - require(datadr) - parms <- list(...) # test inputs if (length(parms) == 0) return(NULL) - if (!all(unlist(lapply(parms, function(x) inherits(x, "ddo"))))) - stop("input values must be ddo objects") - if (!all(unlist(lapply(parms, function(x) inherits(x[[1]]$value, "ftmsData") | inherits(x[[1]]$value, "groupComparison"))))) - stop("input values must be distributed data objects of ftmsData or groupComparison objects") + if (!all(unlist(lapply(parms, function(x) inherits(x, "list"))))) + stop("input values must be list objects") + if (!all(unlist(lapply(parms, function(x) inherits(x[[1]], "ftmsData") | inherits(x[[1]], "groupComparison"))))) + stop("input values must be lists of ftmsData or groupComparison objects") if (length(parms) == 1) return(parms[[1]]) - # combine multiple DDOs - tmp <- unlist(lapply(parms, as.list), recursive = FALSE) - res <- ddo(tmp) + # combine multiple lists of ftmsData Objects + res <- c(unlist(parms, recursive=FALSE)) return(res) } - diff --git a/R/summarizeGroupComparisons.R b/R/summarizeGroupComparisons.R index 424b866..42563ae 100644 --- a/R/summarizeGroupComparisons.R +++ b/R/summarizeGroupComparisons.R @@ -22,7 +22,7 @@ summarizeGroupComparisons <- function(compData, summary_functions, summary_funct if (missing(compData)) stop("summary_functions is missing") #if (length(summary_functions) != 1) stop("summary_functions must have length 1") - if (!(inherits(compData, "groupComparison") | inherits(compData, "ddo") ) ) + if (!(inherits(compData, "groupComparison") | inherits(compData, "list") ) ) stop("compData must be of type groupComparison or a ddo containing groupComparisons") if (!is.null(summary_function_params)) { @@ -34,10 +34,10 @@ summarizeGroupComparisons <- function(compData, summary_functions, summary_funct } } - if (inherits(compData, "ddo")) { - res <- drPersist(addTransform(compData, function(v) { + if (inherits(compData, "list")) { + res <- lapply(compData, function(v) { ftmsRanalysis:::.summarizeGroupComparisonsInternal(v, summary_functions, summary_function_params) - })) + }) } else { res <- .summarizeGroupComparisonsInternal(compData, summary_functions, summary_function_params) } diff --git a/tests/testthat/test_concat.R b/tests/testthat/test_concat.R index 4c745ad..12ca6b8 100644 --- a/tests/testthat/test_concat.R +++ b/tests/testthat/test_concat.R @@ -15,14 +15,14 @@ test_that("tests of concat function on group DDOs", { allGrpDdo <-concat(grpDdo1, grpDdo2) expect_equal(length(allGrpDdo), length(grpDdo1)+length(grpDdo2)) - expect_true(all(getKeys(allGrpDdo) %in% c(getKeys(grpDdo1), getKeys(grpDdo2)))) + expect_true(all(names(allGrpDdo) %in% c(names(grpDdo1), names(grpDdo2)))) - expect_true(all(class(allGrpDdo[[1]]$value) == class(grpDdo1[[1]]$value))) + expect_true(all(class(allGrpDdo[[1]]) == class(grpDdo1[[1]]))) grpSummaries <- summarizeGroups(allGrpDdo, c("n_present", "prop_present")) expect_equal(length(grpSummaries), length(allGrpDdo)) - expect_true(all(getKeys(grpSummaries) %in% getKeys(allGrpDdo))) + expect_true(all(names(grpSummaries) %in% names(allGrpDdo))) }) @@ -40,9 +40,9 @@ test_that("tests of concat function on group summary DDOs", { allGrpDdo <-concat(grpDdo1, grpDdo2) expect_equal(length(allGrpDdo), length(grpDdo1)+length(grpDdo2)) - expect_true(all(getKeys(allGrpDdo) %in% c(getKeys(grpDdo1), getKeys(grpDdo2)))) + expect_true(all(names(allGrpDdo) %in% c(names(grpDdo1), names(grpDdo2)))) - expect_true(all(class(allGrpDdo[[1]]$value) == class(grpDdo1[[1]]$value))) + expect_true(all(class(allGrpDdo[[1]]) == class(grpDdo1[[1]]))) }) @@ -58,9 +58,9 @@ test_that("tests of concat function on group comparison DDOs", { allGrpDdo <-concat(grpDdo1, grpDdo2) expect_equal(length(allGrpDdo), length(grpDdo1)+length(grpDdo2)) - expect_true(all(getKeys(allGrpDdo) %in% c(getKeys(grpDdo1), getKeys(grpDdo2)))) + expect_true(all(names(allGrpDdo) %in% c(names(grpDdo1), names(grpDdo2)))) - expect_true(all(class(allGrpDdo[[1]]$value) == class(grpDdo1[[1]]$value))) + expect_true(all(class(allGrpDdo[[1]]) == class(grpDdo1[[1]]))) compSummaries <- summarizeGroupComparisons(allGrpDdo, summary_functions = "uniqueness_gtest", summary_function_params = list(uniqueness_gtest= @@ -69,7 +69,7 @@ test_that("tests of concat function on group comparison DDOs", { pvalue_thresh=0.05))) expect_equal(length(compSummaries), length(allGrpDdo)) - expect_true(all(getKeys(compSummaries) %in% getKeys(allGrpDdo))) + expect_true(all(names(compSummaries) %in% names(allGrpDdo))) }) @@ -95,9 +95,9 @@ test_that("tests of concat function on group comparison summary DDOs", { allGrpDdo <-concat(grpDdo1, grpDdo2) expect_equal(length(allGrpDdo), length(grpDdo1)+length(grpDdo2)) - expect_true(all(getKeys(allGrpDdo) %in% c(getKeys(grpDdo1), getKeys(grpDdo2)))) + expect_true(all(names(allGrpDdo) %in% c(names(grpDdo1), names(grpDdo2)))) - expect_true(all(class(allGrpDdo[[1]]$value) == class(grpDdo1[[1]]$value))) + expect_true(all(class(allGrpDdo[[1]]) == class(grpDdo1[[1]]))) }) diff --git a/tests/testthat/test_summarizeComparisons.R b/tests/testthat/test_summarizeComparisons.R index 61c7dee..3bbfb93 100644 --- a/tests/testthat/test_summarizeComparisons.R +++ b/tests/testthat/test_summarizeComparisons.R @@ -6,7 +6,7 @@ context("summarizeGroupComparisons function") test_that("test of summarizeGroupComparisons on a groupComparison object", { data("exampleProcessedPeakData") - grpComp <- divideByGroupComparisons(exampleProcessedPeakData, comparisons = "all")[[1]]$value + grpComp <- divideByGroupComparisons(exampleProcessedPeakData, comparisons = "all")[[1]] grpCompSummary <- summarizeGroupComparisons(grpComp, summary_functions="uniqueness_gtest", summary_function_params=list( @@ -35,18 +35,18 @@ test_that("test of summarizeGroupComparisons on a ddo", { uniqueness_gtest=list(pres_fn="nsamps", pres_thresh=2, pvalue_thresh=0.05) )) - expect_true(inherits(grpCompSummary, "ddo")) + expect_true(inherits(grpCompSummary, "list")) expect_equal(length(grpCompSummary), length(grpComp)) # test one subset i <- 3 - val <- grpCompSummary[[i]]$value + val <- grpCompSummary[[i]] expect_true(inherits(val, "comparisonSummary")) expect_false(inherits(val, "groupComparison")) expect_equal(ncol(val$e_data), 2) - expect_true(getEDataColName(grpComp[[i]]$value) %in% colnames(val$e_data)) - expect_true(all(dim(grpComp[[i]]$value$e_meta) == dim(val$e_meta))) - expect_true(all(colnames(grpComp[[i]]$value$e_meta) %in% colnames(val$e_meta))) + expect_true(getEDataColName(grpComp[[i]]) %in% colnames(val$e_data)) + expect_true(all(dim(grpComp[[i]]$e_meta) == dim(val$e_meta))) + expect_true(all(colnames(grpComp[[i]]$e_meta) %in% colnames(val$e_meta))) expect_equal(nrow(val$f_data), 1) expect_true(all(grpCompSummary$f_data$Summary_Function_Name == "uniqueness_gtest")) expect_equal(nrow(val$f_data), 1) @@ -59,7 +59,7 @@ test_that("test of summarizeGroupComparisons on a ddo", { test_that("test of summarizeGroupComparisons with multiple summary functions on a groupComparison object", { data("exampleProcessedPeakData") - grpComp <- divideByGroupComparisons(exampleProcessedPeakData, comparisons = "all")[[1]]$value + grpComp <- divideByGroupComparisons(exampleProcessedPeakData, comparisons = "all")[[1]] grpCompSummary <- summarizeGroupComparisons(grpComp, summary_functions=c("uniqueness_gtest", "uniqueness_nsamps", "uniqueness_prop"), summary_function_params=list( From b8f8c9945775935759455fdc0926c8ccbc3d557e Mon Sep 17 00:00:00 2001 From: "clayton.strauch@pnnl.gov" Date: Wed, 28 Jun 2023 13:03:03 -0500 Subject: [PATCH 4/8] Removed Trelliscope Cognostic Function scripts and their respective tests --- R/densityCognostics.R | 162 ------------------------- R/kendrickCognostics.R | 88 -------------- R/panelFunctionGenerator.R | 56 --------- R/summarizeGroups.R | 1 - R/vanKrevelenCognostics.R | 235 ------------------------------------- 5 files changed, 542 deletions(-) delete mode 100644 R/densityCognostics.R delete mode 100644 R/kendrickCognostics.R delete mode 100644 R/panelFunctionGenerator.R delete mode 100644 R/vanKrevelenCognostics.R diff --git a/R/densityCognostics.R b/R/densityCognostics.R deleted file mode 100644 index 2ccdf94..0000000 --- a/R/densityCognostics.R +++ /dev/null @@ -1,162 +0,0 @@ -#' Default cognostics for density plots in Trelliscope -#' -#' The \code{densityCognostics} function provides a set of default cognostics -#' to be used with density plots in Trelliscope. The \code{densityCognostics} -#' function accepts the name of the variable used for the density plot and -#' returns a function that may be applied to each \code{ftmsData} object, as is -#' appropriate for use with the \code{\link[trelliscope:makeDisplay]{makeDisplay}} function. See -#' Examples section for use. -#' -#' @param variable column name of column in \code{e_meta} which should be plotted. Must be one of the column names in \code{ftmsObj$e_meta} that contains numeric values. -#' -#' @return a function that may be applied to objects of type \code{peakData} and \code{groupSummary} -#' @export -#' -#' @examples -#' \dontrun{ -#' library(ftmsRanalysis) -#' library(trelliscope) -#' -#' vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) -#' data('exampleProcessedPeakData') -#' -#' ## Plot density of NOSC variable for each sample -#' sampleDdo <- divideBySample(exampleProcessedPeakData) -#' panelFn1 <- panelFunctionGenerator("densityPlot", variable="NOSC") -#' makeDisplay(sampleDdo, -#' panelFn=panelFn1, -#' cogFn=densityCognostics("NOSC"), -#' name = "NOSC_density_by_sample", -#' group = "Sample") -#' -#' ## Plot density of NOSC for each group -#' groupDdo <- divideByGroup(exampleProcessedPeakData) -#' panelFn2 <- panelFunctionGenerator("densityPlot", variable="NOSC", groups=NA) -#' -#' makeDisplay(groupDdo, -#' panelFn=panelFn2, -#' cogFn=densityCognostics("NOSC"), -#' name = "NOSC_density_by_group", -#' group = "Group") -#' -#' view() -#' } -densityCognostics <- function(variable) { - fn <- function(ftmsObj) { - divisionType <- ftmsRanalysis:::getDivisionType(ftmsObj) - if (divisionType == "sample" | divisionType == "group") { - sample_colnames <- as.character(ftmsObj$f_data[, getFDataColName(ftmsObj)]) - sample_colnames <- sample_colnames[sample_colnames %in% colnames(ftmsObj$e_data)] - presInd <- ftmsRanalysis:::n_present(ftmsObj$e_data[, sample_colnames], - ftmsRanalysis:::getDataScale(ftmsObj)) > 0 - - cogs <- ftmsRanalysis:::commonDensityCognostics(ftmsObj, variable, presInd) - - if (divisionType == "sample") { - cogs <- c(cogs, ftmsRanalysis:::sampleCognostics(ftmsObj)) - } else { - cogs <- c(cogs, ftmsRanalysis:::groupCognostics(ftmsObj)) - } - return(cogs) - - } else if (divisionType == "groupSummary") { - cname <- grep(pattern = ".*_n_present", x = colnames(ftmsObj$e_data), value=TRUE) - if (length(cname) == 0) { - cname <- grep(pattern = ".*_prop_present", x = colnames(ftmsObj$e_data), value=TRUE) - } - if (length(cname) == 0) stop("Cannot find appropriate group summary column of e_data, looking for 'n_present' or 'prop_present'") - - presInd <- ftmsObj$e_data[, cname] > 0 - cogs <- ftmsRanalysis:::commonDensityCognostics(ftmsObj, variable, presInd) - - cogs <- c(cogs, ftmsRanalysis:::groupCognostics(ftmsObj)) - return(cogs) - - } else if (divisionType == "groupComparison") { - cogs <- ftmsRanalysis:::comparisonDensityCognostics(ftmsObj, variable) - return(cogs) - } else { - stop(sprintf("densityCognostics doesn't work with objects of this type (%s)", divisionType)) - } - } - return(fn) - -} - -# Internal function: VK cogs common to both sample and group -commonDensityCognostics <- function(ftmsObj, variable, presenceIndicator) { - - .data <- dplyr::pull(ftmsObj$e_meta, variable)[presenceIndicator] - cogs <- list( - num_peaks=trelliscope::cog(val = sum(presenceIndicator, na.rm=TRUE), desc="Number of peaks observed"), - mean=trelliscope::cog(val=mean(.data, na.rm=TRUE), desc=sprintf("Mean of %s", variable)), - median=trelliscope::cog(val=median(.data, na.rm=TRUE), desc=sprintf("Median of %s", variable)), - stdev=trelliscope::cog(val=sqrt(var(.data, na.rm=TRUE)), desc=sprintf("Standard deviation of %s", variable)), - skewness=trelliscope::cog(val=skewness(.data), desc=sprintf("Skewness of %s", variable)) - ) - return(cogs) -} - -# Cognostics for group comparison and comparison summary ftmsData objects -comparisonDensityCognostics <- function(ftmsObj, variable, uniquenessColName=NA) { - groupDF <- getGroupDF(ftmsObj) - if (is.null(groupDF)) stop("Invalid ftmsObj object, no group definition found") - groups <- as.character(unique(groupDF$Group)) - - if (inherits(ftmsObj, "groupComparison")) { - sampColName <- getFDataColName(ftmsObj) - groupList <- lapply(groups, function(g) as.character(groupDF[groupDF[,"Group"] == g, sampColName])) - names(groupList) <- groups - - presInd1 <- ftmsRanalysis:::n_present(ftmsObj$e_data[, groupList[[1]]], - ftmsRanalysis:::getDataScale(ftmsObj)) > 0 - presInd2 <- ftmsRanalysis:::n_present(ftmsObj$e_data[, groupList[[2]]], - ftmsRanalysis:::getDataScale(ftmsObj)) > 0 - - # } else if (inherits(ftmsObj, "comparisonSummary")) { - # if (identical(uniquenessColName, NA)) { - # uniquenessColName <- setdiff(colnames(ftmsObj$e_data), getEDataColName(ftmsObj)) - # if (length(uniquenessColName) != 1) stop("Cannot determine with column to use for uniqueness, please specify 'uniquenessColName' parameter") - # } - # indNa <- is.na(ftmsObj$e_data[, uniquenessColName]) - # uniqueCol <- as.character(ftmsObj$e_data[, uniquenessColName]) - # presInd1 <- !indNa & (uniqueCol == sprintf("Unique to %s", groups[1]) | uniqueCol == "Observed in Both") - # presInd2 <- !indNa & (uniqueCol == sprintf("Unique to %s", groups[2]) | uniqueCol == "Observed in Both") - # - } else { - stop("ftmsObj must be of class 'groupComparison'") - } - - .data.g1 <- dplyr::pull(ftmsObj$e_meta, variable)[presInd1] - .data.g2 <- dplyr::pull(ftmsObj$e_meta, variable)[presInd2] - - ks.val <- suppressWarnings(ks.test(.data.g1, .data.g2, alternative = "two.sided")) - cogs <- list( - group1=trelliscope::cog(val=groups[1], desc="Group 1"), - group2=trelliscope::cog(val=groups[2], desc="Group 2"), - ks.statistic=trelliscope::cog(val =ks.val$statistic, desc="Kolmogorov-Smirnov statistic for two-sided test"), - ks.pvalue=trelliscope::cog(val =ks.val$p.value, desc="P-value of Kolmogorov-Smirnov statistic for two-sided test"), - num_peaks_g1=trelliscope::cog(val=sum(presInd1), desc="Number of peaks observed in group 1"), - num_peaks_g2=trelliscope::cog(val=sum(presInd2), desc="Number of peaks observed in group 2"), - mean_diff_group1_minus_group2=trelliscope::cog(val=mean(.data.g1, na.rm=TRUE)-mean(.data.g2, na.rm=TRUE), - desc=sprintf("Difference of mean values of %s (group 1 - group 2)", variable)), - median_diff_group1_minus_group2=trelliscope::cog(val=median(.data.g1, na.rm=TRUE)-median(.data.g2, na.rm=TRUE), - desc=sprintf("Difference of median values of %s (group 1 - group 2)", variable)), - stdev_diff_group1_minus_group2=trelliscope::cog(val=sqrt(var(.data.g1, na.rm=TRUE))-sqrt(var(.data.g2, na.rm=TRUE)), - desc=sprintf("Difference of square root values of %s (group 1 - group 2)", variable)), - skewness_diff_group1_minus_group2=trelliscope::cog(val=skewness(.data.g1)-skewness(.data.g2), - desc=sprintf("Difference of skewness values of %s (group 1 - group 2)", variable)) - ) - - return(cogs) -} - -# Internal function to calculate skewness -skewness <- function(vals) { - n <- sum(!is.na(vals)) - if (is.na(n) | n == 0) return(NA) - m_vals <- mean(vals, na.rm=TRUE) - numer <- sum((vals-m_vals)^3, na.rm=TRUE)/n - denom <- sqrt(var(vals, na.rm=TRUE))^3 - return(numer/denom) -} diff --git a/R/kendrickCognostics.R b/R/kendrickCognostics.R deleted file mode 100644 index cfce139..0000000 --- a/R/kendrickCognostics.R +++ /dev/null @@ -1,88 +0,0 @@ -#' Default cognostics for Kendrick plots in Trelliscope -#' -#' The \code{kendrickCognostics} function provides a set of default cognostics -#' to be used with Kendrick plots in Trelliscope. The \code{kendrickCognostics} -#' function accepts the boundary set used for Van Krevelen class calculations -#' and (for \code{comparisonSummary} objects only) the name of the column to use -#' for identifying which peaks are observed in which group. It returns a -#' function that may be applied to each \code{ftmsData} object, as is -#' appropriate for use with the -#' \code{\link[trelliscope:makeDisplay]{makeDisplay}} function. See Examples -#' section for use. -#' -#' @param vkBoundarySet Van Krevelen boundary set to use for calculating class -#' proportions -#' @param uniquenessColName if \code{ftmsObj} is a group comparison summary -#' object, what is the name of the column that specifies uniqueness to a -#' group? If only one uniqueness function has been applied this is -#' unnecessary. (See \code{\link{summarizeGroupComparisons}}.) -#' -#' @return a function that may be applied to objects of type \code{peakData}, -#' \code{groupSummary}, and \code{comparisonSummary} -#' @export -#' -#' @examples -#' \dontrun{ -#' library(ftmsRanalysis) -#' library(trelliscope) -#' -#' vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) -#' data('exampleProcessedPeakData') -#' -#' ## Kendrick plot for each sample -#' sampleDdo <- divideBySample(exampleProcessedPeakData) -#' panelFn1 <- panelFunctionGenerator("kendrickPlot", vkBoundarySet="bs2", title="Test") -#' -#' # Note: make sure the same vkBoundarySet value is provided to the panel and cognostics functions -#' makeDisplay(sampleDdo, -#' panelFn=panelFn1, -#' cogFn=kendrickCognostics(vkBoundarySet="bs2"), -#' name = "Kendrick_plots_per_sample") -#' -#' ## Kendrick plots for group summaries -#' groupDdo <- divideByGroup(exampleProcessedPeakData) -#' groupSummaryDdo <- summarizeGroups(groupDdo, summary_functions = c("prop_present", "n_present")) -#' -#' panelFn2 <- panelFunctionGenerator( -#' "kendrickPlot", -#' colorCName=expr(paste0(getSplitVar(v, "Group"), "_n_present")), -#' legendTitle="Number
Present") -#' -#' makeDisplay(grpCompSummaryDdo, -#' panelFn=panelFn2, -#' cogFn=kendrickCognostics(), -#' name = "Kendrick_plots_for_group_summaries") -#' -#' view() -#' } -kendrickCognostics <- function(vkBoundarySet="bs1", uniquenessColName=NA) { - fn <- function(ftmsObj) { - - cogs <- vanKrevelenCognostics(vkBoundarySet, uniquenessColName)(ftmsObj) - - divisionType <- ftmsRanalysis:::getDivisionType(ftmsObj) - if (divisionType == "sample") { - # add mean observed mass and defect - - sample_colnames <- as.character(ftmsObj$f_data[, getFDataColName(ftmsObj)]) - sample_colnames <- sample_colnames[sample_colnames %in% colnames(ftmsObj$e_data)] - presInd <- ftmsRanalysis:::n_present(ftmsObj$e_data[, sample_colnames], - ftmsRanalysis:::getDataScale(ftmsObj)) > 0 - - massColname <- ftmsRanalysis:::getKendrickMassColName(ftmsObj) - defectColname <- ftmsRanalysis:::getKendrickDefectColName(ftmsObj) - - cogs <- c(cogs, list( - mean_kendrick_mass = trelliscope::cog(val=mean(ftmsObj$e_meta[presInd, massColname], na.rm=TRUE), - desc="Mean observed Kendrick mass"), - mean_kendrick_defect = trelliscope::cog(val=mean(ftmsObj$e_meta[presInd, defectColname], na.rm=TRUE), - desc="Mean observed Kendrick defect") - )) - - } - return(cogs) - } - return(fn) -} - - \ No newline at end of file diff --git a/R/panelFunctionGenerator.R b/R/panelFunctionGenerator.R deleted file mode 100644 index d158ee7..0000000 --- a/R/panelFunctionGenerator.R +++ /dev/null @@ -1,56 +0,0 @@ -#' Convenience function to wrap ftmsRanalysis plotting functions for Trelliscope -#' -#' @param plot_fn_name plot function name, e.g. "vanKrevelenPlot" or "kendrickPlot" -#' @param ... other parameters to pass to the plotting function other than the data object -#' -#' @details Sometimes the additional parameters to pass to the plotting function will depend -#' on the key associated with the data in the ddo (e.g. if a column name is prepended with -#' the group name). In that case, see example below for how -#' to construct an \code{expr} statement to obtain the necessary information. -#' -#' @author Amanda White -#' -#' @export -#' -#' @examples -#' \dontrun{ -#' library(ftmsRanalysis) -#' library(trelliscope) -#' -#' vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) #temporary directory -#' -#' data('exampleProcessedPeakData') -#' groupDdo <- divideByGroup(exampleProcessedPeakData) -#' groupSummaryDdo <- summarizeGroups(groupDdo, summary_functions = c("prop_present", "n_present")) -#' -#' # See rlang::expr here: -#' panelFnG1 <- panelFunctionGenerator( -#' "vanKrevelenPlot", -#' colorCName=rlang::expr(paste0(getSplitVar(v, "Group"), "_prop_present")), -#' legendTitle="Proportion
Present") -#' -#' makeDisplay(groupSummaryDdo, -#' panelFn=panelFnG1, -#' name = "Trelliscope test G_1 with VK plot per group", -#' group = "Group") -#' view() -#' } -panelFunctionGenerator <- function(plot_fn_name, ...) { - if (missing(plot_fn_name)) stop("plot_fn_name must be provided") - if (!is.character(plot_fn_name)) stop("plot_fn_name must be character") - if (length(plot_fn_name)>1) stop("plot_fn_name must be a single value") - -# browser() - parms <- list(...) -# parms2 <- pryr::dots(...) - - plot_fn <- getFromNamespace(plot_fn_name, "ftmsRanalysis") - if (is.null(plot_fn)) stop(sprintf("Unknown function '%s', cannot load this function from ftmsRanalysis", plot_fn_name)) - - fn <- function(v) { - tmp <- list(a=v) - names(tmp)<- NULL - do.call(plot_fn, c(tmp, parms)) - } - return(fn) -} \ No newline at end of file diff --git a/R/summarizeGroups.R b/R/summarizeGroups.R index 8ecd8e6..3628f8b 100644 --- a/R/summarizeGroups.R +++ b/R/summarizeGroups.R @@ -30,7 +30,6 @@ #' groupDdo <- divideByGroup(exampleProcessedPeakData) #' summary2 <- summarizeGroups(groupDdo, summary_functions=c("n_present", "prop_present")) summarizeGroups <- function(ftmsObj, summary_functions) { - require(datadr) if (!(inherits(ftmsObj, "peakData") | !inherits(ftmsObj, "compoundData")) & !inherits(ftmsObj, "list") ) stop("ftmsObj must be of type peakData, compoundData, or a ddo containing those objects") if (inherits(ftmsObj, "groupSummary") | inherits(ftmsObj, "groupComparison") | inherits(ftmsObj, "comparisonSummary")) diff --git a/R/vanKrevelenCognostics.R b/R/vanKrevelenCognostics.R deleted file mode 100644 index 49ab35b..0000000 --- a/R/vanKrevelenCognostics.R +++ /dev/null @@ -1,235 +0,0 @@ - -#' Default cognostics for Van Krevelen plots in Trelliscope -#' -#' The \code{vanKrevelenCognostics} function provides a set of default -#' cognostics to be used with Van Krevelen plots in Trelliscope. The -#' \code{vanKrevelenCognostics} function accepts the boundary set used for Van -#' Krevelen class calculations and (for \code{comparisonSummary} objects only) -#' the name of the column to use for identifying which peaks are observed in -#' which group. It returns a function that may be applied to each -#' \code{ftmsData} object, as is appropriate for use with the -#' \code{\link[trelliscope:makeDisplay]{makeDisplay}} function. See Examples -#' section for use. -#' -#' @param vkBoundarySet Van Krevelen boundary set to use for calculating class -#' proportions -#' @param uniquenessColName if \code{ftmsObj} is a group comparison summary -#' object, what is the name of the column that specifies uniqueness to a -#' group? If only one uniqueness function has been applied this is -#' unnecessary. (See \code{\link{summarizeGroupComparisons}}.) -#' -#' @return a function that may be applied to objects of type \code{peakData}, -#' \code{groupSummary}, and \code{comparisonSummary} -#' @export -#' -#' @examples -#' \dontrun{ -#' library(ftmsRanalysis) -#' library(trelliscope) -#' -#' vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) -#' data('exampleProcessedPeakData') -#' -#' ## Van Krevelen plot for each sample -#' sampleDdo <- divideBySample(exampleProcessedPeakData) -#' panelFn1 <- panelFunctionGenerator("vanKrevelenPlot", vkBoundarySet="bs2", title="Test") -#' -#' # Note: make sure the same vkBoundarySet value is provided to the panel and cognostics functions -#' makeDisplay(sampleDdo, -#' panelFn=panelFn1, -#' cogFn=vanKrevelenCognostics(vkBoundarySet="bs2"), -#' name = "Van_Krevelen_plots_per_sample") -#' -#' ## Van Krevelen plots for group comparison summaries -#' grpCompDdo <- divideByGroupComparisons(exampleProcessedPeakData, "all") -#' grpCompSummaryDdo <- summarizeGroupComparisons( -#' grpCompDdo, -#' summary_functions="uniqueness_gtest", -#' summary_function_params=list(uniqueness_gtest=list( -#' pres_fn="nsamps", -#' pres_thresh=2, -#' pvalue_thresh=0.05))) -#' -#' panelFn2 <- panelFunctionGenerator("vanKrevelenPlot", colorCName="uniqueness_gtest") -#' -#' # Note: uniquenessColName parameter tells vanKrevelenCognostics which column to use to determine -#' # group uniqueness for each peak. If only one summary function is used in summarizeGroupComparisons -#' # then it will be inferred, otherwise it's necessary to specify. -#' makeDisplay(grpCompSummaryDdo, -#' panelFn=panelFn2, -#' cogFn=vanKrevelenCognostics(uniquenessColName="uniqueness_gtest"), -#' name = "Van_Krevelen_plots_for_group_comparison_summaries") -#' -#' view() -#' } -vanKrevelenCognostics <- function(vkBoundarySet="bs1", uniquenessColName=NA) { - fn <- function(ftmsObj) { - divisionType <- ftmsRanalysis:::getDivisionType(ftmsObj) - if (divisionType == "sample" | divisionType == "group") { - sample_colnames <- as.character(ftmsObj$f_data[, getFDataColName(ftmsObj)]) - sample_colnames <- sample_colnames[sample_colnames %in% colnames(ftmsObj$e_data)] - presInd <- ftmsRanalysis:::n_present(ftmsObj$e_data[, sample_colnames], - ftmsRanalysis:::getDataScale(ftmsObj)) > 0 - - cogs <- ftmsRanalysis:::commonVanKrevelenCognostics(ftmsObj, presInd, vkBoundarySet=vkBoundarySet) - - if (divisionType == "sample") { - cogs <- c(cogs, ftmsRanalysis:::sampleCognostics(ftmsObj)) - } else { - cogs <- c(cogs, ftmsRanalysis:::groupCognostics(ftmsObj)) - } - return(cogs) - - } else if (divisionType == "groupSummary") { - cname <- grep(pattern = ".*_n_present", x = colnames(ftmsObj$e_data), value=TRUE) - if (length(cname) == 0) { - cname <- grep(pattern = ".*_prop_present", x = colnames(ftmsObj$e_data), value=TRUE) - } - if (length(cname) == 0) stop("Cannot find appropriate group summary column of e_data, looking for 'n_present' or 'prop_present'") - - presInd <- ftmsObj$e_data[, cname] > 0 - cogs <- ftmsRanalysis:::commonVanKrevelenCognostics(ftmsObj, presInd, vkBoundarySet=vkBoundarySet) - - cogs <- c(cogs, ftmsRanalysis:::groupCognostics(ftmsObj)) - return(cogs) - - } else if (divisionType == "comparisonSummary") { - cogs <- ftmsRanalysis:::comparisonSummaryVanKrevelenCognostics(ftmsObj, vkBoundarySet=vkBoundarySet, uniquenessColName=uniquenessColName) - return(cogs) - } else { - stop(sprintf("vanKrevelenCognostics doesn't work with objects of this type (%s)", divisionType)) - } - } - return(fn) - -} - -# Internal function: VK cogs common to both sample and group -commonVanKrevelenCognostics <- function(ftmsObj, presenceIndicator, vkBoundarySet="bs1") { - vkColname <- getVKColName(ftmsObj, vkBoundarySet) - if (is.null(vkColname)) { - ftmsObj <- assign_class(ftmsObj, boundary_set = vkBoundarySet) - vkColname <- getVKColName(ftmsObj, vkBoundarySet) - } - - vkClasses = ftmsObj$e_meta[, vkColname] - vkClasses <- strsplit(vkClasses, ";") - - denom <- sum(presenceIndicator) - allClasses <- rownames(getVanKrevelenCategoryBounds(vkBoundarySet)$VKbounds) - classProportions <- lapply(allClasses, function(cc) { - trelliscope::cog(val=sum(unlist(vkClasses[which(presenceIndicator)]) == cc, na.rm=TRUE)/denom, desc=sprintf("Proportion of observed peaks of class %s", cc)) - }) - names(classProportions) <- paste("prop_", gsub(" ", "_", allClasses), sep="") - - cogs <- list( - num_peaks=trelliscope::cog(val = denom, desc="Number of peaks observed") - ) - cogs <- c(cogs, classProportions) - return(cogs) -} - -# Cogs for samples: f_data columns -sampleCognostics <- function(ftmsObj) { - # add f_data columns - fdata_cols <- setdiff(colnames(ftmsObj$f_data), getFDataColName(ftmsObj)) - more_cogs <- lapply(fdata_cols, function(cc) { - trelliscope::cog(val=ftmsObj$f_data[1, cc], desc=cc) - }) - names(more_cogs) <- fdata_cols - return(more_cogs) -} - -# Cogs for groups: group defining columns of f_data -groupCognostics <- function(ftmsObj) { - groupDF <- ftmsRanalysis:::getGroupDF(ftmsObj) - if (is.null(groupDF)) stop("Invalid ftmsObj object, no group definition found") - cols <- c(attr(groupDF, "main_effects"), attr(groupDF, "covariates")) - more_cogs <- lapply(cols, function(cc) { - trelliscope::cog(val=groupDF[1, cc], desc=cc) - }) - names(more_cogs) <- cols - return(more_cogs) -} - -# Cognostics for comparison summary ftmsData objects -comparisonSummaryVanKrevelenCognostics <- function(ftmsObj, vkBoundarySet="bs1", uniquenessColName=NA) { - if (!inherits(ftmsObj, "comparisonSummary")) stop("ftmsObj must be of class 'comparisonSummary'") - groupDF <- getGroupDF(ftmsObj) - if (is.null(groupDF)) stop("Invalid ftmsObj object, no group definition found") - - groups <- as.character(unique(groupDF$Group)) - sampColName <- getFDataColName(ftmsObj) - groupList <- lapply(groups, function(g) as.character(groupDF[groupDF[,"Group"] == g, sampColName])) - names(groupList) <- groups - - if (identical(uniquenessColName, NA)) { - uniquenessColName <- setdiff(colnames(ftmsObj$e_data), getEDataColName(ftmsObj)) - if (length(uniquenessColName) != 1) stop("Cannot determine with column to use for uniqueness, please specify 'uniquenessColName' parameter") - } - presInd <- lapply(groups, function(g) { - !is.na(ftmsObj$e_data[, uniquenessColName]) & as.character(ftmsObj$e_data[, uniquenessColName]) == sprintf("Unique to %s", g) - }) - names(presInd) <- groups - - vkColname <- getVKColName(ftmsObj, vkBoundarySet) - if (is.null(vkColname)) { - ftmsObj <- assign_class(ftmsObj, boundary_set = vkBoundarySet) - vkColname <- getVKColName(ftmsObj, vkBoundarySet) - } - - vkClasses <- ftmsObj$e_meta[, vkColname] - vkClasses <- strsplit(vkClasses, ";") - #vkClasses <- vkClasses[!is.na(vkClasses)] - denom <- sum(!is.na(ftmsObj$e_data[, uniquenessColName])) #count how many peaks observed in any group - allClasses <- rownames(getVanKrevelenCategoryBounds(vkBoundarySet)$VKbounds) - classProportions <- lapply(1:2, function(g) { - x <- lapply(allClasses, function(cc) { - trelliscope::cog(val=sum(unlist(vkClasses[which(presInd[[g]])]) == cc, na.rm=TRUE)/denom, - desc=sprintf("Proportion of observed peaks of class %s unique to group %s", cc, g)) - }) - names(x) <- paste("prop_", gsub(" ", "_", allClasses), "_unique_group_", g, sep="") - return(x) - }) - classProportions <- do.call(c, classProportions) - - cogs <- list( - group1=trelliscope::cog(val=groups[1], desc="Group 1"), - group2=trelliscope::cog(val=groups[2], desc="Group 2"), - num_peaks_common=trelliscope::cog(val = sum(ftmsObj$e_data[, uniquenessColName] == "Observed in Both", na.rm=TRUE), desc="Number of peaks observed in both groups"), - num_peaks_g1=trelliscope::cog(val=sum(presInd[[1]]), desc="Number of peaks unique to group 1"), - num_peaks_g2=trelliscope::cog(val=sum(presInd[[2]]), desc="Number of peaks unique to group 2") - ) -# names(cogs)[2:3] <- gsub(" ", "_", paste("num_peaks_", groups, sep="")) - cogs <- c(cogs, classProportions) - return(cogs) -} - -# Internal only function to determine if an ftmsData object is divided by "sample", "group", "groupSummary", "groupComparison" -getDivisionType <- function(ftmsObj) { - svars <- getSplitVars(ftmsObj) - if (getFDataColName(ftmsObj) %in% names(svars)) { - return("sample") - } else if ("Group" %in% names(svars)) { - if (inherits(ftmsObj, "groupSummary")) { - return("groupSummary") - } else { - return("group") - } - } else if (inherits(ftmsObj, "groupComparison")) { - return("groupComparison") - } else if (inherits(ftmsObj, "comparisonSummary")) { - return("comparisonSummary") - } else { - stop("Unknown division type") - } -} - -getVKColName <- function(ftmsObj, vkBoundarySet) { - vkColname = switch(vkBoundarySet, - bs1=getBS1ColName(ftmsObj), - bs2=getBS2ColName(ftmsObj), - bs3=getBS3ColName(ftmsObj) - ) - return(vkColname) -} From 5d777bf6dfc0ebca436f536057b2c44e62d90177 Mon Sep 17 00:00:00 2001 From: "clayton.strauch@pnnl.gov" Date: Fri, 7 Jul 2023 18:48:53 -0500 Subject: [PATCH 5/8] Updated documentation from datadr and trelliscope removal --- NAMESPACE | 4 -- R/concat.R | 19 ++++----- R/divideByGroup.R | 7 ++- R/divideByGroupComparisons.R | 6 +-- R/divideBySample.R | 7 ++- R/summarizeGroupComparisons.R | 8 ++-- R/summarizeGroups.R | 12 +++--- man/concat.Rd | 21 ++++----- man/densityCognostics.Rd | 52 ----------------------- man/divideByGroup.Rd | 9 ++-- man/divideByGroupComparisons.Rd | 6 +-- man/divideBySample.Rd | 9 ++-- man/kendrickCognostics.Rd | 67 ----------------------------- man/panelFunctionGenerator.Rd | 49 --------------------- man/summarizeGroupComparisons.Rd | 6 +-- man/summarizeGroups.Rd | 8 ++-- man/vanKrevelenCognostics.Rd | 73 -------------------------------- 17 files changed, 53 insertions(+), 310 deletions(-) delete mode 100644 man/densityCognostics.Rd delete mode 100644 man/kendrickCognostics.Rd delete mode 100644 man/panelFunctionGenerator.Rd delete mode 100644 man/vanKrevelenCognostics.Rd diff --git a/NAMESPACE b/NAMESPACE index 08176be..a703efa 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -38,7 +38,6 @@ export(compound_calcs) export(concat) export(conf_filter) export(coreMSDataToFtmsData) -export(densityCognostics) export(densityPlot) export(divideByGroup) export(divideByGroupComparisons) @@ -95,7 +94,6 @@ export(getSulfurColName) export(getVanKrevelenCategoryBounds) export(group_designation) export(heatmap) -export(kendrickCognostics) export(kendrickPlot) export(mapCompoundsToModules) export(mapCompoundsToReactions) @@ -104,7 +102,6 @@ export(mass_error_plot) export(mass_filter) export(molecule_filter) export(numPeaksPlot) -export(panelFunctionGenerator) export(parseModuleReaction) export(plotPrincipalCoordinates) export(plotlyHeatmap) @@ -114,7 +111,6 @@ export(summarizeGroupComparisons) export(summarizeGroups) export(transformation_counts) export(unique_mf_assignment) -export(vanKrevelenCognostics) export(vanKrevelenPlot) importFrom(dplyr,"%>%") importFrom(magrittr,"%>%") diff --git a/R/concat.R b/R/concat.R index 159a3ee..47c97ff 100644 --- a/R/concat.R +++ b/R/concat.R @@ -1,16 +1,15 @@ -#' Combine multiple distributed data objects of ftmsData +#' Combine multiple ftmsData objects #' -#' Combine multiple distributed data objects (ddo) into a single ddo +#' Combine multiple ftmsData objects into a single ftmsData object #' for further analysis or visualizations. The inputs to this function are -#' the ddo objects created by \code{\link{divideByGroup}} or -#' \code{\link{divideByGroupComparisons}}. The output is a new ddo +#' the ftmsData objects created by \code{\link{divideByGroup}} or +#' \code{\link{divideByGroupComparisons}}. The output is a new ftmsData #' with all the data of the supplied inputs, in a form that can be #' summarized with \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} #' respectively, or visualized with \code{trelliscope}. #' -#' @param ... two or more ddo objects that are the output of \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} +#' @param ... two or more ftmsData objects that are the output of \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} #' -#' @seealso \link[datadr:ddo]{ddo} #' @author Amanda White #' #' @export @@ -18,13 +17,13 @@ #' @examples #' data("exampleProcessedPeakData") #' exampleProcessedPeakData <- group_designation(exampleProcessedPeakData, main_effects = "Location") -#' grpDdo1 <- divideByGroup(exampleProcessedPeakData) +#' grp1 <- divideByGroup(exampleProcessedPeakData) #' #' exampleProcessedPeakData <- group_designation(exampleProcessedPeakData, main_effects = "Crop.Flora") -#' grpDdo2 <- divideByGroup(exampleProcessedPeakData) +#' grp2 <- divideByGroup(exampleProcessedPeakData) #' -#' allGrpDdo <-concat(grpDdo1, grpDdo2) -#' grpSummaries <- summarizeGroups(allGrpDdo, c("n_present", "prop_present")) +#' allGrps <-concat(grp1, grp2) +#' grpSummaries <- summarizeGroups(allGrps, c("n_present", "prop_present")) concat <- function(...) { parms <- list(...) # test inputs diff --git a/R/divideByGroup.R b/R/divideByGroup.R index 4e3b067..0065fd1 100644 --- a/R/divideByGroup.R +++ b/R/divideByGroup.R @@ -1,14 +1,13 @@ -#' Divide an ftmsData object by group to form a ddo +#' Divide an ftmsData object by group to form a list of ftmsData objects #' -#' Construct a \code{\link[datadr:ddo]{ddo}} from an \code{ftmsData} object by dividing +#' Construct a list of subsetted ftmsData objects from an \code{ftmsData} object by dividing #' by group. The resulting object may be used with Trelliscope to make #' plots for each group. The input data must have a \code{group_DF} attribute #' defining the groups. #' #' @param ftmsObj ftmsData object -#' @return a ddo where each division is a subset of \code{ftmsObj} corresponding +#' @return a list where each element is a subset of \code{ftmsObj} corresponding #' to a single group -#' @seealso \code{\link[datadr:ddo]{ddo}} #' @export divideByGroup <- function(ftmsObj) { sample.colname <- getFDataColName(ftmsObj) diff --git a/R/divideByGroupComparisons.R b/R/divideByGroupComparisons.R index 5bfb782..60fad6e 100644 --- a/R/divideByGroupComparisons.R +++ b/R/divideByGroupComparisons.R @@ -1,13 +1,13 @@ -#' Construct a ddo of group comparisons +#' Construct a list of group comparisons #' -#' Construct a \code{\link[datadr:ddo]{ddo}} where each subset consists of data for +#' Construct a list where each element is a subset consisting of data for #' a pair of groups. This is used to facilitate analysis and visualizations #' of group comparisons. #' #' @param ftmsObj ftmsData object #' @param comparisons dictates which pairwise comparisons to make. 'all' will create a matrix for all pairwise comparisons, 'control' will create a matrix for all comparisons against a specified control group, 'one-factor' will create a matrix of pairwise comparisons to be made where only one 'main_effect' changes between the two groups, or a list of specific comparisons to be made (e.g., list(c("Group1","Group2"),c("Group3","Group4"))) can be given. #' @param control if wanting to only compare against a control, must specify which group or sample is the control -#' @return a distributed data object where each division consists of a subset of \code{ftmsObj} with +#' @return a named list where each element consists of a subset of \code{ftmsObj} with #' data from just two groups. #' @export divideByGroupComparisons <- function(ftmsObj, comparisons, control=NULL) { diff --git a/R/divideBySample.R b/R/divideBySample.R index bbbe396..a7b1fad 100644 --- a/R/divideBySample.R +++ b/R/divideBySample.R @@ -1,13 +1,12 @@ -#' Divide an ftmsData objecdt by sample to form a ddo +#' Divide an ftmsData objecdt by sample to form a list #' -#' Construct a \code{\link[datadr:ddo]{ddo}} from an \code{ftmsData} object by dividing +#' Construct a named list from an \code{ftmsData} object by dividing #' by sample. The resulting object may be used with Trelliscope to make #' plots for each sample. #' #' @param ftmsObj ftmsData object -#' @return a ddo where each division is a subset of \code{ftmsObj} corresponding +#' @return a named list where each element is a subset of \code{ftmsObj} corresponding #' to a single sample -#' @seealso \code{\link[datadr:ddo]{ddo}} #' @export divideBySample <- function(ftmsObj) { diff --git a/R/summarizeGroupComparisons.R b/R/summarizeGroupComparisons.R index 42563ae..bf8326c 100644 --- a/R/summarizeGroupComparisons.R +++ b/R/summarizeGroupComparisons.R @@ -1,13 +1,13 @@ #' Summarize group comparisons #' -#' Summarize a group comparisons object or a ddo of group comparisons objects. This function +#' Summarize a group comparisons object or a list of group comparisons objects. This function #' applies a summary function to the columns of \code{compData$e_data} corresponding to each #' column to calculate a summary column for each group. #' #' Currently this function does not allow executing the same summary function multiple times #' with different parameters. #' -#' @param compData a groupComparison object or a ddo of groupComparison objects, i.e. the output +#' @param compData a groupComparison object or a list of groupComparison objects, i.e. the output #' of \code{\link{divideByGroupComparisons}}. #' @param summary_functions vector of summary function names to apply to each row of \code{ftmsObj$e_data} for each group. Valid #' summary function names are given by \code{\link{getGroupComparisonSummaryFunctionNames}}. @@ -15,7 +15,7 @@ #' match values in \code{summary_functions}, each value should be a list of name/value parameters, e.g. #' \code{list(uniqueness_gtest=list(pval_threshold=0.01))}. #' -#' @return a comparisonSummary object or a ddo of comparisonSummary objects +#' @return a comparisonSummary object or a list of comparisonSummary objects #' @export summarizeGroupComparisons <- function(compData, summary_functions, summary_function_params=NULL) { if (missing(compData)) stop("compData is missing") @@ -23,7 +23,7 @@ summarizeGroupComparisons <- function(compData, summary_functions, summary_funct #if (length(summary_functions) != 1) stop("summary_functions must have length 1") if (!(inherits(compData, "groupComparison") | inherits(compData, "list") ) ) - stop("compData must be of type groupComparison or a ddo containing groupComparisons") + stop("compData must be of type groupComparison or a list containing groupComparisons") if (!is.null(summary_function_params)) { if (!is.list(summary_function_params)) { diff --git a/R/summarizeGroups.R b/R/summarizeGroups.R index 3628f8b..dd4c3b7 100644 --- a/R/summarizeGroups.R +++ b/R/summarizeGroups.R @@ -5,7 +5,7 @@ #' corresponding to samples. It must return a data frame with the same number of #' rows and one column. #' -#' @param ftmsObj an object of class 'peakData' or 'compoundData' or a ddo of +#' @param ftmsObj an object of class 'peakData' or 'compoundData' or a list of #' ftmsData objects (e.g. the output of \code{\link{divideByGroup}}) #' @param summary_functions vector of summary function names to apply to each #' row of \code{ftmsObj$e_data} for each group. Valid summary function names @@ -14,7 +14,7 @@ #' \code{ftmsData} object where each provided summary function will be applied #' to each group found in \code{getGroupDF(ftmsObj)}. If #' \code{getGroupDF(ftmsObj) == null} the function will assume all samples -#' belong to a single group. If the input is a ddo the result will be a ddo +#' belong to a single group. If the input is a list the result will be a list #' where each value is the result of applying \code{summarizeGroups} to each #' value of the input. #' @@ -27,11 +27,11 @@ #' summary1 <- summarizeGroups(exampleProcessedPeakData, #' summary_functions=c("n_present", "prop_present")) #' -#' groupDdo <- divideByGroup(exampleProcessedPeakData) -#' summary2 <- summarizeGroups(groupDdo, summary_functions=c("n_present", "prop_present")) +#' groupList <- divideByGroup(exampleProcessedPeakData) +#' summary2 <- summarizeGroups(groupList, summary_functions=c("n_present", "prop_present")) summarizeGroups <- function(ftmsObj, summary_functions) { if (!(inherits(ftmsObj, "peakData") | !inherits(ftmsObj, "compoundData")) & !inherits(ftmsObj, "list") ) - stop("ftmsObj must be of type peakData, compoundData, or a ddo containing those objects") + stop("ftmsObj must be of type peakData, compoundData, or a list containing those objects") if (inherits(ftmsObj, "groupSummary") | inherits(ftmsObj, "groupComparison") | inherits(ftmsObj, "comparisonSummary")) stop("ftmsObj cannot be a groupSummary, groupComparison or comparisonSummary object") if (missing(summary_functions)) stop("summary_function must be provided") @@ -48,7 +48,7 @@ summarizeGroups <- function(ftmsObj, summary_functions) { return(res) } -# Internal only function for use on 1 ftmsData object not a ddo of them +# Internal only function for use on 1 ftmsData object not a list of them .summarizeGroupsInternal <- function(ftmsObj, summary_functions) { # Get function objects from names diff --git a/man/concat.Rd b/man/concat.Rd index 67a47a8..325152c 100644 --- a/man/concat.Rd +++ b/man/concat.Rd @@ -2,18 +2,18 @@ % Please edit documentation in R/concat.R \name{concat} \alias{concat} -\title{Combine multiple distributed data objects of ftmsData} +\title{Combine multiple ftmsData objects} \usage{ concat(...) } \arguments{ -\item{...}{two or more ddo objects that are the output of \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}}} +\item{...}{two or more ftmsData objects that are the output of \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}}} } \description{ -Combine multiple distributed data objects (ddo) into a single ddo +Combine multiple ftmsData objects into a single ftmsData object for further analysis or visualizations. The inputs to this function are -the ddo objects created by \code{\link{divideByGroup}} or -\code{\link{divideByGroupComparisons}}. The output is a new ddo +the ftmsData objects created by \code{\link{divideByGroup}} or +\code{\link{divideByGroupComparisons}}. The output is a new ftmsData with all the data of the supplied inputs, in a form that can be summarized with \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} respectively, or visualized with \code{trelliscope}. @@ -21,16 +21,13 @@ respectively, or visualized with \code{trelliscope}. \examples{ data("exampleProcessedPeakData") exampleProcessedPeakData <- group_designation(exampleProcessedPeakData, main_effects = "Location") -grpDdo1 <- divideByGroup(exampleProcessedPeakData) +grp1 <- divideByGroup(exampleProcessedPeakData) exampleProcessedPeakData <- group_designation(exampleProcessedPeakData, main_effects = "Crop.Flora") -grpDdo2 <- divideByGroup(exampleProcessedPeakData) +grp2 <- divideByGroup(exampleProcessedPeakData) -allGrpDdo <-concat(grpDdo1, grpDdo2) -grpSummaries <- summarizeGroups(allGrpDdo, c("n_present", "prop_present")) -} -\seealso{ -\link[datadr:ddo]{ddo} +allGrps <-concat(grp1, grp2) +grpSummaries <- summarizeGroups(allGrps, c("n_present", "prop_present")) } \author{ Amanda White diff --git a/man/densityCognostics.Rd b/man/densityCognostics.Rd deleted file mode 100644 index 3ac564c..0000000 --- a/man/densityCognostics.Rd +++ /dev/null @@ -1,52 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/densityCognostics.R -\name{densityCognostics} -\alias{densityCognostics} -\title{Default cognostics for density plots in Trelliscope} -\usage{ -densityCognostics(variable) -} -\arguments{ -\item{variable}{column name of column in \code{e_meta} which should be plotted. Must be one of the column names in \code{ftmsObj$e_meta} that contains numeric values.} -} -\value{ -a function that may be applied to objects of type \code{peakData} and \code{groupSummary} -} -\description{ -The \code{densityCognostics} function provides a set of default cognostics -to be used with density plots in Trelliscope. The \code{densityCognostics} -function accepts the name of the variable used for the density plot and -returns a function that may be applied to each \code{ftmsData} object, as is -appropriate for use with the \code{\link[trelliscope:makeDisplay]{makeDisplay}} function. See -Examples section for use. -} -\examples{ -\dontrun{ -library(ftmsRanalysis) -library(trelliscope) - -vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) -data('exampleProcessedPeakData') - -## Plot density of NOSC variable for each sample -sampleDdo <- divideBySample(exampleProcessedPeakData) -panelFn1 <- panelFunctionGenerator("densityPlot", variable="NOSC") -makeDisplay(sampleDdo, - panelFn=panelFn1, - cogFn=densityCognostics("NOSC"), - name = "NOSC_density_by_sample", - group = "Sample") - -## Plot density of NOSC for each group -groupDdo <- divideByGroup(exampleProcessedPeakData) -panelFn2 <- panelFunctionGenerator("densityPlot", variable="NOSC", groups=NA) - -makeDisplay(groupDdo, - panelFn=panelFn2, - cogFn=densityCognostics("NOSC"), - name = "NOSC_density_by_group", - group = "Group") - -view() -} -} diff --git a/man/divideByGroup.Rd b/man/divideByGroup.Rd index 19fb084..e0f0873 100644 --- a/man/divideByGroup.Rd +++ b/man/divideByGroup.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/divideByGroup.R \name{divideByGroup} \alias{divideByGroup} -\title{Divide an ftmsData object by group to form a ddo} +\title{Divide an ftmsData object by group to form a list of ftmsData objects} \usage{ divideByGroup(ftmsObj) } @@ -10,15 +10,12 @@ divideByGroup(ftmsObj) \item{ftmsObj}{ftmsData object} } \value{ -a ddo where each division is a subset of \code{ftmsObj} corresponding +a list where each element is a subset of \code{ftmsObj} corresponding to a single group } \description{ -Construct a \code{\link[datadr:ddo]{ddo}} from an \code{ftmsData} object by dividing +Construct a list of subsetted ftmsData objects from an \code{ftmsData} object by dividing by group. The resulting object may be used with Trelliscope to make plots for each group. The input data must have a \code{group_DF} attribute defining the groups. } -\seealso{ -\code{\link[datadr:ddo]{ddo}} -} diff --git a/man/divideByGroupComparisons.Rd b/man/divideByGroupComparisons.Rd index 4204a7a..ad36dd7 100644 --- a/man/divideByGroupComparisons.Rd +++ b/man/divideByGroupComparisons.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/divideByGroupComparisons.R \name{divideByGroupComparisons} \alias{divideByGroupComparisons} -\title{Construct a ddo of group comparisons} +\title{Construct a list of group comparisons} \usage{ divideByGroupComparisons(ftmsObj, comparisons, control = NULL) } @@ -14,11 +14,11 @@ divideByGroupComparisons(ftmsObj, comparisons, control = NULL) \item{control}{if wanting to only compare against a control, must specify which group or sample is the control} } \value{ -a distributed data object where each division consists of a subset of \code{ftmsObj} with +a named list where each element consists of a subset of \code{ftmsObj} with data from just two groups. } \description{ -Construct a \code{\link[datadr:ddo]{ddo}} where each subset consists of data for +Construct a list where each element is a subset consisting of data for a pair of groups. This is used to facilitate analysis and visualizations of group comparisons. } diff --git a/man/divideBySample.Rd b/man/divideBySample.Rd index ae8d716..5f89b4b 100644 --- a/man/divideBySample.Rd +++ b/man/divideBySample.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/divideBySample.R \name{divideBySample} \alias{divideBySample} -\title{Divide an ftmsData objecdt by sample to form a ddo} +\title{Divide an ftmsData objecdt by sample to form a list} \usage{ divideBySample(ftmsObj) } @@ -10,14 +10,11 @@ divideBySample(ftmsObj) \item{ftmsObj}{ftmsData object} } \value{ -a ddo where each division is a subset of \code{ftmsObj} corresponding +a named list where each element is a subset of \code{ftmsObj} corresponding to a single sample } \description{ -Construct a \code{\link[datadr:ddo]{ddo}} from an \code{ftmsData} object by dividing +Construct a named list from an \code{ftmsData} object by dividing by sample. The resulting object may be used with Trelliscope to make plots for each sample. } -\seealso{ -\code{\link[datadr:ddo]{ddo}} -} diff --git a/man/kendrickCognostics.Rd b/man/kendrickCognostics.Rd deleted file mode 100644 index d7ccf73..0000000 --- a/man/kendrickCognostics.Rd +++ /dev/null @@ -1,67 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/kendrickCognostics.R -\name{kendrickCognostics} -\alias{kendrickCognostics} -\title{Default cognostics for Kendrick plots in Trelliscope} -\usage{ -kendrickCognostics(vkBoundarySet = "bs1", uniquenessColName = NA) -} -\arguments{ -\item{vkBoundarySet}{Van Krevelen boundary set to use for calculating class -proportions} - -\item{uniquenessColName}{if \code{ftmsObj} is a group comparison summary -object, what is the name of the column that specifies uniqueness to a -group? If only one uniqueness function has been applied this is -unnecessary. (See \code{\link{summarizeGroupComparisons}}.)} -} -\value{ -a function that may be applied to objects of type \code{peakData}, - \code{groupSummary}, and \code{comparisonSummary} -} -\description{ -The \code{kendrickCognostics} function provides a set of default cognostics -to be used with Kendrick plots in Trelliscope. The \code{kendrickCognostics} -function accepts the boundary set used for Van Krevelen class calculations -and (for \code{comparisonSummary} objects only) the name of the column to use -for identifying which peaks are observed in which group. It returns a -function that may be applied to each \code{ftmsData} object, as is -appropriate for use with the -\code{\link[trelliscope:makeDisplay]{makeDisplay}} function. See Examples -section for use. -} -\examples{ -\dontrun{ -library(ftmsRanalysis) -library(trelliscope) - -vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) -data('exampleProcessedPeakData') - -## Kendrick plot for each sample -sampleDdo <- divideBySample(exampleProcessedPeakData) -panelFn1 <- panelFunctionGenerator("kendrickPlot", vkBoundarySet="bs2", title="Test") - -# Note: make sure the same vkBoundarySet value is provided to the panel and cognostics functions -makeDisplay(sampleDdo, - panelFn=panelFn1, - cogFn=kendrickCognostics(vkBoundarySet="bs2"), - name = "Kendrick_plots_per_sample") - -## Kendrick plots for group summaries -groupDdo <- divideByGroup(exampleProcessedPeakData) -groupSummaryDdo <- summarizeGroups(groupDdo, summary_functions = c("prop_present", "n_present")) - -panelFn2 <- panelFunctionGenerator( - "kendrickPlot", - colorCName=expr(paste0(getSplitVar(v, "Group"), "_n_present")), - legendTitle="Number
Present") - -makeDisplay(grpCompSummaryDdo, - panelFn=panelFn2, - cogFn=kendrickCognostics(), - name = "Kendrick_plots_for_group_summaries") - -view() -} -} diff --git a/man/panelFunctionGenerator.Rd b/man/panelFunctionGenerator.Rd deleted file mode 100644 index f8048c9..0000000 --- a/man/panelFunctionGenerator.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/panelFunctionGenerator.R -\name{panelFunctionGenerator} -\alias{panelFunctionGenerator} -\title{Convenience function to wrap ftmsRanalysis plotting functions for Trelliscope} -\usage{ -panelFunctionGenerator(plot_fn_name, ...) -} -\arguments{ -\item{plot_fn_name}{plot function name, e.g. "vanKrevelenPlot" or "kendrickPlot"} - -\item{...}{other parameters to pass to the plotting function other than the data object} -} -\description{ -Convenience function to wrap ftmsRanalysis plotting functions for Trelliscope -} -\details{ -Sometimes the additional parameters to pass to the plotting function will depend -on the key associated with the data in the ddo (e.g. if a column name is prepended with -the group name). In that case, see example below for how -to construct an \code{expr} statement to obtain the necessary information. -} -\examples{ -\dontrun{ -library(ftmsRanalysis) -library(trelliscope) - -vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) #temporary directory - -data('exampleProcessedPeakData') -groupDdo <- divideByGroup(exampleProcessedPeakData) -groupSummaryDdo <- summarizeGroups(groupDdo, summary_functions = c("prop_present", "n_present")) - -# See rlang::expr here: -panelFnG1 <- panelFunctionGenerator( - "vanKrevelenPlot", - colorCName=rlang::expr(paste0(getSplitVar(v, "Group"), "_prop_present")), - legendTitle="Proportion
Present") - -makeDisplay(groupSummaryDdo, - panelFn=panelFnG1, - name = "Trelliscope test G_1 with VK plot per group", - group = "Group") -view() -} -} -\author{ -Amanda White -} diff --git a/man/summarizeGroupComparisons.Rd b/man/summarizeGroupComparisons.Rd index 7c405b7..985b2b7 100755 --- a/man/summarizeGroupComparisons.Rd +++ b/man/summarizeGroupComparisons.Rd @@ -11,7 +11,7 @@ summarizeGroupComparisons( ) } \arguments{ -\item{compData}{a groupComparison object or a ddo of groupComparison objects, i.e. the output +\item{compData}{a groupComparison object or a list of groupComparison objects, i.e. the output of \code{\link{divideByGroupComparisons}}.} \item{summary_functions}{vector of summary function names to apply to each row of \code{ftmsObj$e_data} for each group. Valid @@ -22,10 +22,10 @@ match values in \code{summary_functions}, each value should be a list of name/va \code{list(uniqueness_gtest=list(pval_threshold=0.01))}.} } \value{ -a comparisonSummary object or a ddo of comparisonSummary objects +a comparisonSummary object or a list of comparisonSummary objects } \description{ -Summarize a group comparisons object or a ddo of group comparisons objects. This function +Summarize a group comparisons object or a list of group comparisons objects. This function applies a summary function to the columns of \code{compData$e_data} corresponding to each column to calculate a summary column for each group. } diff --git a/man/summarizeGroups.Rd b/man/summarizeGroups.Rd index 2aff3d0..31887b3 100644 --- a/man/summarizeGroups.Rd +++ b/man/summarizeGroups.Rd @@ -7,7 +7,7 @@ summarizeGroups(ftmsObj, summary_functions) } \arguments{ -\item{ftmsObj}{an object of class 'peakData' or 'compoundData' or a ddo of +\item{ftmsObj}{an object of class 'peakData' or 'compoundData' or a list of ftmsData objects (e.g. the output of \code{\link{divideByGroup}})} \item{summary_functions}{vector of summary function names to apply to each @@ -19,7 +19,7 @@ If the input is an ftmsData object, the result will be a new \code{ftmsData} object where each provided summary function will be applied to each group found in \code{getGroupDF(ftmsObj)}. If \code{getGroupDF(ftmsObj) == null} the function will assume all samples - belong to a single group. If the input is a ddo the result will be a ddo + belong to a single group. If the input is a list the result will be a list where each value is the result of applying \code{summarizeGroups} to each value of the input. } @@ -34,8 +34,8 @@ data("exampleProcessedPeakData") summary1 <- summarizeGroups(exampleProcessedPeakData, summary_functions=c("n_present", "prop_present")) -groupDdo <- divideByGroup(exampleProcessedPeakData) -summary2 <- summarizeGroups(groupDdo, summary_functions=c("n_present", "prop_present")) +groupList <- divideByGroup(exampleProcessedPeakData) +summary2 <- summarizeGroups(groupList, summary_functions=c("n_present", "prop_present")) } \author{ Amanda White diff --git a/man/vanKrevelenCognostics.Rd b/man/vanKrevelenCognostics.Rd deleted file mode 100644 index d6c78f7..0000000 --- a/man/vanKrevelenCognostics.Rd +++ /dev/null @@ -1,73 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vanKrevelenCognostics.R -\name{vanKrevelenCognostics} -\alias{vanKrevelenCognostics} -\title{Default cognostics for Van Krevelen plots in Trelliscope} -\usage{ -vanKrevelenCognostics(vkBoundarySet = "bs1", uniquenessColName = NA) -} -\arguments{ -\item{vkBoundarySet}{Van Krevelen boundary set to use for calculating class -proportions} - -\item{uniquenessColName}{if \code{ftmsObj} is a group comparison summary -object, what is the name of the column that specifies uniqueness to a -group? If only one uniqueness function has been applied this is -unnecessary. (See \code{\link{summarizeGroupComparisons}}.)} -} -\value{ -a function that may be applied to objects of type \code{peakData}, - \code{groupSummary}, and \code{comparisonSummary} -} -\description{ -The \code{vanKrevelenCognostics} function provides a set of default -cognostics to be used with Van Krevelen plots in Trelliscope. The -\code{vanKrevelenCognostics} function accepts the boundary set used for Van -Krevelen class calculations and (for \code{comparisonSummary} objects only) -the name of the column to use for identifying which peaks are observed in -which group. It returns a function that may be applied to each -\code{ftmsData} object, as is appropriate for use with the -\code{\link[trelliscope:makeDisplay]{makeDisplay}} function. See Examples -section for use. -} -\examples{ -\dontrun{ -library(ftmsRanalysis) -library(trelliscope) - -vdbDir <- vdbConn(file.path(tempdir(), "trell_test"), autoYes = TRUE) -data('exampleProcessedPeakData') - -## Van Krevelen plot for each sample -sampleDdo <- divideBySample(exampleProcessedPeakData) -panelFn1 <- panelFunctionGenerator("vanKrevelenPlot", vkBoundarySet="bs2", title="Test") - -# Note: make sure the same vkBoundarySet value is provided to the panel and cognostics functions -makeDisplay(sampleDdo, - panelFn=panelFn1, - cogFn=vanKrevelenCognostics(vkBoundarySet="bs2"), - name = "Van_Krevelen_plots_per_sample") - -## Van Krevelen plots for group comparison summaries -grpCompDdo <- divideByGroupComparisons(exampleProcessedPeakData, "all") -grpCompSummaryDdo <- summarizeGroupComparisons( - grpCompDdo, - summary_functions="uniqueness_gtest", - summary_function_params=list(uniqueness_gtest=list( - pres_fn="nsamps", - pres_thresh=2, - pvalue_thresh=0.05))) - -panelFn2 <- panelFunctionGenerator("vanKrevelenPlot", colorCName="uniqueness_gtest") - -# Note: uniquenessColName parameter tells vanKrevelenCognostics which column to use to determine -# group uniqueness for each peak. If only one summary function is used in summarizeGroupComparisons -# then it will be inferred, otherwise it's necessary to specify. -makeDisplay(grpCompSummaryDdo, - panelFn=panelFn2, - cogFn=vanKrevelenCognostics(uniquenessColName="uniqueness_gtest"), - name = "Van_Krevelen_plots_for_group_comparison_summaries") - -view() -} -} From 5d93600746f27eb6659ff49737e36541ff23552a Mon Sep 17 00:00:00 2001 From: Daniel Claborne Date: Fri, 23 May 2025 12:33:55 -0700 Subject: [PATCH 6/8] add p-values and group counts to uniqueness gtest output remove lingering references and code for datadr/trelliscope --- DESCRIPTION | 4 +--- R/concat.R | 2 +- R/divideByGroup.R | 4 +--- R/divideBySample.R | 3 +-- R/uniqueness_functions.R | 10 +++++++++- man/concat.Rd | 2 +- man/divideByGroup.Rd | 4 +--- man/divideBySample.Rd | 3 +-- tests/by_hand_tests/test_kendrick_plots.R | 2 +- tests/by_hand_tests/test_vankrevelen_plots.R | 2 +- tests/testthat/test_summarizeComparisons.R | 14 +++++++------- vignettes/ftmsRanalysis.Rmd | 2 +- vignettes/kendrick_plots.Rmd | 2 +- vignettes/mapping_to_metacyc.Rmd | 8 ++++---- vignettes/van_krevelen_plots.Rmd | 2 +- 15 files changed, 32 insertions(+), 32 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 755b9a4..fc5f6de 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,6 @@ Imports: readr Suggests: MetaCycData, - datadr, knitr, rmarkdown, foreach, @@ -43,7 +42,6 @@ Suggests: viridis, DT Remotes: - github::delta-rho/datadr, github::EMSL-Computing/MetaCycData VignetteBuilder: knitr -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 diff --git a/R/concat.R b/R/concat.R index 47c97ff..1667ec8 100644 --- a/R/concat.R +++ b/R/concat.R @@ -6,7 +6,7 @@ #' \code{\link{divideByGroupComparisons}}. The output is a new ftmsData #' with all the data of the supplied inputs, in a form that can be #' summarized with \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} -#' respectively, or visualized with \code{trelliscope}. +#' respectively. #' #' @param ... two or more ftmsData objects that are the output of \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} #' diff --git a/R/divideByGroup.R b/R/divideByGroup.R index 0065fd1..8ee40c1 100644 --- a/R/divideByGroup.R +++ b/R/divideByGroup.R @@ -1,9 +1,7 @@ #' Divide an ftmsData object by group to form a list of ftmsData objects #' #' Construct a list of subsetted ftmsData objects from an \code{ftmsData} object by dividing -#' by group. The resulting object may be used with Trelliscope to make -#' plots for each group. The input data must have a \code{group_DF} attribute -#' defining the groups. +#' by group. #' #' @param ftmsObj ftmsData object #' @return a list where each element is a subset of \code{ftmsObj} corresponding diff --git a/R/divideBySample.R b/R/divideBySample.R index a7b1fad..47c7764 100644 --- a/R/divideBySample.R +++ b/R/divideBySample.R @@ -1,8 +1,7 @@ #' Divide an ftmsData objecdt by sample to form a list #' #' Construct a named list from an \code{ftmsData} object by dividing -#' by sample. The resulting object may be used with Trelliscope to make -#' plots for each sample. +#' by sample. #' #' @param ftmsObj ftmsData object #' @return a named list where each element is a subset of \code{ftmsObj} corresponding diff --git a/R/uniqueness_functions.R b/R/uniqueness_functions.R index 2d44918..749330e 100644 --- a/R/uniqueness_functions.R +++ b/R/uniqueness_functions.R @@ -254,7 +254,15 @@ uniqueness_gtest <- function(edata_df, group_df, data_scale, pres_fn, pres_thres res_vec[which(gtest_res$pvals <= pvalue_thresh & max_val_grp >= pres_thresh)] = paste("Unique to", gtest_res$major.group[which(gtest_res$pvals <= pvalue_thresh & max_val_grp >= pres_thresh)], sep = " ") lvls <- c(paste("Unique to", grps), "Observed in Both") - data.frame(uniqueness_gtest = factor(res_vec, levels = lvls)) + out_df = data.frame( + uniqueness_gtest = factor(res_vec, levels = lvls), + pval = gtest_res$pvals + ) %>% + dplyr::bind_cols( + numpres + ) + + return(out_df) } diff --git a/man/concat.Rd b/man/concat.Rd index 325152c..740015a 100644 --- a/man/concat.Rd +++ b/man/concat.Rd @@ -16,7 +16,7 @@ the ftmsData objects created by \code{\link{divideByGroup}} or \code{\link{divideByGroupComparisons}}. The output is a new ftmsData with all the data of the supplied inputs, in a form that can be summarized with \code{\link{summarizeGroups}} or \code{\link{summarizeGroupComparisons}} -respectively, or visualized with \code{trelliscope}. +respectively. } \examples{ data("exampleProcessedPeakData") diff --git a/man/divideByGroup.Rd b/man/divideByGroup.Rd index e0f0873..b2e873e 100644 --- a/man/divideByGroup.Rd +++ b/man/divideByGroup.Rd @@ -15,7 +15,5 @@ a list where each element is a subset of \code{ftmsObj} corresponding } \description{ Construct a list of subsetted ftmsData objects from an \code{ftmsData} object by dividing -by group. The resulting object may be used with Trelliscope to make -plots for each group. The input data must have a \code{group_DF} attribute -defining the groups. +by group. } diff --git a/man/divideBySample.Rd b/man/divideBySample.Rd index 5f89b4b..ee280dd 100644 --- a/man/divideBySample.Rd +++ b/man/divideBySample.Rd @@ -15,6 +15,5 @@ a named list where each element is a subset of \code{ftmsObj} corresponding } \description{ Construct a named list from an \code{ftmsData} object by dividing -by sample. The resulting object may be used with Trelliscope to make -plots for each sample. +by sample. } diff --git a/tests/by_hand_tests/test_kendrick_plots.R b/tests/by_hand_tests/test_kendrick_plots.R index be1923b..5ec41fa 100644 --- a/tests/by_hand_tests/test_kendrick_plots.R +++ b/tests/by_hand_tests/test_kendrick_plots.R @@ -79,7 +79,7 @@ kendrickPlot(msGroup, title="Test17", colorCName="M_S_prop_present", legendTitle # group overlay plot peakGroupComp <- divideByGroupComparisons(peakObj, comparisons="one-factor") -peakCompSummary <- summarizeGroupComparisons(peakGroupComp[[1]]$value, summary_functions="uniqueness_gtest", +peakCompSummary <- summarizeGroupComparisons(peakGroupComp[[1]], summary_functions="uniqueness_gtest", summary_function_params=list( uniqueness_gtest=list(pres_fn="prop", pres_thresh=0.2, pvalue_thresh=0.05) diff --git a/tests/by_hand_tests/test_vankrevelen_plots.R b/tests/by_hand_tests/test_vankrevelen_plots.R index f420253..402e7d5 100644 --- a/tests/by_hand_tests/test_vankrevelen_plots.R +++ b/tests/by_hand_tests/test_vankrevelen_plots.R @@ -84,7 +84,7 @@ vanKrevelenPlot(msGroup, title="Test17", colorCName="M_S_prop_present", vkBounda # group overlay plot peakGroupComp <- divideByGroupComparisons(peakObj, comparisons="one-factor") -peakCompSummary <- summarizeGroupComparisons(peakGroupComp[[1]]$value, summary_functions="uniqueness_gtest", +peakCompSummary <- summarizeGroupComparisons(peakGroupComp[[1]], summary_functions="uniqueness_gtest", summary_function_params=list( uniqueness_gtest=list(pres_fn="prop", pres_thresh=0.2, pvalue_thresh=0.05) diff --git a/tests/testthat/test_summarizeComparisons.R b/tests/testthat/test_summarizeComparisons.R index 3bbfb93..c6d4137 100644 --- a/tests/testthat/test_summarizeComparisons.R +++ b/tests/testthat/test_summarizeComparisons.R @@ -15,12 +15,12 @@ test_that("test of summarizeGroupComparisons on a groupComparison object", { expect_true(inherits(grpCompSummary, "comparisonSummary")) expect_false(inherits(grpCompSummary, "groupComparison")) - expect_equal(ncol(grpCompSummary$e_data), 2) + expect_equal(ncol(grpCompSummary$e_data), 5) expect_true(getEDataColName(grpComp) %in% colnames(grpCompSummary$e_data)) expect_true(all(dim(grpComp$e_meta) == dim(grpCompSummary$e_meta))) expect_true(all(colnames(grpComp$e_meta) %in% colnames(grpCompSummary$e_meta))) expect_true(all(grpCompSummary$f_data$Summary_Function_Name == "uniqueness_gtest")) - expect_equal(nrow(grpCompSummary$f_data), 1) + expect_equal(nrow(grpCompSummary$f_data), 4) expect_true(all(unlist(lapply(grpCompSummary$e_data[, 2], function(x) is.factor(x))))) }) @@ -43,13 +43,13 @@ test_that("test of summarizeGroupComparisons on a ddo", { val <- grpCompSummary[[i]] expect_true(inherits(val, "comparisonSummary")) expect_false(inherits(val, "groupComparison")) - expect_equal(ncol(val$e_data), 2) + expect_equal(ncol(val$e_data), 5) expect_true(getEDataColName(grpComp[[i]]) %in% colnames(val$e_data)) expect_true(all(dim(grpComp[[i]]$e_meta) == dim(val$e_meta))) expect_true(all(colnames(grpComp[[i]]$e_meta) %in% colnames(val$e_meta))) - expect_equal(nrow(val$f_data), 1) + expect_equal(nrow(val$f_data), 4) expect_true(all(grpCompSummary$f_data$Summary_Function_Name == "uniqueness_gtest")) - expect_equal(nrow(val$f_data), 1) + expect_equal(nrow(val$f_data), 4) expect_true(all(unlist(lapply(val$e_data[, 2], function(x) is.factor(x))))) }) @@ -70,13 +70,13 @@ test_that("test of summarizeGroupComparisons with multiple summary functions on expect_true(inherits(grpCompSummary, "comparisonSummary")) expect_false(inherits(grpCompSummary, "groupComparison")) - expect_equal(ncol(grpCompSummary$e_data), 4) + expect_equal(ncol(grpCompSummary$e_data), 7) expect_true(getEDataColName(grpComp) %in% colnames(grpCompSummary$e_data)) expect_true(all(dim(grpComp$e_meta) == dim(grpCompSummary$e_meta))) expect_true(all(colnames(grpComp$e_meta) %in% colnames(grpCompSummary$e_meta))) expect_true(all(c("uniqueness_gtest", "uniqueness_nsamps", "uniqueness_prop") %in% grpCompSummary$f_data$Summary_Function_Name)) - expect_equal(nrow(grpCompSummary$f_data), 3) + expect_equal(nrow(grpCompSummary$f_data), 6) expect_true(all(unlist(lapply(grpCompSummary$e_data[, 2], function(x) is.factor(x))))) }) diff --git a/vignettes/ftmsRanalysis.Rmd b/vignettes/ftmsRanalysis.Rmd index ff4304d..6f418d4 100644 --- a/vignettes/ftmsRanalysis.Rmd +++ b/vignettes/ftmsRanalysis.Rmd @@ -292,7 +292,7 @@ The first step is to create peakData objects that each contain two groups to fac ```{r} byGroup <- divideByGroupComparisons(peakObj, - comparisons = "all")[[1]]$value + comparisons = "all")[[1]] crop_unique <- summarizeGroupComparisons(byGroup, summary_functions="uniqueness_gtest", diff --git a/vignettes/kendrick_plots.Rmd b/vignettes/kendrick_plots.Rmd index 4199f15..efbf40f 100644 --- a/vignettes/kendrick_plots.Rmd +++ b/vignettes/kendrick_plots.Rmd @@ -96,7 +96,7 @@ It can be useful to compare peaks that are unique to one treatment group versus Clicking the "Observed in Both" label on the right hides those points to focus on the points that are unique to M_S or M_C. ```{r} -m_groups <- divideByGroupComparisons(exampleProcessedPeakData, comparisons=list(c("M_S", "M_C")))[[1]]$value +m_groups <- divideByGroupComparisons(exampleProcessedPeakData, comparisons=list(c("M_S", "M_C")))[[1]] comp_summary <- summarizeGroupComparisons(m_groups, summary_functions="uniqueness_gtest", summary_function_params=list( uniqueness_gtest=list(pres_fn="prop", pres_thresh=0.3, diff --git a/vignettes/mapping_to_metacyc.Rmd b/vignettes/mapping_to_metacyc.Rmd index 07f27f0..e8c8fc8 100644 --- a/vignettes/mapping_to_metacyc.Rmd +++ b/vignettes/mapping_to_metacyc.Rmd @@ -104,15 +104,15 @@ rxnCompSummary <- summarizeGroupComparisons(rxnGroupCompData, summary_functions summary_function_params=list(uniqueness_gtest= list(pres_fn="nsamps", pres_thresh=2, pvalue_thresh=0.05))) -getKeys(rxnCompSummary) +names(rxnCompSummary) ``` -The `rxnCompSummary` object is a distributed data object (ddo) (see the [`datadr`](http://deltarho.org/docs-datadr/) package for more information about ddo's). A ddo is a list of key-value pairs, where each key defines the groups under comparison, and each value is `reactionData` object. In this case we have one comparison (C vs S) but if we had more than two groups, the `ddo` could have many comparison objects. +The `rxnCompSummary` object is a list where each key defines the groups under comparison, and each value is a `reactionData` object. In this case we have one comparison (C vs S) but if we had more than two groups, the list could have many comparison objects. Suppose we wanted to examine the reactions that were observed to be unique to only one of the S or C groups. We would look at the `reactionData` value and filter the `e_data` element to rows that contain the word 'Unique'. ```{r} -x <- rxnCompSummary[["Group_Comparison=C vs S"]]$value +x <- rxnCompSummary[["Group_Comparison=C vs S"]] summary(x$e_data) ind <- grep("Unique", x$e_data$uniqueness_gtest) @@ -153,7 +153,7 @@ modCompSummary <- summarizeGroupComparisons(modGroupCompData, summary_functions list(pres_fn="nsamps", pres_thresh=2, pvalue_thresh=0.05))) -y <- modCompSummary[["Group_Comparison=C vs S"]]$value +y <- modCompSummary[["Group_Comparison=C vs S"]] summary(y$e_data) ind <- grep("Unique", y$e_data$uniqueness_gtest) diff --git a/vignettes/van_krevelen_plots.Rmd b/vignettes/van_krevelen_plots.Rmd index eefbe11..c5425a0 100644 --- a/vignettes/van_krevelen_plots.Rmd +++ b/vignettes/van_krevelen_plots.Rmd @@ -115,7 +115,7 @@ It can be useful to compare peaks that are unique to one treatment group versus Clicking the "Observed in Both" label on the right hides those points to focus on the points that are unique to M_S or M_C. ```{r} -m_groups <- divideByGroupComparisons(exampleProcessedPeakData, comparisons=list(c("M_S", "M_C")))[[1]]$value +m_groups <- divideByGroupComparisons(exampleProcessedPeakData, comparisons=list(c("M_S", "M_C")))[[1]] comp_summary <- summarizeGroupComparisons(m_groups, summary_functions="uniqueness_gtest", summary_function_params=list( uniqueness_gtest=list(pres_fn="nsamps", pres_thresh=2, From ed3f31764a9944e91149b3f7c518885a0f7c3256 Mon Sep 17 00:00:00 2001 From: Daniel Claborne Date: Fri, 23 May 2025 14:57:12 -0700 Subject: [PATCH 7/8] add hexbin to imports, remove viridis, add missing rlang:: --- DESCRIPTION | 4 ++-- R/mass_error_plot.R | 4 ++-- R/plot.CoreMSData.R | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index fc5f6de..4d18e6d 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,8 +39,8 @@ Suggests: doParallel, testthat, purrr, - viridis, - DT + DT, + hexbin Remotes: github::EMSL-Computing/MetaCycData VignetteBuilder: knitr diff --git a/R/mass_error_plot.R b/R/mass_error_plot.R index 8477c40..41016d3 100755 --- a/R/mass_error_plot.R +++ b/R/mass_error_plot.R @@ -117,9 +117,9 @@ mass_error_plot <- function(cmsObj, } if (log_color_scale) { - p <- p + viridis::scale_fill_viridis(trans = "log") + p <- p + ggplot2::scale_fill_viridis_c(trans='log') } else { - p <- p + viridis::scale_fill_viridis() + p <- p + ggplot2::scale_fill_viridis_c() } plotly::ggplotly(p) diff --git a/R/plot.CoreMSData.R b/R/plot.CoreMSData.R index 402592a..12c7637 100755 --- a/R/plot.CoreMSData.R +++ b/R/plot.CoreMSData.R @@ -42,8 +42,8 @@ plot.CoreMSData <- function(x, dplyr::distinct(!!rlang::sym(mass_id)) %>% dplyr::tally() %>% dplyr::rename(Sample = sample_id, Monoisotopic = n) - Isotopic <- x$iso_data %>% dplyr::group_by(!!sym(sample_id)) %>% - dplyr::distinct(!!sym(mass_id)) %>% + Isotopic <- x$iso_data %>% dplyr::group_by(!!rlang::sym(sample_id)) %>% + dplyr::distinct(!!rlang::sym(mass_id)) %>% dplyr::tally() %>% dplyr::rename(Sample = sample_id, Isotopic = n) From 0edeefd6ba41322cbe70443ca81621078654eea1 Mon Sep 17 00:00:00 2001 From: Daniel Claborne Date: Fri, 23 May 2025 15:42:29 -0700 Subject: [PATCH 8/8] remove references to cognostic functions in site --- _pkgdown.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index feb9edf..34dcb70 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,7 +1,9 @@ template: + bootstrap: 5 params: bootswatch: cosmo #title: FT-MS Data Analysis in R +url: https://emsl-computing.github.io/ftmsRanalysis/ home: # strip_header: true links: @@ -74,10 +76,6 @@ reference: - '`scatterPlot`' - '`plotPrincipalCoordinates`' - '`vignette_interactivity_between_plots`' - - '`panelFunctionGenerator`' - - '`densityCognostics`' - - '`kendrickCognostics`' - - '`vanKrevelenCognostics`' - title: Database mapping desc: Functions to map to biological databases contents: