Plot with different reactive datasets

shiny
1

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:

image
image1293×878 111 KB

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")  })
  
})
2

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.

3

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)
4

@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.

5

@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...

6

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

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

7

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