#' Generate Parameter Report for mass_dataset Object
#'
#' This function generates an HTML report summarizing the parameters used in the processing of a `mass_dataset` object. The report is saved in a specified directory.
#'
#' @docType methods
#' @author Xiaotao Shen
#' \email{shenxt1990@@outlook.com}
#' @param object A `mass_dataset` object for which the parameter report is to be generated.
#' @param path The directory where the parameter report will be saved. Default is the current working directory.
#'
#' @return An HTML report summarizing the parameters used in the processing of the `mass_dataset` object. The report is saved in the specified directory.
#'
#' @export
#' @examples
#' \dontrun{
#' data("expression_data")
#' data("sample_info")
#' data("variable_info")
#' object =
#' create_mass_dataset(
#' expression_data = expression_data,
#' sample_info = sample_info,
#' variable_info = variable_info
#' )
#' object
#'
#' library(tidyverse)
#'
#' object =
#' object %>%
#' activate_mass_dataset(what = "expression_data") %>%
#' filter(!is.na(QC_1))
#'
#' object =
#' object %>%
#' activate_mass_dataset(what = "expression_data") %>%
#' filter(!is.na(QC_2))
#'
#' object =
#' object %>%
#' mutate_mean_intensity()
#'
#' object =
#' object %>%
#' mutate_median_intensity() %>%
#' mutate_rsd()
#'
#' report_parameters(object = object, path = "demo_data")
#' }
report_parameters <-
function(object,
path = ".") {
check_object_class(object = object, class = "mass_dataset")
options(warn = -1)
dir.create(path, showWarnings = FALSE, recursive = TRUE)
###path
if (length(grep("Parameter_report", dir(path))) > 0) {
output_path = file.path(path, paste('Parameter_report', length(grep(
"Parameter_report", dir(path)
)) + 1, sep = "_"))
} else{
output_path = file.path(path, "Parameter_report")
}
rmarkdown::draft(
file = output_path,
template = "tidymass_parameters",
package = "massdataset",
create_dir = TRUE,
edit = FALSE
)
###get parameters
parameters <-
object@process_info %>%
lapply(function(x){
if(length(x) == 1){
parse_tidymass_parameter(object = x)
}else{
x %>%
lapply(function(y){
parse_tidymass_parameter(object = y)
}) %>%
dplyr::bind_rows()
}
}) %>%
dplyr::bind_rows() %>%
dplyr::arrange(time)
save(parameters, file = file.path(output_path, "parameters.rda"))
rmarkdown::render(
file.path(output_path, "tidymass_parameters.template.Rmd"),
rmarkdown::html_document()
)
file.rename(
from = file.path(output_path, "tidymass_parameters.template.html"),
to = file.path(output_path, "parameter_report.html")
)
file <- dir(output_path)
remove_file <- grep("png|Rmd|parameters|rda", file, value = TRUE)
unlink(
x = file.path(output_path, remove_file),
recursive = TRUE,
force = TRUE
)
file.copy(
from = file.path(output_path, "parameter_report.html"),
to = file.path(path, "parameter_report.html"),
overwrite = TRUE
)
unlink(file.path(output_path),
recursive = TRUE,
force = TRUE)
message(crayon::yellow("Done."))
options(warn = 0)
}
#' Parse tidymass_parameter Object to Data Frame
#'
#' This function takes a `tidymass_parameter` object and converts it into a data frame for easier manipulation and reporting.
#'
#' @docType methods
#' @author Xiaotao Shen
#' \email{shenxt1990@@outlook.com}
#' @param object A `tidymass_parameter` object to be parsed.
#'
#' @return A data frame containing the package name, function name, parameters, and the time when the function was called.
#'
#' @export
#' @examples
#' data("expression_data")
#' data("sample_info")
#' data("variable_info")
#' object =
#' create_mass_dataset(
#' expression_data = expression_data,
#' sample_info = sample_info,
#' variable_info = variable_info
#' )
#' object
#' parse_tidymass_parameter(object@process_info$create_mass_dataset)
parse_tidymass_parameter <-
function(object) {
if (!is(object, class2 = "tidymass_parameter")) {
stop("only support tidymass_parameter class.\n")
}
if (is.null(names(object@parameter))) {
names(object@parameter) = paste("parameter",
seq_along(object@parameter),
sep = "_")
}
result <-
data.frame(
pacakge_name = object@pacakge_name,
function_name = object@function_name,
parameter = purrr::map2(names(object@parameter),
object@parameter,
function(name, value) {
if (length(value) > 5) {
value = head(value, 5)
value = paste(c(value, "..."), collapse = ',')
} else{
value = paste(value, collapse = ',')
}
paste(name, value, sep = ":")
}) %>% unlist(),
time = object@time,
check.names = FALSE
)
return(result)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.