String_200

NAMESPACE

@@ -2,5 +2,8 @@
 
 export(create_iso8601)
 export(fmt_cmp)
+export(sdtm_str_split)
+export(single_str_spilt)
+export(split_var)
 importFrom(rlang,.data)
 importFrom(tibble,tibble)

R/split_var_call.R

@@ -0,0 +1,88 @@
+#' Split a single string
+#'
+#' @param result A list to store the result
+#' @param item The item to be added to the result
+#' @param sep The separator used to split the string
+#' @param max_length_out The maximum length of the output string
+#'
+#' @return A list with the split strings
+#'
+#' @export
+single_str_spilt <- function(result, item, sep, max_length_out) {
+  current <- tail(result, 1L)
+  if (nchar(paste0(current, sep, item)) <= (max_length_out - 1L)) {
+    result[length(result)] <- paste0(current, sep, item)
+  } else {
+    if (!identical(sep, " ")) result[length(result)] <- paste0(current, sep)
+    result <- c(result, item)
+  }
+  return(result)
+}
+
+#' Split a variable
+#'
+#' @param string The string to be split
+#' @param max_length_out The maximum length of the output string (default is 200)
+#'
+#' @return A list with the split strings
+#'
+#' @export
+split_var <- function(string, max_length_out = 200L) {
+  # Pattern spot
+  pattern <- names(which.max(table(stringr::str_extract_all(string, "[:punct:]|[:blank:]")))) |>
+    (\(.) (ifelse(is.null(.), "", .)))()
+
+  # Split the input string into a vector
+  split_vector <- unlist(stringr::str_split(string, pattern))
+
+  # Use reduce to apply the function across the vector
+  split_vector <- split_vector[-1L] |>
+    purrr::reduce(single_str_spilt, .init = list(split_vector[1L]), pattern, max_length_out) |>
+    unlist()
+
+  # Fix case where sentence do not exceed max_length_out
+  last_two <- paste0(tail(split_vector, n = 2L), collapse = if (identical(pattern, " ")) " " else "")
+  if (nchar(last_two) <= max_length_out) {
+    split_vector <- c(
+      head(split_vector, n = -1L),
+      last_two
+    )
+  }
+  return(as.list(split_vector))
+}
+
+#' Split a dataset string
+#'
+#' @param domain_dataset The dataset to be split
+#' @param max_length_out The maximum length of output string (default is 200)
+#'
+#' @return A dataset with the split strings
+#'
+#' @export
+sdtm_str_split <- function(domain_dataset, max_length_out = 200L) {
+  outt <- NULL
+
+  # Filtering columns > 200
+  char_200 <- dplyr::select_if(domain_dataset, ~ max(nchar(.)) >= max_length_out)
+  if (is_empty(char_200)) {
+    dataset_out <- domain_dataset
+  } else {
+    # FUNCTION CALL
+    outt <- purrr::map(char_200, ~ {
+      split_list <- purrr::map(.x, ~ {
+        cv <- as.data.frame(split_var(.x, max_length_out))
+        names(cv) <- seq_along(cv)
+        cv
+      })
+      split_df <- dplyr::bind_rows(split_list)
+      return(split_df)
+    }) |>
+      purrr::imap(~ set_names(.x, .y)) |>
+      dplyr::bind_cols()
+
+    names(outt) <- sub("....$", "", names(outt)) |>
+      make.unique(sep = "_")
+    dataset_out <- dplyr::bind_cols(dplyr::select(domain_dataset, -names(char_200)), outt)
+  }
+  return(dataset_out)
+}

tests/testthat/test-R_SPLIT.R

@@ -0,0 +1,22 @@
+test_that("`sdtm_str_split`: Input type", {
+  x <- c("ASCORBIC ACID;BETACAROTENE;BIOTIN;CALCIUM;CHLORIDE;CHROMIUM;COPPER;FOLIC ACID;
+IODINE;LYCOPENE;MAGNESIUM;MANGANESE;MOLYBDENUM;NICKEL;NICOTINIC ACID;PANTOTHENIC ACID;PHOSPHORUS;POTASSIUM;
+PYRIDOXINE HYDROCHLORIDE;RIBOFLAVIN;SELENIUM;SILICON;THIAMINE;VANADIUM;VITAMIN B12 NOS;VITAMIN D NOS;VITAMIN E NOS;")
+  expect_error(sdtm_str_split(x), "no applicable method for 'tbl_vars' applied to an object of class \"character\"",
+    ignore.case = TRUE
+  )
+})
+
+test_that("`split_var`:separate strings handling", {
+  x <- c("ASCORBIC ACID;BETACAROTENE;BIOTIN;CALCIUM;CHLORIDE;CHROMIUM;COPPER;FOLIC ACID;
+IODINE;LYCOPENE;MAGNESIUM;MANGANESE;MOLYBDENUM;NICKEL;NICOTINIC ACID;PANTOTHENIC ACID;PHOSPHORUS;POTASSIUM;
+PYRIDOXINE HYDROCHLORIDE;RIBOFLAVIN;SELENIUM;SILICON;THIAMINE;VANADIUM;VITAMIN B12 NOS;VITAMIN D NOS;VITAMIN E NOS;")
+  x1 <- split_var(x)
+  y <- list(
+    "ASCORBIC ACID;BETACAROTENE;BIOTIN;CALCIUM;CHLORIDE;CHROMIUM;COPPER;FOLIC ACID;IODINE;LYCOPENE;MAGNESIUM;
+MANGANESE;MOLYBDENUM;NICKEL;NICOTINIC ACID;PANTOTHENIC ACID;PHOSPHORUS;POTASSIUM;",
+    "PYRIDOXINE HYDROCHLORIDE;RIBOFLAVIN;SELENIUM;SILICON;THIAMINE;VANADIUM;VITAMIN B12 NOS;VITAMIN D NOS;
+VITAMIN E NOS;"
+  )
+  expect_identical(x1, y)
+})