how to Pass reactive() data frame into reactiveValues()

shiny
1

... I am fairly new with rshiny apps and I am trying to build an app which works fine but when I try to add a plot with brush and delete points functionality I run into errors.

Essentially, I am reading a csv file into a reactive function df_products_upload() that I use in some other functions (for plotting and to populate columns for user inputs) but when I call this function inside reacticeValues() to pass the data frame it fails me. I am trying to add brush and delete functionality to a plot (Plot1). I cant re-read the csv file just to input into this reactiveValues so it would work. The whole idea of reactive function dies if I have to keep reading csv file for every other function used in the app redundantly.

vals <- reactiveValues(

          df1 <- df_products_upload(),
           data=df1
        )

############## plotting -1

    output$plot1 <- renderPlot({

           ggplot(vals$data, aes_string(x = input$column1, y = input$column2)) + geom_point()

    })

     observe({

         df = brushedPoints(vals$data, brush = input$plot1_brush, allRows = TRUE) 
         vals$data = df[df$selected_== FALSE,  ] ## Taking only those data points where the selected_ value is FALSE (alternatively ignoring rows with selected_ = TRUE status)
   })

Can someone please suggest how do I go about it? what is the right logic to use reactive and reactiveValues inside each other if its possible at all. if not possible how do I get this plot to work with rest of the code. Clearly shiny doesn't like calling a reactive function inside reactiveValues(). I am having this trouble with the Plot1 , code is at the bottom. you can use any csv to test the code, it will only complain about plot -3 where I have hard coded the column names, just change those while testing.

here is complete code:

