From e3da3d90ced73d5ea8ddefcad088244fa6c78e46 Mon Sep 17 00:00:00 2001 From: Daniel Rakotomalala Date: Wed, 1 Apr 2026 00:40:37 +0200 Subject: [PATCH 1/3] in progress: integration of from_example to function --- R/app_ui.R | 14 ++++------ R/mod_func_code.R | 67 +++++++++++++++++++++++++++++++++-------------- 2 files changed, 52 insertions(+), 29 deletions(-) diff --git a/R/app_ui.R b/R/app_ui.R index b86fe57..5c2ff65 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -25,17 +25,13 @@ app_ui <- function(request) { alt = "genproc logo" ) ), - tabsetPanel( - tabPanel("Main", - mod_mask_ui("mask_1"), - mod_func_code_ui("func_1"), - mod_gproc_ui("gproc_1"), - mod_log_ui("log_1") + mod_mask_ui("mask_1"), + mod_func_code_ui("func_1"), + mod_gproc_ui("gproc_1"), + mod_log_ui("log_1") + - ), - tabPanel("Utils") - ) ) ) ) diff --git a/R/mod_func_code.R b/R/mod_func_code.R index 09caec4..4e0463d 100644 --- a/R/mod_func_code.R +++ b/R/mod_func_code.R @@ -15,28 +15,48 @@ mod_func_code_ui <- function(id) { fluidRow( tags$h2("2 - Function"), - column(6, - textAreaInput(ns("funccode"), label = tags$h3("Write your function code"), - width = "800px", height = "100px"), - fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")), - column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))), - column(6, - tags$h3("Function preview"), - wellPanel(class = "gp-well2", - verbatimTextOutput(ns("functext"))))), + # function writing + tabsetPanel( + tabPanel("From example to function", + column(6, + textAreaInput(ns("egcode"), label = tags$h3("Write your example code"), + width = "800px", height = "100px"), + fluidRow(column(4, actionButton(ns("egok"), label = "Validate example")), + column(6, wellPanel(verbatimTextOutput(ns("egcheck")))))), + column(6, + tags$h3("Function preview (from example)"), + wellPanel(class = "gp-well2", + verbatimTextOutput(ns("egfunctext"))))), + tabPanel( + "Write function directly", + column(6, + textAreaInput(ns("funccode"), label = tags$h3("Write your function code"), + width = "800px", height = "100px"), + fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")), + column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))), + + column(6, + tags$h3("Function preview"), + wellPanel(class = "gp-well2", + verbatimTextOutput(ns("functext"))))), + + tabPanel("Arguments mapping", + # arguments mapping + fluidRow( + column(6, + textAreaInput(ns("argmap"), label = tags$h3("Map your function arguments to mask names"), + width = "800px", height = "100px"), + fluidRow(column(4, actionButton(ns("argsok"), label = "Validate mapping")), + column(6, wellPanel(verbatimTextOutput(ns("argscheck")))))), + + column(6, + tags$h3("Arguments mapping preview"), + wellPanel(class = "gp-well2", + verbatimTextOutput(ns("argtext")))))) + + )) - fluidRow( - column(6, - textAreaInput(ns("argmap"), label = tags$h3("Map your function arguments to mask names"), - width = "800px", height = "100px"), - fluidRow(column(4, actionButton(ns("argsok"), label = "Validate mapping")), - column(6, wellPanel(verbatimTextOutput(ns("argscheck")))))), - - column(6, - tags$h3("Arguments mapping preview"), - wellPanel(class = "gp-well2", - verbatimTextOutput(ns("argtext"))))) ) ) } @@ -66,6 +86,13 @@ mod_func_code_server <- function(id, mask_data){ output$argscheck <- renderPrint(args_check()) output$argtext <- renderPrint(args_code()) + # from example to function section + eg_expr <- reactive(parse(text = input$egcode)) + eg_to_func <- eventReactive(input$egok, from_example_to_function(eg_expr())) + + output$egfunctext <- renderPrint(eg_to_func()) + + list("func_code_return" = func_code, "args_mapping_return" = args_code) From 2b2fda83b36070aae62ed8c472583708a95c586c Mon Sep 17 00:00:00 2001 From: Daniel Rakotomalala Date: Mon, 6 Apr 2026 21:00:14 +0200 Subject: [PATCH 2/3] rework from example and directly function writing ui --- .Rhistory | 116 +++++++++++++++++++++++----------------------- R/mod_func_code.R | 26 ++++------- 2 files changed, 68 insertions(+), 74 deletions(-) diff --git a/.Rhistory b/.Rhistory index f481c90..31c65b3 100644 --- a/.Rhistory +++ b/.Rhistory @@ -1,61 +1,3 @@ -} -# Detect x <- ..., x = ... (as assignment), x <<- ..., ... -> x, ... ->> x -is_assignment_call <- function(x) { -is.call(x) && is.symbol(x[[1]]) && as.character(x[[1]]) %in% -c("<-", "=", "<<-", "->", "->>") -} -# Extract symbol bound by an assignment call (only if LHS is a bare symbol) -assignment_lhs_symbol <- function(x) { -if (!is_assignment_call(x)) return(NULL) -op <- as.character(x[[1]]) -# For -> and ->>, the assigned symbol is the 3rd element -lhs <- if (op %in% c("->", "->>")) x[[3]] else x[[2]] -if (is.symbol(lhs)) { -nm <- as.character(lhs) -if (length(nm) == 1 && !is.na(nm) && nm != "") return(nm) -} -NULL -} -rewrite <- function(node, bound = character()) { -# Strings -> params -if (is.character(node) && length(node) == 1) { -key <- paste0("chr:", node) -pname <- make_param(key, node) -return(rlang::sym(pname)) -} -# Symbols: keep local/bound; capture external non-functions -if (is.symbol(node)) { -s <- as.character(node) -if (length(s) != 1 || is.na(s) || s == "") return(node) -if (s %in% bound) return(node) -if (exists(s, envir = env, inherits = TRUE)) { -val <- get(s, envir = env, inherits = TRUE) -if (!is.function(val)) { -key <- paste0("sym:", s) -pname <- make_param(key, val) -return(rlang::sym(pname)) -} -} -return(node) -} -# Expression vectors -if (is.expression(node)) { -out <- lapply(as.list(node), rewrite, bound = bound) -return(as.expression(out)) -} -# Calls -if (is.call(node)) { -head <- node[[1]] -head_name <- if (is.symbol(head)) as.character(head) else NULL -# Handle { ... } as a sequential block with growing bound vars -if (!is.null(head_name) && head_name == "{") { -args <- as.list(node) -# args[[1]] is "{" -cur_bound <- bound -if (length(args) >= 2) { -for (i in seq.int(2, length(args))) { -stmt <- args[[i]] -# Rewrite statement with current bound args[[i]] <- rewrite(stmt, bound = cur_bound) # If original statement binds a new symbol, extend bound for following statements new_nm <- assignment_lhs_symbol(stmt) @@ -510,3 +452,61 @@ library(genprocShiny) remove.packages("genprocShiny") devtools::load_all() devtools::load_all() +devtools::load_all() +run_app() +run_app() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +expression("function (x) x + 1") +expression("function (x) x + 1") %>% eval() +library(dplyr) +expression("function (x) x + 1") %>% eval() +symbol("function (x) x + 1") %>% eval() +sym("function (x) x + 1") %>% eval() +expr(sym("function (x) x + 1")) %>% eval() +expr(sym("function (x) x + 1")) %>% eval +expr(sym("function (x) x + 1")) %>% eval %>% class +expr(sym("function (x) x + 1")) %>% eval %>% eval +as.expression("function (x) x + 1") +as.expression("function (x) x + 1") %>% eval() +as.expression("function (x) x + 1") %>% eval() %>% class +as.expression("function (x) x + 1") %>% eval() %>% expression() +parse("function (x)x + 1") +devtools::load_all() +rlang::parse_expr("function (x) x + 1") +rlang::parse_expr("function (x) x + 1") %>% eval +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +golem::run_dev() +rlang::parse_expr("get('cars') %>% select(1)") +rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function() +library(dplyr) +rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function() +rlang::parse_expr("get('cars') %>% select(1)") +rlang::parse_expr("get('cars') %>% select(1)") %>% str +rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function() +rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function() +golem::run_dev() +parse("get('cars') %>% select(1)") %>% from_example_to_function() +library(dplyr) +parse("get('cars') %>% select(1)") %>% from_example_to_function() +from_example_to_function +golem::run_dev() +devtools::check() diff --git a/R/mod_func_code.R b/R/mod_func_code.R index 4e0463d..005b963 100644 --- a/R/mod_func_code.R +++ b/R/mod_func_code.R @@ -18,28 +18,22 @@ mod_func_code_ui <- function(id) { # function writing tabsetPanel( - tabPanel("From example to function", + tabPanel("Build function", column(6, textAreaInput(ns("egcode"), label = tags$h3("Write your example code"), width = "800px", height = "100px"), fluidRow(column(4, actionButton(ns("egok"), label = "Validate example")), - column(6, wellPanel(verbatimTextOutput(ns("egcheck")))))), + column(6, wellPanel(verbatimTextOutput(ns("egcheck"))))), + textAreaInput(ns("funccode"), label = tags$h3("Write your function code"), + width = "800px", height = "100px"), + fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")), + column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))), + column(6, - tags$h3("Function preview (from example)"), + tags$h3("Function preview"), wellPanel(class = "gp-well2", - verbatimTextOutput(ns("egfunctext"))))), - tabPanel( - "Write function directly", - column(6, - textAreaInput(ns("funccode"), label = tags$h3("Write your function code"), - width = "800px", height = "100px"), - fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")), - column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))), - - column(6, - tags$h3("Function preview"), - wellPanel(class = "gp-well2", - verbatimTextOutput(ns("functext"))))), + verbatimTextOutput(ns("functext")))) + ), tabPanel("Arguments mapping", # arguments mapping From f4e188d771edd67cf6d8b5ca17961d0465d6acfa Mon Sep 17 00:00:00 2001 From: Daniel Rakotomalala Date: Mon, 6 Apr 2026 21:23:54 +0200 Subject: [PATCH 3/3] Add from example to function functionality. Whole minimal process is now working out --- R/mod_func_code.R | 102 +++++++++++++++++------ inst/demo_assets/func_and_args_mapping.R | 6 ++ 2 files changed, 81 insertions(+), 27 deletions(-) diff --git a/R/mod_func_code.R b/R/mod_func_code.R index 005b963..ae1dee6 100644 --- a/R/mod_func_code.R +++ b/R/mod_func_code.R @@ -20,15 +20,19 @@ mod_func_code_ui <- function(id) { tabsetPanel( tabPanel("Build function", column(6, + + # From example textAreaInput(ns("egcode"), label = tags$h3("Write your example code"), width = "800px", height = "100px"), fluidRow(column(4, actionButton(ns("egok"), label = "Validate example")), column(6, wellPanel(verbatimTextOutput(ns("egcheck"))))), + + # Direct writing textAreaInput(ns("funccode"), label = tags$h3("Write your function code"), width = "800px", height = "100px"), fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")), column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))), - + # Preview function column(6, tags$h3("Function preview"), wellPanel(class = "gp-well2", @@ -58,38 +62,82 @@ mod_func_code_ui <- function(id) { #' func_code Server Functions #' #' @noRd -mod_func_code_server <- function(id, mask_data){ - moduleServer(id, function(input, output, session){ +mod_func_code_server <- function(id, mask_data) { + moduleServer(id, function(input, output, session) { ns <- session$ns - func_expr <- reactive(eval_parse(text = input$funccode)) - func_code <- eventReactive(input$funcok, func_expr()) - func_check <- eventReactive(input$funcok, validate_func(func_expr())) - - output$funccheck <- renderPrint(func_check()) - output$functext <- renderPrint(func_code()) - - args_expr <- reactive(eval_parse(text = input$argmap)) - args_code <- eventReactive(input$argsok, args_expr()) - args_check <- eventReactive( - input$argsok, - { - validate_args(args_expr(), - mask_data = mask_data(), func = func_code())}) + # the unique function + current_func <- reactiveVal(NULL) + current_check <- reactiveVal("No function validated yet.") + + # build function from example + observeEvent(input$egok, { + tryCatch({ + eg_expr <- parse(text = input$egcode) + fun <- from_example_to_function(eg_expr) + + # write generated function into the function text area + fun_txt <- paste(deparse(fun), collapse = "\n") + updateTextAreaInput(session, "funccode", value = fun_txt) + + # store as current function + current_func(fun) + current_check(validate_func(fun)) + + }, error = function(e) { + current_check(paste("Error:", conditionMessage(e))) + }) + }) + + # validate function written directly in funccode + observeEvent(input$funcok, { + tryCatch({ + fun <- eval_parse(text = input$funccode) + + current_func(fun) + current_check(validate_func(fun)) + + }, error = function(e) { + current_check(paste("Error:", conditionMessage(e))) + }) + }) + + # unique preview + output$functext <- renderPrint({ + req(current_func()) + current_func() + }) + + # unique validation message + output$funccheck <- renderPrint({ + current_check() + }) + + # arguments mapping + args_expr <- reactive({ + eval_parse(text = input$argmap) + }) + + args_code <- eventReactive(input$argsok, { + args_expr() + }) + + args_check <- eventReactive(input$argsok, { + req(current_func()) + validate_args( + args_expr(), + mask_data = mask_data(), + func = current_func() + ) + }) output$argscheck <- renderPrint(args_check()) output$argtext <- renderPrint(args_code()) - # from example to function section - eg_expr <- reactive(parse(text = input$egcode)) - eg_to_func <- eventReactive(input$egok, from_example_to_function(eg_expr())) - - output$egfunctext <- renderPrint(eg_to_func()) - - - list("func_code_return" = func_code, - "args_mapping_return" = args_code) - + list( + "func_code_return" = current_func, + "args_mapping_return" = args_code + ) }) } diff --git a/inst/demo_assets/func_and_args_mapping.R b/inst/demo_assets/func_and_args_mapping.R index fa9506c..a2bfa83 100644 --- a/inst/demo_assets/func_and_args_mapping.R +++ b/inst/demo_assets/func_and_args_mapping.R @@ -1,3 +1,9 @@ +# eg +{ +data <- readr::read_rds(file.path("./r_built_in_datasets", "airquality.rds")) +data %>% readr::write_csv(file.path("./out", "airquality.csv")) +} + # func function (param_1 = "./r_built_in_datasets", param_2 = "airquality.rds", param_3 = "./out", param_4 = "airquality.csv")