From aefdde43b890121152d62e4f63eff956f668839d Mon Sep 17 00:00:00 2001 From: John Coene Date: Wed, 6 Mar 2024 13:15:07 +0100 Subject: [PATCH 1/6] feat: use title for fields closes #319 fixes #314 --- R/block.R | 38 ++++++++++++++++++++++---------------- R/field.R | 17 +++++++++++++++++ R/ui.R | 16 ++++++++-------- 3 files changed, 47 insertions(+), 24 deletions(-) diff --git a/R/block.R b/R/block.R index d7ff560c..7017f0d9 100644 --- a/R/block.R +++ b/R/block.R @@ -206,7 +206,11 @@ new_data_block <- function( if (length(selected) == 0) selected <- datasets[1] fields <- list( - dataset = new_select_field(selected, datasets) + dataset = new_select_field( + selected, + datasets, + title = "Dataset" + ) ) expr <- substitute( @@ -238,7 +242,7 @@ new_upload_block <- function(...) { new_block( fields = list( - file = new_upload_field(), + file = new_upload_field(title = "File"), expression = new_hidden_field(data_path) ), expr = quote(c(.(expression))), @@ -271,7 +275,7 @@ new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ...) { new_block( fields = list( - file = new_filesbrowser_field(volumes = volumes), + file = new_filesbrowser_field(volumes = volumes, title = "File"), expression = new_hidden_field(data_path) ), expr = quote(c(.(expression))), @@ -377,7 +381,7 @@ xpt_block <- function(data, ...) { new_result_block <- function(...) { fields <- list( - stack = new_result_field() + stack = new_result_field(title = "Stack") ) new_block( @@ -475,8 +479,7 @@ new_filter_block <- function( col_choices <- function(data) colnames(data) fields <- list( - columns = new_select_field(columns, col_choices, multiple = TRUE), - values = new_list_field(values, sub_fields), + columns = new_select_field(columns, col_choices, multiple = TRUE, title = "Columns"), filter_func = new_select_field( filter_fun, choices = c( @@ -489,8 +492,10 @@ new_filter_block <- function( "<", ">=", "<=" - ) + ), + title = "Comparison" ), + values = new_list_field(values, sub_fields, title = "Value"), expression = new_hidden_field(filter_exps) ) @@ -521,7 +526,7 @@ new_select_block <- function(data, columns = colnames(data)[1], ...) { # Select_field only allow one value, not multi select fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE) + columns = new_select_field(columns, all_cols, multiple = TRUE, title = "Columns") ) new_block( @@ -635,8 +640,8 @@ new_summarize_block <- function( ) fields <- list( - funcs = new_select_field(func, func_choices, multiple = TRUE), - columns = new_list_field(sub_fields = sub_fields), + funcs = new_select_field(func, func_choices, multiple = TRUE, title = "Functions"), + columns = new_list_field(sub_fields = sub_fields, title = "Columns"), expression = new_hidden_field(summarize_expr) ) @@ -670,7 +675,7 @@ new_arrange_block <- function(data, columns = colnames(data)[1], ...) { # Type as name for arrange and group_by fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name") + columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns") ) new_block( @@ -694,7 +699,7 @@ new_group_by_block <- function(data, columns = colnames(data)[1], ...) { # Select_field only allow one value, not multi select fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name") + columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns") ) new_block( @@ -742,10 +747,11 @@ new_join_block <- function(data, y = NULL, type = character(), join_func = new_select_field( paste(type, "join", sep = "_"), paste(join_types, "join", sep = "_"), - type = "name" + type = "name", + title = "Type" ), - y = new_result_field(y), - by = new_select_field(by, by_choices, multiple = TRUE) + y = new_result_field(y, title = "Stack"), + by = new_select_field(by, by_choices, multiple = TRUE, title = "By") ) new_block( @@ -779,7 +785,7 @@ new_head_block <- function( } fields <- list( - n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data)), + n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data), title = "Number of rows"), expression = new_hidden_field(tmp_expr) ) diff --git a/R/field.R b/R/field.R index aeb92eee..d98dc18d 100644 --- a/R/field.R +++ b/R/field.R @@ -557,3 +557,20 @@ generate_server.result_field <- function(x, ...) { }) } } + +get_field_name <- function(field, name = "") { + title <- attr(field, "title") + + if (title == "") + return(name) + + title +} + +get_field_names <- function(x) { + titles <- character(length(x)) + for (i in seq_along(x)){ + titles[i] <- get_field_name(x[[i]], names(x)[i]) + } + titles +} diff --git a/R/ui.R b/R/ui.R index 77c52af4..e390baf8 100644 --- a/R/ui.R +++ b/R/ui.R @@ -26,7 +26,7 @@ ui_fields.block <- function(x, ns, inputs_hidden, ...) { ui_input, x, id = chr_ply(names(x), ns), - name = names(x) + name = get_field_names(x) ) div( @@ -629,21 +629,21 @@ ui_update <- function(x, session, id, name) { #' @rdname generate_ui #' @export ui_update.string_field <- function(x, session, id, name) { - updateTextInput(session, input_ids(x, id), name, value(x)) + updateTextInput(session, input_ids(x, id), get_field_name(x, name), value(x)) } #' @rdname generate_ui #' @export ui_update.select_field <- function(x, session, id, name) { updateSelectInput( - session, input_ids(x, id), name, value(x, "choices"), value(x) + session, input_ids(x, id), get_field_name(x, name), value(x, "choices"), value(x) ) } #' @rdname generate_ui #' @export ui_update.switch_field <- function(x, session, id, name) { - bslib::update_switch(input_ids(x, id), name, value(x), session) + bslib::update_switch(input_ids(x, id), get_field_name(x, name), value(x), session) } #' @rdname generate_ui @@ -663,7 +663,7 @@ ui_update.variable_field <- function(x, session, id, name) { insertUI( selector = paste0("#", ns_id, "_cont"), - ui = ui_input(field, ns_id, name), + ui = ui_input(field, ns_id, get_field_name(x, name)), session = session ) } @@ -672,7 +672,7 @@ ui_update.variable_field <- function(x, session, id, name) { #' @export ui_update.range_field <- function(x, session, id, name) { updateSliderInput( - session, input_ids(x, id), name, value(x), value(x, "min"), value(x, "max") + session, input_ids(x, id), get_field_name(x, name), value(x), value(x, "min"), value(x, "max") ) } @@ -680,7 +680,7 @@ ui_update.range_field <- function(x, session, id, name) { #' @export ui_update.numeric_field <- function(x, session, id, name) { updateNumericInput( - session, input_ids(x, id), name, value(x), value(x, "min"), value(x, "max") + session, input_ids(x, id), get_field_name(x, name), value(x), value(x, "min"), value(x, "max") ) } @@ -738,7 +738,7 @@ ui_update.list_field <- function(x, session, id, name) { ui = do.call( tagList, map( - ui_input, fields, input_ids(x, ns_id), paste0(name, "_", names(fields)) + ui_input, fields, input_ids(x, ns_id), paste0(name, ": ", names(fields)) ) ), session = session From 388716d44fb59b2436f05848cecf5bfc4eb523d1 Mon Sep 17 00:00:00 2001 From: John Coene Date: Wed, 6 Mar 2024 14:50:20 +0100 Subject: [PATCH 2/6] feat: field titles as arguments --- R/block.R | 95 ++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 62 insertions(+), 33 deletions(-) diff --git a/R/block.R b/R/block.R index 7017f0d9..60b8eb9b 100644 --- a/R/block.R +++ b/R/block.R @@ -192,7 +192,9 @@ evaluate_block.plot_layer_block <- function(x, data, ...) { new_data_block <- function( ..., dat = as.environment("package:datasets"), - selected = character()) { + selected = character(), + field_dataset = "Dataset" +) { is_dataset_eligible <- function(x) { inherits( get(x, envir = dat, inherits = FALSE), @@ -209,7 +211,7 @@ new_data_block <- function( dataset = new_select_field( selected, datasets, - title = "Dataset" + title = field_dataset ) ) @@ -234,7 +236,7 @@ data_block <- function(...) { #' @rdname new_block #' @export -new_upload_block <- function(...) { +new_upload_block <- function(..., field_file = "File") { data_path <- function(file) { if (length(file)) file$datapath else character() @@ -242,7 +244,7 @@ new_upload_block <- function(...) { new_block( fields = list( - file = new_upload_field(title = "File"), + file = new_upload_field(title = field_file), expression = new_hidden_field(data_path) ), expr = quote(c(.(expression))), @@ -260,7 +262,7 @@ upload_block <- function(...) { #' @rdname new_block #' @param volumes Paths accessible by the shinyFiles browser. #' @export -new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ...) { +new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ..., field_file = "File") { data_path <- function(file) { @@ -275,7 +277,7 @@ new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ...) { new_block( fields = list( - file = new_filesbrowser_field(volumes = volumes, title = "File"), + file = new_filesbrowser_field(volumes = volumes, title = field_file), expression = new_hidden_field(data_path) ), expr = quote(c(.(expression))), @@ -378,10 +380,10 @@ xpt_block <- function(data, ...) { #' @rdname new_block #' @export -new_result_block <- function(...) { +new_result_block <- function(..., field_stack = "Stack") { fields <- list( - stack = new_result_field(title = "Stack") + stack = new_result_field(title = field_stack) ) new_block( @@ -422,7 +424,11 @@ new_filter_block <- function( columns = colnames(data)[1L], values = character(), filter_fun = "==", - ...) { + ..., + field_columns = "Columns", + field_filter_fun = "Comparison", + field_values = "Value" +) { sub_fields <- function(data, columns) { determine_field <- function(x) { switch(class(x), @@ -479,7 +485,7 @@ new_filter_block <- function( col_choices <- function(data) colnames(data) fields <- list( - columns = new_select_field(columns, col_choices, multiple = TRUE, title = "Columns"), + columns = new_select_field(columns, col_choices, multiple = TRUE, title = field_columns), filter_func = new_select_field( filter_fun, choices = c( @@ -493,9 +499,9 @@ new_filter_block <- function( ">=", "<=" ), - title = "Comparison" + title = field_filter_fun ), - values = new_list_field(values, sub_fields, title = "Value"), + values = new_list_field(values, sub_fields, title = field_values), expression = new_hidden_field(filter_exps) ) @@ -521,12 +527,12 @@ filter_block <- function(data, ...) { #' @param columns Column(s) to select. #' @rdname new_block #' @export -new_select_block <- function(data, columns = colnames(data)[1], ...) { +new_select_block <- function(data, columns = colnames(data)[1], ..., field_columns = "Columns") { all_cols <- function(data) colnames(data) # Select_field only allow one value, not multi select fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE, title = "Columns") + columns = new_select_field(columns, all_cols, multiple = TRUE, title = field_columns) ) new_block( @@ -548,10 +554,13 @@ new_select_block <- function(data, columns = colnames(data)[1], ...) { #' @rdname new_block #' @export new_summarize_block <- function( - data, - func = c("mean", "se"), - default_columns = character(), - ...) { + data, + func = c("mean", "se"), + default_columns = character(), + ..., + field_columns = "Columns", + field_funcs = "Functions" +) { if (length(default_columns) > 0) { stopifnot(length(func) == length(default_columns)) } @@ -640,8 +649,8 @@ new_summarize_block <- function( ) fields <- list( - funcs = new_select_field(func, func_choices, multiple = TRUE, title = "Functions"), - columns = new_list_field(sub_fields = sub_fields, title = "Columns"), + funcs = new_select_field(func, func_choices, multiple = TRUE, title = field_funcs), + columns = new_list_field(sub_fields = sub_fields, title = field_columns), expression = new_hidden_field(summarize_expr) ) @@ -670,12 +679,18 @@ select_block <- function(data, ...) { #' @rdname new_block #' @export -new_arrange_block <- function(data, columns = colnames(data)[1], ...) { +new_arrange_block <- function(data, columns = colnames(data)[1], ..., field_columns = "Columns") { all_cols <- function(data) colnames(data) # Type as name for arrange and group_by fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns") + columns = new_select_field( + columns, + all_cols, + multiple = TRUE, + type = "name", + title = field_columns + ) ) new_block( @@ -694,12 +709,18 @@ arrange_block <- function(data, ...) { #' @rdname new_block #' @export -new_group_by_block <- function(data, columns = colnames(data)[1], ...) { +new_group_by_block <- function(data, columns = colnames(data)[1], ..., field_columns = "Columns") { all_cols <- function(data) colnames(data) # Select_field only allow one value, not multi select fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns") + columns = new_select_field( + columns, + all_cols, + multiple = TRUE, + type = "name", + title = field_columns + ) ) new_block( @@ -714,7 +735,13 @@ new_group_by_block <- function(data, columns = colnames(data)[1], ...) { #' @rdname new_block #' @export -group_by_block <- function(data, ...) { +group_by_block <- function( + data, + ..., + field_join_func = "Type", + field_y = "Stack", + field_by = "By" +) { initialize_block(new_group_by_block(data, ...), data) } @@ -748,10 +775,10 @@ new_join_block <- function(data, y = NULL, type = character(), paste(type, "join", sep = "_"), paste(join_types, "join", sep = "_"), type = "name", - title = "Type" + title = field_join_func ), - y = new_result_field(y, title = "Stack"), - by = new_select_field(by, by_choices, multiple = TRUE, title = "By") + y = new_result_field(y, title = field_y), + by = new_select_field(by, by_choices, multiple = TRUE, title = field_by) ) new_block( @@ -773,10 +800,12 @@ join_block <- function(data, ...) { #' @param n_rows_min Minimum number of rows. #' @export new_head_block <- function( - data, - n_rows = numeric(), - n_rows_min = 1L, - ...) { + data, + n_rows = numeric(), + n_rows_min = 1L, + ..., + field_n_rows = "Number of rows" +) { tmp_expr <- function(n_rows) { bquote( head(n = .(n_rows)), @@ -785,7 +814,7 @@ new_head_block <- function( } fields <- list( - n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data), title = "Number of rows"), + n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data), title = field_n_rows), expression = new_hidden_field(tmp_expr) ) From bf04c82227e05a3c4c47b538c50f0b7b495102af Mon Sep 17 00:00:00 2001 From: John Coene Date: Wed, 6 Mar 2024 14:58:43 +0100 Subject: [PATCH 3/6] ci: add tests --- R/block.R | 17 ++++++---- man/new_block.Rd | 62 ++++++++++++++++++++++++++++++------- tests/testthat/test-field.R | 8 +++++ 3 files changed, 70 insertions(+), 17 deletions(-) diff --git a/R/block.R b/R/block.R index 60b8eb9b..06d7472e 100644 --- a/R/block.R +++ b/R/block.R @@ -737,10 +737,7 @@ new_group_by_block <- function(data, columns = colnames(data)[1], ..., field_col #' @export group_by_block <- function( data, - ..., - field_join_func = "Type", - field_y = "Stack", - field_by = "By" + ... ) { initialize_block(new_group_by_block(data, ...), data) } @@ -751,8 +748,16 @@ group_by_block <- function( #' #' @rdname new_block #' @export -new_join_block <- function(data, y = NULL, type = character(), - by = character(), ...) { +new_join_block <- function( + data, + y = NULL, + type = character(), + by = character(), + ..., + field_join_func = "Type", + field_y = "Stack", + field_by = "By" +) { by_choices <- function(data, y) { intersect(colnames(data), colnames(y)) diff --git a/man/new_block.Rd b/man/new_block.Rd index 0b4c709a..e8beb1b2 100644 --- a/man/new_block.Rd +++ b/man/new_block.Rd @@ -100,16 +100,21 @@ evaluate_block(x, ...) new_data_block( ..., dat = as.environment("package:datasets"), - selected = character() + selected = character(), + field_dataset = "Dataset" ) data_block(...) -new_upload_block(...) +new_upload_block(..., field_file = "File") upload_block(...) -new_filesbrowser_block(volumes = c(home = path.expand("~")), ...) +new_filesbrowser_block( + volumes = c(home = path.expand("~")), + ..., + field_file = "File" +) filesbrowser_block(...) @@ -135,7 +140,7 @@ new_xpt_block(data, ...) xpt_block(data, ...) -new_result_block(...) +new_result_block(..., field_stack = "Stack") result_block(...) @@ -146,37 +151,72 @@ new_filter_block( columns = colnames(data)[1L], values = character(), filter_fun = "==", - ... + ..., + field_columns = "Columns", + field_filter_fun = "Comparison", + field_values = "Value" ) filter_block(data, ...) -new_select_block(data, columns = colnames(data)[1], ...) +new_select_block( + data, + columns = colnames(data)[1], + ..., + field_columns = "Columns" +) new_summarize_block( data, func = c("mean", "se"), default_columns = character(), - ... + ..., + field_columns = "Columns", + field_funcs = "Functions" ) summarize_block(data, ...) select_block(data, ...) -new_arrange_block(data, columns = colnames(data)[1], ...) +new_arrange_block( + data, + columns = colnames(data)[1], + ..., + field_columns = "Columns" +) arrange_block(data, ...) -new_group_by_block(data, columns = colnames(data)[1], ...) +new_group_by_block( + data, + columns = colnames(data)[1], + ..., + field_columns = "Columns" +) group_by_block(data, ...) -new_join_block(data, y = NULL, type = character(), by = character(), ...) +new_join_block( + data, + y = NULL, + type = character(), + by = character(), + ..., + field_join_func = "Type", + field_y = "Stack", + field_by = "By" +) join_block(data, ...) -new_head_block(data, n_rows = numeric(), n_rows_min = 1L, ...) +new_head_block( + data, + n_rows = numeric(), + n_rows_min = 1L, + ..., + field_n_rows = "Number of rows" +) head_block(data, ...) diff --git a/tests/testthat/test-field.R b/tests/testthat/test-field.R index 7b24e5b0..41c17944 100644 --- a/tests/testthat/test-field.R +++ b/tests/testthat/test-field.R @@ -93,3 +93,11 @@ test_that("filesbrowser field", { expect_type(field, "list") expect_identical(value(field), character(0)) }) + +test_that("field name", { + blk <- data_block() + expect_equal(get_field_names(blk), "Dataset") + + expect_equal(get_field_name(new_switch_field(), "xxx"), "xxx") + expect_equal(get_field_name(new_switch_field(title = "xxx"), ""), "xxx") +}) From 38e28af7ae571b975ccb0e830f480e5a015fc477 Mon Sep 17 00:00:00 2001 From: John Coene Date: Wed, 6 Mar 2024 15:05:26 +0100 Subject: [PATCH 4/6] lint: blockr 193 --- R/block.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/block.R b/R/block.R index 06d7472e..3661ef1b 100644 --- a/R/block.R +++ b/R/block.R @@ -190,10 +190,10 @@ evaluate_block.plot_layer_block <- function(x, data, ...) { #' @param selected Selected dataset. #' @export new_data_block <- function( - ..., - dat = as.environment("package:datasets"), - selected = character(), - field_dataset = "Dataset" + ..., + dat = as.environment("package:datasets"), + selected = character(), + field_dataset = "Dataset" ) { is_dataset_eligible <- function(x) { inherits( From 7f9d4da6da037b330297e82651f6b613e08e5df1 Mon Sep 17 00:00:00 2001 From: John Coene Date: Wed, 6 Mar 2024 15:16:51 +0100 Subject: [PATCH 5/6] lint: block l 423 --- R/block.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/block.R b/R/block.R index 3661ef1b..b373d43e 100644 --- a/R/block.R +++ b/R/block.R @@ -420,14 +420,14 @@ initialize_block.data_block <- function(x, ...) { #' @rdname new_block #' @export new_filter_block <- function( - data, - columns = colnames(data)[1L], - values = character(), - filter_fun = "==", - ..., - field_columns = "Columns", - field_filter_fun = "Comparison", - field_values = "Value" + data, + columns = colnames(data)[1L], + values = character(), + filter_fun = "==", + ..., + field_columns = "Columns", + field_filter_fun = "Comparison", + field_values = "Value" ) { sub_fields <- function(data, columns) { determine_field <- function(x) { From 638189456f1fcb81f3d43c8679fa8c01ed1c18cb Mon Sep 17 00:00:00 2001 From: John Coene Date: Wed, 6 Mar 2024 16:42:42 +0100 Subject: [PATCH 6/6] revert: do not expose field titles --- R/block.R | 116 +++++++++++++++++------------------------------ man/new_block.Rd | 62 +++++-------------------- 2 files changed, 52 insertions(+), 126 deletions(-) diff --git a/R/block.R b/R/block.R index b373d43e..7017f0d9 100644 --- a/R/block.R +++ b/R/block.R @@ -190,11 +190,9 @@ evaluate_block.plot_layer_block <- function(x, data, ...) { #' @param selected Selected dataset. #' @export new_data_block <- function( - ..., - dat = as.environment("package:datasets"), - selected = character(), - field_dataset = "Dataset" -) { + ..., + dat = as.environment("package:datasets"), + selected = character()) { is_dataset_eligible <- function(x) { inherits( get(x, envir = dat, inherits = FALSE), @@ -211,7 +209,7 @@ new_data_block <- function( dataset = new_select_field( selected, datasets, - title = field_dataset + title = "Dataset" ) ) @@ -236,7 +234,7 @@ data_block <- function(...) { #' @rdname new_block #' @export -new_upload_block <- function(..., field_file = "File") { +new_upload_block <- function(...) { data_path <- function(file) { if (length(file)) file$datapath else character() @@ -244,7 +242,7 @@ new_upload_block <- function(..., field_file = "File") { new_block( fields = list( - file = new_upload_field(title = field_file), + file = new_upload_field(title = "File"), expression = new_hidden_field(data_path) ), expr = quote(c(.(expression))), @@ -262,7 +260,7 @@ upload_block <- function(...) { #' @rdname new_block #' @param volumes Paths accessible by the shinyFiles browser. #' @export -new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ..., field_file = "File") { +new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ...) { data_path <- function(file) { @@ -277,7 +275,7 @@ new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ..., fi new_block( fields = list( - file = new_filesbrowser_field(volumes = volumes, title = field_file), + file = new_filesbrowser_field(volumes = volumes, title = "File"), expression = new_hidden_field(data_path) ), expr = quote(c(.(expression))), @@ -380,10 +378,10 @@ xpt_block <- function(data, ...) { #' @rdname new_block #' @export -new_result_block <- function(..., field_stack = "Stack") { +new_result_block <- function(...) { fields <- list( - stack = new_result_field(title = field_stack) + stack = new_result_field(title = "Stack") ) new_block( @@ -420,15 +418,11 @@ initialize_block.data_block <- function(x, ...) { #' @rdname new_block #' @export new_filter_block <- function( - data, - columns = colnames(data)[1L], - values = character(), - filter_fun = "==", - ..., - field_columns = "Columns", - field_filter_fun = "Comparison", - field_values = "Value" -) { + data, + columns = colnames(data)[1L], + values = character(), + filter_fun = "==", + ...) { sub_fields <- function(data, columns) { determine_field <- function(x) { switch(class(x), @@ -485,7 +479,7 @@ new_filter_block <- function( col_choices <- function(data) colnames(data) fields <- list( - columns = new_select_field(columns, col_choices, multiple = TRUE, title = field_columns), + columns = new_select_field(columns, col_choices, multiple = TRUE, title = "Columns"), filter_func = new_select_field( filter_fun, choices = c( @@ -499,9 +493,9 @@ new_filter_block <- function( ">=", "<=" ), - title = field_filter_fun + title = "Comparison" ), - values = new_list_field(values, sub_fields, title = field_values), + values = new_list_field(values, sub_fields, title = "Value"), expression = new_hidden_field(filter_exps) ) @@ -527,12 +521,12 @@ filter_block <- function(data, ...) { #' @param columns Column(s) to select. #' @rdname new_block #' @export -new_select_block <- function(data, columns = colnames(data)[1], ..., field_columns = "Columns") { +new_select_block <- function(data, columns = colnames(data)[1], ...) { all_cols <- function(data) colnames(data) # Select_field only allow one value, not multi select fields <- list( - columns = new_select_field(columns, all_cols, multiple = TRUE, title = field_columns) + columns = new_select_field(columns, all_cols, multiple = TRUE, title = "Columns") ) new_block( @@ -554,13 +548,10 @@ new_select_block <- function(data, columns = colnames(data)[1], ..., field_colum #' @rdname new_block #' @export new_summarize_block <- function( - data, - func = c("mean", "se"), - default_columns = character(), - ..., - field_columns = "Columns", - field_funcs = "Functions" -) { + data, + func = c("mean", "se"), + default_columns = character(), + ...) { if (length(default_columns) > 0) { stopifnot(length(func) == length(default_columns)) } @@ -649,8 +640,8 @@ new_summarize_block <- function( ) fields <- list( - funcs = new_select_field(func, func_choices, multiple = TRUE, title = field_funcs), - columns = new_list_field(sub_fields = sub_fields, title = field_columns), + funcs = new_select_field(func, func_choices, multiple = TRUE, title = "Functions"), + columns = new_list_field(sub_fields = sub_fields, title = "Columns"), expression = new_hidden_field(summarize_expr) ) @@ -679,18 +670,12 @@ select_block <- function(data, ...) { #' @rdname new_block #' @export -new_arrange_block <- function(data, columns = colnames(data)[1], ..., field_columns = "Columns") { +new_arrange_block <- function(data, columns = colnames(data)[1], ...) { all_cols <- function(data) colnames(data) # Type as name for arrange and group_by fields <- list( - columns = new_select_field( - columns, - all_cols, - multiple = TRUE, - type = "name", - title = field_columns - ) + columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns") ) new_block( @@ -709,18 +694,12 @@ arrange_block <- function(data, ...) { #' @rdname new_block #' @export -new_group_by_block <- function(data, columns = colnames(data)[1], ..., field_columns = "Columns") { +new_group_by_block <- function(data, columns = colnames(data)[1], ...) { all_cols <- function(data) colnames(data) # Select_field only allow one value, not multi select fields <- list( - columns = new_select_field( - columns, - all_cols, - multiple = TRUE, - type = "name", - title = field_columns - ) + columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns") ) new_block( @@ -735,10 +714,7 @@ new_group_by_block <- function(data, columns = colnames(data)[1], ..., field_col #' @rdname new_block #' @export -group_by_block <- function( - data, - ... -) { +group_by_block <- function(data, ...) { initialize_block(new_group_by_block(data, ...), data) } @@ -748,16 +724,8 @@ group_by_block <- function( #' #' @rdname new_block #' @export -new_join_block <- function( - data, - y = NULL, - type = character(), - by = character(), - ..., - field_join_func = "Type", - field_y = "Stack", - field_by = "By" -) { +new_join_block <- function(data, y = NULL, type = character(), + by = character(), ...) { by_choices <- function(data, y) { intersect(colnames(data), colnames(y)) @@ -780,10 +748,10 @@ new_join_block <- function( paste(type, "join", sep = "_"), paste(join_types, "join", sep = "_"), type = "name", - title = field_join_func + title = "Type" ), - y = new_result_field(y, title = field_y), - by = new_select_field(by, by_choices, multiple = TRUE, title = field_by) + y = new_result_field(y, title = "Stack"), + by = new_select_field(by, by_choices, multiple = TRUE, title = "By") ) new_block( @@ -805,12 +773,10 @@ join_block <- function(data, ...) { #' @param n_rows_min Minimum number of rows. #' @export new_head_block <- function( - data, - n_rows = numeric(), - n_rows_min = 1L, - ..., - field_n_rows = "Number of rows" -) { + data, + n_rows = numeric(), + n_rows_min = 1L, + ...) { tmp_expr <- function(n_rows) { bquote( head(n = .(n_rows)), @@ -819,7 +785,7 @@ new_head_block <- function( } fields <- list( - n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data), title = field_n_rows), + n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data), title = "Number of rows"), expression = new_hidden_field(tmp_expr) ) diff --git a/man/new_block.Rd b/man/new_block.Rd index e8beb1b2..0b4c709a 100644 --- a/man/new_block.Rd +++ b/man/new_block.Rd @@ -100,21 +100,16 @@ evaluate_block(x, ...) new_data_block( ..., dat = as.environment("package:datasets"), - selected = character(), - field_dataset = "Dataset" + selected = character() ) data_block(...) -new_upload_block(..., field_file = "File") +new_upload_block(...) upload_block(...) -new_filesbrowser_block( - volumes = c(home = path.expand("~")), - ..., - field_file = "File" -) +new_filesbrowser_block(volumes = c(home = path.expand("~")), ...) filesbrowser_block(...) @@ -140,7 +135,7 @@ new_xpt_block(data, ...) xpt_block(data, ...) -new_result_block(..., field_stack = "Stack") +new_result_block(...) result_block(...) @@ -151,72 +146,37 @@ new_filter_block( columns = colnames(data)[1L], values = character(), filter_fun = "==", - ..., - field_columns = "Columns", - field_filter_fun = "Comparison", - field_values = "Value" + ... ) filter_block(data, ...) -new_select_block( - data, - columns = colnames(data)[1], - ..., - field_columns = "Columns" -) +new_select_block(data, columns = colnames(data)[1], ...) new_summarize_block( data, func = c("mean", "se"), default_columns = character(), - ..., - field_columns = "Columns", - field_funcs = "Functions" + ... ) summarize_block(data, ...) select_block(data, ...) -new_arrange_block( - data, - columns = colnames(data)[1], - ..., - field_columns = "Columns" -) +new_arrange_block(data, columns = colnames(data)[1], ...) arrange_block(data, ...) -new_group_by_block( - data, - columns = colnames(data)[1], - ..., - field_columns = "Columns" -) +new_group_by_block(data, columns = colnames(data)[1], ...) group_by_block(data, ...) -new_join_block( - data, - y = NULL, - type = character(), - by = character(), - ..., - field_join_func = "Type", - field_y = "Stack", - field_by = "By" -) +new_join_block(data, y = NULL, type = character(), by = character(), ...) join_block(data, ...) -new_head_block( - data, - n_rows = numeric(), - n_rows_min = 1L, - ..., - field_n_rows = "Number of rows" -) +new_head_block(data, n_rows = numeric(), n_rows_min = 1L, ...) head_block(data, ...)