将 reactiveValues 数据框传递给反应式表达式

Question

我有一个简单的闪亮应用程序，其中我将数据帧存储在reactiveValues() 中，然后过滤date 以将其传递给reactive() 表达式。但我没有得到任何结果。请注意，此reactiveValues() 数据帧稍后将在多个其他反应表达式中进行子集化，并且这些表达式将被组合以获得最终结果，因此它只需要在反应值中通过date 进行过滤。这个answer 是我使用它的原因

    #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

你犯了两个错误：

1. 您没有将actors 表中的date 列转换为日期格式。只是character
2. 以下代码未将s 分配给sampler，我创建了另一个反应值n 以使用n(s) 存储此结果

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

为您修复了服务器代码：

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)

Answer 2

这是您可能需要的简化版本。确保整个代码中的日期格式正确。 -

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()
  })
})