From eb81f9a07c70343a836fed9334f5567e6d75efc6 Mon Sep 17 00:00:00 2001 From: Edgar Manukyan Date: Sun, 1 Dec 2024 20:29:22 +0000 Subject: [PATCH] #107 adjust test --- R/generate_code.R | 76 ++++++++++++++++++++--------- man/add_pipe.Rd | 18 +++++++ man/generate_code.Rd | 11 ++++- man/generate_one_var_code.Rd | 2 +- man/get_domain_spec.Rd | 17 +++++++ man/remove_last_pipe.Rd | 18 +++++++ tests/testthat/test-generate_code.R | 12 ++--- 7 files changed, 124 insertions(+), 30 deletions(-) create mode 100644 man/add_pipe.Rd create mode 100644 man/get_domain_spec.Rd create mode 100644 man/remove_last_pipe.Rd diff --git a/R/generate_code.R b/R/generate_code.R index 1e0636ab..ef816846 100644 --- a/R/generate_code.R +++ b/R/generate_code.R @@ -1,5 +1,11 @@ #' Generate the code for the mapping SDTM specification #' +#' One can use the option `width` to control the width of the code. A width of +#' twenty will almost always place every parameter on a separate line. This is +#' useful for debugging and understanding the code. The higher the width, the +#' more parameters will be placed on a single line and code will be shorter. +#' See the examples for more details. +#' #' @param spec The specification data frame. #' @param domain The SDTM domain to generate the code for. #' @param out_dir The directory to save the code file. Default is the current @@ -28,25 +34,21 @@ generate_code <- function(spec, domain, out_dir = ".") { spec_domain <- get_domain_spec(spec, domain) - n_rows <- nrow(spec_domain) - # Generate the code for each variable row in spec_domain - code_blocks <- purrr::map( - seq_len(n_rows), - \(row) generate_one_var_code( - spec_domain[row, ], - last_var = identical(row, n_rows) - ) + styled_code <- purrr::map( + seq_len(nrow(spec_domain)), + \(row) generate_one_var_code(spec_domain[row, ]) ) |> - unlist() - - styled_code <- styler::style_text(code_blocks) + unlist() |> + remove_last_pipe() |> + styler::style_text() # Save the code to a file file_name <- paste0(domain, "_sdtm_oak_code.R") writeLines(styled_code, file.path(out_dir, file_name)) } + #' Generate the code for one variable #' #' @param spec_var The specification for one variable. @@ -55,7 +57,7 @@ generate_code <- function(spec, domain, out_dir = ".") { #' @return The code for the variable as a string. #' @keywords internal #' -generate_one_var_code <- function(spec_var, last_var = FALSE) { +generate_one_var_code <- function(spec_var) { admiraldev::assert_data_frame(spec_var) assertthat::assert_that(identical(nrow(spec_var), 1L)) @@ -79,16 +81,47 @@ generate_one_var_code <- function(spec_var, last_var = FALSE) { !!!args ) - # Convert the call to code as a string. Intentionally limiting the width to 20 - # characters to force each parameter to be on a separate line. - raw_code <- rlang::expr_deparse(generated_call) + rlang::expr_deparse(generated_call) |> + add_pipe() +} - # Add the pipe operator if this is not the last variable - if (!last_var) { - raw_code[length(raw_code)] <- paste0(raw_code[length(raw_code)], " %>%") - } - return(raw_code) +#' Add a pipe operator to the last element of a character vector +#' +#' @param code_block A character vector. +#' +#' @return The character vector with a pipe operator added to the last element. +#' @keywords internal +#' +add_pipe <- function(code_block) { + + admiraldev::assert_character_vector(code_block) + + i <- length(code_block) + + # Add pipe operator to the last element of code block + code_block[i] <- paste0(code_block[i], " %>%") + code_block +} + +#' Remove the pipe operator from the last element of a character vector +#' +#' @param code_blocks A character vector. +#' +#' @return The character vector with the pipe operator removed from the last element. +#' @keywords internal +#' +remove_last_pipe <- function(code_blocks) { + + admiraldev::assert_character_vector(code_blocks) + + len_code_block <- length(code_blocks) + + # The last code block should not have a pipe operator + code_blocks[len_code_block] <- code_blocks[len_code_block] |> + stringr::str_remove("%>%") + + code_blocks } #' Get the specification for a domain and modify it @@ -97,7 +130,7 @@ generate_one_var_code <- function(spec_var, last_var = FALSE) { #' @param domain The SDTM domain to get the specification for. #' #' @return -#' @export +#' @keywords internal #' #' @examples get_domain_spec <- function(spec, domain) { @@ -161,7 +194,6 @@ get_domain_spec <- function(spec, domain) { raw_dataset ) ) - } diff --git a/man/add_pipe.Rd b/man/add_pipe.Rd new file mode 100644 index 00000000..c9b1b58d --- /dev/null +++ b/man/add_pipe.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generate_code.R +\name{add_pipe} +\alias{add_pipe} +\title{Add a pipe operator to the last element of a character vector} +\usage{ +add_pipe(code_block) +} +\arguments{ +\item{code_block}{A character vector.} +} +\value{ +The character vector with a pipe operator added to the last element. +} +\description{ +Add a pipe operator to the last element of a character vector +} +\keyword{internal} diff --git a/man/generate_code.Rd b/man/generate_code.Rd index 6363f523..6efd45e0 100644 --- a/man/generate_code.Rd +++ b/man/generate_code.Rd @@ -18,7 +18,11 @@ directory.} Side effect: the code is generated and saved to a file. } \description{ -Generate the code for the mapping SDTM specification +One can use the option \code{width} to control the width of the code. A width of +twenty will almost always place every parameter on a separate line. This is +useful for debugging and understanding the code. The higher the width, the +more parameters will be placed on a single line and code will be shorter. +See the examples for more details. } \examples{ @@ -26,6 +30,11 @@ Generate the code for the mapping SDTM specification spec <- read_spec("cm_sdtm_oak_spec_cdash.csv") domain <- "cm" generate_code(spec, domain) + +# One can use option width to control the width of the code +# Twenty will almost always place every parameter on a separate line +options(width = 20) +generate_code(spec, domain) } } diff --git a/man/generate_one_var_code.Rd b/man/generate_one_var_code.Rd index ce38a1f9..f23d6ace 100644 --- a/man/generate_one_var_code.Rd +++ b/man/generate_one_var_code.Rd @@ -4,7 +4,7 @@ \alias{generate_one_var_code} \title{Generate the code for one variable} \usage{ -generate_one_var_code(spec_var, last_var = FALSE) +generate_one_var_code(spec_var) } \arguments{ \item{spec_var}{The specification for one variable.} diff --git a/man/get_domain_spec.Rd b/man/get_domain_spec.Rd new file mode 100644 index 00000000..976589a6 --- /dev/null +++ b/man/get_domain_spec.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generate_code.R +\name{get_domain_spec} +\alias{get_domain_spec} +\title{Get the specification for a domain and modify it} +\usage{ +get_domain_spec(spec, domain) +} +\arguments{ +\item{spec}{The specification data frame.} + +\item{domain}{The SDTM domain to get the specification for.} +} +\description{ +Get the specification for a domain and modify it +} +\keyword{internal} diff --git a/man/remove_last_pipe.Rd b/man/remove_last_pipe.Rd new file mode 100644 index 00000000..a7538d02 --- /dev/null +++ b/man/remove_last_pipe.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/generate_code.R +\name{remove_last_pipe} +\alias{remove_last_pipe} +\title{Remove the pipe operator from the last element of a character vector} +\usage{ +remove_last_pipe(code_blocks) +} +\arguments{ +\item{code_blocks}{A character vector.} +} +\value{ +The character vector with the pipe operator removed from the last element. +} +\description{ +Remove the pipe operator from the last element of a character vector +} +\keyword{internal} diff --git a/tests/testthat/test-generate_code.R b/tests/testthat/test-generate_code.R index 6b4372ba..59e05428 100644 --- a/tests/testthat/test-generate_code.R +++ b/tests/testthat/test-generate_code.R @@ -15,11 +15,11 @@ test_that("generate_code works", { unlink(out_dir, recursive = TRUE, force = TRUE) dir.create(out_dir, showWarnings = FALSE, recursive = TRUE) - generate_code(spec, domain, out_dir) + withr::with_options(list(width = 20), { + generate_code(spec, domain, out_dir) + observed <- readLines(file.path(out_dir, paste0(domain, "_sdtm_oak_code.R"))) - - observed <- readLines(file.path(out_dir, paste0(domain, "_sdtm_oak_code.R"))) - - expect_true(identical(length(observed), 10L)) - expect_true(grepl("CMTRT", observed[3])) + expect_true(identical(length(observed), 10L)) + expect_true(grepl("CMTRT", observed[3])) + }) })