CODEWITHSUNDEEP
rshinyshiny-reactivity
Jay
Jay

Reputation: 13

elements in ui not reactive

I am trying to make reactive elements in my shiny app using RStudio. I want the radio buttons to appear or disappear depending upon a checkbox. Then I am gathering the inputs from the elements displayed to generate two graphs. The problem is that the elements in UI are not reactive. Below is the coding I used.

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)

Upvotes: 0

Views: 72

Answers (1)

K. Rohde
K. Rohde

Reputation: 9676

You're just overcomplicating things.

In your code, you have reactive expressions, that reactively assign other reactive expressions. So you always fight with a double layer of reactivity.

I don't know if you noticed, but you also delete the placeholder div the first time the checkbox is unchecked. You maybe did this on purpose, because otherwise the radio buttons will always be there. Because overwriting the output$facet will not delete any reacting expressions. And your reactive logic itself does not contain the state of input$checkbox_facet. So you are always fighting with reactive expressions, that you reassign and where you have no control over how they are executed.

What I recommend is, to clean up your code. Pick each output element by itself and define what reactions you really want to happen. And then define a fixed behaviour, that reflects that.

Also, be aware that render functions are reactive environments by default.

Below is a refactoring that works:

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)

To address the comment from Gregor de Cillia about conditional panels: You might not want to recreate the radio buttons every time the checkbox changes, since the options are in fact always the same. (And you might want to keep the state, i.e. which item was selected previously.) A conditionalPanel just hides the radio buttons and therefore cleans up your server code even more.

Example below: 

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)

Upvotes: 1

Related Questions