What penguin specie has the largest flipper?
Collection of instructions, blocks, from data import to wrangling/visualization.
library(shiny)
library(bslib)
library(ggplot2)
library(palmerpenguins)
shinyApp(
ui = page_fluid(
layout_sidebar(
sidebar = sidebar(
radioButtons("sex", "Sex", unique(penguins$sex), "female"),
selectInput(
"xvar",
"X var",
colnames(dplyr::select(penguins, where(is.numeric))),
"body_mass_g"
),
selectInput(
"yvar",
"Y var",
colnames(dplyr::select(penguins, where(is.numeric))),
"flipper_length_mm"
),
selectInput(
"color",
"Color and shape",
colnames(dplyr::select(penguins, where(is.factor))),
"species"
)
),
plotOutput("plot")
)
),
server = function(input, output, session) {
output$plot <- renderPlot({
penguins |>
filter(sex == !!input$sex) |>
ggplot(aes(x = !!input$xvar, y = !!input$yvar)) +
geom_point(aes(color = !!input$color, shape = !!input$color), size = 2)
})
}
)
library(blockr)
1new_stack(
2 data_block = new_dataset_block("penguins", "palmerpenguins"),
filter_block = new_filter_block("sex", "female"),
3 plot_block = new_ggplot_block("body_mass_g", "flipper_length_mm"),
4 layer_block = new_geompoint_block("species", "species")
)
5serve_stack(stack)
Collection of recipes (stacks) to build a dashboard.
library(blockr)
# Creates an empty workspace
1set_workspace(
2 stack_1 = new_stack()
stack_2 = new_stack()
)
3serve_workspace()
Create a new lm() block:
lm(bill_length_mm ~ flipper_length_mm, data = penguins)
1new_lm_block <- function(y = character(), predictor = character(), ...) {
}
constructor
.
new_lm_block <- function(y = character(), predictor = character(), ...) {
2 all_cols <- function(data) colnames(data)
3 fields <- list(
y = new_select_field(y, all_cols, type = "name"),
predictor = new_select_field(predictor, all_cols, type = "name")
)
new_block(
fields = fields,
)
}
type
allows to pass in cols as name instead of strings.)
new_lm_block <- function(y = character(), predictor = character(), ...) {
all_cols <- function(data) colnames(data)
fields <- list(
y = new_select_field(y, all_cols, type = "name"),
predictor = new_select_field(predictor, all_cols, type = "name")
)
new_block(
fields = fields,
4 expr = quote({
model <- lm(data = data, formula = .(y) ~ .(predictor))
lm(f, data = data)
}),
)
}
quote
and pass field name with .(field_name)
. 1
new_lm_block <- function(y = character(), predictor = character(), ...) {
all_cols <- function(data) colnames(data)
fields <- list(
y = new_select_field(y, all_cols, type = "name"),
predictor = new_select_field(predictor, all_cols, type = "name")
)
new_block(
fields = fields,
expr = quote({
model <- lm(data = data, formula = .(y) ~ .(predictor))
broom::tidy(model)
}),
...,
class = c("lm_block", "transform_block")
)
}
transform_block
+ a custom class.#| standalone: true
#| components: [viewer]
#| viewerHeight: 550
## file: app.R
webr::install("blockr", repos = c("https://blockr-org.github.io/webr-repos", "https://repo.r-wasm.org"))
library(blockr)
library(palmerpenguins)
new_lm_block <- function(y = character(), predictor = character(), ...) {
all_cols <- function(data) colnames(data)
fields <- list(
y = new_select_field(y, all_cols, type = "name"),
predictor = new_select_field(predictor, all_cols, type = "name")
)
new_block(
fields = fields,
expr = quote({
model <- lm(data = data, formula = .(y) ~ .(predictor))
broom::tidy(model)
}),
...,
class = c("lm_block", "transform_block")
)
}
stack <- new_stack(
data_block = new_dataset_block("penguins", "palmerpenguins"),
lm_block = new_lm_block("bill_length_mm", "body_mass_g")
)
serve_stack(stack)
register_lm_block <- function(pkg) {
register_block(
constructor = new_lm_block,
name = "lm block",
description = "Create a linear model block",
classes = c("lm_block", "transform_block"),
input = "data.frame",
output = "data.frame",
package = pkg
)
}
# Put in zzz.R
.onLoad <- function(libname, pkgname) {
register_lm_block(pkgname)
invisible(NULL)
}
Share dashboards with your teams to speed up data analysis
You’re an advanced R developer, you can extend blockr!
dplyr::filter
block?#| standalone: true
#| components: [viewer]
#| viewerHeight: 800
webr::install("blockr", repos = c("https://blockr-org.github.io/webr-repos", "https://repo.r-wasm.org"))
library(blockr)
library(palmerpenguins)
library(ggplot2)
new_ggplot_block <- function(col_x = character(), col_y = character(), ...) {
data_cols <- function(data) colnames(data)
new_block(
fields = list(
x = new_select_field(col_x, data_cols, type = "name"),
y = new_select_field(col_y, data_cols, type = "name")
),
expr = quote(
ggplot(mapping = aes(x = .(x), y = .(y)))
),
class = c("ggplot_block", "plot_block"),
...
)
}
new_geompoint_block <- function(color = character(), shape = character(), ...) {
data_cols <- function(data) colnames(data$data)
new_block(
fields = list(
color = new_select_field(color, data_cols, type = "name"),
shape = new_select_field(shape, data_cols, type = "name")
),
expr = quote(
geom_point(aes(color = .(color), shape = .(shape)), size = 2)
),
class = c("plot_layer_block", "plot_block"),
...
)
}
new_penguins_block <- function() {
new_dataset_block("penguins", "palmerpenguins")
}
register_block(
constructor = new_ggplot_block,
name = "ggplot2 block",
description = "Create a ggplot object",
classes = c("ggplot_block", "plot_block"),
input = "data.frame",
output = "ggplot2",
package = "blockr.ggplot2"
)
register_block(
constructor = new_geompoint_block,
name = "geompoint block",
description = "Create a geom point plot layer",
classes = c("plot_layer_block", "plot_block"),
input = "ggplot2",
output = "ggplot2",
package = "blockr.ggplot2"
)
stack <- new_stack(
data_block = new_dataset_block("penguins", "palmerpenguins")
#filter_block = new_filter_block("sex", "female"),
#plot_block = new_ggplot_block("flipper_length_mm", "body_mass_g"),
#layer_block = new_geompoint_block("species", "species")
)
serve_stack(stack)
#| standalone: true
#| components: [viewer]
#| viewerHeight: 800
webr::install("blockr", repos = c("https://blockr-org.github.io/webr-repos", "https://repo.r-wasm.org"))
library(blockr)
library(palmerpenguins)
library(ggplot2)
new_ggplot_block <- function(col_x = character(), col_y = character(), ...) {
data_cols <- function(data) colnames(data)
new_block(
fields = list(
x = new_select_field(col_x, data_cols, type = "name"),
y = new_select_field(col_y, data_cols, type = "name")
),
expr = quote(
ggplot(mapping = aes(x = .(x), y = .(y)))
),
class = c("ggplot_block", "plot_block"),
...
)
}
new_geompoint_block <- function(color = character(), shape = character(), ...) {
data_cols <- function(data) colnames(data$data)
new_block(
fields = list(
color = new_select_field(color, data_cols, type = "name"),
shape = new_select_field(shape, data_cols, type = "name")
),
expr = quote(
geom_point(aes(color = .(color), shape = .(shape)), size = 2)
),
class = c("plot_layer_block", "plot_block"),
...
)
}
new_penguins_block <- function() {
new_dataset_block("penguins", "palmerpenguins")
}
new_lm_block <- function(y = character(), predictor = character(), ...) {
all_cols <- function(data) colnames(data)
fields <- list(
y = new_select_field(y, all_cols, type = "name"),
predictor = new_select_field(predictor, all_cols, type = "name")
)
new_block(
fields = fields,
expr = quote({
model <- lm(data = data, formula = .(y) ~ .(predictor))
broom::tidy(model)
}),
...,
class = c("lm_block", "transform_block")
)
}
register_block(
constructor = new_lm_block,
name = "Linear model block",
description = "Create a linear model",
classes = c("lm_block", "transform_block"),
input = "data.frame",
output = "data.frame",
package = "blockr.lm"
)
register_block(
constructor = new_ggplot_block,
name = "ggplot2 block",
description = "Create a ggplot object",
classes = c("ggplot_block", "plot_block"),
input = "data.frame",
output = "ggplot2",
package = "blockr.ggplot2"
)
register_block(
constructor = new_geompoint_block,
name = "geompoint block",
description = "Create a geom point plot layer",
classes = c("plot_layer_block", "plot_block"),
input = "ggplot2",
output = "ggplot2",
package = "blockr.ggplot2"
)
register_block(
constructor = new_penguins_block,
name = "penguins data block",
description = "Create a palmer penguins dataset block",
classes = c("dataset_block", "data_block"),
input = NA_character_,
output = "data.frame",
package = "blockr.custom"
)
set_workspace(
stack_1 = new_stack(),
stack2 = new_stack()
)
serve_workspace(clear = FALSE)
Funded by