Как мне использовать ввод пользователя для изменения количества строк и столбцов в таблице rhandsontable?

Вопрос или проблема

library(rhandsontable)
library(shiny)
library(shinydashboard)

    #stocking.dat <- data.frame(matrix(nrow=1,ncol=7))
    #yrnum <- sprintf("yr%d",seq(1:5))
    #colnames(stocking.dat) <- c("age","month",yrnum)
    
    stocking.dat <- data.frame(age=c(1), month=c(5), yr1=c(250000), yr2=c(250000), yr3=c(250000),     yr4=c(250000), yr5=c(250000))
    
    
    ui <- dashboardPage(skin = "blue",
                      dashboardHeader(title = "PVA",titleWidth = 450),
                      dashboardSidebar(id="",width=450,
                                       sidebarMenu(
                                                    menuItem("Добро пожаловать",tabName = "menuWelcome", icon = shiny::icon("face-smile")),
                                                    menuItem("Запуск",tabName = "menuStocking", icon = shiny::icon("fish")),
                                                    menuItem("Обзор",tabName = "menuReview", icon = shiny::icon("magnifying-glass-chart")))),
                      dashboardBody(
                            tabItems(
                                    tabItem(tabName="menuWelcome",
                                            valueBox("Анализ жизнеспособности популяции","Добро пожаловать",icon = shiny::icon("face-smile"),width=8)),
                                    tabItem(tabName="menuStocking",
                                            fluidRow(valueBox("Предложенный запуск","Введите данные",icon = shiny::icon("fish"),width=8)),
                                            fluidRow(box(sliderInput("n.stockyrs","Количество лет для запуска",value=5,min=0,max=25,step=1),width=8)),
                                            fluidRow(box(sliderInput("n.stockage","Количество возрастов для запуска",value=1,min=0,max=5,step=1),width=8)),
                                            fluidRow(box(title="Введите данные",status="primary",solidHeader=TRUE,width=8,rHandsontableOutput("hot")))),
                                    tabItem(tabName="menuReview",
                                            fluidRow(valueBox("Обзор","Обзор ввода",icon = shiny::icon("fish"),width=8)),
                                            fluidRow(box(title="Данные о запуске",status="primary",solidHeader=TRUE,width=8,rHandsontableOutput("rvw.hot")))
    
                            )
                      )
    ))

##########################################################################################################

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

    values <- reactiveValues(data = stocking.dat)
    
    observe({
      if(!is.null(input$hot)){
        values$data <- as.data.frame(hot_to_r(input$hot))
        print(values$data)
        output$hot <- renderRHandsontable({
          rhandsontable(values$data)
        })
      }
    })
    
    output$hot <- renderRHandsontable({
      rhandsontable(values$data)
    })
    
    output$rvw.hot <- renderRHandsontable({
      rhandsontable(values$data,readOnly=TRUE)
    })
    
    session$onSessionEnded(stopApp)

}

shinyApp(ui, server)

Ответ или решение

Чтобы изменить количество строк и столбцов в таблице rhandsontable в приложении Shiny в зависимости от пользовательского ввода, необходимо следовать определенному алгоритму. Ваша цель заключается в том, чтобы использовать ползунки для задания числа строк и столбцов в таблице, а также динамически называть столбцы, основываясь на количестве лет, выбранном пользователем. Вот шаги, которые помогут вам достичь этой цели.

Шаг 1: Инициализация переменных

Для начала, создайте пустую таблицу в reactiveValues, которая будет динамически обновляться в зависимости от ввода пользователя. Изначально можно установить минимальное количество строк и столбцов:

values <- reactiveValues(data = data.frame(age = numeric(0), month = numeric(0)))

Шаг 2: Создание функции для обновления таблицы

Создайте функцию, которая будет формировать таблицу на основе входных значений. Эта функция будет извлекать значения из ползунков, добавлять нужные строки и называть столбцы:

updateTable <- function(num_years, num_ages) {
  yr_names <- sprintf("yr%d", seq_len(num_years))
  new_data <- data.frame(
    age = seq_len(num_ages),
    month = rep(5, num_ages), # Вы можете изменить логику месяца, если это необходимо
    matrix(250000, nrow = num_ages, ncol = num_years, dimnames = list(NULL, yr_names))
  )
  return(new_data)
}

