Merge pull request #25 from eodaGmbH/docs/shiny-vignette

Docs/shiny vignette

DESCRIPTION

@@ -23,6 +23,7 @@ Imports:
     glue,
     htmltools,
     htmlwidgets,
+    jsonlite,
     purrr,
     readr,
     shiny

NAMESPACE

@@ -4,7 +4,6 @@ export(add_row)
 export(create_columns)
 export(delete_selected_rows)
 export(for_each_col)
-export(list_to_data_frame)
 export(redo)
 export(renderTabulator)
 export(set_calculation)
@@ -25,7 +24,8 @@ export(set_formatter_toggle_switch)
 export(set_formatter_traffic_light)
 export(set_header_filter)
 export(set_multi_column_header)
-export(set_option_group_by)
+export(set_options_group_by)
+export(set_options_pagination)
 export(set_tooltip)
 export(spreadsheet_def)
 export(tabulator)
@@ -35,6 +35,6 @@ export(tabulator_options)
 export(titanic)
 export(trigger_download)
 export(trigger_get_data)
-export(trigger_get_spreadsheet_data)
+export(trigger_get_sheet_data)
 export(undo)
 import(htmlwidgets)

R/context_calls.R

@@ -3,7 +3,11 @@
 #' @param type (character): csv, json or xlsx (needs sheetjs: \code{tabulator(..., sheetjs = TRUE)})
 #' @param file_name (character): file name
 #' @export
