update vignettes + app examples according to registry change

inst/shinylive/apps/ae-forest-plot/app.R

@@ -139,14 +139,22 @@ new_forest_plot_block <- function(...) {
   )
 }
 
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
 # Register the custom block
 register_block(
   new_forest_plot_block,
   name = "Adverse Event Forest Plot",
-  description = "Create a forest plot of adverse events comparing two treatment arms",
-  classes = c("adverse_event_plot_block", "plot_block"),
-  input = "data.frame",
-  output = "plot"
+  description = "Create a forest plot of adverse events comparing two treatment arms"
 )
 
 # Create the stack

inst/shinylive/apps/ggplot-block/app.R

@@ -38,6 +38,38 @@ new_geompoint_block <- function(color = character(), shape = character(), ...) {
   )
 }
 
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
+block_input_check.plot_layer_block <- function(x, data, ...) {
+  if (inherits(data, "ggplot")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting ggplot input.")
+}
+
+block_output_ptype.plot_layer_block <- function(x, ...) ggplot()
+
+register_blocks(
+  constructor = c(new_ggplot_block, new_geompoint_block),
+  name = c("ggplot block", "geompoint block"),
+  description = c(
+    "Builds a ggplot object",
+    "Add points geom to ggplot object"
+  ),
+  package = "blockr.demo",
+  category = c("Visualization", "Visualization")
+)
+
 stack <- new_stack(
   data_block = new_dataset_block("penguins", "palmerpenguins"),
   plot_block = new_ggplot_block("flipper_length_mm", "body_mass_g"),

inst/shinylive/apps/palmer-penguins/app.R

@@ -38,9 +38,41 @@ new_geompoint_block <- function(color = character(), shape = character(), ...) {
   )
 }
 
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
+block_input_check.plot_layer_block <- function(x, data, ...) {
+  if (inherits(data, "ggplot")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting ggplot input.")
+}
+
+block_output_ptype.plot_layer_block <- function(x, ...) ggplot()
+
+register_blocks(
+  constructor = c(new_ggplot_block, new_geompoint_block),
+  name = c("ggplot block", "geompoint block"),
+  description = c(
+    "Builds a ggplot object",
+    "Add points geom to ggplot object"
+  ),
+  package = "blockr.demo",
+  category = c("Visualization", "Visualization")
+)
+
 stack <- new_stack(
   data_block = new_dataset_block("penguins", "palmerpenguins"),
-  filter_block = new_filter_block("sex", "female"),
+  filter_block = new_filter_block("sex", "female", submit = TRUE),
   plot_block = new_ggplot_block("flipper_length_mm", "body_mass_g"),
   layer_block = new_geompoint_block("species", "species")
 )

inst/shinylive/apps/registry-demo/app.R

@@ -19,10 +19,7 @@ new_tail_block <- function(data, n_rows = numeric(), ...) {
 register_block(
   constructor = new_tail_block,
   name = "tail block",
-  description = "return last n rows",
-  classes = c("tail_block", "transform_block"),
-  input = "data.frame",
-  output = "data.frame"
+  description = "return last n rows"
 )
 
 stack <- new_stack(new_dataset_block)

vignettes/blockr-examples.Rmd

@@ -96,18 +96,16 @@ filter_in_block <- function(data, ...) {
         dplyr::filter(!!dplyr::sym(.(column)) %in% vals[[1]])
     }),
     ...,
-    class = c("filter_in_block", "transform_block", "submit_block")
+    class = c("filter_in_block", "transform_block"),
+    submit = NA
   )
 }
 
 blockr::register_block(
   constructor = filter_in_block,
   name = "Filter in",
   description = "Filter on a vector",
-  category = "transform",
-  classes = c("filter_in_block", "transform_block"),
-  input = "data.frame",
-  output = "data.frame"
+  category = "transform"
 )
 ```
 
@@ -168,24 +166,29 @@ new_prophet_forecast_block <- function(columns = character(), ...) {
   )
 }
 
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
 # Register custom blocks
 register_block(
   new_stock_data_block,
   name = "Stock Data",
   description = "Fetch stock data",
-  category = "data",
-  classes = c("stock_data_block", "data_block"),
-  input = NA_character_,
-  output = "data.frame"
+  category = "data"
 )
 register_block(
   new_prophet_forecast_block,
   name = "Prophet Forecast",
   description = "Forecast using Prophet",
-  category = "plot",
-  classes = c("prophet_forecast_block", "plot_block"),
-  input = "data.frame",
-  output = "plot"
+  category = "plot"
 )
 
 # Create the stack
@@ -282,18 +285,27 @@ new_cardinal02_block <- function(...) {
     expr = expr,
     fields = fields,
     ...,
-    class = c("cardinal02_block", "rtables_block", "submit_block")
+    class = c("cardinal02_block", "rtables_block"),
+    submit = NA
   )
 }
 
+block_input_check.rtables_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.rtables_block <- function(x, ...) list()
+
 register_block(
   new_cardinal02_block,
   "Cardinal 02",
   "A Cardinal 02 table",
-  category = "table",
-  input = "data.frame",
-  output = "list",
-  classes = c("cardinal02_block", "rtables_block", "submit_block")
+  category = "table"
 )
 
 
@@ -380,25 +392,30 @@ new_pollution_forecast_block <- function(columns = character(), ...) {
   )
 }
 
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
 # Register custom blocks
 register_block(
   new_air_quality_block,
   name = "Air Quality Data",
   description = "Import air quality data",
-  category = "data",
-  classes = c("air_quality_block", "data_block"),
-  input = NA_character_,
-  output = "data.frame"
+  category = "data"
 )
 
 register_block(
   new_pollution_forecast_block,
   name = "Pollution Forecast",
   description = "Forecast pollution levels",
-  category = "plot",
-  classes = c("pollution_forecast_block", "plot_block"),
-  input = "data.frame",
-  output = "plot"
+  category = "plot"
 )
 
 # Create the stack
@@ -560,24 +577,29 @@ new_causal_impact_block <- function(columns = character(), ...) {
   )
 }
 
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
 # Register custom blocks
 register_block(
   new_marketing_data_block,
   name = "Marketing Data",
   description = "Load and prepare marketing data",
-  category = "data",
-  classes = c("marketing_data_block", "data_block"),
-  input = NA_character_,
-  output = "data.frame"
+  category = "data"
 )
 register_block(
   new_causal_impact_block,
   name = "Causal Impact Analysis",
   description = "Perform Causal Impact analysis on marketing data",
-  category = "plot",
-  classes = c("causal_impact_block", "plot_block"),
-  input = "data.frame",
-  output = "plot"
+  category = "plot"
 )
 
 # Create the stack

vignettes/plot-block.Rmd

@@ -363,6 +363,33 @@ new_geompoint_block <- function(color = character(), shape = character(), ...) {
 
 Note the class `plot_layer_block`. This is necessary to invoke the corresponding `evaluate_block()` method (to use `+` instead of `%>%`).
 
+### Notes about the registry
+
+As mentioned in the __registry__ [vignette](https://bristolmyerssquibb.github.io/blockr/articles/registry.html), to register the newly defined blocks, we have to define 2 methods that check the block __input__ and __output__ (it is no mandatory to register blocks but we highly advise you to do so if you want to benefit from the clever "add block" feature):
+
+```r
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+
+block_input_check.plot_layer_block <- function(x, data, ...) {
+
+  if (inherits(data, "ggplot")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting ggplot input.")
+}
+
+block_output_ptype.plot_layer_block <- function(x, ...) ggplot()
+```
 
 ### Try it