ui中的元素不是被动的

时间:2018-03-15 20:21:02

标签: r shiny shiny-reactivity

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

1 个答案:

答案 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)