Plot with different reactive datasets

I am creating an app that reads a user file to create a scatterplot, and then reads a second file (named "aref" from global.R) to create an area chart as another layer below the scatterplot. Users can subset aref by "domain," thus the second file should be a subset based on input$domain, but I can't make this happen. I get an error "Error: object 'area_data' not found.

The resulting graph should look like this:

How can my scatter+area plot be created with data from the two sources? Please note that my final application will reference a large set of data for the area plot, thus maintaining the global file seems most efficient.

Data for upload file in the app:

upload<-structure(list(X = 1:9, initialReadProficiency = c(1.5, 2, 3, 
3.3, 2.5, 6.5, 2.2, 4, 4.2), scalescoreChange = c(22L, 33L, 44L, 
44L, 40L, 17L, 28L, 43L, 37L)), class = "data.frame", row.names = c(NA, 
-9L))

Data for the Area Plot (should this be set in global.r ? ):

aref<-structure(list(Domain = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L), .Label = c("Math_bogus", "Reading", "Writing_bogus"
), class = "factor"), Grade = structure(c(5L, 5L, 5L, 5L, 3L, 
3L, 3L, 3L, 7L, 7L, 7L), .Label = c("Eighth Grade", "Fifth Grade", 
"First Grade", "Fourth Grade", "Kindergarten Grade", 
"Ninth-Twelfth Grade", 
"Second Grade", "Seventh Grade", "Sixth Grade", "Third Grade"
), class = "factor"), Percentile = structure(c(4L, 3L, 2L, 1L, 
4L, 3L, 2L, 1L, 4L, 3L, 2L), .Label = c("20th", "40th", "60th", 
"80th"), class = "factor"), PL1 = c(188L, 177L, 166L, 145L, 135L, 
123L, 113L, 92L, 122L, 106L, 93L), PL15 = c(134L, 117L, 105L, 
89L, 91L, 79L, 70L, 51L, 77L, 61L, 47L), PL2 = c(99L, 77L, 60L, 
39L, 69L, 52L, 39L, 24L, 58L, 38L, 24L), PL25 = c(87L, 69L, 55L, 
35L, 55L, 36L, 23L, 10L, 50L, 30L, 16L), PL3 = c(77L, 59L, 47L, 
23L, 46L, 28L, 15L, 2L, 50L, 29L, 14L), PL35 = c(74L, 53L, 41L, 
15L, 42L, 26L, 12L, -3L, 48L, 30L, 13L), PL4 = c(73L, 51L, 36L, 
11L, 40L, 26L, 9L, -6L, 43L, 28L, 10L), PL45 = c(78L, 52L, 36L, 
15L, 39L, 23L, 7L, -10L, 41L, 26L, 12L), PL5 = c(83L, 54L, 37L, 
26L, 38L, 23L, 8L, -11L, 41L, 27L, 15L), PL55 = c(88L, 55L, 37L, 
34L, 35L, 21L, 9L, -7L, 38L, 25L, 12L), PL6 = c(NA, NA, NA, NA, 
29L, 19L, 9L, -4L, 31L, 19L, 8L)), row.names = c(NA, 11L), 
class = "data.frame")

Here is my code:

# global 
# do I need a global file for this application?
library(ggplot2);library(dplyr);library(readxl)
#aref <- read.csv("//srv/shiny-server/cscShinyApps/DASAareaPlot/statewide.csv")

# prepare data for background area chart
df<-reshape2::melt(data=aref,
                   id.vars=c("Percentile"), 
                   measure.vars=c("PL1"  ,"PL15","PL2","PL25","PL3", "PL35","PL4","PL45" ,"PL5","PL55","PL6"))

# stacked area: one area-shape per `group`
# ggplot(df, aes(variable,value,group=Percentile))+geom_area(alpha=.4)
library(stringr)
df$num<-str_extract(df$variable, "[[:digit:]]+") %>% as.integer()
df$pl_axis <- ifelse(df$num>10,df$num/10,df$num)

df$Percentile<-factor(df$Percentile,levels = c("20th","40th","60th","80th"), ordered = T)


layerArea<-function(){
       geom_area(data=area_data, 
            aes(pl_axis,value,group=Percentile,fill=Percentile), 
            alpha=.4, position = "dodge")}
