From e625385cbd7c73687863ec6e8d4ff9c3389b0f2f Mon Sep 17 00:00:00 2001 From: Christoph Sax Date: Thu, 25 Jan 2024 13:36:05 +0100 Subject: [PATCH 1/5] summarize by block --- NAMESPACE | 2 + R/summarize-expr-block.R | 108 ++++++++++++++++++++++++++++++++++++ README.Rmd | 3 + man/summarize_expr_block.Rd | 16 ++++++ 4 files changed, 129 insertions(+) create mode 100644 R/summarize-expr-block.R create mode 100644 man/summarize_expr_block.Rd diff --git a/NAMESPACE b/NAMESPACE index c65ed3f..787b0a2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,8 +2,10 @@ S3method(ui_fields,admiral_dpc_block) S3method(ui_fields,filter_expr_block) +S3method(ui_fields,summarize_expr_block) export(admiral_dpc_block) export(filter_expr_block) +export(summarize_expr_block) import(blockr) importFrom(admiral,derive_param_computed) importFrom(dplyr,filter) diff --git a/R/summarize-expr-block.R b/R/summarize-expr-block.R new file mode 100644 index 0000000..dae3670 --- /dev/null +++ b/R/summarize-expr-block.R @@ -0,0 +1,108 @@ +# pkgload::load_all("."); +# stack <- new_stack(data_block, summarize_expr_block); +# serve_stack(stack) + +#' @importFrom admiral derive_param_computed +#' @importFrom rlang exprs +#' @import blockr +new_summarize_expr_block <- function(data, + new_cols = NULL, + group_by = NULL, + ...) { + + # 0. helper functions + handle_error <- function(e) { + warning(e) + expression() + } + + parse_one <- function(x) { + tryCatch( + parse(text = x), + error = handle_error + ) + } + + parse_multiple <- function(x) { + ans <- try({ + res <- lapply(x, parse_one) + if (length(res)) { + res <- do.call(c, res) + } + }) + if (inherits(ans, "try-error")) { + return(expression()) + } + res + } + + parse_cols <- function(new_cols) { + parse_multiple(new_cols) + } + + parse_grouping <- function(group_by) { + res <- parse_multiple(group_by) + names(res) <- NULL + res + } + + # 1. main expression + main_expr <- function(new_cols = NULL, group_by = NULL) { + + col_expr <- parse_cols(new_cols) + grp_expr <- parse_grouping(group_by) + + bquote( + dplyr::summarize(..(col_expr), .by = c(..(grp_expr))), + list(col_expr = col_expr, grp_expr = grp_expr), + splice = TRUE + ) + } + + # 2. functions for derived inputs + data_cols <- function(data) { + colnames(data) + } + + # 3. fields + fields <- list( + new_cols = new_keyvalue_field( + title = "Summarise each group down to one row", + descr = "Name-value pairs of summary functions. The name will be the name + of the variable in the result.", + value = new_cols, + submit = TRUE + ), + group_by = new_select_field( + title = "Grouping variables", + descr = "Selection of columns to group by for just this + operation, functioning as an alternative to group_by()", + value = group_by, + choices = data_cols, + multiple = TRUE), + expression = new_hidden_field(main_expr) + ) + + # 4. block creation + new_block( + fields = fields, + expr = quote(.(expression)), + ..., + class = c("summarize_expr_block", "transform_block") + ) +} + +#' Summarize By Block +#' +#' @inheritParams blockr::new_block +#' +#' @export +summarize_expr_block <- function(data, ...) { + initialize_block(new_summarize_expr_block(data, ...), data) +} + + +#' @export +ui_fields.summarize_expr_block <- function(x, ns, inputs_hidden, ...) { + ui_fields_one_column(x = x, ns = ns, inputs_hidden = inputs_hidden) +} diff --git a/README.Rmd b/README.Rmd index 8088633..011bc0e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -33,6 +33,9 @@ library(blockr.extra) options(BLOCKR_DEV = TRUE) pkgload::load_all(".") +stack <- new_stack(data_block, summarize_expr_block); +serve_stack(stack) + stack <- new_stack(data_block, filter_expr_block) serve_stack(stack) diff --git a/man/summarize_expr_block.Rd b/man/summarize_expr_block.Rd new file mode 100644 index 0000000..2993f12 --- /dev/null +++ b/man/summarize_expr_block.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summarize-expr-block.R +\name{summarize_expr_block} +\alias{summarize_expr_block} +\title{Summarize By Block} +\usage{ +summarize_expr_block(data, ...) +} +\arguments{ +\item{data}{Block input data} + +\item{...}{Any other params. TO DO} +} +\description{ +Summarize By Block +} From f6536c23cdd4fd158ece5bf0cb46d9990ec9abcd Mon Sep 17 00:00:00 2001 From: Christoph Sax Date: Thu, 25 Jan 2024 14:07:41 +0100 Subject: [PATCH 2/5] test --- tests/testthat/test-filter-expr-block.R | 2 ++ tests/testthat/test-summarize-expr-block.R | 19 +++++++++++++++++++ 2 files changed, 21 insertions(+) create mode 100644 tests/testthat/test-summarize-expr-block.R diff --git a/tests/testthat/test-filter-expr-block.R b/tests/testthat/test-filter-expr-block.R index 6909b89..0642202 100644 --- a/tests/testthat/test-filter-expr-block.R +++ b/tests/testthat/test-filter-expr-block.R @@ -5,6 +5,8 @@ test_that("filter-expr-block", { expect_s3_class(block, "filter_expr_block") expect_type(block, "list") + expect_true(is_initialized(block)) + res <- evaluate_block(block, data) expect_identical(unique(as.character(res$Species)), "virginica") diff --git a/tests/testthat/test-summarize-expr-block.R b/tests/testthat/test-summarize-expr-block.R new file mode 100644 index 0000000..274b09e --- /dev/null +++ b/tests/testthat/test-summarize-expr-block.R @@ -0,0 +1,19 @@ +test_that("summarize-expr-block", { + data <- datasets::iris + + block <- summarize_expr_block( + data, + group_by = "Species", + new_cols = c( + Mean.Sepal.Width = "mean(Sepal.Width)" + ) + ) + + expect_true(is_initialized(block)) + expect_s3_class(block, "summarize_expr_block") + expect_type(block, "list") + + res <- evaluate_block(block, data) + expect_identical(nrow(res), 3L) + +}) From 9a98b79cc243fbab93f2b785a213ad6df74c7278 Mon Sep 17 00:00:00 2001 From: Christoph Sax Date: Thu, 25 Jan 2024 14:10:31 +0100 Subject: [PATCH 3/5] one example --- README.Rmd | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/README.Rmd b/README.Rmd index 011bc0e..27975e5 100644 --- a/README.Rmd +++ b/README.Rmd @@ -33,10 +33,11 @@ library(blockr.extra) options(BLOCKR_DEV = TRUE) pkgload::load_all(".") -stack <- new_stack(data_block, summarize_expr_block); -serve_stack(stack) - -stack <- new_stack(data_block, filter_expr_block) +stack <- new_stack( + data_block, + filter_expr_block, + summarize_expr_block +); serve_stack(stack) # see admiral vingette for how to use admiral_dpc_block From 6c84541a29b607ac54e1757034b1aefda48a497b Mon Sep 17 00:00:00 2001 From: Christoph Sax Date: Thu, 25 Jan 2024 14:30:29 +0100 Subject: [PATCH 4/5] upd REAMDE --- README.Rmd | 8 ++++++++ README.md | 14 +++++++++++++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/README.Rmd b/README.Rmd index 27975e5..f17ef4f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -24,6 +24,14 @@ library(bslib) [![codecov](https://codecov.io/github/blockr-org/blockr.extra/graph/badge.svg?token=9AO88LK8FJ)](https://codecov.io/github/blockr-org/blockr) +## Content + +Provides the following blocks: + +- `filter_expr_block` +- `summarize_expr_block` +- `admiral_dpc_block` + ## Usage ```r diff --git a/README.md b/README.md index f5fe8eb..16615da 100644 --- a/README.md +++ b/README.md @@ -9,6 +9,14 @@ [![codecov](https://codecov.io/github/blockr-org/blockr.extra/graph/badge.svg?token=9AO88LK8FJ)](https://codecov.io/github/blockr-org/blockr) +## Content + +Provides the following blocks: + +- `filter_expr_block` +- `summarize_expr_block` +- `admiral_dpc_block` + ## Usage ``` r @@ -18,7 +26,11 @@ library(blockr.extra) options(BLOCKR_DEV = TRUE) pkgload::load_all(".") -stack <- new_stack(data_block, filter_expr_block) +stack <- new_stack( + data_block, + filter_expr_block, + summarize_expr_block +); serve_stack(stack) # see admiral vingette for how to use admiral_dpc_block From 61a4c35cccb3fa232b1aa3940c39f363dcc155ec Mon Sep 17 00:00:00 2001 From: Christoph Sax Date: Thu, 25 Jan 2024 14:34:49 +0100 Subject: [PATCH 5/5] lintr --- R/summarize-expr-block.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/summarize-expr-block.R b/R/summarize-expr-block.R index dae3670..08ae5e5 100644 --- a/R/summarize-expr-block.R +++ b/R/summarize-expr-block.R @@ -67,19 +67,20 @@ new_summarize_expr_block <- function(data, # 3. fields fields <- list( new_cols = new_keyvalue_field( + value = new_cols, + submit = TRUE, title = "Summarise each group down to one row", descr = "Name-value pairs of summary functions. The name will be the name - of the variable in the result.", - value = new_cols, - submit = TRUE + of the variable in the result." ), group_by = new_select_field( - title = "Grouping variables", - descr = "Selection of columns to group by for just this - operation, functioning as an alternative to group_by()", value = group_by, choices = data_cols, - multiple = TRUE), + multiple = TRUE, + title = "Grouping variables", + descr = "Selection of columns to group by for just this + operation, functioning as an alternative to group_by()" + ), expression = new_hidden_field(main_expr) )