|
| 1 | +#' Parse a Function Call String |
| 2 | +#' |
| 3 | +#' This function takes a string representing a function call and parses it into |
| 4 | +#' its constituent parts: the function name and the argument names. |
| 5 | +#' |
| 6 | +#' @param input_string A character string representing a function call, e.g., "report(empty_droplets_tbl, arg1)". |
| 7 | +#' |
| 8 | +#' @return A list containing two elements: |
| 9 | +#' \item{function_name}{A character string representing the name of the function.} |
| 10 | +#' \item{arguments}{A character vector containing the names of the arguments.} |
| 11 | +#' |
| 12 | +#' @importFrom rlang parse_expr |
| 13 | +#' |
| 14 | +#' @examples |
| 15 | +#' # Example usage: |
| 16 | +#' command <- quote(report(empty_droplets_tbl, arg1)) |
| 17 | +#' output <- parse_function_call(command) |
| 18 | +#' print(output) |
| 19 | +#' |
| 20 | +#' @noRd |
| 21 | +parse_function_call <- function(command) { |
| 22 | + # Parse the input string to an expression |
| 23 | + expr <- command |> deparse() |> parse_expr() |
| 24 | + |
| 25 | + # Extract the function name |
| 26 | + function_name <- as.character(expr[[1]]) |
| 27 | + |
| 28 | + # Extract the arguments |
| 29 | + args <- as.list(expr[-1]) |
| 30 | + |
| 31 | + # Convert arguments to character vector |
| 32 | + args <- sapply(args, as.character) |
| 33 | + |
| 34 | + # Create the output list |
| 35 | + result <- list(function_name = function_name, arguments = args) |
| 36 | + |
| 37 | + return(result) |
| 38 | +} |
| 39 | + |
| 40 | +#' Parse a Function Call String and Expand Tiered Arguments |
| 41 | +#' |
| 42 | +#' This function takes a string representing a function call, parses it into |
| 43 | +#' its constituent parts (function name and arguments), and expands the specified |
| 44 | +#' tiered arguments based on the provided tier labels. |
| 45 | +#' |
| 46 | +#' @param command A character string representing a function call, e.g., "report(empty_droplets_tbl, arg1)". |
| 47 | +#' @param tiers A character vector indicating the tier labels for the specified tiered arguments, e.g., c("_1", "_2", "_3"). |
| 48 | +#' @param tiered_args A character vector specifying which arguments should be tiered, e.g., c("empty_droplets_tbl"). |
| 49 | +#' |
| 50 | +#' @return A character string representing the modified function call with tiered arguments expanded. |
| 51 | +#' |
| 52 | +#' @importFrom rlang parse_expr |
| 53 | +#' |
| 54 | +#' @examples |
| 55 | +#' # Example usage: |
| 56 | +#' input_string <- "report(empty_droplets_tbl, arg1)" |
| 57 | +#' tiers <- c("_1", "_2", "_3") |
| 58 | +#' tiered_args <- c("empty_droplets_tbl", "another_arg") |
| 59 | +#' output <- expand_tiered_arguments(input_string, tiers, tiered_args) |
| 60 | +#' print(output) |
| 61 | +#' |
| 62 | +#' @export |
| 63 | +expand_tiered_arguments <- function(command, tiers, tiered_args) { |
| 64 | + # Parse the input command to get function name and arguments |
| 65 | + parsed_call <- parse_function_call(command) |
| 66 | + |
| 67 | + function_name <- parsed_call$function_name |
| 68 | + arguments <- parsed_call$arguments |
| 69 | + |
| 70 | + # Expand tiered arguments |
| 71 | + expanded_arguments <- unlist(lapply(arguments, function(arg) { |
| 72 | + if (arg %in% tiered_args) { |
| 73 | + # Generate tiered arguments using provided tier labels |
| 74 | + return(paste0(arg, "_", tiers)) |
| 75 | + } else { |
| 76 | + # Return the argument as is |
| 77 | + return(arg) |
| 78 | + } |
| 79 | + })) |
| 80 | + |
| 81 | + # Construct the new function call string |
| 82 | + paste0(function_name, "(", paste(expanded_arguments, collapse = ", "), ")") |> |
| 83 | + rlang::parse_expr() |
| 84 | + |
| 85 | +} |
| 86 | + |
| 87 | + |
| 88 | + |
| 89 | +#' @importFrom stringr str_extract |
| 90 | +factory_split = function(name_output, command, tiers, arguments_to_tier = c(), other_arguments_to_tier = c() ){ |
| 91 | + |
| 92 | + if(command |> deparse() |> str_detect("%>%") |> any()) |
| 93 | + stop("HPCell says: no \"%>%\" allowed in the command, please use \"|>\" ") |
| 94 | + |
| 95 | + #input = command |> deparse() |> paste(collapse = "") |> str_extract("[a-zA-Z0-9_]+\\(([a-zA-Z0-9_]+),.*", group=1) |
| 96 | + |
| 97 | + # Filter out arguments to be tiered from the input command |
| 98 | + other_arguments_to_tier <- other_arguments_to_tier |> str_subset(arguments_to_tier, negate = TRUE) |
| 99 | + |
| 100 | + map2(tiers, names(tiers), ~ { |
| 101 | + |
| 102 | + |
| 103 | + # Pattern |
| 104 | + pattern = as.name("map") |
| 105 | + |
| 106 | + if(arguments_to_tier |> length() > 0) |
| 107 | + pattern = pattern |> c(substitute(slice(input, index = arg ), list(input = as.symbol(arguments_to_tier), arg=.x)) ) |
| 108 | + |
| 109 | + if(other_arguments_to_tier |> length() > 0) |
| 110 | + pattern = pattern |> c(glue("{other_arguments_to_tier}_{.y}") |> lapply(as.name)) |
| 111 | + |
| 112 | + pattern = as.call(pattern) |
| 113 | + |
| 114 | + |
| 115 | + # Resources |
| 116 | + if(length(tiers) == 1) |
| 117 | + resources = targets::tar_option_get("resources") |
| 118 | + else |
| 119 | + resources = tar_resources(crew = tar_resources_crew(.y)) |
| 120 | + |
| 121 | + |
| 122 | + tar_target_raw( |
| 123 | + glue("{name_output}_{.y}") |> as.character(), |
| 124 | + command |> add_tier_inputs(other_arguments_to_tier, .y), |
| 125 | + pattern = pattern, |
| 126 | + iteration = "list", |
| 127 | + resources = resources |
| 128 | + ) |
| 129 | + }) |
| 130 | +} |
| 131 | + |
| 132 | +factory_collapse = function(name_output, command, tiered_input, tiers, ...){ |
| 133 | + |
| 134 | + command = command |> expand_tiered_arguments(names(tiers), tiered_input) |
| 135 | + |
| 136 | + tar_target_raw(name_output, command, ...) |
| 137 | +} |
| 138 | + |
| 139 | +# factory_tiering = function(preparation, tiering, collapsing, tiers){ |
| 140 | +# |
| 141 | +# t1 = tar_target_raw(preparation[[1]], preparation[[2]]) |
| 142 | +# t2 = factory_split( |
| 143 | +# tiering[[1]], |
| 144 | +# tiering[[2]], |
| 145 | +# tiers, |
| 146 | +# tiering[[3]] |
| 147 | +# ) |
| 148 | +# t3 = factory_collapse( |
| 149 | +# collapsing[[1]], |
| 150 | +# collapsing[[2]], |
| 151 | +# collapsing[[3]], |
| 152 | +# tiers |
| 153 | +# |
| 154 | +# ) |
| 155 | +# |
| 156 | +# list(t1, t2, t3) |
| 157 | +# } |
0 commit comments