在 R 中更改链式选择输入后如何保持值?
How to keep values after changing chained selectInputs in shiny in R?
我有一个复杂的闪亮应用程序(这里是一个更简单的示例),看起来像这样:
该应用程序允许用户更改四个参数 (selectInput
)。较低的参数取决于较高的参数(例如 year
上的 month
,year
上的 type
和 month
等等)。一切正常,但当我更改一个参数时,另一个参数也会更改。在某些情况下需要它,但并非总是如此。当之前选择的级别在新配置中不存在时需要它,但是例如当我遇到以下情况时它不应更改。前任。我为某些 year
和 month
选择了类型 'AGD'
和 size
'medium'
并且我展示了这个组合的奖品或其他东西。然后我想将它与 type
'RTV'
中的相同 size
进行比较,因此我更改了 type
参数。一切正常,但 size
更改为 'big'
,而我希望它仍然是 'medium'
。我可以再点击一次,但为什么?那就很不方便了...
你知道如何处理这样的问题吗?
我设法使用 observe
和 reactive values
为两个依赖项做到了,但是对于四个依赖项它不起作用。
这是我的代码:
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "miedium"), 6 + 11))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("year"),
uiOutput("month"),
uiOutput("type"),
uiOutput("size")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
output$year <- renderUI({
year <- data %>%
select(year) %>%
unique()
selectInput("year",
"YEAR",
year$year,
selected = max(year$year))
})
output$month <- renderUI({
month <- data %>%
filter(year == input$year) %>%
select(month) %>%
unique() %>%
arrange()
selectInput("month",
"MONTH",
month$month,
selected = max(month$month))
})
output$type <- renderUI({
type <- data %>%
filter(year == input$year,
month == input$month) %>%
select(type) %>%
unique() %>%
arrange()
selectInput("type",
"TYPE",
type$type,
selected = type$type[1])
})
output$size <- renderUI({
size <- data %>%
filter(year == input$year,
month == input$month,
type == input$type) %>%
select(size) %>%
unique() %>%
arrange()
selectInput("size",
"SIZE",
size$size,
selected = size$size[1])
})
}
shinyApp(ui = ui, server = server)
现有代码的问题
这里的代码有几个问题,解决方案允许我们在应用程序中引入内存的概念。首先,我想立即解决两个问题。
c("big", "small", "medium", "big", "medium")
而不是 c("big", "small", "medium", "big", "miedium")
uiOutput()
和 renderUI()
组合导致服务器提供一个 new selectInput
按钮,每次输入是变了。相反,我们可以简单地实例化一个静态 UI 元素并使用 updateSelectInput()
更新它
解决方案
要解决这个问题,首先要解决上面描述的 1) 和 2)。那么我们就需要引入内存的概念。服务器需要知道之前选择的是什么,以便我们可以在 selectInput
更新时将其设置为默认选项。我们可以将其存储为常规列表(年、月、类型和大小的变量)或使用 reactiveValues
.
的反应列表
很高兴您为过滤选项确定了清晰的逻辑,从年 -> 月 -> 类型 -> 大小有一个清晰的层次结构。但是,每次更改 months
时都会为 type
和 size
生成新的输入。
我们现在想介绍一个简单的逻辑,其中输入选择仅修改内存 selected_vals
。然后内存中的更改会触发其他输入进行更新。这在下面的解决方案中最为明显。
代码解决方案
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))
years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year","Year",choices = years,selected = 2018),
selectInput("month","Month",choices = month,selected = 7),
selectInput("type","Type",choices = type,selected = "AGD"),
selectInput("size","Size",choices = size,selected = "big")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
#------- Initialize the Memory ----------
selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")
#------ Whenever any of the inputs are changed, it only modifies the memory----
observe({
req(input$year,input$month,input$type,input$size)
selected_vals$year <- input$year
selected_vals$month <- input$month
selected_vals$type <- input$type
selected_vals$size <- input$size
})
#------ Update all UI elements using the values stored in memory ------
observe({
year <- data %>%
select(year) %>%
unique()
updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)
})
observe({
month <- data %>%
filter(year == selected_vals$year) %>%
select(month) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$month %in% month$month) displayVal = selected_vals$month else displayVal = NULL
updateSelectInput(session,"month",choices = month$month,selected = displayVal)
})
observe({
type <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month) %>%
select(type) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$type %in% type$type) displayVal = selected_vals$type else displayVal = NULL
updateSelectInput(session,"type",choices = type$type,selected = displayVal)
})
observe({
size <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month,
type == selected_vals$type) %>%
select(size) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if(selected_vals$size %in% size$size) displayVal = selected_vals$size else displayVal = NULL
updateSelectInput(session,"size",choices = size$size,selected = displayVal)
})
}
shinyApp(ui = ui, server = server)
编辑
正如下面评论中提到的,代码中存在错误。这是因为 then displayVal = NULL
shiny 将默认值设置为显示为数组中的第一个元素。但是我们忘记将其存储在内存中,selected_vals
。下面的代码解决了这个问题。
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))
years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year","Year",choices = years,selected = 2018),
selectInput("month","Month",choices = month,selected = 7),
selectInput("type","Type",choices = type,selected = "AGD"),
selectInput("size","Size",choices = size,selected = "big")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
#------- Initialize the Memory ----------
selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")
#------ Whenever any of the inputs are changed, it only modifies the memory----
observe({
req(input$year,input$month,input$type,input$size)
selected_vals$year <- input$year
selected_vals$month <- input$month
selected_vals$type <- input$type
selected_vals$size <- input$size
})
#------ Update all UI elements using the values stored in memory ------
observe({
year <- data %>%
select(year) %>%
unique()
updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)
})
observe({
month <- data %>%
filter(year == selected_vals$year) %>%
select(month) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$month %in% month$month){
displayVal = selected_vals$month
}else{
displayVal = NULL
selected_vals$month = month$month[1]
}
updateSelectInput(session,"month",choices = month$month,selected = displayVal)
})
observe({
type <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month) %>%
select(type) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$type %in% type$type){
displayVal = selected_vals$type
}else{
displayVal = NULL
selected_vals$type = tpye$type[1]
}
updateSelectInput(session,"type",choices = type$type,selected = displayVal)
})
observe({
size <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month,
type == selected_vals$type) %>%
select(size) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if(selected_vals$size %in% size$size){
displayVal = selected_vals$size
} else{
displayVal = NULL
selected_vals$size = size$size[1]
}
updateSelectInput(session,"size",choices = size$size,selected = displayVal)
})
}
shinyApp(ui = ui, server = server)
我有一个复杂的闪亮应用程序(这里是一个更简单的示例),看起来像这样:
该应用程序允许用户更改四个参数 (selectInput
)。较低的参数取决于较高的参数(例如 year
上的 month
,year
上的 type
和 month
等等)。一切正常,但当我更改一个参数时,另一个参数也会更改。在某些情况下需要它,但并非总是如此。当之前选择的级别在新配置中不存在时需要它,但是例如当我遇到以下情况时它不应更改。前任。我为某些 year
和 month
选择了类型 'AGD'
和 size
'medium'
并且我展示了这个组合的奖品或其他东西。然后我想将它与 type
'RTV'
中的相同 size
进行比较,因此我更改了 type
参数。一切正常,但 size
更改为 'big'
,而我希望它仍然是 'medium'
。我可以再点击一次,但为什么?那就很不方便了...
你知道如何处理这样的问题吗?
我设法使用 observe
和 reactive values
为两个依赖项做到了,但是对于四个依赖项它不起作用。
这是我的代码:
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "miedium"), 6 + 11))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("year"),
uiOutput("month"),
uiOutput("type"),
uiOutput("size")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
output$year <- renderUI({
year <- data %>%
select(year) %>%
unique()
selectInput("year",
"YEAR",
year$year,
selected = max(year$year))
})
output$month <- renderUI({
month <- data %>%
filter(year == input$year) %>%
select(month) %>%
unique() %>%
arrange()
selectInput("month",
"MONTH",
month$month,
selected = max(month$month))
})
output$type <- renderUI({
type <- data %>%
filter(year == input$year,
month == input$month) %>%
select(type) %>%
unique() %>%
arrange()
selectInput("type",
"TYPE",
type$type,
selected = type$type[1])
})
output$size <- renderUI({
size <- data %>%
filter(year == input$year,
month == input$month,
type == input$type) %>%
select(size) %>%
unique() %>%
arrange()
selectInput("size",
"SIZE",
size$size,
selected = size$size[1])
})
}
shinyApp(ui = ui, server = server)
现有代码的问题
这里的代码有几个问题,解决方案允许我们在应用程序中引入内存的概念。首先,我想立即解决两个问题。
c("big", "small", "medium", "big", "medium")
而不是c("big", "small", "medium", "big", "miedium")
uiOutput()
和renderUI()
组合导致服务器提供一个 newselectInput
按钮,每次输入是变了。相反,我们可以简单地实例化一个静态 UI 元素并使用updateSelectInput()
更新它
解决方案
要解决这个问题,首先要解决上面描述的 1) 和 2)。那么我们就需要引入内存的概念。服务器需要知道之前选择的是什么,以便我们可以在 selectInput
更新时将其设置为默认选项。我们可以将其存储为常规列表(年、月、类型和大小的变量)或使用 reactiveValues
.
很高兴您为过滤选项确定了清晰的逻辑,从年 -> 月 -> 类型 -> 大小有一个清晰的层次结构。但是,每次更改 months
时都会为 type
和 size
生成新的输入。
我们现在想介绍一个简单的逻辑,其中输入选择仅修改内存 selected_vals
。然后内存中的更改会触发其他输入进行更新。这在下面的解决方案中最为明显。
代码解决方案
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))
years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year","Year",choices = years,selected = 2018),
selectInput("month","Month",choices = month,selected = 7),
selectInput("type","Type",choices = type,selected = "AGD"),
selectInput("size","Size",choices = size,selected = "big")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
#------- Initialize the Memory ----------
selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")
#------ Whenever any of the inputs are changed, it only modifies the memory----
observe({
req(input$year,input$month,input$type,input$size)
selected_vals$year <- input$year
selected_vals$month <- input$month
selected_vals$type <- input$type
selected_vals$size <- input$size
})
#------ Update all UI elements using the values stored in memory ------
observe({
year <- data %>%
select(year) %>%
unique()
updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)
})
observe({
month <- data %>%
filter(year == selected_vals$year) %>%
select(month) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$month %in% month$month) displayVal = selected_vals$month else displayVal = NULL
updateSelectInput(session,"month",choices = month$month,selected = displayVal)
})
observe({
type <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month) %>%
select(type) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$type %in% type$type) displayVal = selected_vals$type else displayVal = NULL
updateSelectInput(session,"type",choices = type$type,selected = displayVal)
})
observe({
size <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month,
type == selected_vals$type) %>%
select(size) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if(selected_vals$size %in% size$size) displayVal = selected_vals$size else displayVal = NULL
updateSelectInput(session,"size",choices = size$size,selected = displayVal)
})
}
shinyApp(ui = ui, server = server)
编辑
正如下面评论中提到的,代码中存在错误。这是因为 then displayVal = NULL
shiny 将默认值设置为显示为数组中的第一个元素。但是我们忘记将其存储在内存中,selected_vals
。下面的代码解决了这个问题。
library("shiny")
library("plotly")
library("dplyr")
data <- data.frame(year = rep(c(rep(2018, 6), rep(2019, 11)), each = 5),
month = rep(c(7:12, 1:11), each = 5),
type = rep(c("AGD", "AGD", "AGD", "RTV", "RTV"), 6 + 11),
value = sample(1:100, 85),
size = rep(c("big", "small", "medium", "big", "medium"), 6 + 11))
years = data %>% arrange(year) %>% .$year %>% unique(.)
month = data %>% arrange(month) %>% .$month %>% unique(.)
type = data %>% arrange(type)%>% .$type %>% unique(.)
size = data %>% arrange(size) %>%.$size %>% unique(.)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year","Year",choices = years,selected = 2018),
selectInput("month","Month",choices = month,selected = 7),
selectInput("type","Type",choices = type,selected = "AGD"),
selectInput("size","Size",choices = size,selected = "big")
),
mainPanel(
)
)
)
server <- function(input, output, session) {
#------- Initialize the Memory ----------
selected_vals = reactiveValues(year = 2019,month = 7, type = "AGD", size = "big")
#------ Whenever any of the inputs are changed, it only modifies the memory----
observe({
req(input$year,input$month,input$type,input$size)
selected_vals$year <- input$year
selected_vals$month <- input$month
selected_vals$type <- input$type
selected_vals$size <- input$size
})
#------ Update all UI elements using the values stored in memory ------
observe({
year <- data %>%
select(year) %>%
unique()
updateSelectInput(session,"year",choices = year$year,selected = selected_vals$year)
})
observe({
month <- data %>%
filter(year == selected_vals$year) %>%
select(month) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$month %in% month$month){
displayVal = selected_vals$month
}else{
displayVal = NULL
selected_vals$month = month$month[1]
}
updateSelectInput(session,"month",choices = month$month,selected = displayVal)
})
observe({
type <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month) %>%
select(type) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if (selected_vals$type %in% type$type){
displayVal = selected_vals$type
}else{
displayVal = NULL
selected_vals$type = tpye$type[1]
}
updateSelectInput(session,"type",choices = type$type,selected = displayVal)
})
observe({
size <- data %>%
filter(year == selected_vals$year,
month == selected_vals$month,
type == selected_vals$type) %>%
select(size) %>%
unique() %>%
arrange()
#Check if the value is in memory, if not return NULL (it defaults to the first element)
if(selected_vals$size %in% size$size){
displayVal = selected_vals$size
} else{
displayVal = NULL
selected_vals$size = size$size[1]
}
updateSelectInput(session,"size",choices = size$size,selected = displayVal)
})
}
shinyApp(ui = ui, server = server)