Pass a reactiveValues dataframe to a reactive expression

Question

I have the simple shiny app below in which I store a dataframe in a reactiveValues() and after filter the date to pass it to a reactive() expression. But I get nothing as a result. Note that This reactiveValues() dataframe will be later subseted in more than one other reactive expressions and those expressions will be combined for the final result,therefore it just need to filtered only by date in the reactiveValues. This answer is why I use it

    #ui.r
        shinyUI(
      fluidPage(
        titlePanel("Organizational Analysis"),
        sidebarLayout(

          sidebarPanel(
            selectInput("gr", "Group by:",
                        choices = c("val","Gender")
            ),
            sliderInput("Date Range",
                        "Dates:",
                        min = as.Date("2018-04-21","%Y-%m-%d"),
                        max = as.Date("2018-10-27","%Y-%m-%d"),
                        value=as.Date("2018-10-27"),
                        timeFormat="%Y-%m-%d")

          ),

          mainPanel(
           visNetworkOutput("network")
          )
        )

      )
    )

    #server.r
    library(shiny)
    library(visNetwork)
    library(geomnet)
    library(igraph)
    library(dplyr)

    shinyServer(function(input, output) {


actors <- data.frame(name1=c("Alice", "Bob", "Cecil", "David",
                               "Esmeralda"),
                       name2=c("Ali", "Boby", "Cecilia", "Daviddff",
                               "Esmeraldagj"),
                       date=c("2018-10-27","2018-09-27","2018-10-17","2018-07-27","2018-04-21"),
                       val<-c(10,20,10,20,10))

  sampler<-reactiveValues(sampl=actors) 
  observe({
    s<-sampler$sampl %>% dplyr::filter( date>= input$DateRange[1] & date <= 
    input$DateRange[2])
    s
  })
      actors2<-reactive({
        actors<- actors %>% dplyr::filter( date>= input$Dates[1] & date<= input$Dates[2])
        actors

      })
      nodes2<-reactive({
        eids<-as.character(actors2()$name1)
        mids<-as.character(actors2()$name2)
        nodes<-data.frame(c(eids,mids))
        nodes<-unique(nodes)
        nodes$ID <- seq.int(nrow(nodes))
        colnames(nodes)<-c("label", "id")
        nodes<-nodes[,c(2,1)]
        colnames(actors2())[1]<-"id"
        nodes$id<-nodes$label
        nodes<-merge(x = actors2(), y = nodes, by = "id", all = TRUE)
        nodes$label<-nodes$id
        nodes [is.na(nodes)] <- "Unknown"
        nodes<-nodes[,c(1,5,4)]
        if(input$gr=="val"){
          nodes$color<-""

          for(i in 1:nrow(nodes)){
            if(nodes[i,3]==10){
              nodes[i,4]<-"green"
            }
            else if(nodes[i,3]==20){
              nodes[i,4]<-"orange"
            }
            else if(nodes[i,3]=="Unknown"){
              nodes[i,4]<-"red"
            }

          }
        }
        else if(input$gr=="Gender"){

        }
        nodes
      })


      #Edges
      edges2<-reactive({
        edges <- actors2()[,1:2]
        colnames(edges) <- c("from", "to") 
        edges
      })


      output$network<-renderVisNetwork(
        visNetwork(nodes2(), edges2(), width = "100%") %>%
          visIgraphLayout() %>%
          visNodes(
            shape = "dot",
            shadow = list(enabled = TRUE, size = 10)
          ) %>%
          visEdges(
            shadow = FALSE,
            color = list(color = "#0085AF", highlight = "#C62F4B")
          ) %>%
          visOptions(highlightNearest = list(enabled = T, degree = 1, hover = T),
                     nodesIdSelection = TRUE) %>% 
          visLayout(randomSeed = 11)


      )


    })

Answer 1

Here's a simplified version of what you probably need. Make sure the dates are in proper format throughout the code. -

shinyServer(function(input, output) {
  actors <- data.frame(name1=c("Alice", "Bob", "Cecil", "David",
                               "Esmeralda"),
                       name2=c("Ali", "Boby", "Cecilia", "Daviddff",
                               "Esmeraldagj"),
                       date=c("2018-10-27","2018-09-27","2018-10-17",
                              "2018-07-27","2018-04-21"),
                       val<-c(10,20,10,20,10))

  sampler <- reactive({
    temp <- actors %>% 
      dplyr::filter(date >= input$DateRange[1] & date <= input$DateRange[2])
    validate(need(nrow(temp) > 0), "No data for selected dates")
  })

  reactive2 <- reactive({
   # sampler() %>% more code
  })

  reactive3 <- reactive({
   # sampler() %>% more code
  })      

  output$tab <- DT::renderDataTable({
    sampler()
  })
})

Answer 2

You made two mistakes:

1. You didn't convert date column in actors table to date format. It was just character
2. The following codes doesn't assign s to sampler, I created another reactive value n to store this result using n(s)

 observe({
    s<-sampler$sampl %>% dplyr::filter( date>= input$DateRange[1] & date <= input$DateRange[2])
    s
  })

Fixed server code for you:

server <- function(input, output) {
  actors <- data.frame(name1=c("Alice", "Bob", "Cecil", "David",
                               "Esmeralda"),
                       name2=c("Ali", "Boby", "Cecilia", "Daviddff",
                               "Esmeraldagj"),
                       date=lubridate::ymd(c("2018-10-27","2018-09-27","2018-10-17","2018-07-27","2018-04-21")), # convert character to date
                       val<-c(10,20,10,20,10))

  sampler<-reactiveValues(sampl=actors) 
  n <- reactiveVal() # create this value to store s in observe() below
  observe({
    s<-sampler$sampl %>% dplyr::filter( date>= input$DateRange[1] & date <= input$DateRange[2])
    n(s)
  })

  #n<-reactive({
  #  s()
  #})

  output$tab<-DT::renderDataTable({
    n()
  })
}

shinyApp(ui = ui, server = server)