From 6aaef86bba210bcdfd116e9fe2b76832c1aab822 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Wed, 3 Jan 2024 13:20:37 +0100 Subject: [PATCH 01/19] refactor: simplify logic for combo and rename matrix into combination --- R/combinations-calculate_matrix_metric.R | 26 ++++- R/combinations-isobolograms.R | 4 +- R/data_type.R | 35 +++--- R/fit_SE.combinations.R | 139 +++++++++-------------- R/runDrugResponseProcessingPipeline.R | 2 +- R/utils.R | 3 +- 6 files changed, 97 insertions(+), 112 deletions(-) diff --git a/R/combinations-calculate_matrix_metric.R b/R/combinations-calculate_matrix_metric.R index 0fddb5ce..a71b7b57 100644 --- a/R/combinations-calculate_matrix_metric.R +++ b/R/combinations-calculate_matrix_metric.R @@ -39,7 +39,13 @@ NULL #' calculate_HSA(sa1, "conc", sa2, "conc2", "x") #' @export calculate_HSA <- function(sa1, series_id1, sa2, series_id2, metric) { - .calculate_matrix_metric(sa1, series_id1, sa2, series_id2, metric, FXN = pmin) + .calculate_matrix_metric(sa1, + series_id1, + sa2, + series_id2, + metric, + FXN = pmin, + measured_col = "mx") } @@ -50,7 +56,12 @@ calculate_HSA <- function(sa1, series_id1, sa2, series_id2, metric) { #' sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), x = seq(n)) #' calculate_Bliss(sa1, "conc", sa2, "conc2", "x") #' @export -calculate_Bliss <- function(sa1, series_id1, sa2, series_id2, metric) { +calculate_Bliss <- function(sa1, + series_id1, + sa2, + series_id2, + metric, + measured_col = "mx") { if (metric %in% c("GRvalue", "GR")) { lambda <- function(x, y) { ifelse(x < 0 | y < 0, @@ -80,7 +91,8 @@ calculate_Bliss <- function(sa1, series_id1, sa2, series_id2, metric) { sa2, series_id2, metric, - FXN = lambda + FXN = lambda, + measured_col = measured_col ) } @@ -89,15 +101,17 @@ calculate_Bliss <- function(sa1, series_id1, sa2, series_id2, metric) { series_id1, sa2, series_id2, - metric, FXN) { + metric, + FXN, + measured_col = "x") { checkmate::assert_data_table(sa1) checkmate::assert_data_table(sa2) checkmate::assert_true(all(sa1[[series_id2]] == 0L)) checkmate::assert_true(all(sa2[[series_id1]] == 0L)) - data.table::setnames(sa1, "x", "metric1", skip_absent = TRUE) - data.table::setnames(sa2, "x", "metric2", skip_absent = TRUE) + data.table::setnames(sa1, measured_col, "metric1", skip_absent = TRUE) + data.table::setnames(sa2, measured_col, "metric2", skip_absent = TRUE) u <- data.table::CJ(sa1[[series_id1]], sa2[[series_id2]]) colnames(u) <- c(series_id1, series_id2) diff --git a/R/combinations-isobolograms.R b/R/combinations-isobolograms.R index 7f4e4067..682a4fde 100644 --- a/R/combinations-isobolograms.R +++ b/R/combinations-isobolograms.R @@ -338,7 +338,7 @@ calculate_Loewe <- function( get_isocutoffs <- function(df_mean, normalization_type) { - if (min(df_mean[normalization_type == normalization_type, x], na.rm = TRUE) > 0.7) { + if (min(df_mean[normalization_type == normalization_type, mx], na.rm = TRUE) > 0.7) { iso_cutoffs <- NULL } else { if (normalization_type == "GR") { @@ -350,7 +350,7 @@ get_isocutoffs <- function(df_mean, normalization_type) { max( max_val, ceiling( - 20 * min(df_mean[normalization_type == normalization_type, x] + 0.08, na.rm = TRUE) + 20 * min(df_mean[normalization_type == normalization_type, mx] + 0.08, na.rm = TRUE) ) / 20 ), 0.8, diff --git a/R/data_type.R b/R/data_type.R index faecca30..b6c9aedc 100644 --- a/R/data_type.R +++ b/R/data_type.R @@ -65,11 +65,13 @@ identify_data_type <- function(df, df[, record_id := .I] df[, type := NA_character_] + + sa_name <- gDRutils::get_experiment_groups("single-agent")[["single-agent"]] controls <- rowSums(df[, conc_ids, with = FALSE] == 0) == length(conc_ids) single_agent <- rowSums(df[, conc_ids, with = FALSE] != 0) == 1 df$type <- ifelse(controls, "control", - ifelse(single_agent, "single-agent", NA)) + ifelse(single_agent, sa_name, NA)) if (length(conc_ids) > 1) { @@ -81,7 +83,9 @@ identify_data_type <- function(df, ) conc_ratio <- conc_ratio[!names(conc_ratio) %in% c("Inf", "-Inf")] - type <- ifelse(length(conc_ratio) <= codilution_conc, "co-dilution", "matrix") + type <- ifelse(length(conc_ratio) <= codilution_conc, + gDRutils::get_experiment_groups("single-agent")[["co-dilution"]], + gDRutils::get_experiment_groups("combination")) df$type[missing_type_rows] <- type } df @@ -156,7 +160,10 @@ split_raw_data <- function(df, "drug_moa", "drug_moa2", "drug_moa3", "concentration", "concentration2", "concentration3"), simplify = FALSE) - ) + ) + + sa_name <- gDRutils::get_experiment_groups("single-agent")[["single-agent"]] + drug_ids <- drug_ids[which(drug_ids %in% names(df))] codrug_ids <- drug_ids[grep("[0-9]", names(drug_ids))] conc_idx <- drug_ids[grep("concentration", names(drug_ids))] @@ -167,7 +174,7 @@ split_raw_data <- function(df, types <- setdiff(names(df_list), "control") control <- df_list[["control"]] df_list[["control"]] <- NULL - cotrt_types <- setdiff(names(df_list), "single-agent") + cotrt_types <- setdiff(names(df_list), sa_name) control_sa_idx <- which( rowSums(df[, conc_idx, with = FALSE] == 0) == length(conc_idx) @@ -193,8 +200,8 @@ split_raw_data <- function(df, df_merged <- rbind( df_list[[x]], cotrt_matching[control, on = intersect(names(cotrt_matching), names(control))]) - if (x == "matrix") { - matrix_data <- rbind(df_merged, df_list[["single-agent"]]) + if (x == gDRutils::get_experiment_groups("combination")) { + matrix_data <- rbind(df_merged, df_list[[sa_name]]) for (j in conc_idx) data.table::set(matrix_data, which(is.na(matrix_data[[j]])), j, 0) for (j in codrug_drug_id) { @@ -207,10 +214,10 @@ split_raw_data <- function(df, }) } - if (any("single-agent" == names(df_list))) { + if (any(sa_name == names(df_list))) { sa_idx <- gDRutils::loop( grep(drug_ids[["concentration"]], drug_ids, value = TRUE), - function(x) which(!df_list[["single-agent"]][, x, with = FALSE] == 0) + function(x) which(!df_list[[sa_name]][, x, with = FALSE] == 0) ) sa_idx[["concentration"]] <- NULL @@ -221,15 +228,15 @@ split_raw_data <- function(df, value = TRUE ) selected_columns <- unname(drug_ids[c("drug_name", "drug", "drug_moa", "concentration")]) - df_list[["single-agent"]][sa_idx[[codrug]], selected_columns] <- - df_list[["single-agent"]][sa_idx[[codrug]], codrug_cols, with = FALSE] + df_list[[sa_name]][sa_idx[[codrug]], selected_columns] <- + df_list[[sa_name]][sa_idx[[codrug]], codrug_cols, with = FALSE] } - df_list[["single-agent"]][, codrug_ids] <- NULL + df_list[[sa_name]][, codrug_ids] <- NULL - selected_columns <- names(df_list[["single-agent"]]) + selected_columns <- names(df_list[[sa_name]]) - df_list[["single-agent"]] <- rbind( - df_list[["single-agent"]], + df_list[[sa_name]] <- rbind( + df_list[[sa_name]], control_sa[, selected_columns, with = FALSE] ) } diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index 21a3e7f4..16e2d8c2 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -21,7 +21,7 @@ #' @examples #' fmae_cms <- gDRutils::get_synthetic_data("finalMAE_combo_matrix_small") #' -#' se1 <- fmae_cms[["matrix"]] +#' se1 <- fmae_cms[[gDRutils::get_experiment_groups("combination")]] #' SummarizedExperiment::assays(se1) <- #' SummarizedExperiment::assays(se1)["Averaged"] #' fit_SE.combinations(se1[1, 1]) @@ -32,7 +32,7 @@ #' @export #' fit_SE.combinations <- function(se, - data_type = "matrix", + data_type = gDRutils::get_experiment_groups("combination"), series_identifiers = NULL, normalization_types = c("GR", "RV"), averaged_assay = "Averaged", @@ -74,10 +74,9 @@ fit_SE.combinations <- function(se, out <- gDRutils::loop(seq_len(nrow(iterator)), function(row) { - bliss_excess <- hsa_excess <- metrics <- all_iso_points <- - isobolograms <- smooth_mx <- NULL - bliss_score <- hsa_score <- CIScore_50 <- CIScore_80 <- - S4Vectors::DataFrame(normalization_type = normalization_types) + metrics <- all_iso_points <- isobolograms <- excess_full <- NULL + excess <- scores <- + data.table::data.table(normalization_type = normalization_types) x <- iterator[row, ] i <- x[["row"]] j <- x[["column"]] @@ -85,11 +84,8 @@ fit_SE.combinations <- function(se, avg_combo <- data.table::as.data.table(avg[avg[["row"]] == i & avg[["column"]] == j, ]) if (all(is.na(avg_combo[, -c("row", "column", "normalization_type")]))) { # omit masked values (all NAs) - smooth_mx <- hsa_excess <- bliss_excess <- isobolograms <- metrics <- - bliss_score[, c("row_id", "col_id")] <- - hsa_score[, c("row_id", "col_id")] <- - CIScore_50[, c("row_id", "col_id")] <- - CIScore_80[, c("row_id", "col_id")] <- + excess <- isobolograms <- metrics <- + scores[, c("row_id", "col_id")] <- all_iso_points <- data.table::data.table(row_id = i, col_id = j) return(list(bliss_excess = bliss_excess, @@ -242,16 +238,17 @@ fit_SE.combinations <- function(se, # store the values from the Averaged assay for reference complete_subset$av_values <- complete_subset$x # and replace by the Smoothed values - complete_subset$x <- rowMeans(mat, na.rm = TRUE) + complete_subset$mx <- rowMeans(mat, na.rm = TRUE) # just keep the relevant columns and change to the metric name - cols <- c(id, id2, "x") + cols <- c(id, id2, "mx") av_matrix <- complete_subset[, cols, with = FALSE] av_matrix[, "normalization_type" := norm_type] - av_matrix[get(id) == 0 & get(id2) == 0, x := 1] - + + av_matrix[get(id) == 0 & get(id2) == 0, mx := 1] if (NROW(av_matrix) == 0) { - av_matrix <- h_excess <- b_excess <- NULL + excess[excess$normalization_type == norm_type, + c("mx", "hsa_excess", "b_excess")] <- NA } else { sa1 <- av_matrix[get(id2) == 0, cols, with = FALSE] sa2 <- av_matrix[get(id) == 0, cols, with = FALSE] @@ -262,26 +259,28 @@ fit_SE.combinations <- function(se, av_matrix, series_identifiers = c(id, id2), metric_col = "metric", - measured_col = "x" + measured_col = "mx" ) - + data.table::setnames(h_excess, "x", "hsa_excess") bliss <- calculate_Bliss(sa1, id, sa2, id2, norm_type) b_excess <- calculate_excess( bliss, av_matrix, series_identifiers = c(id, id2), metric_col = "metric", - measured_col = "x" + measured_col = "mx" ) + data.table::setnames(b_excess, "x", "b_excess") + excess <- Reduce(function(x, y) merge(x, y, all = TRUE), list(av_matrix, h_excess, b_excess)) } # call calculate_Loewe and calculate_isobolograms: # remove rows/columns with less than 2 values discard_conc_1 <- names(which( - table(av_matrix[!is.na(x) & normalization_type == norm_type, id, with = FALSE]) < 3 + table(av_matrix[!is.na(mx) & normalization_type == norm_type, id, with = FALSE]) < 3 )) discard_conc_2 <- names(which( - table(av_matrix[!is.na(x) & normalization_type == norm_type, id2, with = FALSE]) < 3 + table(av_matrix[!is.na(mx) & normalization_type == norm_type, id2, with = FALSE]) < 3 )) av_matrix_dense <- av_matrix[ !(av_matrix[[id]] %in% discard_conc_1) & @@ -306,40 +305,40 @@ fit_SE.combinations <- function(se, # average the top 10-percentile excess to get a single value # for the excess - hsa_score[hsa_score$normalization_type == norm_type, "x"] <- ifelse( + scores[scores$normalization_type == norm_type, "hsa_score"] <- ifelse( is.null(h_excess), NA, mean( - h_excess$x[ - h_excess$x >= - stats::quantile(h_excess$x, 0.9, na.rm = TRUE) + h_excess$hsa_excess[ + h_excess$hsa_excess >= + stats::quantile(h_excess$hsa_excess, 0.9, na.rm = TRUE) ], na.rm = TRUE ) ) - bliss_score[bliss_score$normalization_type == norm_type, "x"] <- ifelse( + scores[scores$normalization_type == norm_type, "bliss_score"] <- ifelse( is.null(b_excess), NA, mean( - b_excess$x[ - b_excess$x >= - stats::quantile(b_excess$x, 0.9, na.rm = TRUE) + b_excess$b_excess[ + b_excess$b_excess >= + stats::quantile(b_excess$b_excess, 0.9, na.rm = TRUE) ], na.rm = TRUE ) ) if (all(vapply(isobologram_out, function(x) is.null(x) || all(is.na(x)), logical(1)))) { - CIScore_50[CIScore_50$normalization_type == norm_type, "x"] <- - CIScore_80[CIScore_80$normalization_type == norm_type, "x"] <- NA + scores[scores$normalization_type == norm_type, "CIScore_50"] <- + scores[scores$normalization_type == norm_type, "CIScore_80"] <- NA } else { - CIScore_50[CIScore_50$normalization_type == norm_type, "x"] <- + scores[scores$normalization_type == norm_type, "CIScore_50"] <- isobologram_out$df_all_AUC_log2CI$CI_100x[ isobologram_out$df_all_AUC_log2CI$iso_level == min(isobologram_out$df_all_AUC_log2CI$iso_level[ isobologram_out$df_all_AUC_log2CI$iso_level >= 0.5 ])] - CIScore_80[CIScore_80$normalization_type == norm_type, "x"] <- + scores[scores$normalization_type == norm_type, "CIScore_80"] <- isobologram_out$df_all_AUC_log2CI$CI_100x[ isobologram_out$df_all_AUC_log2CI$iso_level == min(isobologram_out$df_all_AUC_log2CI$iso_level[ @@ -347,38 +346,23 @@ fit_SE.combinations <- function(se, ])] } - b_excess$row_id <- av_matrix$row_id <- h_excess$row_id <- + excess$row_id <- isobologram_out$df_all_iso_points$row_id <- isobologram_out$df_all_iso_curves$row_id <- col_fittings$row_id <- - hsa_score[, "row_id"] <- bliss_score[, "row_id"] <- - CIScore_50[, "row_id"] <- - CIScore_80[, "row_id"] <- metrics_merged$row_id <- i - b_excess$col_id <- - av_matrix$col_id <- - h_excess$col_id <- isobologram_out$df_all_iso_points$col_id <- + scores$row_id <- + metrics_merged$row_id <- i + excess$col_id <- + isobologram_out$df_all_iso_points$col_id <- isobologram_out$df_all_iso_curves$col_id <- col_fittings$col_id <- - hsa_score[, "col_id"] <- bliss_score[, "col_id"] <- - CIScore_50[, "col_id"] <- - CIScore_80[, "col_id"] <- metrics_merged$col_id <- j + scores$col_id <- + metrics_merged$col_id <- j - b_excess$normalization_type <- h_excess$normalization_type <- - isobologram_out$df_all_iso_points$normalization_type <- - isobologram_out$df_all_iso_curves$normalization_type <- norm_type + isobologram_out$df_all_iso_points$normalization_type <- + isobologram_out$df_all_iso_curves$normalization_type <- norm_type - hsa_excess <- data.table::rbindlist(list(hsa_excess, - h_excess), fill = TRUE) - bliss_excess <- data.table::rbindlist(list(bliss_excess, - b_excess), fill = TRUE) # check if it does not contain only ids - - if (!is.null(smooth_mx) && ncol(smooth_mx) != 2) { - smooth_mx <- data.table::rbindlist(list(smooth_mx, av_matrix), fill = TRUE) - } else { - smooth_mx <- av_matrix - } - if (is.null(all_iso_points)) { all_iso_points <- isobologram_out$df_all_iso_points } else { @@ -398,50 +382,31 @@ fit_SE.combinations <- function(se, } metrics <- data.table::rbindlist(list(metrics, metrics_merged), fill = TRUE) + excess_full <- data.table::rbindlist(list(excess_full, excess), fill = TRUE) } - list(bliss_excess = bliss_excess, - hsa_excess = hsa_excess, - metrics = metrics, + list(metrics = metrics, all_iso_points = all_iso_points, isobolograms = isobolograms, - smooth_mx = smooth_mx, - bliss_score = bliss_score, - hsa_score = hsa_score, - CIScore_50 = CIScore_50, - CIScore_80 = CIScore_80) + excess = excess, + scores = scores) }) - all_smooth_mx <- rbindParallelList(out, "smooth_mx") - all_hsa_excess <- rbindParallelList(out, "hsa_excess") - all_b_excess <- rbindParallelList(out, "bliss_excess") + excess <- rbindParallelList(out, "excess") all_iso_points <- rbindParallelList(out, "all_iso_points") all_isobolograms <- rbindParallelList(out, "isobolograms") all_metrics <- rbindParallelList(out, "metrics") + scores <- rbindParallelList(out, "scores") + - bliss_score <- rbindParallelList(out, "bliss_score") - hsa_score <- rbindParallelList(out, "hsa_score") - CIScore_50 <- rbindParallelList(out, "CIScore_50") - CIScore_80 <- rbindParallelList(out, "CIScore_80") - - SummarizedExperiment::assays(se)[["SmoothMatrix"]] <- - convertDFtoBumpyMatrixUsingIds(all_smooth_mx) - SummarizedExperiment::assays(se)[["BlissExcess"]] <- - convertDFtoBumpyMatrixUsingIds(all_b_excess) - SummarizedExperiment::assays(se)[["HSAExcess"]] <- - convertDFtoBumpyMatrixUsingIds(all_hsa_excess) + SummarizedExperiment::assays(se)[["excess"]] <- + convertDFtoBumpyMatrixUsingIds(excess) SummarizedExperiment::assays(se)[["all_iso_points"]] <- convertDFtoBumpyMatrixUsingIds(all_iso_points) SummarizedExperiment::assays(se)[["isobolograms"]] <- convertDFtoBumpyMatrixUsingIds(all_isobolograms) - SummarizedExperiment::assays(se)[["BlissScore"]] <- - convertDFtoBumpyMatrixUsingIds(bliss_score) - SummarizedExperiment::assays(se)[["HSAScore"]] <- - convertDFtoBumpyMatrixUsingIds(hsa_score) - SummarizedExperiment::assays(se)[["CIScore_50"]] <- - convertDFtoBumpyMatrixUsingIds(CIScore_50) - SummarizedExperiment::assays(se)[["CIScore_80"]] <- - convertDFtoBumpyMatrixUsingIds(CIScore_80) + SummarizedExperiment::assays(se)[["scores"]] <- + convertDFtoBumpyMatrixUsingIds(scores) SummarizedExperiment::assays(se)[[metrics_assay]] <- convertDFtoBumpyMatrixUsingIds(all_metrics) diff --git a/R/runDrugResponseProcessingPipeline.R b/R/runDrugResponseProcessingPipeline.R index d1396735..91808d49 100644 --- a/R/runDrugResponseProcessingPipeline.R +++ b/R/runDrugResponseProcessingPipeline.R @@ -343,7 +343,7 @@ runDrugResponseProcessingPipeline <- function(x, ) # 4th step - Fit SE - if (data_type == "matrix") { + if (data_type == gDRutils::get_experiment_groups("combination")) { step_args <- list( se = se$result, data_type = data_type, diff --git a/R/utils.R b/R/utils.R index 8211a9ff..7bb5b6f9 100755 --- a/R/utils.R +++ b/R/utils.R @@ -208,9 +208,8 @@ data_model.data.table <- function(x) { get_data_type_to_data_model_mapping <- function() { c( `single-agent` = "single-agent", - "cotreatment" = "single-agent", "co-dilution" = "single-agent", - "matrix" = "combination" + "combination" = "combination" ) } From 19b7cdb329c44c4a861c72b39c9e333e219b91ef Mon Sep 17 00:00:00 2001 From: czechb3 Date: Wed, 3 Jan 2024 13:20:44 +0100 Subject: [PATCH 02/19] reoxygenate --- man/calculate_matrix_metric.Rd | 12 ++++++++++-- man/fit_SE.combinations.Rd | 4 ++-- man/map_untreated.Rd | 20 ++++++++++++++++++++ 3 files changed, 32 insertions(+), 4 deletions(-) create mode 100644 man/map_untreated.Rd diff --git a/man/calculate_matrix_metric.Rd b/man/calculate_matrix_metric.Rd index ac8b06af..ee477dc0 100644 --- a/man/calculate_matrix_metric.Rd +++ b/man/calculate_matrix_metric.Rd @@ -9,9 +9,17 @@ \usage{ calculate_HSA(sa1, series_id1, sa2, series_id2, metric) -calculate_Bliss(sa1, series_id1, sa2, series_id2, metric) +calculate_Bliss(sa1, series_id1, sa2, series_id2, metric, measured_col = "mx") -.calculate_matrix_metric(sa1, series_id1, sa2, series_id2, metric, FXN) +.calculate_matrix_metric( + sa1, + series_id1, + sa2, + series_id2, + metric, + FXN, + measured_col = "x" +) } \arguments{ \item{sa1}{data.table containing single agent data where entries in diff --git a/man/fit_SE.combinations.Rd b/man/fit_SE.combinations.Rd index 46a2a299..5f10f1f9 100644 --- a/man/fit_SE.combinations.Rd +++ b/man/fit_SE.combinations.Rd @@ -6,7 +6,7 @@ \usage{ fit_SE.combinations( se, - data_type = "matrix", + data_type = gDRutils::get_experiment_groups("combination"), series_identifiers = NULL, normalization_types = c("GR", "RV"), averaged_assay = "Averaged", @@ -46,7 +46,7 @@ concentrations nested in the assay. \examples{ fmae_cms <- gDRutils::get_synthetic_data("finalMAE_combo_matrix_small") -se1 <- fmae_cms[["matrix"]] +se1 <- fmae_cms[[gDRutils::get_experiment_groups("combination")]] SummarizedExperiment::assays(se1) <- SummarizedExperiment::assays(se1)["Averaged"] fit_SE.combinations(se1[1, 1]) diff --git a/man/map_untreated.Rd b/man/map_untreated.Rd new file mode 100644 index 00000000..6b91504b --- /dev/null +++ b/man/map_untreated.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map_df.R +\name{map_untreated} +\alias{map_untreated} +\title{Identify untreated rows based on Drug treatment alone} +\usage{ +map_untreated(mat_elem) +} +\arguments{ +\item{mat_elem}{input data frame} +} +\value{ +list +} +\description{ +Identify untreated rows based on Drug treatment alone +} +\details{ +Using the given rownames, map the untreated conditions +} From 7d42f8212fed5cd68243037b79e31639f9a286ae Mon Sep 17 00:00:00 2001 From: czechb3 Date: Wed, 3 Jan 2024 13:21:02 +0100 Subject: [PATCH 03/19] refactor: update unit test --- tests/testthat/test-data_type.R | 3 ++- tests/testthat/test-fit_SE.R | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-data_type.R b/tests/testthat/test-data_type.R index 731755d3..16a122d6 100644 --- a/tests/testthat/test-data_type.R +++ b/tests/testthat/test-data_type.R @@ -25,7 +25,8 @@ test_that("identify_data_type and split_raw_data works as expected", { df_list <- split_raw_data(df) expect_true(inherits(df_list, "list")) - expect_true(all(names(df_list) %in% c("matrix", "single-agent"))) + expect_true(all(names(df_list) %in% c(gDRutils::get_experiment_groups("combination"), + gDRutils::get_experiment_groups("single-agent")[["single-agent"]]))) df2 <- data.table::data.table(Gnumber = c(rep("DrugA", 9), "DrugB"), diff --git a/tests/testthat/test-fit_SE.R b/tests/testthat/test-fit_SE.R index 186e7c24..b61376d1 100644 --- a/tests/testthat/test-fit_SE.R +++ b/tests/testthat/test-fit_SE.R @@ -50,7 +50,7 @@ test_that("fit_SE.combinations works as expected", { # combo data fmae_cms <- gDRutils::get_synthetic_data("finalMAE_combo_matrix_small") - se1 <- fmae_cms[["matrix"]] + se1 <- fmae_cms[[gDRutils::get_experiment_groups("combination")]] SummarizedExperiment::assays(se1) <- SummarizedExperiment::assays(se1)["Averaged"] new_se1 <- purrr::quietly(fit_SE.combinations)(se1[1, 1]) From b5f8af4069d242d73b4f1801cb96c05c3b19345c Mon Sep 17 00:00:00 2001 From: czechb3 Date: Wed, 3 Jan 2024 13:21:14 +0100 Subject: [PATCH 04/19] chore: bump version and update NEWS.md --- DESCRIPTION | 4 ++-- NEWS.md | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3dd6aaeb..fc345b5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Type: Package Package: gDRcore Title: Processing functions and interface to process and analyze drug dose-response data -Version: 1.1.2 -Date: 2023-12-15 +Version: 1.1.3 +Date: 2024-01-03 Authors@R: c( person("Bartosz", "Czech", , "bartosz.czech@contractors.roche.com", role = "aut"), person("Arkadiusz", "Gladki", role=c("cre", "aut"), email="gladki.arkadiusz@gmail.com"), diff --git a/NEWS.md b/NEWS.md index 0a0fe091..03feee31 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +## 1.1.3 (2024-01-03) +- simplify logic of assays for combination data +- rename `matrix` into `combination` + ## 1.1.2 (2023-12-15) - fix issue with wrong assignment of `untreated` records From 3f0f39db92fa2c7117d2cca776e30b839002aea0 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 4 Jan 2024 08:57:30 +0100 Subject: [PATCH 05/19] test: fix unit tests --- ...est-combinations-calculate_matrix_metric.R | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-combinations-calculate_matrix_metric.R b/tests/testthat/test-combinations-calculate_matrix_metric.R index 12633ca6..e3ac4fac 100644 --- a/tests/testthat/test-combinations-calculate_matrix_metric.R +++ b/tests/testthat/test-combinations-calculate_matrix_metric.R @@ -1,30 +1,30 @@ test_that("calculate_HSA works as expected", { n <- 10 - sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), x = seq(n)) - sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), x = seq(n)) - hsa <- calculate_HSA(sa1, "conc", sa2, "conc2", "x") + sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) + sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) + hsa <- calculate_HSA(sa1, "conc", sa2, "conc2", "mx") expect_equal(dim(hsa), c(100, 5)) }) test_that("calculate_Bliss works as expected", { n <- 10 - sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), x = seq(n)) - sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), x = seq(n)) - bliss <- calculate_Bliss(sa1, "conc", sa2, "conc2", "x") + sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) + sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) + bliss <- calculate_Bliss(sa1, "conc", sa2, "conc2", "mx") expect_equal(dim(bliss), c(100, 5)) }) test_that(".calculate_matrix_metric works as expected", { n <- 10 - sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), x = seq(n)) - sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), x = seq(n)) - obs <- gDRcore:::.calculate_matrix_metric(sa1, series_id1 = "conc", sa2, series_id2 = "conc2", "x", sum) + sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) + sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) + obs <- gDRcore:::.calculate_matrix_metric(sa1, series_id1 = "conc", sa2, series_id2 = "conc2", "mx", sum, measured_col = "mx") expect_equal(dim(obs), c(n ^ 2, 5)) # Validates data. temp1 <- sa2 temp2 <- sa1 expect_error( - gDRcore:::.calculate_matrix_metric(temp1, series_id1 = "conc", temp2, series_id2 = "conc2", "x", sum) + gDRcore:::.calculate_matrix_metric(temp1, series_id1 = "conc", temp2, series_id2 = "conc2", "mx", sum, measured_col = "mx") ) }) From d49b0b46413921b7b02e6e1c074bb8ca196046ed Mon Sep 17 00:00:00 2001 From: czechb3 Date: Fri, 12 Jan 2024 15:11:17 +0100 Subject: [PATCH 06/19] fix: bug with wrong excess taken into assay --- R/fit_SE.combinations.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index 16e2d8c2..ca1d2d50 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -387,7 +387,7 @@ fit_SE.combinations <- function(se, list(metrics = metrics, all_iso_points = all_iso_points, isobolograms = isobolograms, - excess = excess, + excess = excess_full, scores = scores) }) From 803d8bfac2ede1ec537aad57c341d47bee0773ac Mon Sep 17 00:00:00 2001 From: czechb3 Date: Wed, 17 Jan 2024 11:47:49 +0100 Subject: [PATCH 07/19] refactor: appease lintr --- tests/testthat/test-combinations-calculate_matrix_metric.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-combinations-calculate_matrix_metric.R b/tests/testthat/test-combinations-calculate_matrix_metric.R index e3ac4fac..e27b16fe 100644 --- a/tests/testthat/test-combinations-calculate_matrix_metric.R +++ b/tests/testthat/test-combinations-calculate_matrix_metric.R @@ -18,7 +18,8 @@ test_that(".calculate_matrix_metric works as expected", { n <- 10 sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) - obs <- gDRcore:::.calculate_matrix_metric(sa1, series_id1 = "conc", sa2, series_id2 = "conc2", "mx", sum, measured_col = "mx") + obs <- gDRcore:::.calculate_matrix_metric(sa1, series_id1 = "conc", sa2, series_id2 = "conc2", + "mx", sum, measured_col = "mx") expect_equal(dim(obs), c(n ^ 2, 5)) # Validates data. From d90bd8f9b2b274abb8b8b67eb46c512d437646bf Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 18 Jan 2024 11:44:59 +0100 Subject: [PATCH 08/19] refactor: appease lintr --- tests/testthat/test-combinations-calculate_matrix_metric.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-combinations-calculate_matrix_metric.R b/tests/testthat/test-combinations-calculate_matrix_metric.R index e27b16fe..a0430b3a 100644 --- a/tests/testthat/test-combinations-calculate_matrix_metric.R +++ b/tests/testthat/test-combinations-calculate_matrix_metric.R @@ -26,6 +26,7 @@ test_that(".calculate_matrix_metric works as expected", { temp1 <- sa2 temp2 <- sa1 expect_error( - gDRcore:::.calculate_matrix_metric(temp1, series_id1 = "conc", temp2, series_id2 = "conc2", "mx", sum, measured_col = "mx") + gDRcore:::.calculate_matrix_metric(temp1, series_id1 = "conc", temp2, + series_id2 = "conc2", "mx", sum, measured_col = "mx") ) }) From ec508479a298a0fbe1ae2519638775aa8cccd01f Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 18 Jan 2024 13:30:07 +0100 Subject: [PATCH 09/19] refactor: update unit tests --- tests/testthat/test-fit_SE.R | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-fit_SE.R b/tests/testthat/test-fit_SE.R index b61376d1..33ee8516 100644 --- a/tests/testthat/test-fit_SE.R +++ b/tests/testthat/test-fit_SE.R @@ -55,19 +55,8 @@ test_that("fit_SE.combinations works as expected", { new_se1 <- purrr::quietly(fit_SE.combinations)(se1[1, 1]) exp_as <- - c( - "Averaged", - "SmoothMatrix", - "BlissExcess", - "HSAExcess", - "all_iso_points", - "isobolograms", - "BlissScore", - "HSAScore", - "CIScore_50", - "CIScore_80", - "Metrics" - ) + c("Averaged", "excess", "all_iso_points", "isobolograms", "scores", + "Metrics") expect_equal(SummarizedExperiment::assayNames(new_se1$result), exp_as) aip_df <- From 72d26b4ca43fa58d7f8b210b5fcfac857cb9f3de Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 18 Jan 2024 15:50:30 +0100 Subject: [PATCH 10/19] refactor: update field names --- R/fit_SE.combinations.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index ca1d2d50..b7b8a303 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -241,14 +241,14 @@ fit_SE.combinations <- function(se, complete_subset$mx <- rowMeans(mat, na.rm = TRUE) # just keep the relevant columns and change to the metric name - cols <- c(id, id2, "mx") + cols <- c(id, id2, "smooth") av_matrix <- complete_subset[, cols, with = FALSE] av_matrix[, "normalization_type" := norm_type] av_matrix[get(id) == 0 & get(id2) == 0, mx := 1] if (NROW(av_matrix) == 0) { excess[excess$normalization_type == norm_type, - c("mx", "hsa_excess", "b_excess")] <- NA + c("smooth", "hsa_excess", "bliss_excess")] <- NA } else { sa1 <- av_matrix[get(id2) == 0, cols, with = FALSE] sa2 <- av_matrix[get(id) == 0, cols, with = FALSE] @@ -259,19 +259,19 @@ fit_SE.combinations <- function(se, av_matrix, series_identifiers = c(id, id2), metric_col = "metric", - measured_col = "mx" + measured_col = "smooth" ) data.table::setnames(h_excess, "x", "hsa_excess") bliss <- calculate_Bliss(sa1, id, sa2, id2, norm_type) - b_excess <- calculate_excess( + bliss_excess <- calculate_excess( bliss, av_matrix, series_identifiers = c(id, id2), metric_col = "metric", - measured_col = "mx" + measured_col = "smooth" ) - data.table::setnames(b_excess, "x", "b_excess") - excess <- Reduce(function(x, y) merge(x, y, all = TRUE), list(av_matrix, h_excess, b_excess)) + data.table::setnames(bliss_excess, "x", "bliss_excess") + excess <- Reduce(function(x, y) merge(x, y, all = TRUE), list(av_matrix, h_excess, bliss_excess)) } # call calculate_Loewe and calculate_isobolograms: @@ -317,12 +317,12 @@ fit_SE.combinations <- function(se, ) ) scores[scores$normalization_type == norm_type, "bliss_score"] <- ifelse( - is.null(b_excess), + is.null(bliss_excess), NA, mean( - b_excess$b_excess[ - b_excess$b_excess >= - stats::quantile(b_excess$b_excess, 0.9, na.rm = TRUE) + bliss_excess$bliss_excess[ + bliss_excess$bliss_excess >= + stats::quantile(bliss_excess$bliss_excess, 0.9, na.rm = TRUE) ], na.rm = TRUE ) From 6956f29b2978417760b3a0f2620dc7b349d0eca4 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 18 Jan 2024 16:10:53 +0100 Subject: [PATCH 11/19] refactor: switch from mx to smooth --- R/combinations-calculate_matrix_metric.R | 4 ++-- R/combinations-isobolograms.R | 4 ++-- R/fit_SE.combinations.R | 23 +++++++------------ man/calculate_matrix_metric.Rd | 9 +++++++- ...est-combinations-calculate_matrix_metric.R | 20 ++++++++-------- 5 files changed, 30 insertions(+), 30 deletions(-) diff --git a/R/combinations-calculate_matrix_metric.R b/R/combinations-calculate_matrix_metric.R index a71b7b57..ba524fa8 100644 --- a/R/combinations-calculate_matrix_metric.R +++ b/R/combinations-calculate_matrix_metric.R @@ -45,7 +45,7 @@ calculate_HSA <- function(sa1, series_id1, sa2, series_id2, metric) { series_id2, metric, FXN = pmin, - measured_col = "mx") + measured_col = "smooth") } @@ -61,7 +61,7 @@ calculate_Bliss <- function(sa1, sa2, series_id2, metric, - measured_col = "mx") { + measured_col = "smooth") { if (metric %in% c("GRvalue", "GR")) { lambda <- function(x, y) { ifelse(x < 0 | y < 0, diff --git a/R/combinations-isobolograms.R b/R/combinations-isobolograms.R index 682a4fde..49440447 100644 --- a/R/combinations-isobolograms.R +++ b/R/combinations-isobolograms.R @@ -338,7 +338,7 @@ calculate_Loewe <- function( get_isocutoffs <- function(df_mean, normalization_type) { - if (min(df_mean[normalization_type == normalization_type, mx], na.rm = TRUE) > 0.7) { + if (min(df_mean[normalization_type == normalization_type, smooth], na.rm = TRUE) > 0.7) { iso_cutoffs <- NULL } else { if (normalization_type == "GR") { @@ -350,7 +350,7 @@ get_isocutoffs <- function(df_mean, normalization_type) { max( max_val, ceiling( - 20 * min(df_mean[normalization_type == normalization_type, mx] + 0.08, na.rm = TRUE) + 20 * min(df_mean[normalization_type == normalization_type, smooth] + 0.08, na.rm = TRUE) ) / 20 ), 0.8, diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index b7b8a303..e5d0ae41 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -74,7 +74,7 @@ fit_SE.combinations <- function(se, out <- gDRutils::loop(seq_len(nrow(iterator)), function(row) { - metrics <- all_iso_points <- isobolograms <- excess_full <- NULL + metrics <- all_iso_points <- isobolograms <- NULL excess <- scores <- data.table::data.table(normalization_type = normalization_types) x <- iterator[row, ] @@ -84,20 +84,13 @@ fit_SE.combinations <- function(se, avg_combo <- data.table::as.data.table(avg[avg[["row"]] == i & avg[["column"]] == j, ]) if (all(is.na(avg_combo[, -c("row", "column", "normalization_type")]))) { # omit masked values (all NAs) - excess <- isobolograms <- metrics <- - scores[, c("row_id", "col_id")] <- - all_iso_points <- + excess <- isobolograms <- metrics <- scores <- all_iso_points <- data.table::data.table(row_id = i, col_id = j) - return(list(bliss_excess = bliss_excess, - hsa_excess = hsa_excess, + return(list(excess = excess, metrics = metrics, all_iso_points = all_iso_points, isobolograms = isobolograms, - smooth_mx = smooth_mx, - bliss_score = bliss_score, - hsa_score = hsa_score, - CIScore_50 = CIScore_50, - CIScore_80 = CIScore_80)) + scores = scores)) } conc_map <- map_conc_to_standardized_conc(avg_combo[[id]], avg_combo[[id2]]) @@ -238,14 +231,14 @@ fit_SE.combinations <- function(se, # store the values from the Averaged assay for reference complete_subset$av_values <- complete_subset$x # and replace by the Smoothed values - complete_subset$mx <- rowMeans(mat, na.rm = TRUE) + complete_subset$smooth <- rowMeans(mat, na.rm = TRUE) # just keep the relevant columns and change to the metric name cols <- c(id, id2, "smooth") av_matrix <- complete_subset[, cols, with = FALSE] av_matrix[, "normalization_type" := norm_type] - av_matrix[get(id) == 0 & get(id2) == 0, mx := 1] + av_matrix[get(id) == 0 & get(id2) == 0, smooth := 1] if (NROW(av_matrix) == 0) { excess[excess$normalization_type == norm_type, c("smooth", "hsa_excess", "bliss_excess")] <- NA @@ -277,10 +270,10 @@ fit_SE.combinations <- function(se, # call calculate_Loewe and calculate_isobolograms: # remove rows/columns with less than 2 values discard_conc_1 <- names(which( - table(av_matrix[!is.na(mx) & normalization_type == norm_type, id, with = FALSE]) < 3 + table(av_matrix[!is.na(smooth) & normalization_type == norm_type, id, with = FALSE]) < 3 )) discard_conc_2 <- names(which( - table(av_matrix[!is.na(mx) & normalization_type == norm_type, id2, with = FALSE]) < 3 + table(av_matrix[!is.na(smooth) & normalization_type == norm_type, id2, with = FALSE]) < 3 )) av_matrix_dense <- av_matrix[ !(av_matrix[[id]] %in% discard_conc_1) & diff --git a/man/calculate_matrix_metric.Rd b/man/calculate_matrix_metric.Rd index ee477dc0..46c1ee56 100644 --- a/man/calculate_matrix_metric.Rd +++ b/man/calculate_matrix_metric.Rd @@ -9,7 +9,14 @@ \usage{ calculate_HSA(sa1, series_id1, sa2, series_id2, metric) -calculate_Bliss(sa1, series_id1, sa2, series_id2, metric, measured_col = "mx") +calculate_Bliss( + sa1, + series_id1, + sa2, + series_id2, + metric, + measured_col = "smooth" +) .calculate_matrix_metric( sa1, diff --git a/tests/testthat/test-combinations-calculate_matrix_metric.R b/tests/testthat/test-combinations-calculate_matrix_metric.R index a0430b3a..8333c705 100644 --- a/tests/testthat/test-combinations-calculate_matrix_metric.R +++ b/tests/testthat/test-combinations-calculate_matrix_metric.R @@ -1,25 +1,25 @@ test_that("calculate_HSA works as expected", { n <- 10 - sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) - sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) - hsa <- calculate_HSA(sa1, "conc", sa2, "conc2", "mx") + sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), smooth = seq(n)) + sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), smooth = seq(n)) + hsa <- calculate_HSA(sa1, "conc", sa2, "conc2", "smooth") expect_equal(dim(hsa), c(100, 5)) }) test_that("calculate_Bliss works as expected", { n <- 10 - sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) - sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) - bliss <- calculate_Bliss(sa1, "conc", sa2, "conc2", "mx") + sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), smooth = seq(n)) + sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), smooth = seq(n)) + bliss <- calculate_Bliss(sa1, "conc", sa2, "conc2", "smooth") expect_equal(dim(bliss), c(100, 5)) }) test_that(".calculate_matrix_metric works as expected", { n <- 10 - sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), mx = seq(n)) - sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), mx = seq(n)) + sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), smooth = seq(n)) + sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), smooth = seq(n)) obs <- gDRcore:::.calculate_matrix_metric(sa1, series_id1 = "conc", sa2, series_id2 = "conc2", - "mx", sum, measured_col = "mx") + "smooth", sum, measured_col = "smooth") expect_equal(dim(obs), c(n ^ 2, 5)) # Validates data. @@ -27,6 +27,6 @@ test_that(".calculate_matrix_metric works as expected", { temp2 <- sa1 expect_error( gDRcore:::.calculate_matrix_metric(temp1, series_id1 = "conc", temp2, - series_id2 = "conc2", "mx", sum, measured_col = "mx") + series_id2 = "conc2", "smooth", sum, measured_col = "smooth") ) }) From 082361033625c75fbd844586ed63a1e12ad59717 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Fri, 19 Jan 2024 11:49:58 +0100 Subject: [PATCH 12/19] refactor: update variable names --- R/fit_SE.combinations.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index e5d0ae41..e4c38f58 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -74,7 +74,7 @@ fit_SE.combinations <- function(se, out <- gDRutils::loop(seq_len(nrow(iterator)), function(row) { - metrics <- all_iso_points <- isobolograms <- NULL + metrics <- all_iso_points <- isobolograms <- excess_full <- NULL excess <- scores <- data.table::data.table(normalization_type = normalization_types) x <- iterator[row, ] From 032f9e59d9c588c964177e32c31424a55614d73c Mon Sep 17 00:00:00 2001 From: czechb3 Date: Fri, 19 Jan 2024 14:29:48 +0100 Subject: [PATCH 13/19] refactor: add missing var --- R/packages.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/packages.R b/R/packages.R index 7a3887ba..c41cb635 100644 --- a/R/packages.R +++ b/R/packages.R @@ -45,7 +45,8 @@ if (getRversion() >= "2.15.1") { "Duration", "isDay0", "record_id", - "ratio" + "ratio", + "smooth" ), utils::packageName()) } From acb229691ed385dc468b9254a233337a004157d3 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Fri, 19 Jan 2024 16:57:42 +0100 Subject: [PATCH 14/19] reoxygenate --- R/combinations-calculate_matrix_metric.R | 4 ++-- man/calculate_matrix_metric.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/combinations-calculate_matrix_metric.R b/R/combinations-calculate_matrix_metric.R index ba524fa8..e4d30009 100644 --- a/R/combinations-calculate_matrix_metric.R +++ b/R/combinations-calculate_matrix_metric.R @@ -34,8 +34,8 @@ NULL #' @rdname calculate_matrix_metric #' @examples #' n <- 10 -#' sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), x = seq(n)) -#' sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), x = seq(n)) +#' sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), smooth = seq(n)) +#' sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), smooth = seq(n)) #' calculate_HSA(sa1, "conc", sa2, "conc2", "x") #' @export calculate_HSA <- function(sa1, series_id1, sa2, series_id2, metric) { diff --git a/man/calculate_matrix_metric.Rd b/man/calculate_matrix_metric.Rd index 46c1ee56..c80dc357 100644 --- a/man/calculate_matrix_metric.Rd +++ b/man/calculate_matrix_metric.Rd @@ -66,8 +66,8 @@ for more details. } \examples{ n <- 10 -sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), x = seq(n)) -sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), x = seq(n)) +sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), smooth = seq(n)) +sa2 <- data.table::data.table(conc = rep(0, n), conc2 = seq(n), smooth = seq(n)) calculate_HSA(sa1, "conc", sa2, "conc2", "x") n <- 10 sa1 <- data.table::data.table(conc = seq(n), conc2 = rep(0, n), x = seq(n)) From 062b0a6b4aabdf7a5020b541888620a66f79a553 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Mon, 29 Jan 2024 15:13:05 +0100 Subject: [PATCH 15/19] refactor: add unique for calculating scores --- R/fit_SE.combinations.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index e4c38f58..267b981d 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -73,6 +73,7 @@ fit_SE.combinations <- function(se, iterator <- unique(avg[, c("column", "row")]) out <- gDRutils::loop(seq_len(nrow(iterator)), function(row) { + print(row) metrics <- all_iso_points <- isobolograms <- excess_full <- NULL excess <- scores <- @@ -135,6 +136,7 @@ fit_SE.combinations <- function(se, for (norm_type in normalization_types) { + print(norm_type) avg_combo <- data.table::as.data.table(avg_combo) avg_subset <- avg_combo[normalization_type == norm_type] @@ -326,17 +328,17 @@ fit_SE.combinations <- function(se, scores[scores$normalization_type == norm_type, "CIScore_80"] <- NA } else { scores[scores$normalization_type == norm_type, "CIScore_50"] <- - isobologram_out$df_all_AUC_log2CI$CI_100x[ + unique(isobologram_out$df_all_AUC_log2CI$CI_100x[ isobologram_out$df_all_AUC_log2CI$iso_level == min(isobologram_out$df_all_AUC_log2CI$iso_level[ isobologram_out$df_all_AUC_log2CI$iso_level >= 0.5 - ])] + ])]) scores[scores$normalization_type == norm_type, "CIScore_80"] <- - isobologram_out$df_all_AUC_log2CI$CI_100x[ + unique(isobologram_out$df_all_AUC_log2CI$CI_100x[ isobologram_out$df_all_AUC_log2CI$iso_level == min(isobologram_out$df_all_AUC_log2CI$iso_level[ isobologram_out$df_all_AUC_log2CI$iso_level >= 0.2 - ])] + ])]) } excess$row_id <- From da81958e5db8c0fefbe326ed2045825f5242d571 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Mon, 29 Jan 2024 15:13:27 +0100 Subject: [PATCH 16/19] chore: remove browser --- R/fit_SE.combinations.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/fit_SE.combinations.R b/R/fit_SE.combinations.R index 267b981d..9ce530ba 100644 --- a/R/fit_SE.combinations.R +++ b/R/fit_SE.combinations.R @@ -73,7 +73,6 @@ fit_SE.combinations <- function(se, iterator <- unique(avg[, c("column", "row")]) out <- gDRutils::loop(seq_len(nrow(iterator)), function(row) { - print(row) metrics <- all_iso_points <- isobolograms <- excess_full <- NULL excess <- scores <- @@ -136,7 +135,6 @@ fit_SE.combinations <- function(se, for (norm_type in normalization_types) { - print(norm_type) avg_combo <- data.table::as.data.table(avg_combo) avg_subset <- avg_combo[normalization_type == norm_type] From ca27b274eddc22fbf97d799f98e9cca4378b49f8 Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 1 Feb 2024 10:48:09 +0100 Subject: [PATCH 17/19] ci: trigger build From cd140943ad128a5c78a7c4eb976f0462e7511a3c Mon Sep 17 00:00:00 2001 From: czechb3 Date: Wed, 7 Feb 2024 19:15:24 +0100 Subject: [PATCH 18/19] fix: conflict leftovers --- DESCRIPTION | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a36fb26..202137ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,11 +25,7 @@ Imports: BiocParallel, checkmate, futile.logger, -<<<<<<< HEAD gDRutils (>= 1.1.3), -======= - gDRutils (>= 1.1.3), ->>>>>>> master MultiAssayExperiment, purrr, stringr, @@ -38,15 +34,9 @@ Imports: data.table Suggests: BiocStyle, -<<<<<<< HEAD - gDRstyle (>= 1.1.1), - gDRimport (>= 1.1.4), - gDRtestData (>= 1.1.3), -======= gDRstyle (>= 1.1.2), gDRimport (>= 1.1.4), gDRtestData (>= 1.1.6), ->>>>>>> master IRanges, knitr, pkgbuild, From 83749feb67c0d73a9c87a0c56e3a5c5d5ab2c6cc Mon Sep 17 00:00:00 2001 From: czechb3 Date: Thu, 8 Feb 2024 10:29:50 +0100 Subject: [PATCH 19/19] ci: trigger build