Шаг 3: Наблюдение за изменениями на ползунках

Добавьте observeEvent, который будет реагировать на изменения в ползунках и обновлять таблицу values$data:

observeEvent(c(input$n.stockyrs, input$n.stockage), {
    req(input$n.stockyrs, input$n.stockage) # Заставляем приложение ждать ввода
    values$data <- updateTable(input$n.stockyrs, input$n.stockage)
    output$hot <- renderRHandsontable({
      rhandsontable(values$data)
    })
  })

Шаг 4: Отображение таблицы в пользовательском интерфейсе

Обеспечьте отображение обновлённой таблицы в интерфейсе Shiny:

output$hot <- renderRHandsontable({
  rhandsontable(values$data)
})

Шаг 5: Убедитесь, что данные можно редактировать и просматривать в режиме "только чтение"

Ваш код уже содержит соответствующий сегмент для отображения таблицы в режиме "только чтение":

output$rvw.hot <- renderRHandsontable({
  rhandsontable(values$data, readOnly = TRUE)
})

Полный код приложения

Вот финальная версия вашего приложения, которая выполняет указанные шаги:

library(rhandsontable)
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  skin = "blue",
  dashboardHeader(title = "PVA", titleWidth = 450),
  dashboardSidebar(id = "", width = 450,
    sidebarMenu(
      menuItem("Welcome", tabName = "menuWelcome", icon = icon("face-smile")),
      menuItem("Stocking", tabName = "menuStocking", icon = icon("fish")),
      menuItem("Review", tabName = "menuReview", icon = icon("magnifying-glass-chart"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "menuWelcome",
        valueBox("Population Viability Analysis", "Welcome", icon = icon("face-smile"), width = 8)
      ),
      tabItem(tabName = "menuStocking",
        fluidRow(valueBox("Proposed Stocking", "Enter Data", icon = icon("fish"), width = 8)),
        fluidRow(box(sliderInput("n.stockyrs", "Number years to stock", value = 5, min = 0, max = 25, step = 1), width = 8)),
        fluidRow(box(sliderInput("n.stockage", "Number ages to stock", value = 1, min = 0, max = 5, step = 1), width = 8)),
        fluidRow(box(title = "Enter data", status = "primary", solidHeader = TRUE, width = 8, rHandsontableOutput("hot")))
      ),
      tabItem(tabName = "menuReview",
        fluidRow(valueBox("Review", "Review Input", icon = icon("fish"), width = 8)),
        fluidRow(box(title = "Stocking Data", status = "primary", solidHeader = TRUE, width = 8, rHandsontableOutput("rvw.hot")))
      )
    )
  )
)

server <- function(input, output, session) {
  values <- reactiveValues(data = data.frame(age = numeric(0), month = numeric(0)))

  updateTable <- function(num_years, num_ages) {
    yr_names <- sprintf("yr%d", seq_len(num_years))
    new_data <- data.frame(
      age = seq_len(num_ages),
      month = rep(5, num_ages),
      matrix(250000, nrow = num_ages, ncol = num_years, dimnames = list(NULL, yr_names))
    )
    return(new_data)
  }

  observeEvent(c(input$n.stockyrs, input$n.stockage), {
    req(input$n.stockyrs, input$n.stockage)
    values$data <- updateTable(input$n.stockyrs, input$n.stockage)
    output$hot <- renderRHandsontable({
      rhandsontable(values$data)
    })
  })

  output$rvw.hot <- renderRHandsontable({
    rhandsontable(values$data, readOnly = TRUE)
  })

  session$onSessionEnded(stopApp)
}

shinyApp(ui, server)

Заключение

Следуя вышеописанным шагам, вы сможете динамически изменять количество строк и столбцов в вашей таблице rhandsontable в зависимости от ввода пользователя. Это расширит функциональность вашего приложения и сделает его более удобным для пользователей. Удачи в разработке вашего Shiny приложения!