edit example code

R/Help_Func.R

@@ -509,7 +509,7 @@ model_gen <- function(y, type = "lm", batch = NULL, covariates = NULL, interacti
 #' @export
 #'
 #' @examples
-#' covariates = adni[, c("AGE", "SEX")]
+#' covariates <- adni[, c("AGE", "SEX")]
 #' form_gen(x = "lm", c = covariates)
 #'
 
@@ -560,13 +560,12 @@ form_gen <- function(x, c = NULL, i = NULL, random = NULL, smooth = NULL){
 #' @export
 #'
 #' @examples
-#' \dontrun{
 #' interaction_gen(type = "lm", covariates = c("AGE", "SEX", "DIAGNOSIS"),
 #' interaction = "AGE,DIAGNOSIS")
 #'
 #' interaction_gen(type = "gam", covariates = c("AGE", "SEX", "DIAGNOSIS"),
 #' smooth = "AGE", smooth_int_type = "linear", interaction = "AGE,DIAGNOSIS")
-#' }
+#'
 
 
 
@@ -645,12 +644,22 @@ interaction_gen <- function(type = "lm", covariates = NULL, smooth = NULL, inter
 #'
 #'
 #' @examples
-#' \dontrun{
-#' result <- readRDS("./tests/testthat/previous-results/lm_result.rds")
-#' temp_dir <- tempdir()
-#' diag_save(temp_dir, result)
+#' # Initialize result to NULL for safety
+#' result <- NULL
+#'
+#' # Check if the previous results file exists and load it, or run `visual_prep`
+#' if (file.exists("./tests/testthat/previous-results/lm_result.rds")) {
+#'   result <- readRDS("./tests/testthat/previous-results/lm_result.rds")
+#' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(result)) {
+#'   temp_dir <- tempdir()
+#'   diag_save(temp_dir, result)
+#'   message("Diagnostics saved to: ", temp_dir)
+#' } else {
+#'   message("Result is NULL. Please ensure the file exists and is accessible.")
 #' }
-
 
 diag_save <- function(path, result, use_quarto = TRUE){
   quarto_package <- requireNamespace("quarto", quietly = TRUE)
@@ -720,11 +729,25 @@ diag_save <- function(path, result, use_quarto = TRUE){
 #'
 #'
 #' @examples
-#' \dontrun{
-#' age_list <- readRDS("./tests/testthat/previous-results/age_list.rds")
-#' temp_dir <- tempdir()
-#' age_save(temp_dir, age_list )
+#' # Initialize result to NULL for safety
+#' age_list <- NULL
+#'
+#' # Check if the previous results file exists and load it
+#' if (file.exists("./tests/testthat/previous-results/age_list.rds")) {
+#'   age_list <- readRDS("./tests/testthat/previous-results/age_list.rds")
 #' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(age_list)) {
+#'   temp_dir <- tempdir()
+#'   age_save(temp_dir, age_list)
+#'   message("Age trend table saved to: ", temp_dir)
+#' } else {
+#'   message("Age list is NULL. Please ensure the file exists and is accessible.")
+#' }
+#'
+
+
 
 
 age_save <- function(path, age_list){
@@ -783,22 +806,26 @@ age_save <- function(path, age_list){
 #' @export
 #'
 #' @examples
-#' \dontrun{
-#' set.seed(123)
-#' sub_df <- data.frame(
-#'   age = seq(1, 20, length.out = 100),
-#'   height = 50 + 2.5 * seq(1, 20, length.out = 100) + rnorm(100, 0, 5)
-#' )
-#'
-#' mdl <- gamlss(height ~ pb(age), data = sub_df, family = NO())
-#'
-#' quantile_function <- getQuantileRefactored(
-#'   obj = mdl,
-#'   term = "age",
-#'   quantile = c(0.25, 0.5, 0.75),
-#'   data = sub_df
-#' )
-#' }
+#' if (requireNamespace("gamlss", quietly = TRUE)) {
+#'   library(gamlss)
+#'   set.seed(123)
+#'   sub_df <- data.frame(
+#'     age = seq(1, 20, length.out = 100),
+#'     height = 50 + 2.5 * seq(1, 20, length.out = 100) + rnorm(100, 0, 5)
+#'   )
+#'
+#'   mdl <- gamlss(height ~ pb(age), data = sub_df, family = NO())
+#'
+#'   quantile_function <- getQuantileRefactored(
+#'     obj = mdl,
+#'     term = "age",
+#'     quantile = c(0.25, 0.5, 0.75),
+#'     data = sub_df
+#'   )
+#'  }else{
+#'  message("The 'gamlss' package is not installed. Please install it to run this example.")
+#'  }
+
 
 getQuantileRefactored <- function(obj, term, quantile, data, n.points = 100, fixed.at = list()) {
   if (is.null(obj) || !inherits(obj, "gamlss"))

R/age_shiny.R

@@ -26,8 +26,8 @@
 #' colnames(sub_df) <- c("y", "age", "sex", "icv")
 #' age_list <- list("Volume_1" = age_list_gen(sub_df = sub_df))
 #' quantile_type <- c("quantile_25", "median", "quantile_75")
-#' \dontrun{
-#' age_shiny(age_list = age_list, features = "Volume_1", quantile_type = quantile_type)
+#' if(interactive()){
+#'   age_shiny(age_list = age_list, features = "Volume_1", quantile_type = quantile_type)
 #' }
 
 
@@ -339,10 +339,20 @@ age_list_gen <- function(sub_df, lq = 0.25, hq = 0.75, mu = "smooth", sigma = "s
 #' @export
 #'
 #' @examples
-#' \dontrun{
-#' customize_percentile(age_list, feature = "Volume_1", q = 0.5, s = "F")
+#' # Initialize result to NULL for safety
+#' age_list <- NULL
+#'
+#' # Check if the previous results file exists and load it
+#' if (file.exists("./tests/testthat/previous-results/age_list.rds")) {
+#'   age_list <- readRDS("./tests/testthat/previous-results/age_list.rds")
+#' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(age_list)) {
+#'   customize_percentile(age_list, feature = "Volume_1", q = 0.5, s = "F")
+#' } else {
+#'   message("Age list is NULL. Please ensure the file exists and is accessible.")
 #' }
-
 
 customize_percentile <- function(age_list, feature, q = 0.75, s = "F"){
   mdl_sex <- age_list[[feature]]$model
@@ -377,8 +387,19 @@ customize_percentile <- function(age_list, feature, q = 0.75, s = "F"){
 #' @export
 #'
 #' @examples
-#' \dontrun{
-#' cus_result_gen(age_list, customized_q = 0.75, f = "Volume_1")
+#' # Initialize result to NULL for safety
+#' age_list <- NULL
+#'
+#' # Check if the previous results file exists and load it
+#' if (file.exists("./tests/testthat/previous-results/age_list.rds")) {
+#'   age_list <- readRDS("./tests/testthat/previous-results/age_list.rds")
+#' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(age_list)) {
+#'   cus_result_gen(age_list, customized_q = 0.75, f = "Volume_1")
+#' } else {
+#'   message("Age list is NULL. Please ensure the file exists and is accessible.")
 #' }
 
 cus_result_gen <- function(age_list, customized_q = 0.75, f){
@@ -415,16 +436,27 @@ cus_result_gen <- function(age_list, customized_q = 0.75, f){
 #' @export
 #'
 #' @examples
-#' \dontrun{
-#' # Generate a plot for a specific feature and quantile
-#' age_trend_plot(
-#'   age_list = age_list,
-#'   f = "Volume_1",
-#'   s = "F",
-#'   q = "customization",
-#'   cus_list = customized_results,
-#'   use_plotly = TRUE
-#' )
+#' # Initialize result to NULL for safety
+#' age_list <- NULL
+#'
+#' # Check if the previous results file exists and load it
+#' if (file.exists("./tests/testthat/previous-results/age_list.rds")) {
+#'   age_list <- readRDS("./tests/testthat/previous-results/age_list.rds")
+#' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(age_list)) {
+#'   customized_results <- cus_result_gen(age_list, customized_q = 0.75, f = "Volume_1")
+#'   age_trend_plot(
+#'     age_list = age_list,
+#'     f = "Volume_1",
+#'     s = "F",
+#'     q = "customization",
+#'     cus_list = customized_results,
+#'     use_plotly = TRUE
+#'   )
+#' } else {
+#'   message("Age list is NULL. Please ensure the file exists and is accessible.")
 #' }
 
 age_trend_plot <- function(age_list, f, s = "none", q = "median", cus_list = NULL, use_plotly = TRUE){
@@ -615,12 +647,20 @@ age_trend_plot <- function(age_list, f, s = "none", q = "median", cus_list = NUL
 #' The output table is formatted using the `DT` package with additional features, such as CSV and Excel export options.
 #'
 #' @examples
-#' \dontrun{
-#' # Generate table for females at the 50th percentile
-#' age_table_gen(result, q = "median", s = "F")
+#' # Initialize result to NULL for safety
+#' age_list <- NULL
+#'
+#' # Check if the previous results file exists and load it
+#' if (file.exists("./tests/testthat/previous-results/age_list.rds")) {
+#'   age_list <- readRDS("./tests/testthat/previous-results/age_list.rds")
+#' }
 #'
-#' # Generate comparison table for females vs. males at the 75th percentile
-#' age_table_gen(result, q = "quantile_75", s = "F vs M")
+#' # Use the result if it is available
+#' if (!is.null(age_list)) {
+#'   result <- age_list[[1]]
+#'   age_table_gen(result, q = "median", s = "F")
+#' } else {
+#'   message("Age list is NULL. Please ensure the file exists and is accessible.")
 #' }
 #'
 #' @export

R/comfam_shiny.R

@@ -25,8 +25,8 @@
 #' result_lm <- visual_prep(type = "lm", features = colnames(adni)[43:53],
 #' batch = "manufac", covariates = c("AGE", "SEX", "DIAGNOSIS"),
 #' df = head(adni, 500), cores = 1)
-#' \dontrun{
-#' comfam_shiny(result = result_lm)
+#' if (interactive()) {
+#'   comfam_shiny(result = result_lm)
 #' }
 
 
@@ -950,9 +950,20 @@ comfam_shiny <- function(result, after = FALSE){
 #' - `"eb_scale"`: Empirical Bayes scale parameter density plots.
 #'
 #' @examples
-#' \dontrun{
-#' combat_plot_gen(result, f = "Feature1", plot_name = "batch_density")
-#' combat_plot_gen(result, f = "Feature1", c = "Age", plot_name = "cov_feature")
+#' # Initialize result to NULL for safety
+#' result <- NULL
+#'
+#' # Check if the previous results file exists and load it, or run `visual_prep`
+#' if (file.exists("./tests/testthat/previous-results/lm_result.rds")) {
+#'   result <- readRDS("./tests/testthat/previous-results/lm_result.rds")
+#' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(result)) {
+#'   combat_plot_gen(result, f = "Feature1", plot_name = "batch_density")
+#'   combat_plot_gen(result, f = "Feature1", c = "Age", plot_name = "cov_feature")
+#' } else {
+#'   message("Result is NULL. Please ensure the file exists and is accessible.")
 #' }
 #'
 #' @export
@@ -1507,10 +1518,21 @@ combat_plot_gen <- function(result, f = NULL, batch_control = "No", batch_level
 #' The function dynamically generates tables based on the `table_name` parameter.
 #'
 #' @examples
-#' \dontrun{
-#' combat_table_gen(result, table_name = "data_overview")
-#' combat_table_gen(result, table_name = "cov_table", c = "Age")
-#' combat_table_gen(result, table_name = "pc_variance", PC1 = "PC1", PC2 = "PC2")
+#' # Initialize result to NULL for safety
+#' result <- NULL
+#'
+#' # Check if the previous results file exists and load it, or run `visual_prep`
+#' if (file.exists("./tests/testthat/previous-results/lm_result.rds")) {
+#'   result <- readRDS("./tests/testthat/previous-results/lm_result.rds")
+#' }
+#'
+#' # Use the result if it is available
+#' if (!is.null(result)) {
+#'   combat_table_gen(result, table_name = "data_overview")
+#'   combat_table_gen(result, table_name = "cov_table", c = "Age")
+#'   combat_table_gen(result, table_name = "pc_variance", PC1 = "PC1", PC2 = "PC2")
+#' } else {
+#'   message("Result is NULL. Please ensure the file exists and is accessible.")
 #' }
 #'
 #' @export