Merge pull request #14 from BristolMyersSquibb/13-blockr-update

update for blockr 0.0.2

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: blockr.extra
 Title: Experimental Blocks for blockr
-Version: 0.0.1.9000
+Version: 0.0.2.9000
 Authors@R:
     c(person(given = "Christoph",
              family = "Sax",
@@ -26,16 +26,15 @@ Description: Experimental Blocks for blockr.
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
-Depends:
-    blockr
+RoxygenNote: 7.3.2
 Imports:
     shiny,
     admiral,
     dplyr,
-    rlang
+    rlang,
+    blockr
 Remotes:
-    blockr-org/blockr
+    BristolMyersSquibb/blockr
 Suggests:
     knitr,
     shinyAce,

NAMESPACE

@@ -4,22 +4,14 @@ S3method(layout,code_plot_block)
 S3method(layout,code_transform_block)
 S3method(ui_fields,admiral_dpc_block)
 S3method(ui_fields,filter_expr_block)
-S3method(ui_fields,summarize_expr_block)
 S3method(ui_input,code_field)
 S3method(ui_update,code_field)
 S3method(validate_field,code_field)
-export(admiral_dpc_block)
-export(code_field)
-export(code_plot_block)
-export(code_transform_block)
-export(filter_expr_block)
 export(new_code_field)
 export(new_code_plot_block)
 export(new_code_transform_block)
-export(summarize_expr_block)
 import(blockr)
 importFrom(admiral,derive_param_computed)
-importFrom(dplyr,filter)
 importFrom(rlang,exprs)
 importFrom(shiny,div)
 importFrom(shiny,p)

NEWS.md

@@ -0,0 +1,12 @@
+# blockr.extra 0.0.2.9000
+
+## Documentation
+- Updated readme example with new API.
+
+## Breaking changes
+- Change blocks constructor names to `new_*_block` according to `{blockr}` 0.0.2.
+- Remove `data` parameter from constructor functions.
+
+# blockr.extra 0.0.0.9000
+
+* Initial GitHub version.

R/admiral-dpc-block.R

@@ -11,14 +11,13 @@
 #   )
 #
 # pkgload::load_all(".");
-# stack <- new_stack(data_block, mutate_block, admiral_dpc_block);
+# stack <- new_stack(new_dataset_block, new_mutate_block, new_admiral_dpc_block);
 # serve_stack(stack)
 
 #' @importFrom admiral derive_param_computed
 #' @importFrom rlang exprs
 #' @import blockr
-new_admiral_dpc_block <- function(data,
-                                  by_vars = NULL,
+new_admiral_dpc_block <- function(by_vars = NULL,
                                   parameters = NULL,
                                   set_values_to = NULL,
                                   ...) {
@@ -123,15 +122,6 @@ new_admiral_dpc_block <- function(data,
   )
 }
 
-#' Admiral Block
-#'
-#' @inheritParams blockr::new_block
-#'
-#' @export
-admiral_dpc_block <- function(data, ...) {
-  initialize_block(new_admiral_dpc_block(data, ...), data)
-}
-
 #' @export
 ui_fields.admiral_dpc_block <- function(x, ns, inputs_hidden, ...) {
   ui_fields_one_column(x = x, ns = ns, inputs_hidden = inputs_hidden)

R/code.R

@@ -11,10 +11,6 @@ new_code_field <- function(value = character(), ...) {
   )
 }
 
-#' @rdname code_field
-#' @export
-code_field <- function(...) validate_field(new_code_field(...))
-
 #' @rdname code_field
 #' @export
 validate_field.code_field <- function(x) {
@@ -39,11 +35,10 @@ ui_update.code_field <- function(x, session, id, name) {
 }
 
 #' Code Block
-#' @param data Dataset.
 #' @param ... Ignored.
 #' @name code_block
 #' @export
-new_code_transform_block <- function(data, ...) {
+new_code_transform_block <- function(...) {
   new_block(
     fields = list(
       code = new_code_field("data # from parent block")
@@ -60,13 +55,7 @@ new_code_transform_block <- function(data, ...) {
 
 #' @rdname code_block
 #' @export
-code_transform_block <- function(data, ...) {
-  initialize_block(new_code_transform_block(data, ...), data)
-}
-
-#' @rdname code_block
-#' @export
-new_code_plot_block <- function(data, ...) {
+new_code_plot_block <- function(...) {
   new_block(
     fields = list(
       code = new_code_field("plot(data) # from parent block")
@@ -81,12 +70,6 @@ new_code_plot_block <- function(data, ...) {
   )
 }
 
-#' @rdname code_block
-#' @export
-code_plot_block <- function(data, ...) {
-  initialize_block(new_code_plot_block(data, ...), data)
-}
-
 code_layout_fields <- function(x, fields, ...) {
   # we apply padding because there seems to be some
   # CSS that pushes the editor up and hides the buttons

R/filter-expr-block.R

@@ -21,7 +21,7 @@ filter_expr_expression <- function(value = c(a = "2.1", b = "4.5")) {
   )
 }
 
-new_filter_expr_block <- function(data, value = NULL, ...) {
+new_filter_expr_block <- function(value = NULL, ...) {
   fields <- list(
     value = new_keyvalue_field(
       value = value,
@@ -45,16 +45,6 @@ new_filter_expr_block <- function(data, value = NULL, ...) {
   )
 }
 
-#' Filter Expression Block
-#'
-#' @inheritParams blockr::new_block
-#'
-#' @export
-#' @importFrom dplyr filter
-filter_expr_block <- function(data, ...) {
-  initialize_block(new_filter_expr_block(data, ...), data)
-}
-
 #' @export
 ui_fields.filter_expr_block <- function(x, ns, inputs_hidden, ...) {
   ui_fields_one_column(x = x, ns = ns, inputs_hidden = inputs_hidden)

R/summarize-expr-block.R

@@ -1,12 +1,11 @@
 # pkgload::load_all(".");
-# stack <- new_stack(data_block, summarize_expr_block);
+# stack <- new_stack(new_dataset_block, new_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,
+new_summarize_expr_block <- function(new_cols = NULL,
                                      group_by = NULL,
                                      ...) {
 
@@ -33,7 +32,7 @@ new_summarize_expr_block <- function(data,
     if (inherits(ans, "try-error")) {
       return(expression())
     }
-    res
+    ans
   }
 
   parse_cols <- function(new_cols) {
@@ -93,17 +92,7 @@ new_summarize_expr_block <- function(data,
   )
 }
 
-#' 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)
-}
+#ui_fields.summarize_expr_block <- function(x, ns, inputs_hidden, ...) {
+#  ui_fields_one_column(x = x, ns = ns, inputs_hidden = inputs_hidden)
+#}

R/utils.R

@@ -40,11 +40,11 @@ register_blockr_extra_blocks <- function(pkg) {
 
   register_blocks(
     constructor = c(
-      admiral_dpc_block,
-      filter_expr_block,
-      summarize_expr_block,
-      code_transform_block,
-      code_plot_block
+      new_admiral_dpc_block,
+      new_filter_expr_block,
+      new_summarize_expr_block,
+      new_code_transform_block,
+      new_code_plot_block
     ),
     name = c(
       "admiral dpc block",

README.Rmd

@@ -28,11 +28,11 @@ library(bslib)
 
 Provides the following blocks:
 
-- `filter_expr_block`
-- `summarize_expr_block`
-- `admiral_dpc_block`
-- `code_plot_block`
-- `code_transform_block`
+- `new_filter_expr_block`
+- `new_summarize_expr_block`
+- `new_admiral_dpc_block`
+- `new_code_plot_block`
+- `new_code_transform_block`
 
 ## Usage
 
@@ -43,17 +43,17 @@ library(blockr.extra)
 options(BLOCKR_DEV = TRUE)
 pkgload::load_all(".")
 
-stack <- new_stack(
-  data_block,
-  filter_expr_block,
-  summarize_expr_block
-);
-serve_stack(stack)
+stack1 <- new_stack(
+  new_dataset_block,
+  new_filter_expr_block,
+  new_summarize_expr_block
+)
 
 # see admiral vingette for how to use admiral_dpc_block
-stack <- new_stack(data_block, mutate_block, admiral_dpc_block)
-serve_stack(stack)
+stack2 <- new_stack(new_dataset_block, new_mutate_block, new_admiral_dpc_block)
 
+set_workspace(summarize_expr_stack = stack1, admiral_stack = stack2)
+serve_workspace(clear = FALSE)
 ```
 
 ## Installation

inst/examples/bms-demo-cdisc/app.R

@@ -7,17 +7,27 @@ library(ggiraph)
 # Note: sometimes memories issue due to the join block
 # can be solved by restarting R between each run.
 serve_workspace(
-  stack1 = new_stack(lab_data_block, head_block),
-  stack2 = new_stack(demo_data_block, demo_join_block),
+  stack1 = new_stack(new_dataset_block("lab", package = "blockr.data"), new_head_block),
+  stack2 = new_stack(new_dataset_block("demo", package = "blockr.data"), new_join_block(
+    y = "demo",
+    type = "inner",
+    by_col = c("STUDYID", "USUBJID")
+  )),
   stack3 = new_stack(
-    result_block,
-    demo_filter_block_1,
-    demo_filter_block_2#,
-    #demo_arrange_block,
-    #asfactor_block#,
-    #demo_group_by_block,
-    #demo_summarize_block,
-    #ggiraph_block
+    new_result_block,
+    new_filter_block(
+      columns = "LBTEST",
+      values = "Hemoglobin"
+    ),
+    new_filter_block(
+      columns = "VISIT",
+      values = "UNSCHEDULED",
+      filter_fun = "!startsWith"
+    ),
+    new_arrange_block(columns = "VISITNUM"),
+    #new_asfactor_block,
+    new_group_by_block(columns = c("VISIT", "ACTARM"))#,
+    #new_summarize_block(func = c(), default_columns = c("LBSTRESN", "LBSTRESN"))
   ),
   title = "My workspace"
 )

inst/examples/code-block/app.R

@@ -2,8 +2,8 @@ devtools::load_all()
 library(shiny)
 
 stack <- new_stack(
-  data_block,
-  code_transform_block
+  new_dataset_block,
+  new_code_transform_block
 )
 
 ui <- fluidPage(