Как сделать RHANDSONTABLE повторной визуализации автоматически после selectInput в Shiny - PullRequest
Новая
       66

Как сделать RHANDSONTABLE повторной визуализации автоматически после selectInput в Shiny

1 голос
/ 14 апреля 2020

Я работаю над приложением Shiny, в котором пользователь может вводить некоторые данные в разные наборы данных, которые затем используются для вычисления других переменных в наборе данных. Выбор набора данных определяется selecInput. Я выбрал rHandsontable, потому что он успешно имитирует знакомый ввод электронных таблиц. Я адаптировал решение для расчета столбцов из этого ответа и все работает довольно хорошо. за исключением одной маленькой вещи: после выбора другого набора данных, rhandsontable не перерисовывается, пока пользователь не взаимодействует с ним. Я понимаю, что это то, что должно произойти, но в моем случае нам нужен повторный рендеринг. Я пробовал разные комбинации Наблюдать, Наблюдать за событиями и событиями Реактивно, ничего не получалось. Ближе всего я подошел с включением индикатора реактивного значения изменения выбора, который, по крайней мере, сигнализирует о необходимости использования новых данных. Вот MRE того, что я получил. 

library(shiny)
library(rhandsontable)

data <- list (
  table1 = data.frame( beginning = as.numeric(rep(8, 4)),
                ending = as.numeric(rep(15, 4))),

table2 = data.frame( beginning = as.numeric(rep(9, 4)),
                ending = as.numeric(rep(17, 4)))
)

data[["table1"]]$hours <- data[["table1"]]$ending - data[["table1"]]$beginning
data[["table2"]]$hours <- data[["table2"]]$ending - data[["table2"]]$beginning

############################# UI #############################

ui = shinyUI(fluidPage(
  selectInput("tab", "Chose table: ", choices = list("table1", "table2")),
  fluidRow(wellPanel(
    column(6,
           rHandsontableOutput("hot"),
           actionButton(inputId="enter",label="Save")
    ),

    column(6,
           textOutput("title"),
           tableOutput("tabela")
    )))
))

########################## SEREVER ###########################

server=function(input,output, session){

  tab_change <- reactiveVal(FALSE)


   # rw <- reactivePoll(1000, session, file_name, read.csv2)
   react_week <- reactive({
     df <- data[[input$tab]]
     })

  output$title <- renderText(input$tab)

  output$tabela <- renderTable(react_week())

  observeEvent(input$tab,
               {tab_change(TRUE)
               })


  # Calculation of columns
  for_week <- reactive({

    datacopy <- NULL

    #For initial data upltabd
    if(isolate(tab_change()) || is.null(input$hot)) {
      datacopy <- react_week()
    }
    else {
      datacopy <- hot_to_r(input$hot)
    }

    #If there is change in data
    if(!is.null(input$hot$changes$changes)){

      col.no <- as.numeric(unlist(input$hot$changes$changes)[2])
      new.val <- unlist(input$hot$changes$changes)[4]

      #If the changed value is prihod or odhod
      if(col.no == 0 || col.no == 1){
        datacopy[, 3] <- as.numeric(datacopy[, 2]) - as.numeric(datacopy[, 1])
      }

    }

    tab_change(FALSE)
    datacopy

  })

  output$hot <- renderRHandsontable(
    rhandsontable(for_week())
  )

  observeEvent(input$enter, {
    data[[input$tab]] <<- hot_to_r(input$hot)
    output$tabela <- renderTable( data[[input$tab]])
  })

}

shinyApp(ui = ui, server = server)

Я новичок в Shiny, так что я могу упустить очевидное, но есть ли способ повторно сделать rhandsontable сразу после короткого изменения выбора использования некоторых низкоуровневых функций, таких как sendInputMessage, которых я боюсь? И если нет, где я могу найти некоторые инструкции о том, как создать такое сообщение, чтобы работать для меня?

1 Ответ

0 голосов
/ 14 апреля 2020

Используйте eventReactive и активируйте input$tab и input$hot вместо reactive для вашего for_week реактивного объекта: 

library(shiny)
library(rhandsontable)

data <- list (
  table1 = data.frame( beginning = as.numeric(rep(8, 4)),
                       ending = as.numeric(rep(15, 4))),

  table2 = data.frame( beginning = as.numeric(rep(9, 4)),
                       ending = as.numeric(rep(17, 4)))
)

data[["table1"]]$hours <- data[["table1"]]$ending - data[["table1"]]$beginning
data[["table2"]]$hours <- data[["table2"]]$ending - data[["table2"]]$beginning

############################# UI #############################

ui = shinyUI(fluidPage(
  selectInput("tab", "Chose table: ", choices = list("table1", "table2")),
  fluidRow(wellPanel(
    column(6,
           rHandsontableOutput("hot"),
           actionButton(inputId="enter",label="Save")
    ),

    column(6,
           textOutput("title"),
           tableOutput("tabela")
    )))
))

########################## SEREVER ###########################

server=function(input,output, session){

  tab_change <- reactiveVal(FALSE)


  # rw <- reactivePoll(1000, session, file_name, read.csv2)
  react_week <- reactive({
    df <- data[[input$tab]]
  })

  output$title <- renderText(input$tab)

  output$tabela <- renderTable(react_week())

  observeEvent(input$tab,
               {tab_change(TRUE)
               })


  # Calculation of columns
  # ----------------------------Modified here----------------------------
  # for_week <- reactive({
  for_week <- eventReactive(c(input$tab, input$hot), {
  # ---------------------------------------------------------------------

    datacopy <- NULL

    #For initial data upltabd
    if(isolate(tab_change()) || is.null(input$hot)) {
      datacopy <- react_week()
    }
    else {
      datacopy <- hot_to_r(input$hot)
    }

    #If there is change in data
    if(!is.null(input$hot$changes$changes)){

      col.no <- as.numeric(unlist(input$hot$changes$changes)[2])
      new.val <- unlist(input$hot$changes$changes)[4]

      #If the changed value is prihod or odhod
      if(col.no == 0 || col.no == 1){
        datacopy[, 3] <- as.numeric(datacopy[, 2]) - as.numeric(datacopy[, 1])
      }

    }

    tab_change(FALSE)
    datacopy

  })

  output$hot <- renderRHandsontable(
    rhandsontable(for_week())
  )

  observeEvent(input$enter, {
    data[[input$tab]] <<- hot_to_r(input$hot)
    output$tabela <- renderTable( data[[input$tab]])
  })

}

shinyApp(ui = ui, server = server)
...