ramnathv / htmlwidgets

HTML Widgets for R
http://htmlwidgets.org
Other
790 stars 207 forks source link

JSON conversion is not consistent #471

Closed pietrodito closed 1 year ago

pietrodito commented 1 year ago

Context

I am creating a Shniy widget for integrating the JS library tabulator.

In order to that, I use the htmlwidgets R package.

Here is a github repo with the project.


Reproducible steps (RStudio)

Package setup

library(devtools)
library(usethis)
library(htmlwidgets)

create_package("SOirisIssueTabulator")
scaffoldWidget("tabulator")

Dependencies

Download js and css tabulator dependencies on website and place tabulator.min.css and tabulator.min.js inside the inst/htmlwidgets/tabulator/ directory.

Then, edit inst/htmlwidgets/tabulator.yaml:

dependencies:
  - name: tabulator
    version: 5.5.2
    src: htmlwidgets/tabulator
    script: tabulator.min.js
    stylesheet: tabulator.min.css

JS side

Edit the inst/htmlwidgets/tabulator.js:

HTMLWidgets.widget({
  name: 'tabulator',
  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
       new Tabulator("#" + el.id, {
          data: x.data,
          autoColumns: true,
          layout: "fitColumns",
          height: "100%"
        });
      },

      resize: function(width, height) {}
    };
  }
});

R side

Edit R/tabulator.R

#' @import htmlwidgets
#' @export
tabulator <- function(message, width = NULL, height = NULL, elementId = NULL) {

  x = list(
    message = message
  )

  ## Add this line to template
  attr(x, 'TOJSON_ARGS') <- list(dataframe = "rows")

  htmlwidgets::createWidget(
    name = 'tabulator',
    x,
    width = width,
    height = height,
    package = 'SOirisIssueTabulator',
    elementId = elementId
  )
}

### Nothing to change after

#' @name tabulator-shiny
#' @export
tabulatorOutput <- function(outputId, width = '100%', height = '400px'){
  htmlwidgets::shinyWidgetOutput(outputId, 'tabulator', width, height, package = 'SOirisIssueTabulator')
}

#' @rdname tabulator-shiny
#' @export
renderTabulator <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) }
  htmlwidgets::shinyRenderWidget(expr, tabulatorOutput, env, quoted = TRUE)
}

Build package

document(); install()

Shinhy App

Create app.R:

library(shiny)
library(tabulator)

ui <- fluidPage(
  selectInput("data", "Data", choices = c("mtcars", "iris")),
  tabulatorOutput("table"))

server <- function(input, output, session) {
  output$table <- renderTabulator(
    tabulator(get(input$data)))}

shinyApp(ui, server)

Issue

The widget works fine with mtcars and all data.frames I have tested but not with iris but I cannot figure why!