library(DT)
  library(shinydashboard)
  library(ggplot2)
  library(shinyFiles)

    ui <- fluidPage(

        # File upload button
        shinyFilesButton(id = 'file', label= 'Choose file to upload',
                         title = 'Select file', multiple = FALSE),

        #Shows data table on the main page
        fluidRow(
          column(12, DT::dataTableOutput('tabl'))
          #  dataTableOutput("tabl")
        ),

        # h5('Select two Columns to Plot'),
        uiOutput("Col1"),
        uiOutput("Col2"),

    #-----------------------------------------------------------

        #Shows Plot button
        fluidRow(
          column(6, plotOutput('plot2', height = 500)),
          column(6, plotOutput('plot3', height = 500))
        ),


        fluidRow(
          column(7, class = "row",
                 h4("Brush and click to exclude Point"),
                 plotOutput("plot1", height = 500,
                           # click = "plot1_click",
                            brush = brushOpts(
                              id = "plot1_brush"
                              # resetOnNew = TRUE
                            )
                 )
            )
          )
      )

  #------------------------------------------------------------------------


  server <- function(input, output, session) {


      ###Read cvs file and convert julian Date to regular Date format
      shinyFileChoose(input, 'file', roots= c(wd="/Users/mnoon/Desktop/projects/2018/rShinyApp_imageData"), filetypes= c('', 'csv'))

      df_products_upload <- reactive({
        inFile <- parseFilePaths(roots=c(wd='/Users/mnoon/Desktop/projects/2018/rShinyApp_imageData/'), input$file)
        if (NROW(inFile)){
          # return(NULL)
          df <- read.csv(as.character(inFile$datapath), header = TRUE, sep = ",", stringsAsFactors = F)
          # Convert Julian to Calendar date
          df$Julian.Date <- as.Date((as.numeric(df$Julian.Date) - 2400000.5), origin=as.Date("1858-11-17"))
          #Change Column name to 'Date'
          names(df)[names(df) == 'Julian.Date'] <- 'Date'
          df <- as.data.frame(df)
          return(df)
        }
      })



      ###Previews data table on the main display window
      output$tabl<- DT::renderDataTable({
        df <- df_products_upload()
        DT::datatable(df)
      }, server = FALSE)


      ###The following set of functions populate the column selectors
      output$Col1 <- renderUI({
        df <-df_products_upload()
        if (is.null(df)) return(NULL)

        cols=names(df)
        names(cols)=cols
        selectInput("column1", "Select Column for X-axis", cols)

      })

      output$Col2 <- renderUI({
        df <-df_products_upload()
        if (is.null(df)) return(NULL)

        cols=names(df)
        names(cols)=cols
        selectInput("column2", "Select Column for Y-axis", cols)

      })

      # -------------------------------------------------------------------

     ###plot2
      #   # # A scatterplot with certain points highlighted
      #   #
        output$plot2 = renderPlot({

          df2 <- df_products_upload()
          df <- df2[,c(input$column1, input$column2)]

          s1 = input$tabl_rows_current  # rows on the current page
          s2 = input$tabl_rows_all      # rows on all pages (after being filtered)

          req(input$column1)

          ##get xlim values for plot
          xdiff <- (as.numeric(max(df[,1])) - as.numeric(min(df[,1])))
          xd1 <- (as.numeric(max(df[,1]))) + 0.7*(xdiff)
          xd2 <- (as.numeric(min(df[,1]))) - 0.7*(xdiff)


          ##get ylim values for plot
          ydiff <- (ceiling(as.numeric(max(df[,2]))) - floor(as.numeric(min(df[,2]))))
          yd1 <- (ceiling(as.numeric(max(df[,2])))) + 0.7*(ydiff)
          yd2 <- (floor(as.numeric(min(df[,2])))) - 0.7*(ydiff)


          ######################## ---   Plotting -2

          par(mar = c(4, 4, 1, .1))

          plot(df, pch = 21, xlim = c(xd2,xd1), ylim = c(yd2,yd1), xlab = input$column1, ylab = input$column2)
          grid()

          # solid dots (pch = 19) for current page
          if (length(s1)) {
            points(df[s1, , drop = FALSE], pch = 19, cex = 1.5)
          }

          # show red circles when performing searching
          if (length(s2) > 0 && length(s2) < nrow(df)) {
            points(df[s2, , drop = FALSE], pch = 21, cex = 2, col = 'red')
          }

          # dynamically change the legend text
          s = input$tabl_search
          txt = if (is.null(s) || s == '') 'Filtered data' else {
            sprintf('Data matching "%s"', s)
          }

          legend(
            'topright', c('Original data', 'Data on current page', txt),
            pch = c(21, 19, 21), pt.cex = c(1, 1.5, 2), col = c(1, 1, 2),
            y.intersp = 2, bty = 'n'
          )

        })

      # -------------------------------------------------------------------

      ###plot3 
         ########[Always plot these two columns - 'Right.Ascension..deg.', 'Declination..deg.']

        output$plot3 = renderPlot({

          df2 <- df_products_upload()

          ## Columns hard-coded (always plot these)
          df3 = df2[, c('Right.Ascension..deg.', 'Declination..deg.' )]


          s1 = input$tabl_rows_current  # rows on the current page
          s2 = input$tabl_rows_all      # rows on all pages (after being filtered)


          ##get xlim values for plot
          xdiff <- (as.numeric(max(df3[,"Right.Ascension..deg."])) - as.numeric(min(df3[,"Right.Ascension..deg."])))
          xd1 <- (as.numeric(max(df3[,"Right.Ascension..deg."]))) + 0.2*(xdiff)
          xd2 <- (as.numeric(min(df3[,"Right.Ascension..deg."]))) - 0.2*(xdiff)


          ##get ylim values for plot
          yd1 <- (as.numeric(max(df3[,"Declination..deg."]))) - 0.1
          yd2 <- (ceiling((as.numeric(min(df3[,"Declination..deg."])))))

          ########################## --- Plotting -3

          par(mar = c(4, 4, 1, .1))

          plot(df3, pch = 21, xlim = c(xd2,xd1), ylim = c(yd2,yd1), xlab = names(df3[1]), ylab = names(df3[2]))
          # axis(1, )
          grid()

          # solid dots (pch = 19) for current page
          if (length(s1)) {
            points(df3[s1, , drop = FALSE], pch = 19, cex = 1.5)
          }

          # show red circles when performing searching
          if (length(s2) > 0 && length(s2) < nrow(df3)) {
            points(df3[s2, , drop = FALSE], pch = 21, cex = 2, col = 'red')
          }

          # dynamically change the legend text
          s = input$tabl_search
          txt = if (is.null(s) || s == '') 'Filtered data' else {
            sprintf('Data matching "%s"', s)
          }

          legend(
            'topright', c('Original data', 'Data on current page', txt),
            pch = c(21, 19, 21), pt.cex = c(1, 1.5, 2), col = c(1, 1, 2),
            y.intersp = 2, bty = 'n'
          )

        })

        # -------------------------------------------------------------------

   ###plot1
            # brush and delete with ggplot

      vals <- reactiveValues(
        df1 <- df_products_upload(),
        data=df1
        )

      ############## plotting -1

      output$plot1 <- renderPlot({

        ggplot(vals$data, aes_string(x = input$column1, y = input$column2)) + geom_point()

      })

      observe({
        df = brushedPoints(vals$data, brush = input$plot1_brush, allRows = TRUE) 
        vals$data = df[df$selected_== FALSE,  ] ## Taking only those data points where the selected_ value is FALSE (alternatively ignoring rows with selected_ = TRUE status)
      })

  }

  #------------------------------------------------------------

  shinyApp(ui, server)
2

No one there who knows how to fix it?? Any one from Shiny developers???

3

Try something like?;
vals <- reactiveValues(
df1=data.frame()
)
vals$df1<-as.data.frame(df_products_upload)

4

I tried this logic but i get this error:
Warning: Error in $<-.data.frame: replacement has 1 row, data has 0
[No stack trace available]

CODE::

vals <- reactiveValues(
dat=data.frame()
)

############## plotting -1

output$plot1 <- renderPlot({

vals$dat <- as.data.frame(df_products_upload())
ggplot(vals$dat, aes_string(x = input$column1, y = input$column2)) + geom_point()

})

observe({
df = brushedPoints(vals$dat, brush = input$plot1_brush, allRows = TRUE)
vals$dat = df[df$selected_== FALSE, ] ## Taking only those data points where the selected_ value is FALSE (alternatively ignoring rows with selected_ = TRUE status)
})

5

Separate it out into two steps.

  1. Make reactive data. Make reactive values.
  2. Set reactive value key when reactive data updates.
# init the values
df1 <- df_products_upload()
vals <- reactiveValues(
  df1 = NULL,
  data = NULL
)

# set vals$df1 whenever df1 updates
observe({
  vals$df1 <- df1()
})
2 Likes
6

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

If you have a query related to it or one of the replies, start a new topic and refer back with a link.