1
votes

As an example I will be using the built-in diamonds data in ggplot2.

I want to display the dataframe according to cut, color and clarity. However, I wanted to select the items through deduction. I would want to select the colors in the drop-down menu that are available and so on with clarity.

The method below does not refresh when you wanted to look at another item. Is there an easier way of doing this in shiny using plyr?

The diamonds dataframe may not be the best example but I cant find any other data.

server.R

library(plyr)

dm<-dlply(diamonds, .(cut))

for(x in 1:length(dm)){
   assign(eval(parse(text = paste("names(dm)[x]"))),dm[[x]])
}

shinyServer(function(input, output) {
   output$choose_cut <- renderUI({
      selectInput("cut", "Cut", as.list(names(dm), multiple = TRUE))
    })

   output$choose_color <- renderUI({
      if(is.null(input$cut)) return()
      dat <- get(input$cut)
      dm2<-dlply(dat, .(color))
      for(x in 1:length(dm2)){
         assign(eval(parse(text = paste("names(dm2)[x]"))),dm2[[x]], envir = globalenv()
       )}

    selectInput("color", "Color", as.list(names(dm2)))})

    output$choose_clarity <- renderUI({
    if(is.null(input$color)) return()
    dat <- get(input$color)
    dm3<-dlply(dat, .(clarity))
    for(x in 1:length(dm3)){
       assign(eval(parse(text = paste("names(dm3)[x]"))),dm3[[x]], envir = globalenv())
    }

    selectInput("clarity", "Clarity", as.list(names(dm3)))
   })

    output$table <- renderTable({
       if (is.null(input$clarity)) return()
       dat <- get(input$clarity)
       dat
    })                  
})  

ui.R

shinyUI(pageWithSidebar(
headerPanel(""),

    sidebarPanel(
      uiOutput("choose_cut"),
      uiOutput("choose_color"),
      uiOutput("choose_clarity"),
  br()
),

mainPanel(
  "Data", tableOutput("table"))))
1

1 Answers

3
votes

The reason it doesn't refresh for certain drop-down variable changes is that the reactivity is not set.

You have a couple of options:

Option 1: Explicitly induce Reactivity

Notice that as written, output$table depends only on input$clarity. You can bring in reactivity for other variables by adding a couple of lines:

 output$table <- renderTable({
    if (is.null(input$clarity)) return()
    if (is.null(input$color)) return()
    if (is.null(input$cut)) return()
    dat <- get(input$clarity)
    dat
  })          

Similary in choose_clarity add in a check for input$cut. (You already have the is.null check for input$color.)

 output$choose_clarity <- renderUI({
    if (is.null(input$cut)) return()
    if (is.null(input$color)) return()
    ...

This did it when I tested it.

Option 2: Use a Reactive Function

In server.R add

  subsetData <- reactive({
    # I use subset() here, but you can use ddply() to split the data frame
    subset(diamonds, cut==input$cut & color==input$color & clarity==input$clarity)    
  })

Leave the rest of it the same and in output$table, just call the reactive function.

  output$table <- renderTable({
    subsetData()
  })                  

The UI.R is unchanged. Here's the full Server.R

modified Server.R

library(plyr)
library(ggplot2)

dm<-dlply(diamonds, .(cut))

for(x in 1:length(dm)){
  assign(eval(parse(text = paste("names(dm)[x]"))),dm[[x]])
}

shinyServer(function(input, output) {
  
  
  subsetData <- reactive({
    subset(diamonds, cut==input$cut & color==input$color & clarity==input$clarity)    
  })
  
  
  output$choose_cut <- renderUI({
    selectInput("cut", "Cut", as.list(names(dm), multiple = TRUE))
  })
  
  output$choose_color <- renderUI({
    if(is.null(input$cut)) return()
    dat <- get(input$cut)
    dm2<-dlply(dat, .(color))
    for(x in 1:length(dm2)){
      assign(eval(parse(text = paste("names(dm2)[x]"))),dm2[[x]], envir = globalenv()
      )}
    
    selectInput("color", "Color", as.list(names(dm2)))})
  
  output$choose_clarity <- renderUI({
    if (is.null(input$cut)) return()
    if (is.null(input$color)) return()
    dat <- get(input$color)
    dm3<-dlply(dat, .(clarity))
    for(x in 1:length(dm3)){
      assign(eval(parse(text = paste("names(dm3)[x]"))),dm3[[x]], envir = globalenv())
    }
    
    selectInput("clarity", "Clarity", as.list(names(dm3)))
  })
  
  output$table <- renderTable({
    if (is.null(input$clarity)) return()
    if (is.null(input$color)) return()
    if (is.null(input$cut)) return()
    dat <- get(input$clarity)
    dat
#    subsetData()
  })                  
})