我正在尝试使用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)
答案 0 :(得分：1)
你只是过度复杂化了。
在您的代码中，您有反应式表达式，可以反应性地分配其他反应式表达式。因此，你总是以双层反应来对抗。
我不知道您是否注意到了，但是在第一次取消选中复选框时，您也会删除占位符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)