diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 271d466..d46a617 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -1,4 +1,4 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/master/examples +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: @@ -6,7 +6,9 @@ on: pull_request: branches: [main, master] -name: R-CMD-check +name: R-CMD-check.yaml + +permissions: read-all jobs: R-CMD-check: @@ -18,7 +20,7 @@ jobs: fail-fast: false matrix: config: - - {os: macOS-latest, r: 'release'} + - {os: macos-latest, r: 'release'} - {os: windows-latest, r: 'release'} - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} @@ -29,18 +31,22 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v1 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: rcmdcheck + extra-packages: any::rcmdcheck + needs: check - - uses: r-lib/actions/check-r-package@v1 + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 63cbb18..4bbce75 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,35 +1,50 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/master/examples +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: branches: [main, master] + pull_request: + branches: [main, master] release: types: [published] workflow_dispatch: -name: pkgdown +name: pkgdown.yaml + +permissions: read-all jobs: pkgdown: runs-on: ubuntu-latest + # Only restrict concurrency for non-PR jobs + concurrency: + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v1 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: pkgdown + extra-packages: any::pkgdown, local::. needs: website - - name: Deploy package - run: | - git config --local user.name "$GITHUB_ACTOR" - git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" - Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' + - name: Build site + run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) + shell: Rscript {0} + + - name: Deploy to GitHub pages 🚀 + if: github.event_name != 'pull_request' + uses: JamesIves/github-pages-deploy-action@v4.5.0 + with: + clean: false + branch: gh-pages + folder: docs diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index a2ed6d1..448c9d2 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -1,4 +1,4 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/master/examples +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: @@ -6,7 +6,9 @@ on: pull_request: branches: [main, master] -name: test-coverage +name: test-coverage.yaml + +permissions: read-all jobs: test-coverage: @@ -15,16 +17,45 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v1 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: covr + extra-packages: any::covr, any::xml2 + needs: coverage - name: Test coverage - run: covr::codecov(token = "${{ secrets.CODECOV_TOKEN }}") + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + covr::to_cobertura(cov) shell: Rscript {0} + + - uses: codecov/codecov-action@v4 + with: + fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }} + file: ./cobertura.xml + plugin: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 5fc7fb4..591bab3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: toxpiR Type: Package Title: Create ToxPi Prioritization Models -Version: 1.2.1 +Version: 1.3.0 Authors@R: c(person("Dayne L", "Filer", role = c("aut", "cre", "fnd"), @@ -14,6 +14,8 @@ Authors@R: comment = c(ORCID = "0000-0001-5447-0129")), person("Skylar W", "Marvel", role = "aut"), + person("Jonathon", "Fleming", + role = "aut"), person("Alison A", "Motsinger-Reif", role = c("fnd"), comment = c(ORCID = "0000-0003-1346-2493")), @@ -41,10 +43,11 @@ Imports: BiocGenerics, pryr, tidyr, - utils + utils, + ggplot2 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.3 Roxygen: list(markdown = TRUE) Depends: R (>= 4.0) diff --git a/NAMESPACE b/NAMESPACE index 2628804..da29601 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ exportMethods(plot) exportMethods(sort) exportMethods(txpCalculateScores) exportMethods(txpIDs) +exportMethods(txpMissing) exportMethods(txpModel) exportMethods(txpRanks) exportMethods(txpResultParam) @@ -53,6 +54,7 @@ exportMethods(txpSlices) exportMethods(txpTransFuncs) exportMethods(txpValueNames) exportMethods(txpWeights) +import(ggplot2) import(grid) import(methods) importClassesFrom(S4Vectors,List) diff --git a/R/allClasses.R b/R/allClasses.R index e0cfee7..e91acd5 100644 --- a/R/allClasses.R +++ b/R/allClasses.R @@ -33,8 +33,8 @@ setClassUnion("TxpTransFunc_OR_NULL", members = c("TxpTransFunc", "NULL")) #' @rdname TxpTransFuncList-class #' @exportClass TxpTransFuncList -setClass("TxpTransFuncList", - contains = "SimpleList", +setClass("TxpTransFuncList", + contains = "SimpleList", prototype = prototype(elementType = "TxpTransFunc_OR_NULL")) ##----------------------------------------------------------------------------## @@ -43,7 +43,7 @@ setClass("TxpTransFuncList", #' @rdname TxpSlice-class #' @exportClass TxpSlice -setClass("TxpSlice", +setClass("TxpSlice", slots = c(txpValueNames = "character", txpTransFuncs = "TxpTransFuncList")) @@ -66,8 +66,8 @@ setClass("TxpSliceList", #' @rdname TxpModel-class #' @exportClass TxpModel -setClass("TxpModel", - slots = c(txpSlices = "TxpSliceList", +setClass("TxpModel", + slots = c(txpSlices = "TxpSliceList", txpWeights = "numeric", txpTransFuncs = "TxpTransFuncList")) @@ -90,8 +90,8 @@ setClass("TxpModelList", #' @name TxpResultParam-class #' @exportClass TxpResultParam -setClass("TxpResultParam", - slots = c(rank.ties.method = "character", +setClass("TxpResultParam", + slots = c(rank.ties.method = "character", negative.value.handling = "character")) ##----------------------------------------------------------------------------## @@ -100,10 +100,11 @@ setClass("TxpResultParam", #' @name TxpResult-class #' @exportClass TxpResult -setClass("TxpResult", - slots = c(txpScores = "numeric", +setClass("TxpResult", + slots = c(txpScores = "numeric", txpSliceScores = "matrix", txpRanks = "numeric", + txpMissing = "numeric", txpModel = "TxpModel", txpIDs = "character_OR_NULL", txpResultParam = "TxpResultParam")) diff --git a/R/allGenerics.R b/R/allGenerics.R index e4d1414..a26c3e1 100644 --- a/R/allGenerics.R +++ b/R/allGenerics.R @@ -5,12 +5,12 @@ #' @name txpGenerics #' @title toxpiR package generics -#' @description toxpiR package generics; see class man pages for associated +#' @description toxpiR package generics; see class man pages for associated #' methods #' @param x toxpiR S4 object #' @param value Replacement value #' @param ... Included for extendability; not currently used -#' +#' #' @return See specific methods for details. NULL @@ -19,32 +19,32 @@ NULL setGeneric("txpValueNames", function(x, ...) standardGeneric("txpValueNames")) #' @rdname txpGenerics -setGeneric("txpValueNames<-", +setGeneric("txpValueNames<-", function(x, ..., value) standardGeneric("txpValueNames<-")) #' @rdname txpGenerics setGeneric("txpTransFuncs", function(x, ...) standardGeneric("txpTransFuncs")) #' @rdname txpGenerics -setGeneric("txpTransFuncs<-", +setGeneric("txpTransFuncs<-", function(x, ..., value) standardGeneric("txpTransFuncs<-")) #' @rdname txpGenerics setGeneric("txpSlices", function(x, ...) standardGeneric("txpSlices")) #' @rdname txpGenerics -setGeneric("txpSlices<-", +setGeneric("txpSlices<-", function(x, ..., value) standardGeneric("txpSlices<-")) #' @rdname txpGenerics setGeneric("txpWeights", function(x, ...) standardGeneric("txpWeights")) #' @rdname txpGenerics -setGeneric("txpWeights<-", +setGeneric("txpWeights<-", function(x, ..., value) standardGeneric("txpWeights<-")) #' @rdname txpCalculateScores -setGeneric("txpCalculateScores", +setGeneric("txpCalculateScores", function(model, input, ...) standardGeneric("txpCalculateScores")) #' @rdname txpGenerics @@ -65,5 +65,8 @@ setGeneric("txpIDs<-", function(x, ..., value) standardGeneric("txpIDs<-")) #' @rdname txpGenerics setGeneric("txpRanks", function(x, ...) standardGeneric("txpRanks")) +#' @rdname txpGenerics +setGeneric("txpMissing", function(x, ...) standardGeneric("txpMissing")) + #' @rdname txpGenerics setGeneric("txpResultParam", function(x, ...) standardGeneric("txpResultParam")) diff --git a/R/methods-TxpResult-plot.R b/R/methods-TxpResult-plot.R index 51e6414..f195b99 100644 --- a/R/methods-TxpResult-plot.R +++ b/R/methods-TxpResult-plot.R @@ -6,44 +6,62 @@ #' @title Plot TxpResult objects #' @description Plot [TxpResult] objects #' @aliases plot -#' +#' #' @param x [TxpResult] object #' @param y Rank vector, i.e. `txpRanks(x)` -#' @param fills Vector of colors to fill slices +#' @param package Character scalar, choice of "grid" or "ggplot2" for plotting +#' ToxPi profiles +#' @param fills Vector of colors to fill slices. Set to NULL to use default #' @param showScore Logical scalar, overall score printed below the name when #' `TRUE` #' @param labels Integer vector, indices of `x` to label in the rank plot #' @param margins Passed to [grid::plotViewport]; only affects the scatterplot #' region margins -#' @param gp,vp,name Passed to [grid::frameGrob] when creating the plotting +#' @param gp,vp,name Passed to [grid::frameGrob] when creating the plotting #' area #' @param newpage Logical scalar, [grid::grid.newpage] called prior to plotting #' when `TRUE` #' @param ... Passed to [pieGridGrob] when plotting ToxPi and to pointsGrob #' when plotting ranks -#' -#' @details +#' @param ncol Number of columns for [ggplot2] ToxPi profiles +#' @param bgColor,borderColor,sliceBorderColor,sliceValueColor,sliceLineColor +#' Various color options when creating [ggplot2] ToxPi profiles. Set to NULL +#' for no color +#' @param showMissing Boolean for coloring data missingness in [ggplot2] +#' ToxPi profiles +#' @param showCenter Boolean for showing inner circle in [ggplot2] ToxPi +#' profiles. When set to False overrides showMissing +#' +#' @details #' It is strongly recommended to use a specific device (e.g., [grDevices::png], -#' [grDevices::pdf]) when creating rank plots. +#' [grDevices::pdf]) when creating rank plots. #' Using a GUI device will likely lead to inaccurate labeling, and any changes -#' to the device size WILL lead to inaccurate labeling. -#' +#' to the device size WILL lead to inaccurate labeling. +#' #' The plotting is built on the [grid::grid-package], and can be adjusted or -#' edited as such. -#' -#' If the labels are running of the device, the top or bottom margins can be -#' increased with the `margins` parameter. -#' +#' edited as such. +#' +#' If the labels are running of the device, the top or bottom margins can be +#' increased with the `margins` parameter. +#' +#' ToxPi profiles can also be plotted using the [ggplot2] package. +#' #' @template roxgn-loadExamples #' @template roxgn-calcTxpModel -#' -#' @examples +#' +#' @examples #' library(grid) #' plot(res) -#' +#' plot(res[order(txpRanks(res))[1:4]]) +#' +#' library(ggplot2) +#' plot(res, package = "gg") +#' plot(res[order(txpRanks(res))], package = "gg", ncol = 5) + +#' theme(legend.position = "bottom") +#' #' plot(res, txpRanks(res)) #' plot(res, txpRanks(res), pch = 16, size = unit(0.75, "char")) -#' +#' #' ## Will likely make inaccurate labels within a GUI, e.g. RStudio #' ## use png, pdf, etc. to get accurate labels #' \dontrun{ @@ -52,48 +70,81 @@ #' plot(res, txpRanks(res), labels = c(10, 4, 2), pch = 16) #' dev.off() #' } -#' -#' @return No return value; called for side effect (i.e. drawing in current -#' graphics device.) +#' +#' @return No return value when using grid; called for side effect (i.e. +#' drawing in current graphics device). Will return ggplot2 object otherwise. NULL +.TxpResult.toxpiPlot <- function( + x, + package = c("grid", "ggplot2"), + fills = NULL, + showScore = TRUE, + gp = NULL, + vp = NULL, + name = NULL, + newpage = TRUE, + ..., + ncol = NULL, + bgColor = "grey80", + borderColor = "white", + sliceBorderColor = "white", + sliceValueColor = NULL, + sliceLineColor = NULL, + showMissing = TRUE, + showCenter = TRUE) { + + if (tolower(substr(package[1], 0, 2)) == "gg") { + .TxpResult.toxpiGGPlot( + x, fills, showScore, ncol, bgColor, borderColor, + sliceBorderColor, sliceValueColor, sliceLineColor, showMissing, + showCenter + ) + } else { + .TxpResult.toxpiGridPlot( + x, fills, showScore, gp, vp, name, newpage, ... + ) + } + +} + +#' @describeIn TxpResult-plot Plot ToxPi diagrams +#' @export + +setMethod("plot", c("TxpResult", "missing"), .TxpResult.toxpiPlot) + #' @import grid -.TxpResult.toxpiPlot <- function(x, - fills = NULL, - showScore = TRUE, - gp = NULL, - vp = NULL, - name = NULL, - newpage = TRUE, - ...) { - +.TxpResult.toxpiGridPlot <- function(x, + fills = NULL, + showScore = TRUE, + gp = NULL, + vp = NULL, + name = NULL, + newpage = TRUE, + ...) { + if (is.null(fills)) fills <- getOption("txp.fills", TXP_FILLS) sNames <- names(txpSlices(x)) - pg <- pieGridGrob(txpSliceScores(x, adjusted = FALSE), + pg <- pieGridGrob(txpSliceScores(x, adjusted = FALSE), wts = txpWeights(x), labels = txpIDs(x), - fills = fills, + fills = fills, showRadSum = showScore, ...) lg <- boxLegendGrob(labels = sNames, fills = fills) wids <- unit(c(10, 1), "grobwidth", lg) - fg <- frameGrob(layout = grid.layout(nrow = 1, ncol = 2, widths = wids), - name = name, - gp = gp, + fg <- frameGrob(layout = grid.layout(nrow = 1, ncol = 2, widths = wids), + name = name, + gp = gp, vp = vp) fg <- placeGrob(frame = fg, grob = pg, row = 1, col = 1) fg <- placeGrob(frame = fg, grob = lg, row = 1, col = 2) if (newpage) grid.newpage() grid.draw(fg) - -} -#' @describeIn TxpResult-plot Plot ToxPi diagrams -#' @export - -setMethod("plot", c("TxpResult", "missing"), .TxpResult.toxpiPlot) +} #' @importFrom rlang is_named is_integerish is_scalar_logical #' @import grid @@ -101,14 +152,14 @@ setMethod("plot", c("TxpResult", "missing"), .TxpResult.toxpiPlot) .TxpResult.rankPlot <- function(x, y, labels = NULL, newpage = TRUE, margins = c(4, 0, 1, 1), name = NULL, gp = NULL, vp = NULL, ...) { - + stopifnot(is_scalar_logical(newpage)) stopifnot(is.null(labels) || is_integerish(labels)) - + drawLabels <- !is.null(labels) - + if (newpage) grid.newpage() - + if (drawLabels) { stopifnot(is_named(x)) names(labels) <- txpIDs(x[labels]) @@ -116,12 +167,12 @@ setMethod("plot", c("TxpResult", "missing"), .TxpResult.toxpiPlot) } else { labelWidth <- unit(0, "mm") } - + gl <- grid.layout(nrow = 1, ncol = 2, unit.c(labelWidth, unit(1, "null"))) - + fg <- frameGrob(layout = gl, name = name, gp = gp, vp = vp) - - rnk <- annScatterGrob(x = txpScores(x), + + rnk <- annScatterGrob(x = txpScores(x), y = y, ann = if (drawLabels) labels else NULL, yscale = rev(extendrange(range(y))), @@ -129,16 +180,16 @@ setMethod("plot", c("TxpResult", "missing"), .TxpResult.toxpiPlot) xlab = "ToxPi Score", margins = margins, ...) - + fg <- placeGrob(frame = fg, grob = rnk, row = 1, col = 2) grid.draw(fg) - + if (drawLabels) { lblGrob <- .refLabel(names(labels), labelWidth) fg <- placeGrob(frame = fg, grob = lblGrob, row = 1, col = 1) grid.draw(fg$children[fg$childrenOrder[2]]) } - + } #' @describeIn TxpResult-plot Plot ToxPi ranks @@ -146,18 +197,188 @@ setMethod("plot", c("TxpResult", "missing"), .TxpResult.toxpiPlot) setMethod("plot", c("TxpResult", "numeric"), .TxpResult.rankPlot) +#' @import ggplot2 + +.TxpResult.toxpiGGPlot <- function( + x, + fills = NULL, + showScore = TRUE, + ncol = NULL, + bgColor = "grey80", + borderColor = "white", + sliceBorderColor = "white", + sliceValueColor = NULL, + sliceLineColor = NULL, + showMissing = TRUE, + showCenter = TRUE + ) { + + # Set to NULL to prevent note from devtools::check() + left <- right <- mid <- radii <- Slices <- NULL + + if (is.null(fills)) { + fills <- getOption("txp.fills", TXP_FILLS) + } + + #get plotting df + toxResultDF <- as.data.frame(x) + txpModel <- txpModel(x) + profileDF <- .getPlotList(txpWeights(x), names(txpModel), toxResultDF) + + #make plot + if(showCenter){ + innerRad <- 0.1 # percent + } else { + innerRad <- 0 + } + yText <- 1.22 + + plot <- ggplot2::ggplot(profileDF) + + ggplot2::theme_void() + + ggplot2::ylim(0, ifelse(is.null(sliceValueColor), 1, yText)) + + ggplot2::theme(plot.margin = ggplot2::margin(2, 2, 2, 2, unit = "mm")) + + if (showScore) { + plot <- plot + ggplot2::facet_wrap( + ~factor(NameScore, levels = unique(profileDF$NameScore)), + ncol = ncol + ) + } else { + plot <- plot + ggplot2::facet_wrap( + ~factor(Name, levels = unique(profileDF$Name)), + ncol = ncol + ) + } + + if (!is.null(sliceLineColor)) { + nSlices <- length(unique(profileDF$Slices)) + x1 <- profileDF$left + y1 <- rep(innerRad, length(x1)) + xend <- x1 + yend <- rep(1, length(x1)) + plot <- plot + ggplot2::geom_segment( + ggplot2::aes(x = x1, y = y1, xend = xend, yend = yend), + linetype = "dashed", + colour = sliceLineColor + ) + } + if(showCenter){ + if (showMissing) { + missingData <- txpMissing(x) + } else { + missingData <- rep(0, length(txpSlices(x))) + } + plot <- plot + ggplot2::geom_rect( + ggplot2::aes(xmin = left, xmax = right, ymin = 0, ymax = innerRad), + fill = rep(grDevices::gray(1 - missingData), length(x)) + ) + } + + if (!is.null(sliceBorderColor)) { + plot <- plot + ggplot2::geom_rect( + ggplot2::aes( + xmin = left, + xmax = right, + ymin = innerRad, + ymax = innerRad + radii * (1 - innerRad), + fill = Slices + ), + color = sliceBorderColor, + linewidth = 0.5 + ) + } else { + plot <- plot + ggplot2::geom_rect( + ggplot2::aes( + xmin = left, + xmax = right, + ymin = innerRad, + ymax = innerRad + radii * (1 - innerRad), + fill = Slices + ) + ) + } + + plot <- plot + ggplot2::scale_fill_manual( + breaks = unique(profileDF$Slices), + values = fills + ) + + if (!is.null(borderColor)) { + plot <- plot + ggplot2::geom_hline( + yintercept = 1, color = borderColor, linewidth = 0.5 + ) + } + + if (!is.null(sliceValueColor)) { + plot <- plot + ggplot2::geom_text( + ggplot2::aes( + x = mid, + y = yText, + label = as.character(radii) + ), + colour = sliceValueColor, + size = 3 + ) + } + + plot <- plot + ggplot2::geom_hline( + yintercept = innerRad, color = "black", linewidth = 0.4 + ) + + if (!is.null(bgColor)) { + plot <- plot + ggplot2::theme( + panel.background = ggplot2::element_rect(fill = bgColor, color = bgColor) + ) + } + + plot + ggplot2::coord_polar(start = 3 * pi / 2, direction = -1) + +} + +.getSlicePositions <- function(wts) { + endWts <- cumsum(wts) + startWts <- c(0, utils::head(endWts, -1)) + list(start = startWts, end = endWts) +} + +# Generate dataframe for plotting a profile +.generateProfileDF <- function(startWts, endWts, radii, sliceNames, id, score) { + df <- data.frame( + left = startWts, + right = endWts, + mid = (startWts + endWts) / 2, + radii = round(radii, 3), + Slices = sliceNames, + Name = id, + Score = round(score, 4) + ) + df$NameScore <- paste(df$Name, df$Score, sep = "\n") + df +} + +#get dataframe containing all necessary info for selected samples +.getPlotList <- function(wts, sliceNames, data) { + pos <- .getSlicePositions(wts) + do.call(rbind, lapply(1:nrow(data), function(x) { + .generateProfileDF( + pos$start, pos$end, unlist(data[x, sliceNames]), sliceNames, + data[x, "id"], data[x, "score"] + ) + })) +} + .maxStrWidth <- function(x) { wids <- lapply(x, stringWidth) wids[[which.max(sapply(wids, convertWidth, "inches"))]] } .refLabel <- function(lbl, xloc) { - + yloc <- do.call("unit.c", sapply(lbl, .getDeviceLoc)["y", ]) ord <- order(yloc) yloc <- yloc[ord] lbl <- lbl[ord] - + n <- length(lbl) ypos <- yloc wd <- convertUnit(unit(1, "char"), "in") @@ -174,28 +395,28 @@ setMethod("plot", c("TxpResult", "numeric"), .TxpResult.rankPlot) ypos[i] <- min(yloc[i], ypos[i + 1] - ht) } } - + x1 <- rep(xloc, n) x2 <- x1 - 0.5*wd x3 <- x2 - 2*wd x4 <- x3 - 0.5*wd - - s1 <- segmentsGrob(x0 = unit(x1, "npc"), - y0 = unit(yloc, "npc"), - x1 = unit(x2, "npc"), + + s1 <- segmentsGrob(x0 = unit(x1, "npc"), + y0 = unit(yloc, "npc"), + x1 = unit(x2, "npc"), y1 = unit(yloc, "npc")) - s2 <- segmentsGrob(x0 = unit(x2, "npc"), - y0 = unit(yloc, "npc"), - x1 = unit(x3, "npc"), + s2 <- segmentsGrob(x0 = unit(x2, "npc"), + y0 = unit(yloc, "npc"), + x1 = unit(x3, "npc"), y1 = unit(ypos, "npc")) - s3 <- segmentsGrob(x0 = unit(x3, "npc"), - y0 = unit(ypos, "npc"), - x1 = unit(x4, "npc"), + s3 <- segmentsGrob(x0 = unit(x3, "npc"), + y0 = unit(ypos, "npc"), + x1 = unit(x4, "npc"), y1 = unit(ypos, "npc")) tg <- textGrob(label = lbl, x = wd, y = ypos, just = "left") - + gTree(children = gList(s1, s2, s3, tg)) - + } .getDeviceLoc <- function(x, units = "npc") { diff --git a/R/methods-TxpResult.R b/R/methods-TxpResult.R index d7c6793..fe500f9 100644 --- a/R/methods-TxpResult.R +++ b/R/methods-TxpResult.R @@ -6,11 +6,12 @@ #' @aliases TxpResult #' @title ToxPi Result #' @description S4 class to store ToxPi results -#' +#' #' @slot txpScores `vector()` of model scores -#' @slot txpSliceScores `matrix()`, sample by slice `matrix` with +#' @slot txpSliceScores `matrix()`, sample by slice `matrix` with #' individual slice scores #' @slot txpRanks `vector()` with rank of scores +#' @slot txpMissing `vector()` with data missingness #' @slot txpModel [TxpModel] object #' @slot txpIDs `vector()` of observation IDs #' @slot txpResultParam [TxpResultParam] object @@ -19,58 +20,60 @@ #' @param value Replacement value #' @param adjusted Logical scalar, when `TRUE` the weights are adjusted to sum #' to 1 or the slice scores are scaled to their respective weight -#' @param level `c('model', 'slices')`; indicates whether to retrieve +#' @param level `c('model', 'slices')`; indicates whether to retrieve #' `txpTransFuncs` slot from the model or underlying slices -#' @param simplify Logical scalar, flatten `txpValueNames` or `txpTransFunc` +#' @param simplify Logical scalar, flatten `txpValueNames` or `txpTransFunc` #' slots when retrieving slice-level information #' @param i Subsetting index #' @param j,drop,optional Not currently implemented #' @param decreasing,na.last Passed to [base::sort] #' @param row.names Passed to [base::data.frame] -#' @param id.name,score.name,rank.name Character scalar; when coercing to -#' [base::data.frame], the name for the `txpIDs`, `txpScores`, and `txpRanks` +#' @param id.name,score.name,rank.name Character scalar; when coercing to +#' [base::data.frame], the name for the `txpIDs`, `txpScores`, and `txpRanks` #' columns, respectively #' @param ... Passed to [base::data.frame] in `as.data.frame` or [base::sort] #' in `sort` -#' +#' #' @seealso [txpCalculateScores], [plot], [TxpResultList] -#' +#' #' @template roxgn-loadExamples #' @template roxgn-calcTxpModel -#' -#' @examples +#' +#' @examples #' ## Accessors #' txpScores(res) -#' +#' #' txpSliceScores(res) ## adjusted for weight, by default #' apply(txpSliceScores(res), 2, max, na.rm = TRUE) -#' +#' #' txpSliceScores(res, adjusted = FALSE) ## each score should have maximum of 1 #' apply(txpSliceScores(res, adjusted = FALSE), 2, max, na.rm = TRUE) -#' +#' #' txpRanks(res) -#' +#' +#' txpMissing(res) +#' #' txpModel(res) #' identical(txpModel(res), txp_example_model) -#' +#' #' txpIDs(res) #' names(res) ## identical to txpIDs(res) #' identical(txpIDs(res), names(res)) -#' +#' #' # Can access TxpModel slots directly #' txpWeights(res) #' txpWeights(res, adjusted = TRUE) #' txpSlices(res) -#' # When retrieving transform functions, must specify level because both +#' # When retrieving transform functions, must specify level because both #' # models and slices have transform functions #' txpTransFuncs(res, level = "model") -#' +#' #' # Can access TxpSliceList slots directly #' txpValueNames(res) #' txpValueNames(res, simplify = TRUE) #' txpTransFuncs(res, level = "slices") #' txpTransFuncs(res, level = "slices", simplify = TRUE) -#' +#' #' ## Subsetting #' res[1] #' res[c("chem01", "chem09")] @@ -78,19 +81,19 @@ #' \dontrun{ #' res[c(TRUE, FALSE)] ## gets recycled with warning #' } -#' +#' #' ## length -- returns number of observations #' length(res) #' length(res[1:5]) -#' +#' #' ## sort #' names(res) #' names(sort(res)) -#' +#' #' txpScores(res) #' txpScores(sort(res)) #' txpScores(sort(res, decreasing = FALSE)) -#' +#' #' ## as.data.frame #' as.data.frame(res) #' as.data.frame(res, id.name = "nm", score.name = "scr", rank.name = "rnk") @@ -100,13 +103,14 @@ NULL ##----------------------------------------------------------------------------## ## constructor -- NOT exported -TxpResult <- function(txpScores, txpSliceScores, txpRanks, +TxpResult <- function(txpScores, txpSliceScores, txpRanks, txpMissing, txpModel, txpIDs = NULL, txpResultParam) { - new2("TxpResult", - txpScores = txpScores, + new2("TxpResult", + txpScores = txpScores, txpSliceScores = txpSliceScores, txpRanks = txpRanks, - txpModel = txpModel, + txpMissing = txpMissing, + txpModel = txpModel, txpIDs = txpIDs, txpResultParam = txpResultParam) } @@ -119,14 +123,14 @@ TxpResult <- function(txpScores, txpSliceScores, txpRanks, setMethod("txpScores", "TxpResult", function(x) { x@txpScores }) -#' @describeIn TxpResult-class Return `txpSliceScores` slot; default +#' @describeIn TxpResult-class Return `txpSliceScores` slot; default #' `adjusted = TRUE`, i.e. return slice scores adjusted for weight #' @importFrom rlang is_scalar_logical #' @export setMethod("txpSliceScores", "TxpResult", function(x, adjusted = TRUE) { stopifnot(is_scalar_logical(adjusted)) - scr <- x@txpSliceScores + scr <- x@txpSliceScores if (adjusted) { wts <- txpWeights(x, adjusted = TRUE) scr <- scr*rep(wts, each = NROW(scr)) @@ -139,6 +143,11 @@ setMethod("txpSliceScores", "TxpResult", function(x, adjusted = TRUE) { setMethod("txpRanks", "TxpResult", function(x) { x@txpRanks }) +#' @describeIn TxpResult-class Return `txpMissing` slot +#' @export + +setMethod("txpMissing", "TxpResult", function(x) { x@txpMissing }) + #' @describeIn TxpResult-class Return `txpResultParam` slot #' @export @@ -154,7 +163,7 @@ setMethod("txpModel", "TxpResult", function(x) { x@txpModel }) setMethod("txpIDs", "TxpResult", function(x) { x@txpIDs }) -.TxpResult.replaceIDs <- function(x, value) { +.TxpResult.replaceIDs <- function(x, value) { x@txpIDs <- value validObject(x) x @@ -166,12 +175,12 @@ setMethod("txpIDs", "TxpResult", function(x) { x@txpIDs }) setReplaceMethod("txpIDs", "TxpResult", .TxpResult.replaceIDs) #' @describeIn TxpResult-class Return `txpWeights` slot from model -- shortcut -#' for `txpWeights(txpModel(x))`; default `adjusted = FALSE`, i.e. return +#' for `txpWeights(txpModel(x))`; default `adjusted = FALSE`, i.e. return #' unadjusted weights #' @importFrom rlang is_scalar_logical #' @export -setMethod("txpWeights", "TxpResult", function(x, adjusted = FALSE) { +setMethod("txpWeights", "TxpResult", function(x, adjusted = FALSE) { stopifnot(is_scalar_logical(adjusted)) txpWeights(txpModel(x), adjusted = adjusted) }) @@ -192,36 +201,37 @@ setMethod("txpSlices", "TxpResult", function(x) { txpSlices(txpModel(x)) }) } } -#' @describeIn TxpResult-class Return `txpTransFuncs` slot from model -- +#' @describeIn TxpResult-class Return `txpTransFuncs` slot from model -- #' shortcut for `txpTransFuncs(txpModel(x))` #' @importFrom rlang is_scalar_logical #' @export setMethod("txpTransFuncs", "TxpResult", .TxpResult.txpTransFuncs) -#' @describeIn TxpResult-class Return `txpValueNames` slot from slices -- +#' @describeIn TxpResult-class Return `txpValueNames` slot from slices -- #' shortcut for `txpValueNames(txpSlices(txpModel(x)))` #' @export -setMethod("txpValueNames", "TxpResult", function(x, simplify = FALSE) { +setMethod("txpValueNames", "TxpResult", function(x, simplify = FALSE) { txpValueNames(txpSlices(txpModel(x)), simplify = simplify) }) -.TxpResult.squareBracket <- function(x, i, j, ..., drop = FALSE) { +.TxpResult.squareBracket <- function(x, i, j, ..., drop = FALSE) { ss <- txpSliceScores(x, adjusted = FALSE)[i, , drop = FALSE] - TxpResult(txpScores = txpScores(x)[i], + TxpResult(txpScores = txpScores(x)[i], txpSliceScores = ss, txpRanks = txpRanks(x)[i], + txpMissing = txpMissing(x), txpModel = txpModel(x), txpIDs = txpIDs(x)[i], - txpResultParam = txpResultParam(x)) + txpResultParam = txpResultParam(x)) } #' @rdname TxpResult-class #' @export setMethod("[", - c("TxpResult", "logical", "missing"), + c("TxpResult", "logical", "missing"), function(x, i, j, ..., drop = FALSE) { if (length(i) < length(x)) { warning("Length of logical vector less than length of object; ", @@ -243,12 +253,12 @@ setMethod("[", c("TxpResult", "numeric", "missing"), .TxpResult.squareBracket) #' @rdname TxpResult-class #' @export -setMethod("[", - c("TxpResult", "character", "missing"), +setMethod("[", + c("TxpResult", "character", "missing"), function(x, i, j, ..., drop = FALSE) { ids <- txpIDs(x) if (is.null(ids)) { - stop("TxpResult object must have assigned names, e.g. txpIDs(), to ", + stop("TxpResult object must have assigned names, e.g. txpIDs(), to ", "susbet using a character vector.") } ind <- match(i, ids) @@ -266,7 +276,7 @@ setMethod("length", "TxpResult", function(x) { length(txpScores(x)) }) #' @describeIn TxpResult-class Sort the ``TxpResult` object by their ranks #' @export -setMethod("sort", "TxpResult", function(x, decreasing = TRUE, +setMethod("sort", "TxpResult", function(x, decreasing = TRUE, na.last = TRUE, ...) { ind <- order(txpScores(x), decreasing = decreasing, na.last = na.last, ...) x[ind] @@ -311,11 +321,11 @@ setValidity2("TxpResult", .TxpResult.validity) #' @importFrom rlang is_scalar_character is_scalar_logical -.TxpResult.as.data.frame <- function(x, +.TxpResult.as.data.frame <- function(x, row.names = NULL, optional = FALSE, ..., - id.name = "id", + id.name = "id", score.name = "score", rank.name = "rank", adjusted = FALSE) { diff --git a/R/methods-TxpTransFunc.R b/R/methods-TxpTransFunc.R index c4f441f..cb4fa0d 100644 --- a/R/methods-TxpTransFunc.R +++ b/R/methods-TxpTransFunc.R @@ -5,26 +5,26 @@ #' @name TxpTransFunc-class #' @title Numeric transformation function #' @description S4 class to store numeric transformation functions -#' +#' #' @param x function, see details -#' -#' @details -#' \code{TxpTransFunc} inherits from a standard R function, but specifies a +#' +#' @details +#' \code{TxpTransFunc} inherits from a standard R function, but specifies a #' single input and a numeric output of the same length. -#' -#' Functions can be passed directly to \code{TxpTransFuncList} list and the +#' +#' Functions can be passed directly to \code{TxpTransFuncList} list and the #' functions will be coerced to \code{TxpTransFunc}. -#' -#' We have an imperfect system for dealing with primitive functions (e.g., +#' +#' We have an imperfect system for dealing with primitive functions (e.g., #' [base::sqrt]). #' To coerce primitives to TxpTransFunc's, we wrap them in another function #' cal; wrapping the primitives obscures the original function and requires -#' the user to explore the function environment to understand the primitive +#' the user to explore the function environment to understand the primitive #' called. #' We recommend wrapping primitives in separate functions to make the intent -#' clear, .e.g., `mysqrt <- function(x) sqrt(x)`. -#' -#' @examples +#' clear, .e.g., `mysqrt <- function(x) sqrt(x)`. +#' +#' @examples #' f1 <- function(x) "hello" #' f2 <- function(x) 3 #' f3 <- function(x) x + 5 @@ -33,12 +33,12 @@ #' t2 <- TxpTransFunc(x = f2) ## Produces error #' } #' t3 <- TxpTransFunc(x = f3) -#' +#' #' ## TxpTransFunc objects act as any other function #' body(t3) #' formals(t3) #' t3(1:10) -#' +#' #' ## Coercion from functions #' \dontrun{ #' TxpTransFuncList(f1, f2, f3) ## Produces error because f1, f3 not valid @@ -50,7 +50,7 @@ NULL ## constructor #' @rdname TxpTransFunc-class -#' @export +#' @export TxpTransFunc <- function(x) { if (missing(x)) return(new("TxpTransFunc")) @@ -67,8 +67,10 @@ TxpTransFunc <- function(x) { .TxpTransFunc.validity <- function(object) { msg <- NULL - res1 <- try(object(1:5), silent = TRUE) - res2 <- try(object(1:6), silent = TRUE) + suppressWarnings({ + res1 <- try(object(1:5), silent = TRUE) + res2 <- try(object(1:6), silent = TRUE) + }) if (is(res1, "try-error") || is(res2, "try-error")) { msg <- c(msg, "TxpTransFunc returned error when given numeric input.") return(msg) diff --git a/R/toxpiR-package.R b/R/toxpiR-package.R index c9f848c..7e2d5c1 100644 --- a/R/toxpiR-package.R +++ b/R/toxpiR-package.R @@ -5,55 +5,64 @@ ## usethis namespace: end NULL -TXP_FILLS = c("dodgerblue", - "bisque", - "darkolivegreen3", - "darkorchid3", - "mistyrose2", - "darkgoldenrod1") - +# TXP_FILLS = c("dodgerblue", +# "bisque", +# "darkolivegreen3", +# "darkorchid3", +# "mistyrose2", +# "darkgoldenrod1") +TXP_FILLS = c( + "#f3622d", + "#fba71b", + "#57b757", + "#41a9c9", + "#4258c9", + "#9a42c8", + "#c84164", + "#888888" +) #' @name toxpiR-datasets #' @title toxpiR data objects -#' @description Objects included in the toxpiR package, loaded with +#' @description Objects included in the toxpiR package, loaded with #' [utils::data] #' @aliases txp_example_input txp_example_model -#' +#' #' @usage data(txp_example_input, package = "toxpiR") #' @usage data(txp_example_model, package = "toxpiR") -#' +#' #' @section txp_example_input: -#' +#' #' Small example input data to be used with [txpCalculateScores] in creating #' [TxpResult] objects. A [base::data.frame] with 10 rows and 9 variables #' \describe{ #' \item{name}{Observation names} #' \item{metric#}{Input data for ToxPi models} #' } -#' +#' #' @source -#' +#' #' @section txp_example_model: -#' +#' #' Example [TxpModel] object intended for `txp_example_data`; model with 4 #' slices. -#' +#' #' @examples #' data(txp_example_input, package = "toxpiR") #' data(txp_example_model, package = "toxpiR") #' txp_example_input #' txp_example_model -#' +#' #' ## Code to create txp_example_model #' tf1 <- TxpTransFuncList(linear = function(x) x) #' sl <- TxpSliceList(s1 = TxpSlice(sprintf("metric%d", 1:2)), #' s2 = TxpSlice("metric3"), -#' s3 = TxpSlice(sprintf("metric%d", 4:7), +#' s3 = TxpSlice(sprintf("metric%d", 4:7), #' tf1[rep("linear", 4)]), #' s4 = TxpSlice("metric8", tf1)) #' tf2 <- TxpTransFuncList(NULL, linear = function(x) x, NULL, NULL) #' TxpModel(txpSlices = sl, txpWeights = c(2, 1, 3, 2), txpTransFuncs = tf2) -#' +#' #' @importFrom utils data -NULL \ No newline at end of file +NULL diff --git a/R/txpCalculateScores.R b/R/txpCalculateScores.R index 32b02cf..da6c15a 100644 --- a/R/txpCalculateScores.R +++ b/R/txpCalculateScores.R @@ -5,28 +5,31 @@ #' @name txpCalculateScores #' @title Calculate ToxPi Scores for the given model and input data #' @description Calculate ToxPi Scores for the given model and input data -#' +#' #' @param model [TxpModel] object or [TxpModelList] object #' @param input data.frame object containing the model input data -#' @param id.var Character scalar, column in 'input' to store in +#' @param id.var Character scalar, column in 'input' to store in #' @inheritParams TxpResultParam-class #' @inheritParams txpGenerics -#' -#' @details +#' +#' @details #' `txpCalculateScores` is implemented as an S4 generic function with methods #' for [TxpModel] and [TxpModelList]. -#' +#' #' Ranks are calculated such that the highest ToxPi score has a rank of 1. -#' +#' +#' Missingness is determined after applying input-level transformations but +#' before applying slice-level transformations. +#' #' @seealso [TxpModel], [TxpResult], [TxpResultParam] -#' +#' #' @template roxgn-loadExamples #' @template roxgn-calcTxpModel #' @template roxgn-calcTxpModelList -#' +#' #' @return [TxpResult] or [TxpResultList] object -#' -#' @export +#' +#' @export NULL @@ -47,32 +50,36 @@ NULL if (negative.value.handling == "missing") dat[dat < 0] <- NA tfs <- txpTransFuncs(slice) for (i in seq_along(nms)) { - if (is.null(tfs[[i]])) next + if (is.null(tfs[[i]])) next dat[[i]] <- tfs[[i]](dat[[i]]) } - apply(dat, MARGIN = 1, .sumNA) + x <- apply(dat, MARGIN = 1, .sumNA) + dat <- unlist(dat) + y <- sum(!is.finite(dat)) / length(dat) + list(sum = x, mis = y) } -.calculateScores <- function(model, input, +.calculateScores <- function(model, input, id.var = NULL, - rank.ties.method = c("average", "first", "last", + rank.ties.method = c("average", "first", "last", "random", "max", "min"), negative.value.handling = c("keep", "missing")) { - + ## Test inputs .chkModelInput(model = model, input = input) param <- TxpResultParam(rank.ties.method = rank.ties.method, negative.value.handling = negative.value.handling) - + ## Clean up infinite in input input <- .rmInfinite(model = model, input = input) - - ## Calculate raw slice scores - slc <- sapply(txpSlices(model), - .sumSlice, - input = input, - negative.value.handling = slot(param, "negative.value.handling")) - + + ## Calculate raw slice scores and missingness + x <- lapply( + txpSlices(model), .sumSlice, input = input, + negative.value.handling = slot(param, "negative.value.handling")) + slc <- sapply(x, "[[", "sum") + mis <- sapply(x, "[[", "mis") + ## Look for and apply slice-level transformation functions tfs <- txpTransFuncs(model) if (any(!sapply(tfs, is.null))) { @@ -81,33 +88,34 @@ NULL slc[ , i] <- tfs[[i]](slc[ , i]) } } - + ## Make infinite NaN slc[is.infinite(slc)] <- NaN - + ## Scale slice scores from 0 to 1 slc <- apply(slc, 2, .z2o) - + ## Make NA 0 slc[is.na(slc)] <- 0 - + ## Calculate ToxPi score wts <- txpWeights(model, adjusted = TRUE) score <- rowSums(slc*rep(wts, each = NROW(slc)), na.rm = TRUE) - + ## Calculate ToxPi ranks rnks <- rank(-score, ties.method = rank.ties.method) - + ## Assign IDs ids <- if (!is.null(id.var)) as.character(input[[id.var]]) else NULL - - TxpResult(txpScores = score, - txpSliceScores = slc, - txpRanks = rnks, + + TxpResult(txpScores = score, + txpSliceScores = slc, + txpRanks = rnks, + txpMissing = mis, txpModel = model, txpIDs = ids, txpResultParam = param) - + } ##----------------------------------------------------------------------------## diff --git a/README.md b/README.md index 873ea8a..594bfd3 100644 --- a/README.md +++ b/README.md @@ -6,32 +6,45 @@ [![cran-version](https://www.r-pkg.org/badges/version-last-release/toxpiR?color=blue)](https://cran.r-project.org/web/packages/toxpiR/index.html) [![downloads](https://cranlogs.r-pkg.org/badges/grand-total/toxpiR)](https://cranlogs.r-pkg.org/badges/grand-total/toxpiR) [![codecov](https://codecov.io/gh/ToxPi/toxpiR/branch/main/graph/badge.svg?token=7yocvT0KzZ)](https://codecov.io/gh/ToxPi/toxpiR) +[![R-CMD-check](https://github.com/ToxPi/toxpiR/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/ToxPi/toxpiR/actions/workflows/R-CMD-check.yaml) -R package for the Toxicological Priority Index (ToxPi) prioritization algorithm. Package developed and maintained by the [Reif Lab](http://reif-lab.org). +R package for the Toxicological Priority Index (ToxPi) prioritization algorithm. +Package developed and maintained by the [Reif Lab](http://reif-lab.org). ### Installation -Current stable release: +Current stable release (CRAN): ```r install.packages("toxpiR") ``` -Build from GitHub (current stable release): +Current stable release (Build from GitHub): ```r -if (!require(remotes)) install.packages("remotes") remotes::install_github("ToxPi/toxpiR", - dependencies = TRUE, - build_vignettes = TRUE) + dependencies = TRUE) + +Note: Users may need to ensure "remotes" package and packages +requiring "BiocManager" are installed before building package. + +if (!require(remotes)) install.packages("remotes") + +if (!require(BiocManager, quietly = TRUE)) { + install.packages("BiocManager") +} +BiocManager::install(c("S4Vectors","BiocGenerics")) + ``` -Build from GitHub (current dev version): +Current stable release (Build from GitHub with vignettes): ```r -if (!require(remotes)) install.packages("remotes") -remotes::install_github("ToxPi/toxpiR@dev", +remotes::install_github("ToxPi/toxpiR", dependencies = TRUE, build_vignettes = TRUE) + +Note: Building packages with vignettes requires the package +"pandoc" to be installed. ``` diff --git a/man/TxpModel-class.Rd b/man/TxpModel-class.Rd index 07dabc2..aa98b27 100644 --- a/man/TxpModel-class.Rd +++ b/man/TxpModel-class.Rd @@ -63,25 +63,25 @@ S4 class to store ToxPi models } \section{Functions}{ \itemize{ -\item \code{txpSlices,TxpModel-method}: Return \code{txpSlices} slot +\item \code{txpSlices(TxpModel)}: Return \code{txpSlices} slot -\item \code{txpWeights,TxpModel-method}: Return \code{txpWeights} slot +\item \code{txpWeights(TxpModel)}: Return \code{txpWeights} slot -\item \code{txpTransFuncs,TxpModel-method}: Return \code{txpTransFuncs} slot +\item \code{txpTransFuncs(TxpModel)}: Return \code{txpTransFuncs} slot -\item \code{txpValueNames,TxpModel-method}: Return \code{list} of \code{txpValueNames} slots for the +\item \code{txpValueNames(TxpModel)}: Return \code{list} of \code{txpValueNames} slots for the contained \link{TxpSliceList} object, or \code{vector} when \code{simplify = TRUE} -\item \code{names,TxpModel-method}: Return slice names; shortcut for +\item \code{names(TxpModel)}: Return slice names; shortcut for \code{names(txpSlices(x))} -\item \code{length,TxpModel-method}: Return number of slices in model; shortcut for +\item \code{length(TxpModel)}: Return number of slices in model; shortcut for \code{length(txpSlices(x))} -\item \code{merge,TxpModel,TxpModel-method}: Merge two \code{TxpModel} objects into a single +\item \code{merge(x = TxpModel, y = TxpModel)}: Merge two \code{TxpModel} objects into a single model -}} +}} \section{Slots}{ \describe{ diff --git a/man/TxpModelList-class.Rd b/man/TxpModelList-class.Rd index 56edae0..900cd5d 100644 --- a/man/TxpModelList-class.Rd +++ b/man/TxpModelList-class.Rd @@ -25,13 +25,13 @@ objects. } \section{Functions}{ \itemize{ -\item \code{duplicated,TxpModelList-method}: Returns logical vector of \code{length(x)}, where +\item \code{duplicated(TxpModelList)}: Returns logical vector of \code{length(x)}, where \code{TRUE} indicates a duplicate model in the list; see \link[base:duplicated]{base::duplicated} -\item \code{as.TxpModelList}: Coerce list or \link{TxpModel} objects to +\item \code{as.TxpModelList()}: Coerce list or \link{TxpModel} objects to TxpModelList -}} +}} \examples{ ## Create some TxpModel objects; see ?TxpModel for more details s1 <- list(S1 = TxpSlice("inpt1"), S2 = TxpSlice("inpt2")) diff --git a/man/TxpResult-class.Rd b/man/TxpResult-class.Rd index c088ed8..a78376b 100644 --- a/man/TxpResult-class.Rd +++ b/man/TxpResult-class.Rd @@ -7,6 +7,7 @@ \alias{txpScores,TxpResult-method} \alias{txpSliceScores,TxpResult-method} \alias{txpRanks,TxpResult-method} +\alias{txpMissing,TxpResult-method} \alias{txpResultParam,TxpResult-method} \alias{txpModel,TxpResult-method} \alias{txpIDs,TxpResult-method} @@ -32,6 +33,8 @@ \S4method{txpRanks}{TxpResult}(x) +\S4method{txpMissing}{TxpResult}(x) + \S4method{txpResultParam}{TxpResult}(x) \S4method{txpModel}{TxpResult}(x) @@ -109,43 +112,45 @@ S4 class to store ToxPi results } \section{Functions}{ \itemize{ -\item \code{txpScores,TxpResult-method}: Return \code{txpScores} slot +\item \code{txpScores(TxpResult)}: Return \code{txpScores} slot -\item \code{txpSliceScores,TxpResult-method}: Return \code{txpSliceScores} slot; default +\item \code{txpSliceScores(TxpResult)}: Return \code{txpSliceScores} slot; default \code{adjusted = TRUE}, i.e. return slice scores adjusted for weight -\item \code{txpRanks,TxpResult-method}: Return \code{txpRanks} slot +\item \code{txpRanks(TxpResult)}: Return \code{txpRanks} slot + +\item \code{txpMissing(TxpResult)}: Return \code{txpMissing} slot -\item \code{txpResultParam,TxpResult-method}: Return \code{txpResultParam} slot +\item \code{txpResultParam(TxpResult)}: Return \code{txpResultParam} slot -\item \code{txpModel,TxpResult-method}: Return \code{txpModel} slot +\item \code{txpModel(TxpResult)}: Return \code{txpModel} slot -\item \code{txpIDs,TxpResult-method}: Return \code{txpIDs} slot +\item \code{txpIDs(TxpResult)}: Return \code{txpIDs} slot -\item \code{txpWeights,TxpResult-method}: Return \code{txpWeights} slot from model -- shortcut +\item \code{txpWeights(TxpResult)}: Return \code{txpWeights} slot from model -- shortcut for \code{txpWeights(txpModel(x))}; default \code{adjusted = FALSE}, i.e. return unadjusted weights -\item \code{txpSlices,TxpResult-method}: Return \code{txpSlices} slot from model -- shortcut +\item \code{txpSlices(TxpResult)}: Return \code{txpSlices} slot from model -- shortcut for \code{txpSlices(txpModel(x))} -\item \code{txpTransFuncs,TxpResult-method}: Return \code{txpTransFuncs} slot from model -- +\item \code{txpTransFuncs(TxpResult)}: Return \code{txpTransFuncs} slot from model -- shortcut for \code{txpTransFuncs(txpModel(x))} -\item \code{txpValueNames,TxpResult-method}: Return \code{txpValueNames} slot from slices -- +\item \code{txpValueNames(TxpResult)}: Return \code{txpValueNames} slot from slices -- shortcut for \code{txpValueNames(txpSlices(txpModel(x)))} -\item \code{length,TxpResult-method}: Return the number of observations; shortcut for +\item \code{length(TxpResult)}: Return the number of observations; shortcut for \code{length(txpScores(x))} -\item \code{sort,TxpResult-method}: Sort the ``TxpResult` object by their ranks +\item \code{sort(TxpResult)}: Sort the ``TxpResult` object by their ranks -\item \code{names,TxpResult-method}: Returns IDs; equal to \code{txpIDs(x)} +\item \code{names(TxpResult)}: Returns IDs; equal to \code{txpIDs(x)} -\item \code{as.data.frame,TxpResult-method}: Coerce TxpResult to \link[base:data.frame]{base::data.frame} object +\item \code{as.data.frame(TxpResult)}: Coerce TxpResult to \link[base:data.frame]{base::data.frame} object with IDs, scores, ranks, and slice scores -}} +}} \section{Slots}{ \describe{ @@ -156,6 +161,8 @@ individual slice scores} \item{\code{txpRanks}}{\verb{vector()} with rank of scores} +\item{\code{txpMissing}}{\verb{vector()} with data missingness} + \item{\code{txpModel}}{\link{TxpModel} object} \item{\code{txpIDs}}{\verb{vector()} of observation IDs} @@ -184,6 +191,8 @@ apply(txpSliceScores(res, adjusted = FALSE), 2, max, na.rm = TRUE) txpRanks(res) +txpMissing(res) + txpModel(res) identical(txpModel(res), txp_example_model) @@ -195,7 +204,7 @@ identical(txpIDs(res), names(res)) txpWeights(res) txpWeights(res, adjusted = TRUE) txpSlices(res) -# When retrieving transform functions, must specify level because both +# When retrieving transform functions, must specify level because both # models and slices have transform functions txpTransFuncs(res, level = "model") diff --git a/man/TxpResult-plot.Rd b/man/TxpResult-plot.Rd index ece7701..2cdedcf 100644 --- a/man/TxpResult-plot.Rd +++ b/man/TxpResult-plot.Rd @@ -9,13 +9,22 @@ \usage{ \S4method{plot}{TxpResult,missing}( x, + package = c("grid", "ggplot2"), fills = NULL, showScore = TRUE, gp = NULL, vp = NULL, name = NULL, newpage = TRUE, - ... + ..., + ncol = NULL, + bgColor = "grey80", + borderColor = "white", + sliceBorderColor = "white", + sliceValueColor = NULL, + sliceLineColor = NULL, + showMissing = TRUE, + showCenter = TRUE ) \S4method{plot}{TxpResult,numeric}( @@ -33,7 +42,10 @@ \arguments{ \item{x}{\link{TxpResult} object} -\item{fills}{Vector of colors to fill slices} +\item{package}{Character scalar, choice of "grid" or "ggplot2" for plotting +ToxPi profiles} + +\item{fills}{Vector of colors to fill slices. Set to NULL to use default} \item{showScore}{Logical scalar, overall score printed below the name when \code{TRUE}} @@ -47,6 +59,17 @@ when \code{TRUE}} \item{...}{Passed to \link{pieGridGrob} when plotting ToxPi and to pointsGrob when plotting ranks} +\item{ncol}{Number of columns for \link{ggplot2} ToxPi profiles} + +\item{bgColor, borderColor, sliceBorderColor, sliceValueColor, sliceLineColor}{Various color options when creating \link{ggplot2} ToxPi profiles. Set to NULL +for no color} + +\item{showMissing}{Boolean for coloring data missingness in \link{ggplot2} +ToxPi profiles} + +\item{showCenter}{Boolean for showing inner circle in \link{ggplot2} ToxPi +profiles. When set to False overrides showMissing} + \item{y}{Rank vector, i.e. \code{txpRanks(x)}} \item{labels}{Integer vector, indices of \code{x} to label in the rank plot} @@ -55,8 +78,8 @@ when plotting ranks} region margins} } \value{ -No return value; called for side effect (i.e. drawing in current -graphics device.) +No return value when using grid; called for side effect (i.e. +drawing in current graphics device). Will return ggplot2 object otherwise. } \description{ Plot \link{TxpResult} objects @@ -72,14 +95,16 @@ edited as such. If the labels are running of the device, the top or bottom margins can be increased with the \code{margins} parameter. + +ToxPi profiles can also be plotted using the \link{ggplot2} package. } \section{Functions}{ \itemize{ -\item \code{plot,TxpResult,missing-method}: Plot ToxPi diagrams +\item \code{plot(x = TxpResult, y = missing)}: Plot ToxPi diagrams -\item \code{plot,TxpResult,numeric-method}: Plot ToxPi ranks -}} +\item \code{plot(x = TxpResult, y = numeric)}: Plot ToxPi ranks +}} \examples{ ## Load example dataset & model; see ?TxpModel for building model objects data(txp_example_input, package = "toxpiR") @@ -92,6 +117,12 @@ res <- txpCalculateScores(model = txp_example_model, library(grid) plot(res) +plot(res[order(txpRanks(res))[1:4]]) + +library(ggplot2) +plot(res, package = "gg") +plot(res[order(txpRanks(res))], package = "gg", ncol = 5) + + theme(legend.position = "bottom") plot(res, txpRanks(res)) plot(res, txpRanks(res), pch = 16, size = unit(0.75, "char")) diff --git a/man/TxpSlice-class.Rd b/man/TxpSlice-class.Rd index d2af686..d234b24 100644 --- a/man/TxpSlice-class.Rd +++ b/man/TxpSlice-class.Rd @@ -44,17 +44,17 @@ the given function will be recycled for each input with a warning. } \section{Functions}{ \itemize{ -\item \code{txpValueNames,TxpSlice-method}: Return \code{txpValueNames} slot +\item \code{txpValueNames(TxpSlice)}: Return \code{txpValueNames} slot -\item \code{txpTransFuncs,TxpSlice-method}: Return \code{txpTransFuncs} slot +\item \code{txpTransFuncs(TxpSlice)}: Return \code{txpTransFuncs} slot -\item \code{length,TxpSlice-method}: Return number of inputs in slice; shortcut for +\item \code{length(TxpSlice)}: Return number of inputs in slice; shortcut for \code{length(txpValueNames(x))} -\item \code{merge,TxpSlice,TxpSlice-method}: Merge two \code{TxpSlice} objects into a single +\item \code{merge(x = TxpSlice, y = TxpSlice)}: Merge two \code{TxpSlice} objects into a single slice -}} +}} \section{Slots}{ \describe{ diff --git a/man/TxpSliceList-class.Rd b/man/TxpSliceList-class.Rd index 49df62c..67eaa41 100644 --- a/man/TxpSliceList-class.Rd +++ b/man/TxpSliceList-class.Rd @@ -39,16 +39,16 @@ names are required. } \section{Functions}{ \itemize{ -\item \code{txpValueNames,TxpSliceList-method}: Return \code{list} of \code{txpValueNames} slots for the +\item \code{txpValueNames(TxpSliceList)}: Return \code{list} of \code{txpValueNames} slots for the contained \link{TxpSlice} objects, or \code{vector} when \code{simplify = TRUE} -\item \code{txpTransFuncs,TxpSliceList-method}: Return \code{list} of \code{txpTransFuncs} slots for the +\item \code{txpTransFuncs(TxpSliceList)}: Return \code{list} of \code{txpTransFuncs} slots for the contained \link{TxpSlice} objects, or \link{TxpTransFuncList} when \code{simplify = TRUE} -\item \code{duplicated,TxpSliceList-method}: Returns logical vector of \code{length(x)}, where +\item \code{duplicated(TxpSliceList)}: Returns logical vector of \code{length(x)}, where \code{TRUE} indicates a duplicate slice in the list; see \link[base:duplicated]{base::duplicated} -}} +}} \examples{ ## Create TxpSlice objects s1 <- TxpSlice("input1", list(linear = function(x) x)) diff --git a/man/toxpiR-datasets.Rd b/man/toxpiR-datasets.Rd index b39a3fe..22f52fd 100644 --- a/man/toxpiR-datasets.Rd +++ b/man/toxpiR-datasets.Rd @@ -45,7 +45,7 @@ txp_example_model tf1 <- TxpTransFuncList(linear = function(x) x) sl <- TxpSliceList(s1 = TxpSlice(sprintf("metric\%d", 1:2)), s2 = TxpSlice("metric3"), - s3 = TxpSlice(sprintf("metric\%d", 4:7), + s3 = TxpSlice(sprintf("metric\%d", 4:7), tf1[rep("linear", 4)]), s4 = TxpSlice("metric8", tf1)) tf2 <- TxpTransFuncList(NULL, linear = function(x) x, NULL, NULL) diff --git a/man/toxpiR-package.Rd b/man/toxpiR-package.Rd index 8c390d2..dead85d 100644 --- a/man/toxpiR-package.Rd +++ b/man/toxpiR-package.Rd @@ -6,7 +6,7 @@ \alias{toxpiR-package} \title{toxpiR: Create ToxPi Prioritization Models} \description{ -Enables users to build 'ToxPi' prioritization models and provides functionality within the grid framework for plotting ToxPi graphs. 'toxpiR' allows for more customization than the 'ToxPi GUI' () and integration into existing workflows for greater ease-of-use, reproducibility, and transparency. toxpiR package behaves nearly identically to the GUI; the package documentation includes notes about all differences. The vignettes download example files from . +Enables users to build 'ToxPi' prioritization models and provides functionality within the grid framework for plotting ToxPi graphs. 'toxpiR' allows for more customization than the 'ToxPi GUI' (\url{https://toxpi.org}) and integration into existing workflows for greater ease-of-use, reproducibility, and transparency. toxpiR package behaves nearly identically to the GUI; the package documentation includes notes about all differences. The vignettes download example files from \url{https://github.com/ToxPi/ToxPi-example-files}. } \seealso{ Useful links: @@ -25,6 +25,7 @@ Authors: \item Dillon T Lloyd \item Preethi Thunga (\href{https://orcid.org/0000-0001-5447-0129}{ORCID}) \item Skylar W Marvel + \item Jonathon Fleming \item David M Reif \email{reif.david@gmail.com} (\href{https://orcid.org/0000-0001-7815-6767}{ORCID}) [funder] } diff --git a/man/txpCalculateScores.Rd b/man/txpCalculateScores.Rd index 1083afd..8a190cf 100644 --- a/man/txpCalculateScores.Rd +++ b/man/txpCalculateScores.Rd @@ -58,6 +58,9 @@ Calculate ToxPi Scores for the given model and input data for \link{TxpModel} and \link{TxpModelList}. Ranks are calculated such that the highest ToxPi score has a rank of 1. + +Missingness is determined after applying input-level transformations but +before applying slice-level transformations. } \examples{ ## Load example dataset & model; see ?TxpModel for building model objects diff --git a/man/txpGenerics.Rd b/man/txpGenerics.Rd index 7ffc5f9..101d482 100644 --- a/man/txpGenerics.Rd +++ b/man/txpGenerics.Rd @@ -16,6 +16,7 @@ \alias{txpIDs} \alias{txpIDs<-} \alias{txpRanks} +\alias{txpMissing} \alias{txpResultParam} \title{toxpiR package generics} \usage{ @@ -47,6 +48,8 @@ txpIDs(x, ...) <- value txpRanks(x, ...) +txpMissing(x, ...) + txpResultParam(x, ...) } \arguments{ diff --git a/tests/testthat/test-TxpResult.R b/tests/testthat/test-TxpResult.R index 0350def..c1fd66a 100644 --- a/tests/testthat/test-TxpResult.R +++ b/tests/testthat/test-TxpResult.R @@ -62,6 +62,10 @@ test_that("TxpResult accessors return expected slots", { expect_equal(txpValueNames(res), txpValueNames(txpSlices(txpModel(res)))) expect_equal(txpValueNames(res, simplify = TRUE), txpValueNames(txpSlices(txpModel(res)), simplify = TRUE)) + expect_is(txpMissing(res), "numeric") + expect_equal(length(txpMissing(res)), length(txpSlices(res))) + expect_true(all(txpMissing(res) >=0 & txpMissing(res) <=1)) + expect_equal(txpMissing(res), c(s1 = 0.1,s2 =0.1,s3 =0.125,s4 =0.1)) }) ##----------------------------------------------------------------------------## @@ -164,6 +168,15 @@ test_that("We can make ToxPi diagrams", { id.var = "name") }) expect_silent(plot(res)) + expect_silent(plot(res, package = "gg")) + expect_silent(plot(res, package = "gg",fills = c("red","blue","green","magenta"))) + expect_silent(plot(res, package = "gg",showScore = FALSE)) + expect_silent(plot(res, package = "gg",ncol = 2)) + expect_silent(plot(res, package = "gg",bgcolor = "white")) + expect_silent(plot(res, package = "gg",sliceBorderColor = "#FF00FF")) + expect_silent(plot(res, package = "gg",sliceValueColor = "#FF00FF",)) + expect_silent(plot(res, package = "gg",sliceLineColor = "#FF00FF")) + expect_silent(plot(res, package = "gg",showMissing = FALSE)) }) ##----------------------------------------------------------------------------## diff --git a/vignettes/embeddedFigures/coord_munch_new.png b/vignettes/embeddedFigures/coord_munch_new.png new file mode 100644 index 0000000..8e96c32 Binary files /dev/null and b/vignettes/embeddedFigures/coord_munch_new.png differ diff --git a/vignettes/embeddedFigures/coord_munch_orig.png b/vignettes/embeddedFigures/coord_munch_orig.png new file mode 100644 index 0000000..648b1d4 Binary files /dev/null and b/vignettes/embeddedFigures/coord_munch_orig.png differ diff --git a/vignettes/embeddedFigures/txp_PDF.pdf b/vignettes/embeddedFigures/txp_PDF.pdf new file mode 100644 index 0000000..e071a27 Binary files /dev/null and b/vignettes/embeddedFigures/txp_PDF.pdf differ diff --git a/vignettes/embeddedFigures/txp_explain1.png b/vignettes/embeddedFigures/txp_explain1.png new file mode 100644 index 0000000..a3e5465 Binary files /dev/null and b/vignettes/embeddedFigures/txp_explain1.png differ diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 23e3147..4db97fe 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -35,7 +35,8 @@ code.r{ /* Code block */ ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, - comment = "#>" + comment = "#>", + fig.retina = 6 ) ``` @@ -45,10 +46,10 @@ This document introduces ToxPi and describes how to use the `toxpiR` package to ## What is ToxPi? -Toxicological Priority Index (ToxPi) is a decision support tool that allows transparent integration and visualization of data across disparate information domains to aid in prioritization. ToxPi takes input data of disparate sources,from a biological assay or a computer predicted model,to genetic features or proteomic data, and combines all of these data types into one overall model. This model then calculates an overall score for each datapoint of interest. It does this by the user specifying one or more features to go into each "slice" of a unit circle, and the weights that these slices have. These slices can contain one or more features of any type in the same slice. The slice weights are user defined, and decided based on prior information that one may have about the analysis. When a slice has a higher weight, it takes up more room on the unit square. When a slice has a higher calculated score, it goes further out from the center of the circle. As shown below, a feature with a low score will have overall smaller slices than one with an overall higher score. This means that we can understand at a glance the top level differences between what we are interested in. The component slices also add up to the overall ToxPi score with the weights add importance to that specific slice. The metrics that make up each component slice are simulated in data in this case, but can be many different kinds of data that fits your own analysis. More information on the methodological details can be found at [toxpi.org](https://toxpi.org). +The Toxicological Prioritization Index (ToxPi) is a statistical modeling framework that allows transparent integration and visualization of data across disparate sources (i.e. multimodal or multiscale information). This framework aggregates related features into scored ‘slices’, rescales individual slice scores to range 0–1, and then develops an overall score for each sample using a weighted model. The slice weights can be interpreted as the "importance" of categorized features when predicting sample scores and associated ranks. The resulting scores for each sample are visualized as ToxPi profiles (see image below). Slice weights are represented as the arc-width, slice scores are represented as the radius, and the overall sample scores are represented by the combination of slice weights and radii. These visualizations allow for quick comparison of overall feature importance, feature impacts driving a specific sample, relative impact ranking of common features between samples, and overall ranking between samples. As a flexible method capable of integrating data from any source, it has been [applied](https://scholar.google.com/scholar?start=5&hl=en&as_sdt=0,34&sciodt=0,34&cites=14315759707117183281,8409987751811922970,6830405381891567320,6660731247750930378,6264826653350493071,6008919238370157052,5228323847718230279,14470107422640831138) to problems in several different fields. Additional information is linked from [toxpi.org](https://toxpi.org).
-![](embeddedFigures/txp_explain.png){width=700px} +![](embeddedFigures/txp_explain1.png){width=700px}
@@ -93,10 +94,10 @@ library(toxpiR) ## Flowchart
-![](embeddedFigures/toxpiR-flowchart.svg){width=700px} +![](embeddedFigures/toxpiR-flowchart.svg){height=100% width=100%}
-This flowchart details the basic steps necessary to analyze data using `toxpiR`. A separate vignette describes how load and work with the GUI data file using txpImportGui() function. Usage for all other functions is described below using an example data set. To view a list of all functions available in this package, please run: +This flowchart details the basic steps necessary to analyze data using `toxpiR`. A separate vignette describes how to load and work with the GUI data file using txpImportGui() function. Usage for all other functions is described below using an example data set. To view a list of all functions available in this package, please run: > lsf.str("package:toxpiR") @@ -109,7 +110,7 @@ The standard data input is a standard R dataframe with rows as your datapoints a ### Load the dataset -```{r } +```{r} data(txp_example_input, package = "toxpiR") head(txp_example_input) ``` @@ -137,7 +138,7 @@ The first step is to specify information about each slice before creating a Toxp -```{r } +```{r} ## Goal - Create two slices with transformation functions # Slice 1: Metric 1, No transformation @@ -170,7 +171,7 @@ The ToxPi model object is core for specifying how the created slices should beha **Usage** -```{r } +```{r} ## Goal - Create ToxPi model. # Slice 1, weight = 2 @@ -205,38 +206,439 @@ Calculate ToxPi Scores for the given ToxPi model and input data. This input data **Usage** -```{r } -f.results <- txpCalculateScores(model = f.model, + +```{r} +f.model <- txp_example_model #Load a more complex 4 slice model +f.results <- txpCalculateScores(model = f.model, input = txp_example_input, id.var = 'name' ) txpSliceScores(f.results) #ToxPi scores txpWeights(f.results) #Print weights +txpMissing(f.results) #Proportion of missing data within each slice +``` + + +### Visualization + +Two paths exist for visualization, **ggplot** methods and **grid** methods. The ggplot method uses the `ggplot2` package and allows for highly customizable profiles allowing for several visualization experiences. The grid method uses advanced `grid` graphics and can be implemented using pieGrob objects that are compatible with the grid system. Additional plots can be made such as a rank plot by using the data stored in the results object. The results object also allows for the flexibility to use other R plotting packages if preferred. + +
+**Summary**: The ggPlot graphics path will be the best option for users wanting to create ToxPi profiles, with many options for customization. The grid graphics path is for users wanting to modify very specific, basic elements of ToxPi profiles and/or recombine profiles with other graphics. The `ggplot2` package (high-level) is built atop `grid` graphics (low-level), so the two systems interact well. + +:::: {style="display: flex; justify-content:space-around;"} + +
+

