使用单选按钮的动态handsontable

Question

您好希望使用单选按钮的输入来获得一个动态的（改变行数）rhandsontable。

所以我一直在研究需要将数据输入到表中的闪亮。然而，当增加更多的复杂性时，需要一个年度选项。因此，对于当前表格，我可以要求用户仅填写第一行，但这并不漂亮。

这是当前表格的可重现示例

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  br(),
  rHandsontableOutput('table'),
  textOutput('result'),
  br(),
  actionButton("recalc", "re-enter data")
)

rowNames <- c("Spring", "Summer", "Autum", "Winter", "Sum")
defaultDF <- data.frame(
    row.names = rowNames,
    Lake = rep(NA_integer_, 5),
    Beach = rep(NA_integer_, 5),
    Garden = rep(NA_integer_, 5),
    stringsAsFactors = FALSE
  )

server <- function(input, output, session)
  ({
    values <- reactiveValues(data = defaultDF) ## assign it with NULL

    ## button press resets now the data frame
    observeEvent(input$recalc, {
      values$data[] <- NA_integer_
    })

    observe({
      req(input$table)
        DF <- hot_to_r(input$table)
        DF[setdiff(rowNames, "Sum"),]
        DF["Sum",] <- colSums(DF[setdiff(rowNames, "Sum"),], na.rm = TRUE)
        values$data <- DF
    })

    output$table <- renderRHandsontable({
      req(values$data)
      rhandsontable(values$data, rowHeaderWidth = 100) %>%
        hot_row(nrow(values$data), readOnly = TRUE)
    })

  })

shinyApp(ui = ui, server = server)

我正在尝试做的（在下面的代码中）是使用单选按钮中的值来更改表中的行数。不幸的是，它没有奏效。任何指针将不胜感激。

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  br(),
  rHandsontableOutput('table'),
  textOutput('result'),
  br(),
  actionButton("recalc", "re-enter data")

  radioButtons("Step", label = h4("Choose Step"),
               choices = list("Annual" = 2, "Season" = 5), 
               inline= TRUE, selected = 1),
)


server <- function(input, output) ({

    tabval<- reactive({

    SeasonAnunal<- rowNames <- if (input$Step==2){ rowNames <- c("Spring", "Summer", "Autum", "Winter", "Sum")
    } else{
    rowNames <-c("Annual","Sum")}

    defaultDF <- data.frame(
      row.names = rowNames,
      Lake = rep(NA_integer_, tabval()),
      Beach = rep(NA_integer_, tabval()),
      Garden = rep(NA_integer_, tabval()),
      stringsAsFactors = FALSE)
  })

    values <- reactiveValues(data = defaultDF) ## assign it with NULL

    ## button press resets now the data frame
    observeEvent(input$recalc, {
      values$data[] <- NA_integer_
    })

    observe({
      req(input$table)
      DF <- hot_to_r(input$table)
      DF[setdiff(rowNames, "Sum"),]
      DF["Sum",] <- colSums(DF[setdiff(rowNames, "Sum"),], na.rm = TRUE)
      values$data <- DF
    })

    output$table <- renderRHandsontable({
      req(values$data)
      rhandsontable(values$data, rowHeaderWidth = 100) %>%
        hot_row(nrow(values$data), readOnly = TRUE)
    })

  })

shinyApp(ui = ui, server = server)

Answer 1

我不确定您的年表应该是什么样子，但请检查以下内容：

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  br(),
  rHandsontableOutput('table'),
  textOutput('result'),
  br(),
  actionButton("recalc", "re-enter data"),
  radioButtons("Step", label = h4("Choose Step"),
               choices = list("Annual" = 2, "Season" = 5), 
               inline= TRUE, selected = 2)
)

rowNames <- list("5" = c("Spring", "Summer", "Autum", "Winter", "Sum"), "2" = c("Year", "Sum"))

server <- function(input, output, session)
  ({

    values <- reactiveValues(data = NULL) ## assign it with NULL

    observeEvent(input$Step, {
      req(input$Step)
      values$data <- data.frame(
        row.names = rowNames[[input$Step]],
        Lake = rep(NA_integer_, as.integer(input$Step)),
        Beach = rep(NA_integer_, as.integer(input$Step)),
        Garden = rep(NA_integer_, as.integer(input$Step)),
        stringsAsFactors = FALSE
      )
    })


    ## button press resets now the data frame
    observeEvent(input$recalc, {
      values$data[] <- NA_integer_
    })

    observe({
      req(input$table)
      DF <- hot_to_r(input$table)
      DF[setdiff(rownames(DF), "Sum"),]
      DF["Sum",] <- colSums(DF[setdiff(rownames(DF), "Sum"),], na.rm = TRUE)
      values$data <- DF
    })

    output$table <- renderRHandsontable({
      req(values$data)
      rhandsontable(values$data, rowHeaderWidth = 100) %>%
        hot_row(nrow(values$data), readOnly = TRUE)
    })

  })

shinyApp(ui = ui, server = server)