0

我正在尝试使用 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)
4

1 回答 1

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关于条件面板的评论：您可能不想在每次复选框更改时重新创建单选按钮，因为选项实际上总是相同的。（并且您可能希望保留状态，即先前选择了哪个项目。） AconditionalPanel只是隐藏了单选按钮，因此更加清理了您的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)
于 2018-03-16T10:36:50.803 回答