diff --git a/NAMESPACE b/NAMESPACE index 6f9797f..7a6fa5e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,6 +39,7 @@ export(qp_mark_outliers) export(qp_plot_plate) export(qp_plot_standards) export(qp_remove_empty) +export(qp_report) export(qp_summarize) export(qp_tidy) importFrom(rlang,.data) diff --git a/R/qp_report.R b/R/qp_report.R index 820cf80..68d2807 100644 --- a/R/qp_report.R +++ b/R/qp_report.R @@ -1,11 +1,31 @@ -qp_report <- function(qp, output_file) { +#' Create a report for a protein quantificaiton experiment +#' +#' @param qp Likely the output from `qp` AND `qp_dilute`. +#' @param output_file Character. The path of the file to export, +#' including `.html` +#' @param other Generally used for Shiny application. Assumes a +#' named list of key-values that will be used to document report +#' parameters. +#' +#' @export +#' @examples +#' \dontrun{ +#' absorbances |> +#' qp() |> +#' qp_dilute() |> +#' qp_report( +#' "~/my_report.html", +#' other = list(key = "value") # Essentially metadata +#' ) +#' } +qp_report <- function(qp, output_file, other = list()) { rmarkdown::render( system.file( "rmarkdown/templates/quantify-protein-report/skeleton/skeleton.Rmd", package = "qp" ), output_file = output_file, - params = list(qp = qp) + params = list(qp = qp, other = other) ) } @@ -17,34 +37,15 @@ qp_standards_all <- function(x) { #' @export qp_standards_all.data.frame <- function(x) { - stds <- dplyr::filter(x, .data$sample_type == "standard") - stds$.coord <- paste0(LETTERS[stds$.row], stds$.col) - - table_data <- stds |> - dplyr::select( - ".sample_name", ".abs", ".is_outlier", ".pred_conc", ".coord", ".conc", - ) |> - dplyr::group_by(.data$.sample_name, .data$.pred_conc, .data$.conc) |> - tidyr::nest() |> - dplyr::mutate(gg = purrr::map(.data$data, make_well_circles_plot)) |> - tidyr::unnest(.data$data) |> - dplyr::select(-c(".is_outlier", ".coord")) |> - dplyr::ungroup() - + x <- add_coords_col(x) + table_data <- add_well_circles_plot_col( + x, + "standard", + c(".sample_name", ".abs", ".is_outlier", ".pred_conc", ".coord", ".conc"), + c(".sample_name", ".pred_conc", ".conc") + ) table_data |> - gt::gt() |> - gt::text_transform( - location = gt::cells_body( - columns = .data$gg - ), - fn = function(x) { - gt::ggplot_image(table_data$gg, height = gt::px(35), aspect_ratio = 1) - } - ) |> - gt::fmt_number( - c(".abs", ".pred_conc", ".conc"), - n_sigfig = 2 - ) |> + make_gt(35, 1, c(".abs", ".pred_conc", ".conc")) |> gt::cols_label( .sample_name = "Sample", .conc = "[Actual]", .pred_conc = "[Predicted]", .abs = "Absorbance", gg = "" @@ -64,34 +65,16 @@ qp_standards_summary <- function(x) { #' @export qp_standards_summary.data.frame <- function(x) { - stds <- dplyr::filter(x, .data$sample_type == "standard") - stds$.coord <- paste0(LETTERS[stds$.row], stds$.col) - - table_data <- stds |> - dplyr::select( - ".sample_name", ".pred_conc_mean", ".is_outlier", ".abs", ".coord" - ) |> - dplyr::group_by(.data$.sample_name, .data$.pred_conc_mean) |> - tidyr::nest() |> - dplyr::mutate(gg = purrr::map(.data$data, make_well_circles_plot)) |> - dplyr::select(-.data$data) |> - dplyr::ungroup() - + x <- add_coords_col(x) + table_data <- add_well_circles_plot_col( + x, + "standard", + c(".sample_name", ".pred_conc_mean", ".is_outlier", ".abs", ".coord"), + c(".sample_name", ".pred_conc_mean"), + summary = TRUE + ) table_data |> - gt::gt() |> - gt::text_transform( - location = gt::cells_body( - columns = .data$gg - ), - fn = function(x) { - gt::ggplot_image(table_data$gg, height = gt::px(50), aspect_ratio = 2) - } - ) |> - gt::fmt_number( - c(".pred_conc_mean"), - drop_trailing_zeros = TRUE, - n_sigfig = 2 - ) |> + make_gt(50, 2, ".pred_conc_mean") |> gt::cols_label( .sample_name = "Sample", .pred_conc_mean = "Concentration", gg = "" ) @@ -112,34 +95,15 @@ qp_samples_all <- function(x) { #' @export qp_samples_all.data.frame <- function(x) { - samples <- dplyr::filter(x, .data$sample_type == "unknown") - samples$.coord <- paste0(LETTERS[samples$.row], samples$.col) - - table_data <- samples |> - dplyr::select( - ".sample_name", ".abs", ".is_outlier", ".pred_conc", ".coord" - ) |> - dplyr::group_by(.data$.sample_name, .data$.pred_conc) |> - tidyr::nest() |> - dplyr::mutate(gg = purrr::map(.data$data, make_well_circles_plot)) |> - tidyr::unnest(.data$data) |> - dplyr::select(-c(".is_outlier", ".coord")) |> - dplyr::ungroup() - + x <- add_coords_col(x) + table_data <- add_well_circles_plot_col( + x, + "unknown", + c(".sample_name", ".abs", ".is_outlier", ".pred_conc", ".coord"), + group_vars = c(".sample_name", ".pred_conc") + ) table_data |> - gt::gt() |> - gt::text_transform( - location = gt::cells_body( - columns = .data$gg - ), - fn = function(x) { - gt::ggplot_image(table_data$gg, height = gt::px(35), aspect_ratio = 1) - } - ) |> - gt::fmt_number( - c(".abs", ".pred_conc"), - n_sigfig = 2 - ) |> + make_gt(35, 1, c(".abs", ".pred_conc")) |> gt::cols_label( .sample_name = "Sample", .pred_conc = "[Predicted]", .abs = "Absorbance", gg = "" @@ -159,34 +123,16 @@ qp_samples_summary <- function(x) { #' @export qp_samples_summary.data.frame <- function(x) { - samples <- dplyr::filter(x, .data$sample_type == "unknown") - samples$.coord <- paste0(LETTERS[samples$.row], samples$.col) - - table_data <- samples |> - dplyr::select( - ".sample_name", ".pred_conc_mean", ".is_outlier", ".abs", ".coord" - ) |> - dplyr::group_by(.data$.sample_name, .data$.pred_conc_mean) |> - tidyr::nest() |> - dplyr::mutate(gg = purrr::map(.data$data, make_well_circles_plot)) |> - dplyr::select(-.data$data) |> - dplyr::ungroup() - + x <- add_coords_col(x) + table_data <- add_well_circles_plot_col( + x, + "unknown", + c(".sample_name", ".pred_conc_mean", ".is_outlier", ".abs", ".coord"), + c(".sample_name", ".pred_conc_mean"), + summary = TRUE + ) table_data |> - gt::gt() |> - gt::text_transform( - location = gt::cells_body( - columns = .data$gg - ), - fn = function(x) { - gt::ggplot_image(table_data$gg, height = gt::px(50), aspect_ratio = 2) - } - ) |> - gt::fmt_number( - c(".pred_conc_mean"), - drop_trailing_zeros = TRUE, - n_sigfig = 2 - ) |> + make_gt(50, 2, ".pred_conc_mean") |> gt::cols_label( .sample_name = "Sample", .pred_conc_mean = "Concentration", gg = "" ) @@ -232,6 +178,56 @@ make_well_circles_plot <- function(df) { ggplot2::theme(plot.margin = ggplot2::margin(0, 1.5, 0, 1.5, unit = "cm")) } +add_well_circles_plot_col <- function(x, + sample_type, + select_vars, + group_vars, + summary = FALSE) { + x <- dplyr::filter(x, .data$sample_type == .env$sample_type) + + x <- x |> + dplyr::select(dplyr::all_of(select_vars)) |> + dplyr::group_by(dplyr::across(dplyr::all_of(group_vars))) |> + tidyr::nest() |> + dplyr::mutate(gg = purrr::map(.data$data, make_well_circles_plot)) + + if (summary) { + x <- dplyr::select(x, -"data") + } else { + x <- x |> + tidyr::unnest(.data$data) |> + dplyr::select(-c(".is_outlier", ".coord")) + } + + dplyr::ungroup(x) +} + +add_coords_col <- function(x) { + x$.coord <- paste0(LETTERS[x$.row], x$.col) + x +} + +make_gt <- function(x, well_img_height, well_img_aspect_ratio, cols_to_round) { + x |> + gt::gt() |> + gt::text_transform( + location = gt::cells_body( + columns = .data$gg + ), + fn = function(z) { + gt::ggplot_image( + x$gg, + height = gt::px(well_img_height), + aspect_ratio = well_img_aspect_ratio + ) + } + ) |> + gt::fmt_number( + dplyr::all_of(cols_to_round), + n_sigfig = 2 + ) +} + dil_summary <- function(qp) { check_has_cols(qp, c( ".sample_name", ".pred_conc_mean", ".target_conc", diff --git a/inst/rmarkdown/templates/quantify-protein-report/skeleton/skeleton.Rmd b/inst/rmarkdown/templates/quantify-protein-report/skeleton/skeleton.Rmd index 6832ede..97bd2da 100644 --- a/inst/rmarkdown/templates/quantify-protein-report/skeleton/skeleton.Rmd +++ b/inst/rmarkdown/templates/quantify-protein-report/skeleton/skeleton.Rmd @@ -141,10 +141,12 @@ out_file <- "~/Desktop/test.html" # Report Parameters ```{r} -params$other |> - as.data.frame() |> - t() |> - as_tibble(rownames = "Parameter") |> - rename("Value" = "V1") |> - kable() +if (length(params$other) > 0) { + params$other |> + as.data.frame() |> + t() |> + as_tibble(rownames = "Parameter") |> + rename("Value" = "V1") |> + kable() +} ``` diff --git a/man/qp_dilute.Rd b/man/qp_dilute.Rd index cd27af2..116516b 100644 --- a/man/qp_dilute.Rd +++ b/man/qp_dilute.Rd @@ -26,8 +26,8 @@ qp_dilute(x, ...) } \arguments{ \item{x}{A \code{data.frame} or \code{list} containing a \code{data.frame} named \code{qp} with -a column named \code{.pred_conc} or \code{.mean_pred_conc}. If both, will favor -\code{.mean_pred_conc}.} +a column named \code{.pred_conc} or \code{.pred_conc_mean}. If both, will favor +\code{.pred_conc_mean}.} \item{...}{Unused} diff --git a/man/qp_report.Rd b/man/qp_report.Rd new file mode 100644 index 0000000..0880937 --- /dev/null +++ b/man/qp_report.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/qp_report.R +\name{qp_report} +\alias{qp_report} +\title{Create a report for a protein quantificaiton experiment} +\usage{ +qp_report(qp, output_file, other = list()) +} +\arguments{ +\item{qp}{Likely the output from \code{qp} AND \code{qp_dilute}.} + +\item{output_file}{Character. The path of the file to export, +including \code{.html}} + +\item{other}{Generally used for Shiny application. Assumes a +named list of key-values that will be used to document report +parameters.} +} +\description{ +Create a report for a protein quantificaiton experiment +} +\examples{ +\dontrun{ +absorbances |> + qp() |> + qp_dilute() |> + qp_report( + "~/my_report.html", + other = list(key = "value") # Essentially metadata + ) +} +}