r - 更新闪亮的反应数据框会导致替换错误
问题描述
我在下面有一个闪亮的应用程序,用户在其中上传一个文件(这里我只是把它dt
放在一个反应函数中),然后他可以从那里选择他想selectInput()
通过pickerInput()
. 如果他选择了,value1
他应该能够通过将所有值与 相乘来更新其所有值,numericInput()
value1
并创建一个新的sliderInput()
,因此也更新表中显示的数据框。当我尝试使用以下内容更新我的数据框时:
dt<-reactive({input$button
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
dt<-data.frame(name,value1)
dt$value1<-dt$value1*isolate(input$num)
dt
})
我明白了:replacement has 0 rows, data has 3
我dt
需要被阅读为反应式,因为在我的原始应用程序中它是通过加载的fileInput()
library(DT)
library(shiny)
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
uiOutput("inputp1"),
uiOutput("NUM"),
#Add the output for new pickers
uiOutput("pickers"),
actionButton("button", "Update")
),
mainPanel(
DTOutput("table")
)
)
)
# server()
server <- function(input, output) {
dt<-reactive({
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
dt<-data.frame(name,value1)
dt$value1<-dt$value1*isolate(input$num)
dt
})
output$NUM<-renderUI({
if("value1" %in% colnames(dt())){
numericInput("num", label = ("value"), value = 1)
}
else{
return(NULL)
}
})
output$inputp1 <- renderUI({
pickerInput(
inputId = "p1",
label = "Select Column headers",
choices = colnames( dt()),
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
})
observeEvent(input$p1, {
#Create the new pickers
output$pickers<-renderUI({
input$button2
div(lapply(input$p1, function(x){
if (is.numeric(dt()[[x]])) {
sliderInput(inputId=x, label=x, min=min(dt()[x]), max=max(dt()[[x]]), value=c(min(dt()[[x]]),max(dt()[[x]])))
}
else if (is.factor(dt()[[x]])) {
pickerInput(
inputId = x#The colname of selected column
,
label = x #The colname of selected column
,
choices = as.character(unique(dt()[,x]))#all rows of selected column
,
multiple = TRUE,options = list(`actions-box` = TRUE)
)
}
}))
})
})
output_table <- reactive({
req(input$p1, sapply(input$p1, function(x) input[[x]]))
dt_part <- dt()
for (colname in input$p1) {
if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
} else {
if (!is.null(input[[colname]][[1]])) {
dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
}
}
}
dt_part
})
output$table<-renderDT({
output_table()
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
解决方案
试试这个代码。我不清楚您要在
output_table()
数据框中做什么。
library(shiny)
library(shinyWidgets)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
uiOutput("inputp1"),
numericInput("num", label = ("value"), value = 1),
#Add the output for new pickers
uiOutput("pickers"),
actionButton("button", "Update")
),
mainPanel(
DTOutput("table")
)
)
)
# server()
server <- function(input, output, session) {
DF1 <- reactiveValues(data=NULL)
dt <- reactive({
name<-c("John","Jack","Bill")
value1<-c(2,4,6)
dt<-data.frame(name,value1)
})
observe({
DF1$data <- dt()
})
output$inputp1 <- renderUI({
pickerInput(
inputId = "p1",
label = "Select Column headers",
choices = colnames( dt()),
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
})
observeEvent(input$p1, {
#Create the new pickers
output$pickers<-renderUI({
dt1 <- DF1$data
div(lapply(input$p1, function(x){
if (is.numeric(dt1[[x]])) {
sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
}else { # if (is.factor(dt1[[x]])) {
selectInput(
inputId = x, # The col name of selected column
label = x, # The col label of selected column
choices = dt1[,x], # all rows of selected column
multiple = TRUE
)
}
}))
})
})
dt2 <- eventReactive(input$button, {
req(input$num)
dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
dt$value1<-dt$value1*isolate(input$num)
dt
})
observe({DF1$data <- dt2()})
output_table <- reactive({
req(input$p1, sapply(input$p1, function(x) input[[x]]))
dt_part <- dt2()
for (colname in input$p1) {
if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
} else {
if (!is.null(input[[colname]][[1]])) {
dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
}
}
}
dt_part
})
output$table<-renderDT({
output_table()
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
推荐阅读
- python - 如何在使用 OpenCV python 进行测量时提高精度
- python - 将 csv 中的 itens 复制到 pythonic dict 或 json
- php - 使用自定义插件覆盖插件 CSS
- python - Python,将一些输出从shell重定向到文件
- r - Lavaan 不良拟合优度值
- arrays - 为numpy中的每个元素返回匹配元素的所有索引的声明性方式?
- yaml - 在具有几乎相同元素的列表中有效使用 YAML 锚点
- gitlab - Ubuntu上的线性Gitlab更新路径?
- c# - 如何诊断 Newtonsoft 反序列化器返回一个空对象并且没有错误
- python - 我正在尝试在 OS 中的 python 中做一个最适合的算法