我是 Shiny 的新手，我正在开发一个应用程序，用户可以在其中输入他们希望在每个年龄（由用户指定）储存的鱼的数量，持续用户指定的年数。目前，该应用程序打开时会显示一个默认的常用值表，但我希望用户能够轻松编辑该表，包括行数和列数。用户使用滑块选择库存年数，我希望所选值根据所选数字更新表中的列数。还应该有一列代表年龄，一列代表月份。每年的列应命名为“yr1”、“yr2”等。类似地，用户使用滑块选择年龄数，我希望此选定值来更新行数。我开发的代码如下：
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("Welcome",tabName = "menuWelcome", icon = shiny::icon("face-smile")),
menuItem("Stocking",tabName = "menuStocking", icon = shiny::icon("fish")),
menuItem("Review",tabName = "menuReview", icon = shiny::icon("magnifying-glass-chart")))),
dashboardBody(
tabItems(
tabItem(tabName="menuWelcome",
valueBox("Population Viability Analysis","Welcome",icon = shiny::icon("face-smile"),width=8)),
tabItem(tabName="menuStocking",
fluidRow(valueBox("Proposed Stocking","Enter Data",icon = shiny::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 = shiny::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 = 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)
该表应该在“库存”选项卡中可编辑，在“审阅”选项卡中只读，我认为我已经按预期工作了。我不确定如何根据输入滑块更新行数（年龄）和列数（放养年数）。我也不确定如何动态命名以“yr1”开头的列，依此类推，具体取决于所选的年数。
这并不是一件小事，因为您需要保留用户编辑的值（至少在保留已编辑值的行/列时）。
我将您的库存和年龄输入更改为最小值 1，以避免出现空表错误。
使用
stocking.datobserveEventdf = hot_to_r(input$hot)if(!is.null(input$hot))之后，您必须考虑用户添加列或行的情况以及用户删除列或行的情况，并根据现有表相应地构建数据框。最后更新
reactiveValuesoutput$hot
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("Welcome",tabName = "menuWelcome", icon = shiny::icon("face-smile")),
menuItem("Stocking",tabName = "menuStocking", icon = shiny::icon("fish")),
menuItem("Review",tabName = "menuReview", icon = shiny::icon("magnifying-glass-chart")))),
dashboardBody(
tabItems(
tabItem(tabName="menuWelcome",
valueBox("Population Viability Analysis","Welcome",icon = shiny::icon("face-smile"),width=8)),
tabItem(tabName="menuStocking",
fluidRow(valueBox("Proposed Stocking","Enter Data",icon = shiny::icon("fish"),width=8)),
fluidRow(box(sliderInput("n.stockyrs","Number years to stock",value=5,min=1,max=25,step=1),width=8)),
fluidRow(box(sliderInput("n.stockage","Number ages to stock",value=1,min=1,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 = shiny::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 = stocking.dat)
observeEvent(input$n.stockyrs, {
if(!is.null(input$hot)){
df = hot_to_r(input$hot)
dfyrs = df[,-(1:2)]
# add new columns if input > number of existing columns
if(input$n.stockyrs > ncol(dfyrs)) {
newcols = as.data.frame(matrix(250000, ncol = input$n.stockyrs - ncol(dfyrs)))
dfyrs = cbind(dfyrs, newcols)
} else { # else remove columns
dfyrs = dfyrs[,1:input$n.stockyrs]
}
names(dfyrs) = paste0("yr", 1:input$n.stockyrs)
df = cbind(df[,1:2], dfyrs)
values <- reactiveValues(data = df)
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
observeEvent(input$n.stockage, {
if(!is.null(input$hot)){
df = hot_to_r(input$hot)
dfam = df[,1:2]
# add new rows if input > number of existing rows
if(input$n.stockage > nrow(df)) {
# new rows
newrows = as.data.frame(matrix(250000, nrow = input$n.stockage - nrow(dfyrs), ncol = input$n.stockyrs))
names(newrows) = paste0("yr", 1:input$n.stockyrs)
highestexistingage = dfam[length(dfam$age),1]
dfamnewrows = data.frame(age = seq(highestexistingage + 1, input$n.stockage), month = rep(5))
newrows = cbind(dfamnewrows, newrows)
df = rbind(df, newrows)
} else { #remove rows
df = df[1:input$n.stockage,]
}
values <- reactiveValues(data = df)
print(values$data)
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
observe({
if(!is.null(input$hot)){
values$data <- as.data.frame(hot_to_r(input$hot))
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)