ggPlot

+* Examples shown in this vignette produce a "look-and-feel" that is closer to the graphics output of the familiar [ToxPi GUI](www.toxpi.org) +* Aesthetics are easy to customize +* Includes missing data visuals (center circle à la ToxPi GUI output) +
+ +
+

grid

+* Formal, S4-based customization options for visuals using the R `grid` package and the "grob" (grid graphical object) framework +* ToxPi profile graphics created as grobs can be directly inserted into more complex figures as points on a scatterplot, leaves on a cluster dengrogram, overlaid on a map, etc. +* Vignette examples show how to highlight individual profiles and highlight individual slices +
+ +:::: + +#### ggplot Method + +This method uses the `ggplot2` package to draw highly customizable ToxPi profiles with multiple different aesthetics and information options. The most notable aesthetic addition is the inclusion of information regarding the amount of missing data each slice has, which is represented by the a small circle of interior slices as is shown in profiles generated by the ToxPi GUI. Each interior slice is colored on a grey scale, with black representing all missing data and white representing no missing data. Each new customization option, along with some other notable differences, are described below. + +
+**Customization Options (Arguments)** + +> *fills* : Vector containing slice colors. Defaults to a color scheme matching the ToxPi GUI. + +> *showMissing* : Boolean to show missing data information. Defaults to TRUE. + +> *showCenter* : Boolean to show inner circle. Defaults to TRUE. FALSE overrides showMissing. + +> *showScore* : Boolean to show overall profile scores. Defaults to TRUE. + +> *ncol* : Integer specifying number of columns in plot. Default is an automatic calculation by ggplot. + +> *bgColor* : Text specifying background color for profiles as either hex codes or R recognized colors. Defaults to "gray80". + +> *borderColor* : Text specifying color of max radius ring as either hex codes or R recognized colors. Defaults to "white". + +> *sliceBorderColor* : Text specifying color of slice borders as either hex codes or R recognized colors. Defaults to "white". + +> *sliceValueColor* : Text specifying color of slice scores as either hex codes or R recognized colors. Defaults to NULL. + +> *sliceLineColor* : Text specifying color of slice guidelines as either hex codes or R recognized colors. Defaults to NULL. + +
+**Usage** + +Depending on export method, plot resolution may end up poor. SVG and PDF images tend to produce better results than PNG. Usage and example plot output are shown below. +```{r, eval=FALSE} +library("ggplot2") + +# Default plot +plot(f.results, package = "gg") # Using ggplot package +``` +
+```{r, fig.show='hold', fig.width=4, fig.height=4, echo=FALSE} +library("ggplot2") + +# Default plot +plot(f.results, package = "gg") # Using ggplot package +``` +
+ +Sometimes the inner circle of the ToxPi figure can show plotting artifacts. A possible workaround for this is to create a wrapper function around `ggplot2:::coord_munch` as shown below. + +```{r, fig.show = "hide"} +## Optional code to make smoother lines + +# Plot before updating coord_munch +plot(f.results["chem01"], package = "gg") + +# Save the original version of coord_munch +coord_munch_orig <- ggplot2:::coord_munch + +# Make a wrapper function that has a different default for segment_length +if (length(formals(coord_munch_orig)) == 5) { + coord_munch_new <- function(coord, data, range, segment_length = 1/1000, + is_closed = FALSE) { + coord_munch_orig(coord, data, range, segment_length, is_closed) + } +} else { + coord_munch_new <- function(coord, data, range, segment_length = 1/1000) { + coord_munch_orig(coord, data, range, segment_length) + } +} + +# The environment may need to be set +#environment(coord_munch_new) <- environment(coord_munch_orig) + +# Replace ggplot2:::coord_munch with coord_munch_new +assignInNamespace("coord_munch", coord_munch_new, ns = "ggplot2") + +# Plot after updating coord_munch +plot(f.results["chem01"], package = "gg") + +# Revert to original coord_munch ater plotting if desired +#assignInNamespace("coord_munch", coord_munch_orig, ns = "ggplot2") ``` +
+![](embeddedFigures/coord_munch_orig.png) +![](embeddedFigures/coord_munch_new.png) +
+ +
+**Customization examples** -### Plotting +#### Coloration Options -Basic ToxPi visuals and rank plots can be created using the plot() function. Ranks are calculated such that the highest ToxPi score has a rank of 1. Advanced grid graphics can be implemented using pieGrob objects that are compatible with the grid system. Additional plots can be made such as a rank plot by using the data stored in the results object. The results object also allows for the flexibility to use other R plotting packages if preffered. +```{r, eval=FALSE} +# Changing the slice colors +colors <- c("orange", "green", "magenta", "lightblue") +plot(f.results["chem02"], package = "gg", fills = colors) +plot(f.results["chem02"], package = "gg", fills = NULL) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Changing the slice colors +colors <- c("orange", "green", "magenta", "lightblue") +plot(f.results["chem02"], package = "gg", fills = colors) +plot(f.results["chem02"], package = "gg", fills = NULL) +``` +
+```{r, eval=FALSE} +# Changing the background color +plot(f.results["chem02"], package = "gg", bgColor = "lightskyblue") +plot(f.results["chem02"], package = "gg", bgColor = NULL) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Changing the background color +plot(f.results["chem02"], package = "gg", bgColor = "lightskyblue") +plot(f.results["chem02"], package = "gg", bgColor = NULL) +``` +
+ +```{r, eval=FALSE} +# Changing the max radius ring color +plot(f.results["chem02"], package = "gg", borderColor = "black") +plot(f.results["chem02"], package = "gg", borderColor = NULL) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Changing the max radius ring color +plot(f.results["chem02"], package = "gg", borderColor = "black") +plot(f.results["chem02"], package = "gg", borderColor = NULL) +``` +
+ +```{r, eval=FALSE} +# Changing the slice border color +plot(f.results["chem02"], package = "gg", sliceBorderColor = "magenta") +plot(f.results["chem02"], package = "gg", sliceBorderColor = NULL) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Changing the slice border color +plot(f.results["chem02"], package = "gg", sliceBorderColor = "magenta") +plot(f.results["chem02"], package = "gg", sliceBorderColor = NULL) +``` +
+ +```{r, eval=FALSE} +# Adding slice guidelines +plot(f.results["chem02"], package = "gg", sliceLineColor = "red") +plot(f.results["chem02"], package = "gg", sliceLineColor = NULL) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Adding slice guidelines +plot(f.results["chem02"], package = "gg", sliceLineColor = "red") +plot(f.results["chem02"], package = "gg", sliceLineColor = NULL) +``` +
+ +```{r, eval=FALSE} +# Adding visible slice scores +plot(f.results["chem02"], package = "gg", sliceValueColor = "brown") +plot(f.results["chem02"], package = "gg", sliceValueColor = NULL) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Adding visible slice scores +plot(f.results["chem02"], package = "gg", sliceValueColor = "brown") +plot(f.results["chem02"], package = "gg", sliceValueColor = NULL) +``` +
+ +#### Binary Options +```{r, eval=FALSE} +# Hiding inner circle +plot(f.results["chem02"], package = "gg", showCenter = TRUE) +plot(f.results["chem02"], package = "gg", showCenter = FALSE) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Hiding inner circle +plot(f.results["chem02"], package = "gg", showCenter = TRUE) +plot(f.results["chem02"], package = "gg", showCenter = FALSE) +``` +
+ +```{r, eval=FALSE} +# Hiding missing data information (pure white inner circle) +plot(f.results["chem02"], package = "gg", showMissing = TRUE) +plot(f.results["chem02"], package = "gg", showMissing = FALSE) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Hiding missing data information (pure white inner circle) +plot(f.results["chem02"], package = "gg", showMissing = TRUE) +plot(f.results["chem02"], package = "gg", showMissing = FALSE) +``` +
+ +```{r, eval=FALSE} +# Hiding the overall profile scores +plot(f.results["chem02"], package = "gg", showScore = TRUE) +plot(f.results["chem02"], package = "gg", showScore = FALSE) +``` +
+```{r, fig.show="hold", echo=FALSE} +# Hiding the overall profile scores +plot(f.results["chem02"], package = "gg", showScore = TRUE) +plot(f.results["chem02"], package = "gg", showScore = FALSE) +``` +
+ +#### Format/Theme Options + +```{r, fig.width = 7, fig.align='center'} +# Specifying the number of columns in the plot +plot(f.results, package = "gg", ncol = 5) +``` + +```{r, eval=FALSE} +# Moving the legend using ggplot built in theme functions +plot(f.results, package = "gg", ncol = 5) + theme(legend.position = "bottom") +plot(f.results, package = "gg", ncol = 2) + theme(legend.position = "left") +``` +
+```{r, fig.show="hold", fig.height=5, echo=FALSE} +# Moving the legend using ggplot built in theme functions +plot(f.results, package = "gg", ncol = 5) + theme(legend.position = "bottom") +plot(f.results, package = "gg", ncol = 2) + theme(legend.position = "left") +``` +
+ +```{r, fig.align='center'} +# Removing plot margins +plot(f.results, package = "gg") + theme(plot.margin = margin(0, 0, 0, 0, "cm")) +# Removing spacing between panels +plot(f.results, package = "gg") + theme(panel.spacing = unit(0, "lines")) +# Removing text labels +plot(f.results, package = "gg") + theme(strip.text.x = element_blank()) +# A combination of the above for a rank ordered plot +plot(f.results[order(txpRanks(f.results)[1:9])], package = "gg") + + theme( + plot.margin = margin(0, 0, 0, 0, "cm"), + panel.spacing = unit(0, "lines"), + strip.text.x = element_blank(), + legend.position = "none" + ) +``` + +**Missing Data Examples** +```{r, fig.align='center'} +## Creating an example with more variable missing data amounts +f.input <- txp_example_input + +# Add more missing data to slice 2 via metric3 in the raw data +f.input[3:10, "metric3"] <- NA + +# Modify transformation function for slice 4 +txpSlices(f.model)[[4]] <- TxpSlice("metric8", c(fn = \(x) sqrt(x - 30))) + +# Calculate new ToxPi results +f.results_missing <- txpCalculateScores(f.model, f.input, id.var = "name") + +# View missing data proportions +txpMissing(f.results_missing) + +# View new result profile +plot(f.results_missing["chem02"], package = "gg") +``` + + +#### pieGrob Method +This method is the default and uses the grid package with grob objects to draw ToxPi profiles that can be individually customized after plotting. This method does not allow for the wide array of aesthetics as ggplot does, but instead it allows the user to highlight specific profiles or slices that have significant importance in their results. Methods for highlighting information after plotting is shown below. ```{r fig.width=7, fig.height=3} library(grid) # Load library plot(f.results) # ToxPi visuals # grid.ls() #List grid info # Highlight one figure using its label -grid.edit("pie-1", fills = c("red", "black")) +grid.edit("pie-1", fills = c("red", "blue", "black", "brown")) # Or just one slice in a figure -grid.edit("pie-10::slice1", gp = gpar(fill = "#7DBC3D")) +grid.edit("pie-10::slice1", gp = gpar(fill = "#FC0FC0")) +``` + +#### ggplot vs grid Comparison + +```{r, eval=FALSE} +#Single sample +plot(f.results["chem02"]) +plot(f.results["chem02"], package = "gg") +``` +
+```{r, fig.show="hold", echo=FALSE} +#Single sample +plot(f.results["chem02"]) +plot(f.results["chem02"], package = "gg") +``` +
+ +```{r, eval=FALSE} +# Subset plots +plot(f.results[order(txpRanks(f.results))[1:4]]) #Profiles ranked 1-4 +plot(f.results[order(txpRanks(f.results))[1:4]], package = "gg") #Profiles ranked 1-4 +``` +
+```{r, fig.show="hold", echo=FALSE} +# Subset plots +plot(f.results[order(txpRanks(f.results))[1:4]]) #Profiles ranked 1-4 +plot(f.results[order(txpRanks(f.results))[1:4]], package = "gg") #Profiles ranked 1-4 +``` +
+ +```{r, eval=FALSE} +## Long sample names for cramped plots + +#change the first sample name in f.results +txpIDs(f.results)[1] <- "I am a long sample name" + +plot(f.results) #grid plot for all samples +plot(f.results, package = "gg") #ggplot for all samples + +txpIDs(f.results)[1] <- "chem01" # Change the sample name back ``` +
+```{r, fig.show="hold", echo=FALSE} +## Long sample names for cramped plots + +#change the first sample name in f.results +txpIDs(f.results)[1] <- "I am a long sample name" + +plot(f.results) #grid plot for all samples +plot(f.results, package = "gg") #ggplot for all samples + +txpIDs(f.results)[1] <- "chem01" # Change the sample name back +``` +
+ +```{r, eval=FALSE} +## Long slice names for cramped plots + +#change first slice name in model slot +names(f.results@txpModel)[1] <- "long slice name" +#change first slice name in scores slot +colnames(f.results@txpSliceScores)[1] <- "long slice name" +#change first slice name in missing data slot +names(f.results@txpMissing)[1] <- "long slice name" + +#plot results using grid +plot(f.results) +#plot results using ggplot +plot(f.results, package = "gg") + theme( + legend.position = "bottom", + legend.title = element_text(size = 10), + legend.text = element_text(size = 6) +) -```{r fig.width=5, fig.height=4} +#change slice name back +names(f.results@txpModel)[1] <- "s1" +colnames(f.results@txpSliceScores)[1] <- "s1" +names(f.results@txpMissing)[1] <- "s1" +``` +
+```{r, fig.show="hold", echo=FALSE} +## Long slice names for cramped plots + +#change first slice name in model slot +names(f.results@txpModel)[1] <- "long slice name" +#change first slice name in scores slot +colnames(f.results@txpSliceScores)[1] <- "long slice name" +#change first slice name in missing data slot +names(f.results@txpMissing)[1] <- "long slice name" + +#plot results using grid +plot(f.results) +#plot results using ggplot +plot(f.results, package = "gg") + theme( + legend.position = "bottom", + legend.title = element_text(size = 10), + legend.text = element_text(size = 6) +) + +#change slice name back +names(f.results@txpModel)[1] <- "s1" +colnames(f.results@txpSliceScores)[1] <- "s1" +names(f.results@txpMissing)[1] <- "s1" +``` +
+ +#### Statistic Plots +```{r fig.width=5, fig.height=4, fig.align='center'} # Rank plot plot(f.results, y = txpRanks(f.results), labels = 1:10) # Hierarchical Clustering - f.hc <- hclust(dist(txpSliceScores(f.results))) plot(f.hc, hang = -1, labels = txpIDs(f.results), xlab = '', sub = '')