ui 中的元素不具有反应性
elements in ui not reactive
我正在尝试使用 RStudio 在我闪亮的应用程序中制作反应元素。我希望单选按钮根据复选框出现或消失。然后我从显示的元素中收集输入以生成两个图表。问题是 UI 中的元素不是反应性的。下面是我使用的编码。
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
tags$div(id = 'placeholder'),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg"),
uiOutput(outputId = "facet")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
observeEvent(input$checkbox_facet, { if (input$checkbox_facet == TRUE) { # radio buttons for facet options show, and graph be made accordingly.
output$facet <- eventReactive(input$checkbox_facet, { insertUI( selector = "#placeholder",
ui = radioButtons("radio_facet", label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"), selected = "owner")
) })
output$exp <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
facet_wrap(~get(input$radio_facet), labeller = label_both) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
)
})
})
output$reg <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
facet_wrap(~get(input$radio_facet), labeller = label_both) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
)
})
})
}
else { # radio buttons disappear and graph is without facets
output$facet <- eventReactive(input$checkbox_facet, { removeUI(selector = 'div:has(> #radio_facet)', immediate = TRUE) })
output$exp <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
)
})
})
output$reg <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
)
})
})
}
}) # end observeEvent for graphs
}
shinyApp(ui, server)
你只是把事情复杂化了。
在您的代码中，您有反应式表达式，可以反应式地分配其他反应式表达式。所以你总是与双层反应性作斗争。
我不知道您是否注意到，但您在第一次取消选中复选框时也删除了占位符 div。您可能是故意这样做的，否则单选按钮将始终存在。因为覆盖 output$facet 不会删除任何反应表达式。而且你的反应逻辑本身不包含 input$checkbox_facet 的状态。所以你总是在与反应式表达式作斗争，你重新分配并且你无法控制它们的执行方式。
我的建议是清理您的代码。单独选择每个输出元素并定义您真正想要发生的反应。然后定义一个固定的行为，反映这一点。
此外，请注意渲染函数默认是反应式环境。
下面是一个有效的重构：
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
uiOutput("facets"),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
output$facets <- renderUI({
if (input$checkbox_facet) {
radioButtons("radio_facet",
label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"),
selected = "owner"
)
}
})
output$exp <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
output$reg <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
}
shinyApp(ui, server)
解决 Gregor de Cillia 关于条件面板的评论：您可能不希望每次复选框更改时都重新创建单选按钮，因为选项实际上总是相同的。 （并且您可能希望保持状态，即先前选择了哪个项目。）conditionalPanel 只是隐藏了单选按钮，因此进一步清理了您的 server 代码。
示例如下：
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
conditionalPanel('input.checkbox_facet',
radioButtons("radio_facet",
label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"),
selected = "owner"
)
),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
output$exp <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
output$reg <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
}
shinyApp(ui, server)
我正在尝试使用 RStudio 在我闪亮的应用程序中制作反应元素。我希望单选按钮根据复选框出现或消失。然后我从显示的元素中收集输入以生成两个图表。问题是 UI 中的元素不是反应性的。下面是我使用的编码。
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
tags$div(id = 'placeholder'),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg"),
uiOutput(outputId = "facet")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
observeEvent(input$checkbox_facet, { if (input$checkbox_facet == TRUE) { # radio buttons for facet options show, and graph be made accordingly.
output$facet <- eventReactive(input$checkbox_facet, { insertUI( selector = "#placeholder",
ui = radioButtons("radio_facet", label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"), selected = "owner")
) })
output$exp <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
facet_wrap(~get(input$radio_facet), labeller = label_both) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
)
})
})
output$reg <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
facet_wrap(~get(input$radio_facet), labeller = label_both) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
)
})
})
}
else { # radio buttons disappear and graph is without facets
output$facet <- eventReactive(input$checkbox_facet, { removeUI(selector = 'div:has(> #radio_facet)', immediate = TRUE) })
output$exp <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
)
})
})
output$reg <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
)
})
})
}
}) # end observeEvent for graphs
}
shinyApp(ui, server)
你只是把事情复杂化了。
在您的代码中，您有反应式表达式，可以反应式地分配其他反应式表达式。所以你总是与双层反应性作斗争。
我不知道您是否注意到，但您在第一次取消选中复选框时也删除了占位符 div。您可能是故意这样做的，否则单选按钮将始终存在。因为覆盖 output$facet 不会删除任何反应表达式。而且你的反应逻辑本身不包含 input$checkbox_facet 的状态。所以你总是在与反应式表达式作斗争，你重新分配并且你无法控制它们的执行方式。
我的建议是清理您的代码。单独选择每个输出元素并定义您真正想要发生的反应。然后定义一个固定的行为，反映这一点。
此外，请注意渲染函数默认是反应式环境。
下面是一个有效的重构：
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
uiOutput("facets"),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
output$facets <- renderUI({
if (input$checkbox_facet) {
radioButtons("radio_facet",
label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"),
selected = "owner"
)
}
})
output$exp <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
output$reg <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
}
shinyApp(ui, server)
解决 Gregor de Cillia 关于条件面板的评论：您可能不希望每次复选框更改时都重新创建单选按钮，因为选项实际上总是相同的。 （并且您可能希望保持状态，即先前选择了哪个项目。）conditionalPanel 只是隐藏了单选按钮，因此进一步清理了您的 server 代码。
示例如下：
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
conditionalPanel('input.checkbox_facet',
radioButtons("radio_facet",
label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"),
selected = "owner"
)
),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
output$exp <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
output$reg <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
}
shinyApp(ui, server)