Пользовательский интерактивный стол из реактивных данных - PullRequest
0 голосов
/ 30 октября 2019

Я очень новичок в Shiny и изо всех сил пытаюсь понять реактивность.

Контекст: я хочу, чтобы пользователь выбрал имя для столбца, добавил этот столбец в реактивную таблицу и затем отредактировал эту таблицу. Таблица является реагирующей (она поступает из загруженного файла, отфильтрованного пользователем).

Благодаря эта ответит, что все отлично работает с нереактивной таблицей (см. mydata <- mtcars[1:5,]). Но это не работает, когда mydata становится реактивным!

Вот воспроизводимый рабочий пример с НЕРЕАКТИВНЫМИ данными из @ dww ответ:

library(rhandsontable)

ui <- fluidPage(
  h2("The mtcars data"),
  rHandsontableOutput("mytable"),
  textInput('NewCol', 'Enter new column name'),
  radioButtons("type", "Column type:",
    c("Integer" = "integer",
      "Floating point" = "numeric",
      "Text" = "character")),
  actionButton("goButton", "Update Table")
)

server <- function(input, output) {
  mydata <- mtcars[1:5,]
  output$mytable = renderRHandsontable(df())
  df <- eventReactive(input$goButton, {
    if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
      if (input$type == "integer") v1 <- integer(NROW(mydata))
      if (input$type == "numeric") v1 <- numeric(NROW(mydata))
      if (input$type == "character") v1 <- character(NROW(mydata))
      newcol <- data.frame(v1)
      names(newcol) <- input$NewCol
      mydata <<- cbind(mydata, newcol)
    }
    rhandsontable(mydata, stretchH = "all")
  }, ignoreNULL = FALSE)
  observe(if (!is.null(input$mytable)) mydata <<- hot_to_r(input$mytable))
}

shinyApp(ui,server)

Я безуспешно пытался эти изменения внутри кода (в основном я изменил все mydata для mydata()):

server <- function(input, output) {

# mydata <- reactive({ }) #make mydata a reactive object

output$mytable = renderRHandsontable(df())
df <- eventReactive(input$goButton, {
    if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
        if (input$type == "integer") v1 <- integer(NROW(mydata()))
        if (input$type == "numeric") v1 <- numeric(NROW(mydata()))
        if (input$type == "character") v1 <- character(NROW(mydata()))
        newcol <- data.frame(v1)
        names(newcol) <- input$NewCol
        mydata <<- cbind(mydata(), newcol)
    }
    rhandsontable(mydata(), stretchH = "all")
}, ignoreNULL = FALSE)
observe(if (!is.null(input$mytable)) mydata() <<- hot_to_r(input$mytable))}

Я не нашел это ответы на вопросы / комментарии, полезные для решения моей проблемы).

Не могли бы вы объяснить, как использовать реактивный mydata внутри @dww потрясающего ответа?

[ПРАВИТЬ: названиеобновлено, чтобы лучше соответствовать ответу]

1 Ответ

1 голос
/ 30 октября 2019

Я обрезал некоторые дополнительные функции, такие как типы данных столбцов ... Как правило - все, что вы будете рендерить, может стать реактивным, просто обернув его в "реактивный". Ниже я использую «реактивные значения», но другие реактивные методы также будут работать.

Обобщенный способ сделать ваш вывод реагирующим на изменения ввода данных -

foo_func = function() return(mydata)
foo_func_reactive = reactive(foo_func)
output$foo = renderMethod( foo_func_reactive() )

Для вашего примера:

shinyApp(

ui = fluidPage(
  rHandsontableOutput("out_tbl"),
  textInput(inputId = "in_txt", label = "New column name"),
  actionButton(inputId = "in_btn1", label = "Add new column to the table above ..."),
  actionButton(inputId = "in_btn2", label = "... Or, generate new data")
),


server = function(input, output, session) {

  # establishes tbl_react as the holder for our reactive data, and pre-fills it for the first display with 1,2,3
  tbl_react <- reactiveValues(tbl = 
    data.frame(a = c(1,2,3))
  )

   # button one adds a new column with the inputted name
  observeEvent(input$in_btn1,{
    newcolname <- as.character(input$in_txt)
    newcol <- character(NROW(tbl_react$tbl))
    tbl_react$tbl <- cbind(tbl_react$tbl, newcol)
    colnames(tbl_react$tbl) <- c(colnames(tbl_react$tbl)[1:ncol(tbl_react$tbl)-1], newcolname)
  })

  # to show our output data is reactive, we can take a dependancy on button two to generate new data - this could instead be using an uploaded file
  observeEvent(input$in_btn2,{
    tbl_react$tbl <- data.frame(b = c(9,10,11))
  })


  output$out_tbl = renderRHandsontable( rhandsontable(tbl_react$tbl) )


  }
)
...