#ui
library(shiny);library(plotly);library(ggthemes)
ui<-fluidPage(
  titlePanel("Visualize Your Data"),# title
  sidebarLayout(    
    sidebarPanel(column=3, position="left",
        fileInput("file1", "STEP 1: Choose CSV File",  # Input: Select a file ----
                  multiple = TRUE,
                  accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
        checkboxInput("header", "Header", TRUE),# Input: Checkbox if file has header
        
        # Input: Select separator
        radioButtons("sep", "Separator",
                     choices = c(Semicolon = ";",
                                 Comma = ",",Tab = "\t"),
                     selected = ","),
        tags$hr(),          # add a Horizontal line 
      
        # Input: Select what to display
        selectInput("dataset","STEP 2: Choose 'Uploaded File' Here:",choices=list(iris="iris",uploaded_file="inFile"), selected = NULL),
        selectInput("x_axis","STEP 3: Choose X-axis variable (initial proficiency):", choices = NULL),
        selectInput("y_axis","STEP 4: Choose Y-axis variable (scale score change):", choices = NULL),
        selectInput("point_label","STEP 5: Label for points:", choices = NULL),
        selectInput("domain","STEP 6: Choose ACCESS Domain:",choices=c("Math_bogus","Reading","Writing_bogus")),
                width=4
            ),       # end sidebarPanel ;


    fluidRow(column(6, # column width
      h3(textOutput("caption")),
      #h3(htmlOutput("caption")),
      plotlyOutput("finalplot")  # quoted object is named in server code
    ))  # end fluidRow
    
  ) # end sideBarLayout
)
# server

source("global.R" ,local=TRUE )  

library(shiny)
# shiny server side code for each call
server<-(function(input, output, session){
  #update variable and group based on dataset
  observe({
    if(!exists(input$dataset)) return() #make sure upload exists
    var.opts<-colnames(get(input$dataset))
    updateSelectInput(session, "x_axis", choices = var.opts)
    updateSelectInput(session, "y_axis", choices = var.opts)
    updateSelectInput(session, "point_label", choices = var.opts)
          })   # end `observe`
  
  
  #get data object
  get_data<-reactive({
    
    # set uploaded file
    upload_data<-reactive({
      
      inFile <- input$file1
      
      if (is.null(inFile))    return(NULL)
      
      #do I need to store in a reactiveValues object?
      read.csv(inFile$datapath,
               header = input$header,
               sep = input$sep)
    })     # end `upload data`
    
    observeEvent(input$file1,{
      inFile<<-upload_data()
    })      # section end
    
    
    if(!exists(input$dataset)) return() # if no upload
    
    check<-function(x){is.null(x) || x==""}
    if(check(input$dataset)) return()
    
    obj<-list(data=get(input$dataset),   # get the dataset and then choose the inputs
              x_axis=input$x_axis,y_axis=input$y_axis,
              point_label=input$point_label    )
    
    #require all to be set to proceed
    if(any(sapply(obj,check))) return()
    #make sure choices had a chance to update
    check<-function(obj){
      !all(c(obj$x_axis,obj$y_axis) %in% colnames(obj$data))
    }
    
    if(check(obj)) return()  
    
    obj
    
       
  })     # end `get data`


  
  # second reactive dataset for area plot layer; this doesn't seem to work
  area_data<-reactive({
    area_data<<-subset(df, df$Domain==input$domain)
    
  area_data
  
  })  # end of area_data  (data for the area plot)
  
  
  
    #plotting function using ggplot2
  output$finalplot<-renderPlotly({    
    
    plot.obj<-get_data()     
    
    # conditions for plotting
    if(is.null(plot.obj)) return()
    if(plot.obj$x_axis == "" | plot.obj$y_axis=="")  return(NULL)
    
    require(ggplot2);require(plotly)
   
    p<-ggplot()

# NOTE: pl_axis is from global.R
    p<-p+geom_point(data=plot.obj$data,
                    mapping=aes_string(
                      x= plot.obj$x_axis, 
                      y= plot.obj$y_axis,
                      label=plot.obj$point_label )) + xlim(1,6)

    p<-p+layerArea()+      ggplot2::theme_minimal()

    #a<-plot.obj$point_label
    
    ggplotly(p)
  })  # end renderPlot
 
  
output$plot <- renderUI({plotlyOutput("finalplot")  })
  
})

You did not define the variable area_data.

Please format your question properly. You can use triply backticks ``` before R code. Otherwise it will look like a mess.

You can have reactive blocks inside other reactive blocks.

I don't think you can use <<- in shiny. This sets a variable in the parent environment.

@woodward Again, thanks for your reply. A couple questions:

  1. The code needs to permit a user to choose a Domain to subset the area plot. I don't see a subset of df in your code. Would this work:
  #  second reactive dataset for area plot layer
  area_data <- reactive({
    print(paste("subsetting area_data by", input$domain))
    print("Warning -- df$Domain does not exist so ignoring")
    area_data<-subset(df, df$Domain==input$domain)  # sketchycoder addition
    
  }) # end of area_data (data for the area plot)
  1. When I run the app, and then select a file from the ui, I get an error:
    Warning: Error in get: object 'upload' not found

Can you offer any ideas on how to proceeed?

Thank you...

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

This is at least running now. Hopefully you can modify it to do what you want from here.


library(ggplot2)
library(dplyr)
library(readxl)
library(stringr)
library(shiny)
library(plotly)

upload <- structure(list(X = 1:9, initialReadProficiency = c(
  1.5, 2, 3,
  3.3, 2.5, 6.5, 2.2, 4, 4.2
), scalescoreChange = c(
  22L, 33L, 44L,
  44L, 40L, 17L, 28L, 43L, 37L
)), class = "data.frame", row.names = c(
  NA,
  -9L
))

aref <- structure(list(Domain = structure(c(
  2L, 2L, 2L, 2L, 2L, 2L, 2L,
  2L, 2L, 2L, 2L
), .Label = c("Math_bogus", "Reading", "Writing_bogus"), class = "factor"), Grade = structure(c(
  5L, 5L, 5L, 5L, 3L,
  3L, 3L, 3L, 7L, 7L, 7L
), .Label = c(
  "Eighth Grade", "Fifth Grade",
  "First Grade", "Fourth Grade", "Kindergarten Grade", "Ninth-Twelfth Grade",
  "Second Grade", "Seventh Grade", "Sixth Grade", "Third Grade"
), class = "factor"), Percentile = structure(c(
  4L, 3L, 2L, 1L,
  4L, 3L, 2L, 1L, 4L, 3L, 2L
), .Label = c(
  "20th", "40th", "60th",
  "80th"
), class = "factor"), PL1 = c(
  188L, 177L, 166L, 145L, 135L,
  123L, 113L, 92L, 122L, 106L, 93L
), PL15 = c(
  134L, 117L, 105L,
  89L, 91L, 79L, 70L, 51L, 77L, 61L, 47L
), PL2 = c(
  99L, 77L, 60L,
  39L, 69L, 52L, 39L, 24L, 58L, 38L, 24L
), PL25 = c(
  87L, 69L, 55L,
  35L, 55L, 36L, 23L, 10L, 50L, 30L, 16L
), PL3 = c(
  77L, 59L, 47L,
  23L, 46L, 28L, 15L, 2L, 50L, 29L, 14L
), PL35 = c(
  74L, 53L, 41L,
  15L, 42L, 26L, 12L, -3L, 48L, 30L, 13L
), PL4 = c(
  73L, 51L, 36L,
  11L, 40L, 26L, 9L, -6L, 43L, 28L, 10L
), PL45 = c(
  78L, 52L, 36L,
  15L, 39L, 23L, 7L, -10L, 41L, 26L, 12L
), PL5 = c(
  83L, 54L, 37L,
  26L, 38L, 23L, 8L, -11L, 41L, 27L, 15L
), PL55 = c(
  88L, 55L, 37L,
  34L, 35L, 21L, 9L, -7L, 38L, 25L, 12L
), PL6 = c(
  NA, NA, NA, NA,
  29L, 19L, 9L, -4L, 31L, 19L, 8L
)), row.names = c(NA, 11L), class = "data.frame")

# aref <- read.csv("//srv/shiny-server/cscShinyApps/DASAareaPlot/statewide.csv")

df <- reshape2::melt(
  data = aref,
  id.vars = c("Percentile"),
  measure.vars = c("PL1", "PL15", "PL2", "PL25", "PL3", "PL35", "PL4", "PL45", "PL5", "PL55", "PL6")
)

ggplot(df, aes(variable, value, group = Percentile)) +
  geom_area(alpha = .4) # this will not be shown

df$num <- str_extract(df$variable, "[[:digit:]]+") %>% as.integer()

df$pl_axis <- ifelse(df$num > 10, df$num / 10, df$num)

df$Percentile <- factor(df$Percentile, levels = c("20th", "40th", "60th", "80th"), ordered = T)

# ui
ui <- fluidPage(
  titlePanel("Visualize Your Data"), # title
  sidebarLayout(
    sidebarPanel(
      column = 3, position = "left",
      fileInput("file1", "STEP 1: Choose CSV File", # Input: Select a file ----
        multiple = FALSE,
        accept = c("text/csv", "text/comma-separated-values,text/plain", ".csv")
      ),
      checkboxInput("header", "Header", TRUE), # Input: Checkbox if file has header

      # Input: Select separator
      radioButtons("sep", "Separator",
        choices = c(
          Semicolon = ";",
          Comma = ",", Tab = "\t"
        ),
        selected = ","
      ),
      tags$hr(), # add a Horizontal line

      # Input: Select what to display
      selectInput("dataset", "STEP 2: Choose 'Uploaded File' Here:", choices = c("iris", "upload")),
      selectInput("x_axis", "STEP 3: Choose X-axis variable (initial proficiency):", choices = NULL),
      selectInput("y_axis", "STEP 4: Choose Y-axis variable (scale score change):", choices = NULL),
      selectInput("point_label", "STEP 5: Label for points:", choices = NULL),
      selectInput("domain", "STEP 6: Choose ACCESS Domain:", choices = c("Math_bogus", "Reading", "Writing_bogus")),
      width = 4
    ), # end sidebarPanel ;


    fluidRow(column(
      6, # column width
      h3(textOutput("caption")),
      # h3(htmlOutput("caption")),
      plotlyOutput("finalplot") # quoted object is named in server code
    )) # end fluidRow
  ) # end sideBarLayout
)

# server shiny server side code for each call
server <- function(input, output, session) {

  output$caption <- renderText({
    "Plot caption"
  })

  # set uploaded file
  upload_data <- reactive({
    upload # currently hard coded
  }) # end

  # update variable and group based on dataset
  observe({
    print(paste("update ui for", input$dataset))
    var.opts <- names(get(input$dataset)) %>% print
    updateSelectInput(session, "x_axis", choices = var.opts)
    updateSelectInput(session, "y_axis", choices = var.opts)
    updateSelectInput(session, "point_label", choices = var.opts)
  }) # end observe

  get_data <- reactive({
    req(input$dataset, input$x_axis, input$y_axis, input$point_label)
    print(paste("update data for", input$dataset, input$x_axis, input$y_axis, input$point_label))
    list(
      data = get(input$dataset), # get the dataset and then choose the inputs
      x_axis = input$x_axis,
      y_axis = input$y_axis,
      point_label = input$point_label
    )
  })

  #  second reactive dataset for area plot layer; this doesn't seem to work
  area_data <- reactive({
    print(paste("subsetting area_data by", input$domain))
    print("Warning -- df$Domain does not exist so ignoring")
    df
  }) # end of area_data (data for the area plot)

  # plotting function using ggplot2
  output$finalplot <- renderPlotly({
    req(get_data(), area_data())
    print(paste("render plot", get_data()$x_axis, get_data()$y_axis, get_data()$point_label))
    p <- ggplot() +
      geom_point(data = get_data()$data,
                 mapping = aes_string(x = get_data()$x_axis,
                                      y = get_data()$y_axis,
                                      colour = get_data()$point_label)) +
      xlim(1, 6)

    p <- p +
      ggplot2::theme_minimal() +
      geom_area(
        data = area_data(),
        mapping = aes(x = pl_axis, y = value, group = Percentile, fill = Percentile),
        alpha = 0.4
      )

    print("plot done")
    ggplotly(p)

  }) # end renderPlot

}

shinyApp(ui, server)

@woodward Thanks very much...wasn't sure on how to format code here. I've improved the format and added a graphic to clarify my objective.

  1. print("Warning -- df$Domain does not exist so ignoring")

  2. obviously you need to upload the file into the variable upload