Merge pull request #123 from gdrplatform/GDR-2500

[GDR-2500] Move plot functions from other packages to gDRplots

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: gDRutils
 Type: Package
 Title: A package with helper functions for processing drug response data
-Version: 1.3.4
-Date: 2024-07-08
+Version: 1.3.5
+Date: 2024-07-12
 Authors@R: c(person("Bartosz", "Czech", role=c("aut"),
                    comment = c(ORCID = "0000-0002-9908-3007")),
              person("Arkadiusz", "Gladki", role=c("cre", "aut"), email="[email protected]",

NAMESPACE

@@ -45,7 +45,6 @@ export(get_additional_variables)
 export(get_assay_names)
 export(get_combo_assay_names)
 export(get_combo_base_assay_names)
-export(get_combo_col_settings)
 export(get_combo_excess_field_names)
 export(get_combo_score_assay_names)
 export(get_combo_score_field_names)
@@ -58,7 +57,6 @@ export(get_experiment_groups)
 export(get_header)
 export(get_identifiers_dt)
 export(get_idfs_synonyms)
-export(get_iso_colors)
 export(get_isobologram_columns)
 export(get_non_empty_assays)
 export(get_prettified_identifiers)

NEWS.md

@@ -1,3 +1,6 @@
+## gDRutils 1.3.5 - 2024-07-12
+* move `get_combo_col_settings` and `get_iso_colors` to `gDRplots` package
+
 ## gDRutils 1.3.4 - 2024-07-08
 * add residual sum of square and p-value to Metrics assay
 

R/combo.R

@@ -45,112 +45,6 @@ convert_combo_data_to_dt <-
   }
 
 
-#' get_iso_colors
-#' 
-#' 
-#' @param  normalization_type charvec normalization_types expected in the data
-#' @keywords combination_data
-#'
-#' @return named charvec with iso colors
-#' 
-#' @examples 
-#' get_iso_colors()
-#' 
-#' @export
-get_iso_colors <-
-  function(normalization_type = c("RV", "GR")) {
-    normalization_type <- match.arg(normalization_type)
-    iso_cutoff <- seq(0, 1, 0.05)
-    breaks <- iso_cutoff
-    if (normalization_type == "GR") {
-      colors <- vapply(iso_cutoff, function(x) {
-        color_vector <- c(70, round((0.85 - x * 0.7) * 170), round((1.1 - x * 0.7) * 200))
-        assert_RGB_format(color_vector)
-        sprintf("#%s", paste(as.hexmode(color_vector), collapse = ""))
-      },
-      character(1)
-      )
-    } else {
-      colors <- vapply(iso_cutoff, function(x) {
-        color_vector <- c(70, round((1 - x * .85) * 170), round((1.1 - x * .85) * 232))
-        assert_RGB_format(color_vector)
-        sprintf("#%s", paste(as.hexmode(color_vector), collapse = ""))
-      },
-      character(1)
-      )
-    }
-    names(colors) <- iso_cutoff
-    colors
-  }
-
-assert_RGB_format <- function(x) {
-  if (any(x > 255)) {
-    stop("Some value is greater than 255. Not valid RGB format.")
-  }
-}
-
-#' Get colorscale data for given combo assay and growth metric
-#'
-#' @param g_metric growth metric
-#' @param assay_type assay type
-#' @keywords combination_data
-#'
-#' @return list with colors, breaks and limits
-#' @examples 
-#' get_combo_col_settings("GR", "excess")
-#' 
-#' @export
-get_combo_col_settings <-
-  function(g_metric,
-           assay_type) {
-    assay_names <- get_combo_assay_names()
-    assay_types <- names(assay_names)
-    checkmate::assert_choice(g_metric, c("RV", "GR"))
-    checkmate::assert_choice(assay_type, assay_types)
-
-    colors <- breaks <- limits <- NULL
-    if (assay_type %in% names(get_combo_assay_names(group = "combo_iso"))) {
-      myv <- get_iso_colors(g_metric)
-      colors <- as.character(myv)
-      breaks <- names(myv)
-    } else if (assay_type %in% c(names(get_combo_assay_names(group = "combo_excess")),
-                                 names(get_combo_assay_names(group = "combo_score")))) {
-      colors <- c("#003355", "#4488dd", "#eeeedd", "#CC8844", "#662200")
-      if (g_metric == "GR") {
-        breaks <- c(-0.5, -0.25, 0, 0.25, 0.5)
-      } else if (g_metric == "RV") {
-        breaks <- c(-0.3, -0.15, 0, 0.15, 0.3)
-      } else {
-        stop(sprintf("unexpected 'g_metric' type: '%s'", g_metric))
-      }
-    } else if (assay_type %in% names(get_combo_assay_names(group = "combo_score_mx"))) {
-      colors <- c("#003355", "#4488dd", "#eeeedd", "#CC8844", "#662200")
-      breaks <- c(-4, -2, 0, 2, 4)
-    } else if (assay_type %in% names(get_combo_assay_names(group = "combo_base_mx"))) {
-      if (g_metric == "GR") {
-        colors <- c("#001155", "#1122AA", "#AA4400", "#FF7711", "#ffffee")
-        breaks <- c(-0.6, -0.2, 0.2, 0.6, 1)
-      } else if (g_metric == "RV") {
-        colors <- c("#330033", "#770033", "#BB6633", "#ffaa11", "#ffffee")
-        breaks <- c(0, 0.25, 0.5, 0.75, 1)
-      } else {
-        stop(sprintf("unexpected 'g_metric' type: '%s'", g_metric))
-      }
-    } else {
-      stop(sprintf("no logic found for the assay_type: '%s'", assay_type))
-    }
-    stopifnot(
-      "unexpected error when determining combo color settings - either 'colors' or 'breaks' is NULL" = 
-        !(is.null(colors) || is.null(breaks))
-    )
-    list(
-      colors = colors,
-      breaks = breaks,
-      limits = c(min(breaks), max(breaks))
-    )
-  }
-
-
 DATA_COMBO_INFO_TBL <- data.table::data.table(
   name = c("hsa_score", "bliss_score", "CIScore_50", "CIScore_80",
            "smooth", "hsa_excess", "bliss_excess"),
@@ -262,7 +156,6 @@ define_matrix_grid_positions <- function(conc1, conc2) {
   list(axis_1 = axis_1, axis_2 = axis_2)
 }
 
-
 #' Round concentration to ndigit significant digits
 #'
 #' @param x value to be rounded.

R/fit_curves.R

@@ -176,7 +176,7 @@ fit_curves <- function(df_,
 #'
 #' @details
 #' Implementation of the genedata approach for curve fit:
-#' https://screener.genedata.com/documentation/display/DOC15/Business+Rules+for+Dose-Response+Curve+Fitting+Model+Selection+and+Fit+Validity #nolint
+#' https://screener.genedata.com/documentation/display/DOC21/Business-Rules-for-Dose-Response-Curve-Fitting,-Model-Selection,-and-Fit-Validity.html #nolint
 #'
 #' The output parameter names correspond to the following definitions:
 #' \describe{

R/merge_SE.R

@@ -98,7 +98,7 @@ merge_SE <- function(SElist,
 #' 
 #' @examples 
 #' mae <- get_synthetic_data("finalMAE_combo_2dose_nonoise")
-
+#' 
 #' listSE <- list(
 #'   combo1 = mae[[1]], 
 #'   sa = mae[[2]]

tests/testthat/test-combo.R

@@ -42,34 +42,6 @@ test_that("convert_combo_data_to_dt", {
   )
 })
 
-test_that("get_iso_colors", {
-  ### expected values
-  gic <- get_iso_colors()
-  expect_true(length(gic) > 2)
-  expect_identical("character", class(gic))
-  gic2 <- get_iso_colors(formals(get_iso_colors)[[1]][[3]])
-  expect_true(any(gic != gic2))
-  expect_identical(length(gic), length(gic2))
-
-  ### errors
-  expect_error(get_iso_colors("inv_param"), "'arg' should be one of ")
-})
-
-test_that("get_combo_col_settings",  {
-  ### expected values
-  gcan <- names(get_combo_assay_names()[1])
-  gcc <-
-    get_combo_col_settings(g_metric = "GR", assay_type = gcan)
-  expect_true(inherits(gcc, "list"))
-  expect_identical(sort(names(gcc)), c("breaks", "colors", "limits"))
-
-  ### errors
-  err_msg <- "Assertion on 'assay_type' failed: "
-  expect_error(get_combo_col_settings("GR", 8), err_msg)
-  err_msg <- "Assertion on 'g_metric' failed: "
-  expect_error(get_combo_col_settings("grvalue", 8), err_msg)
-})
-
 test_that("shorten_normalization_type_name", {
   ### expected values
   expect_identical("GR", shorten_normalization_type_name("GRvalue"))