-trigger_download <- function(ctx, type = c("csv", "json", "xlsx"), file_name) {
+trigger_download <- function(ctx, type = c("csv", "json", "xlsx"), file_name = NULL) {
+  if (is.null(file_name)) {
+    file_name <- glue::glue("data.{type}")
+  }
+
   invoke_method(ctx, "download", match.arg(type), file_name)
 }
 
@@ -51,6 +55,6 @@ redo <- function(ctx) {
 #' Submit data to R
 #' @inheritParams trigger_download
 #' @export
-trigger_get_spreadsheet_data <- function(ctx) {
-  invoke_method(ctx, "getSpreadsheetData")
+trigger_get_sheet_data <- function(ctx) {
+  invoke_method(ctx, "getSheetData")
 }

R/input_handlers.R

@@ -0,0 +1,36 @@
+# https://book.javascript-for-r.com/shiny-complete.html
+input_handler_data <- function(value, ...) {
+  if (debug_mode()) {
+    print("custom input handler data")
+  }
+
+  if (getOption("rtabulator.raw_data", FALSE)) {
+    return(value)
+  }
+
+  data <- value$data
+  try(data <- tabulator_data_as_df(value$data))
+  return(data)
+}
+
+# TODO: Not used at the moment
+input_handler_sheet_data <- function(value, ...) {
+  if (debug_mode()) {
+    print("custom input handler data")
+  }
+
+  if (getOption("rtabulator.raw_data", FALSE)) {
+    return(value)
+  }
+
+  data <- value$data
+  # try(data <- jsonlite::fromJSON(jsonlite::toJSON(value$data, auto_unbox = TRUE)))
+  try(data <- sheet_data_to_matrix(data), silent = TRUE)
+  return(data)
+}
+
+sheet_data_to_matrix <- function(data) {
+  vec <- unlist(purrr::map(data, ~ as_vec(.x)))
+  # try({vec <- as.numeric(vec)})
+  return(matrix(vec, nrow = length(data), byrow = TRUE))
+}

R/js_dependencies.R

@@ -6,7 +6,7 @@ sheetjs_dependency <- htmltools::htmlDependency(
   name = "sheetjs",
   version = SHEETJS_VERSION,
   src = list(
-    href = glue::glue("https://cdn.sheetjs.com/xlsx-{SHEETJS_VERSION}/package/dist/")
+    href = glue::glue("https://cdn.sheetjs.com/xlsx-{SHEETJS_VERSION}/package/dist")
   ),
   script = "xlsx.mini.min.js",
   all_files = FALSE
@@ -17,7 +17,7 @@ luxon_dependency <- htmltools::htmlDependency(
   name = "luxon",
   version = LUXON_VERSION,
   src = list(
-    href = glue::glue("https://cdn.jsdelivr.net/npm/luxon@{LUXON_VERSION}/build/global/")
+    href = glue::glue("https://cdn.jsdelivr.net/npm/luxon@{LUXON_VERSION}/build/global")
   ),
   script = "luxon.min.js",
   all_files = FALSE

R/package.R

@@ -0,0 +1,3 @@
+debug_mode <- function() {
+  return(getOption("rtabulator.debug", FALSE))
+}

R/tabulator_options.R

@@ -96,28 +96,40 @@ default_spreadsheet_options <- list(
   spreadsheet_column_definition = list(editor = "input")
 )
 
-# TODO: Helper function to set pagination
-set_option_pagination <- function(
+#' Set pagination options
+#' @inheritParams set_formatter_html
+#' @inheritParams tabulator_options
+#' @example examples/options/pagination_options.R
+#' @export
+set_options_pagination <- function(
     widget,
-    pagination = FALSE,
+    pagination = TRUE,
     pagination_size = 10,
     pagination_size_selector = FALSE,
     pagination_add_row = c("page", "table"),
     ...) {
-  return(widget)
+  # Body
+  options_update <- list(
+    pagination = pagination,
+    paginationSize = pagination_size,
+    paginationSizeSelector = pagination_size_selector,
+    paginationAddRow = match.arg(pagination_add_row),
+    ...
+  )
+  modify_tabulator_options(widget, options_update)
 }
 
-#' Set group by option
+#' Set group by options
 #' @inheritParams set_formatter_html
 #' @inheritParams tabulator_options
 #' @export
-set_option_group_by <- function(
+set_options_group_by <- function(
     widget,
     group_by,
     group_start_open = TRUE,
     group_toggle_element = "header",
     ...) {
-  # return(widget)
+  # Body
   options_update <- list(
     groupBy = group_by,
     groupStartOpen = group_start_open,

R/utils.R

@@ -6,15 +6,25 @@ keys_to_camel_case <- function(x) {
   stats::setNames(x, to_camel_case(names(x)))
 }
 
-# Remove NULL values from list
+# Drop NULL values from list
 compact <- function(x) {
   x[!sapply(x, is.null)]
 }
 
-#' Parse List to Data Frame
-#' @param x (list): A list of named lists.
-#' @export
+# Convert list of named lists to data frame
 list_to_data_frame <- function(x) {
   # jsonlite::toJSON(x, auto_unbox = TRUE) |> jsonlite::fromJSON()
   return(do.call(rbind.data.frame, x))
 }
+
+# Convert data returned from JavaScript ####
+
+as_NA <- function(...) NA
+
+as_vec <- function(l) {
+  unlist(purrr::modify_if(l, is.null, as_NA))
+}
+
+tabulator_data_as_df <- function(data) {
+  return(as.data.frame(purrr::map(data, ~ as_vec(.x))))
+}

R/zzz.R

@@ -0,0 +1,8 @@
+.onLoad <- function(libname, pkgname) {
+  # For devtools::load_all() we need to remove to handler if it is already registered
+  try(shiny::removeInputHandler("rtabulator.data"), silent = FALSE)
+  try(shiny::removeInputHandler("rtabulator.sheet_data"), silent = FALSE)
+
+  try(shiny::registerInputHandler("rtabulator.data", input_handler_data))
+  try(shiny::registerInputHandler("rtabulator.sheet_data", input_handler_sheet_data))
+}

_pkgdown.yml

@@ -9,7 +9,8 @@ reference:
     contents:
       - tabulator
       - tabulator_options
-      - set_option_group_by
+      - set_options_group_by
+      - set_options_pagination
 
   - title: Column Settings
     desc: >
@@ -40,7 +41,7 @@ reference:
       - delete_selected_rows
       - trigger_download
       - trigger_get_data
-      - trigger_get_spreadsheet_data
+      - trigger_get_sheet_data
       - undo
       - redo
 
@@ -49,7 +50,6 @@ reference:
       Utitily functions
     contents:
       - spreadsheet_def
-      - list_to_data_frame
       - create_columns
 
   - title: Data Sets

examples/options/group_by_options.R

@@ -0,0 +1,2 @@
+tabulator(iris) |>
+  set_options_group_by("Species", group_start_open = FALSE)

examples/options/pagination_options.R

@@ -0,0 +1,2 @@
+tabulator(iris) |>
+  set_options_pagination(pagination_size_selector = c(10, 20, 50))

examples/shiny/advanced_app/app.R

@@ -0,0 +1,32 @@
+library(shiny)
+library(rtabulator)
+
+ui <- fluidPage(
+  titlePanel("Titanic Data Set"),
+  tabulatorOutput("titanic"),
+  actionButton("submit", "Submit data to R")
+)
+
+server <- function(input, output) {
+  output$titanic <- renderTabulator({
+    tabulator(titanic(c("PassengerId", "Name", "Pclass", "Sex", "Fare", "Survived"))) |>
+      set_formatter_progress("Fare") |>
+      set_tooltip("Fare") |>
+      set_formatter_tick_cross("Survived") |>
+      set_formatter_star("Pclass", number_of_stars = 3)
+  })
+
+  observeEvent(input$submit, {
+    print(input$submit)
+    tabulatorContext("titanic") |>
+      trigger_get_data()
+  })
+
+  observeEvent(input$titanic_get_data, {
+    print(input$titanic_get_data)
+    # print(head(tabulator_data_as_data_frame(input$titanic_get_data$data)))
+    # print(list_to_data_frame(input$table_data$data))
+  })
+}
+
+shinyApp(ui = ui, server = server)

examples/shiny/basic_app/app.R

@@ -0,0 +1,19 @@
+library(shiny)
+library(rtabulator)
+
+ui <- fluidPage(
+  titlePanel("Titanic Data Set"),
+  tabulatorOutput("titanic")
+)
+
+server <- function(input, output) {
+  output$titanic <- renderTabulator({
+    tabulator(titanic()) |>
+      set_formatter_progress("Fare") |>
+      set_tooltip("Fare") |>
+      set_formatter_tick_cross("Survived") |>
+      set_formatter_star("Pclass", number_of_stars = 3)
+  })
+}
+
+shinyApp(ui = ui, server = server)

examples/shiny/spreadsheet/app.R

@@ -31,13 +31,20 @@ server <- function(input, output) {
   observe({
     print(input$submit)
     tabulatorContext(TABULATOR_OUTPUT_ID) |>
-      trigger_get_spreadsheet_data()
+      trigger_get_sheet_data() # |> trigger_get_data()
   }) |> bindEvent(input$submit)
 
 
+  # observe({
+  #  print("get_data")
+  #  # print(head(input$spreadsheet_get_data) |> tibble::as_tibble())
+  # }) |> bindEvent(input$spreadsheet_get_data)
+
   observe({
-    print(input$spreadsheet_spreadsheet_data)
-  }) |> bindEvent(input$spreadsheet_spreadsheet_data)
+    print("get_sheet_data")
+    print(input$spreadsheet_get_sheet_data)
+    # browser()
+  }) |> bindEvent(input$spreadsheet_get_sheet_data)
 }
 
 shinyApp(ui = ui, server = server)

examples/shiny/titanic/app.R

@@ -1,19 +1,70 @@
 library(shiny)
 
-data_url <- "https://raw.githubusercontent.com/datasciencedojo/datasets/master/titanic.csv"
+OUTPUT_ID <- "titanic"
+
+data <- titanic(c("PassengerId", "Pclass", "Survived", "Fare"))
+setup <- tabulator_options(
+  selectable_rows = TRUE,
+  edit_trigger_event = "focus"
+)
 
 ui <- fluidPage(
   titlePanel("Titanic Data"),
-  tabulatorOutput("titanic")
+  tabulatorOutput(OUTPUT_ID),
+  actionButton("download", "Download"),
+  actionButton("submit", "Submit data to R")
 )
 
 server <- function(input, output) {
   output$titanic <- renderTabulator({
-    tabulator(data_url, editable = TRUE) |>
-      set_formatter_progress("Fare") |>
+    tabulator(data, setup, editable = TRUE) |>
+      set_header_filter("Pclass", "list") |>
+      set_header_filter("Survived", "list") |>
+      set_header_filter("Fare", "number", "<=", clearable = TRUE) |>
+      set_options_pagination() |>
+      set_formatter_money(
+        "Fare",
+        symbol = "\U00A3", symbol_after = FALSE, precision = 1, hoz_align = "right"
+      ) |>
+      set_tooltip("Fare") |>
       set_formatter_tick_cross("Survived") |>
       set_formatter_star("Pclass", number_of_stars = 3)
   })
+
+  observeEvent(input$download, {
+    tabulatorContext(OUTPUT_ID) |>
+      trigger_download("csv")
+  })
+
+  observeEvent(input$titanic_row_clicked, {
+    print(input$titanic_row_clicked)
+  })
+
+  observeEvent(input$titanic_rows_selected, {
+    print("rows_selected")
+    print(input$titanic_rows_selected)
+  })
+
+  observeEvent(input$titanic_cell_edited, {
+    print("cell_edited")
+    print(input$titanic_cell_edited)
+  })
+
+  observeEvent(input$titanic_data_filtered, {
+    print("data_filtered")
+    print(head(input$titanic_data_filtered))
+  })
+
+  observeEvent(input$submit, {
+    print("Trigger get data")
+    tabulatorContext(OUTPUT_ID) |>
+      trigger_get_data()
+  })
+
+  observeEvent(input$titanic_get_data, {
+    print("Got data. Thanx!")
+    print(head(input$titanic_get_data))
+  })
 }
 
 shinyApp(ui = ui, server = server)