BristolMyersSquibb / blockr

Composable, extensible no-code UI
https://bristolmyerssquibb.github.io/blockr/
GNU General Public License v3.0
32 stars 3 forks source link

doc: ggiraph plot does not appear in stack UI but opens a new viewer instead (vignette) #375

Open DivadNojnarg opened 4 months ago

DivadNojnarg commented 4 months ago
library(blockr)
library(ggplot2)
library(ggiraph)

custom_data_block <- function(...) {
  new_dataset_block(
      ...,
      selected = "mtcars"
    )
}

new_ggplot_block <- function(...) {

  data_cols <- function(data) colnames(data)

  new_block(
    fields = list(
      x = new_select_field("wt", data_cols, type = "name"),
      y = new_select_field("qsec", data_cols, type = "name"),
      color = new_select_field("disp", data_cols, type = "name")
    ),
    expr = quote(
      ggplot(mapping = aes(x = .(x), y = .(y), color = .(color)))
    ),
    class = c("ggplot_block", "plot_block"),
    ...
  )
}

# We could have use a mutate_block instead of
# changing the data from inside the block ...
# {blockr} is flexible here.
new_geompoint_interactive_block <- function(...) {
  build_expr <- function(data) {
    # Get data from the previous ggplot layer
    # data is the ggplot so we need to use data$data
    # to get the initial data
    data$data$carname <- row.names(data$data)
    substitute(
      geom_point_interactive(
        # Pass in new data
        data = new_data,
        aes(
          tooltip = carname,
          data_id = carname
        )
      ),
      list(new_data = data$data)
    )
  }

  new_block(
    fields = list(
      expression = new_hidden_field(build_expr)
    ),
    expr = quote(.(expression)),
    class = c("plot_layer_block", "plot_block"),
    ...
  )
}

new_theme_block <- function(...) {
  new_block(
    fields = list(
      theme = new_select_field(
        "theme_minimal", 
        grep("^theme_.*$", ls("package:ggplot2"), perl = TRUE, value = TRUE),
        type = "name"
      )
    ),
    expr = quote(
      .(theme)()
    ),
    class = c("plot_layer_block", "plot_block"),
    ...
  )
}

new_ggiraph_block <- function(...) {

  get_dat <- function(data) {
    data
  }

  new_block(
    fields = list(
      data = new_hidden_field(get_dat),
      pointsize = new_numeric_field(12, min = 1, max = 20)
    ),
    expr = quote(
      girafe(ggobj = .(data), pointsize = .(pointsize))
    ),
    class = c("ggiraph_block", "plot_block"),
    ...
  )
}

stack <- new_stack(
  custom_data_block,
  new_ggplot_block,
  new_geompoint_interactive_block,
  new_theme_block,
  new_ggiraph_block
)
serve_stack(stack)
JohnCoene commented 4 months ago

I think it is missing the methods for the output and render. e.g.:

#' @method server_output correlation_boxplot_block
#' @export
server_output.correlation_boxplot_block <- function (x, result, output){
    ggiraph::renderGirafe(result())
}

#' @method uiOutputBlock correlation_boxplot_block
#' @export
uiOutputBlock.correlation_boxplot_block <- function (x, ns){
    ggiraph::girafeOutput(ns("res"))
}
DivadNojnarg commented 4 months ago

Yes that's true: https://github.com/blockr-org/blockr/blob/5798d528092d2e7efbaf07a4ad6c494d20b5ecc4/R/server.R#L424. We cleaned the server scripts few months ago but the vignette wasn't updated to account for this.

To add:

uiOutputBlock.ggiraph_block <- function(x, ns) {
  ggiraph::girafeOutput(ns("plot"))
}

server_output.ggiraph_block <- function(x, result, output) {
  ggiraph::renderGirafe(result())
}
JohnCoene commented 4 months ago

I think we could remove these blocks and create a blockr.ggiraph package instead, thoughts?

DivadNojnarg commented 4 months ago

Sorry @JohnCoene, I did not labelled the issue correctly. The issue happens in a vignette where we describe the process to create plot blocks layer by layer with a last example involving ggiraph. These blocks and any supporting code are not intended to be in the blockr package.