如何在所有输入都经过重新验证之后使用去抖动仅重绘图形

时间:2019-03-29 23:46:27

标签: r shiny shiny-reactivity

我正在努力消除抖动。我试图将其插入到下面的代码中看到的反应函数链中,但无济于事。我试图弄清楚如何仅在无效序列停止更新后使图刷新。

我在哪里以及如何使用去抖?

server: 

    library(shiny)
    library(dplyr)
    library(ggplot2)

    shinyServer(function(input, output, session, clientData) {


      Accident.Date <- as.Date(c("2018-06-04", "2018-06-05", "2018-06-06", "2018-06-07", "2018-06-08", "2018-06-09", "2018-06-10", "2018-06-11", "2018-06-12", "2018-06-13", "2018-06-14", "2018-06-15", "2018-06-16", "2018-06-17", "2018-06-18", "2018-07-18"))
      Time.of.Kill <- as.character(c("DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DAY", "DAY", "DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DARK", "DUSK", "DARK", "DAY"))
      Sex <- as.character(c("MALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "MALE", "MALE", "FEMALE", "FEMALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "FEMALE"))
      Age <- as.character(c("ADULT", "YOUNG", "UNKNOWN", "ADULT", "UNKNOWN", "ADULT", "YOUNG", "YOUNG", "ADULT", "ADULT", "ADULT", "YOUNG", "ADULT", "YOUNG", "YOUNG", "ADULT"))
      Species <- as.character(c("Deer", "Deer", "Deer", "Bear", "Deer", "Cougar", "Bear", "Beaver", "Deer", "Skunk", "Moose", "Deer", "Deer", "Elk", "Elk", "Elk"))
      Year <- as.numeric(c("0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0"))


      data <- data.frame(Accident.Date, Time.of.Kill, Sex, Age, Species, stringsAsFactors = FALSE)
      data <- data %>% mutate(Data.Set = "Current")

      #A set of reactive filters. Only data that has passed all filters is passed to the map, graph, datatable etc. **Order goes datacheck > yearcheck > speccheck > sexcheck > timecheck > agecheck > indaterange


      bindata <- reactive({
        filter(data, Data.Set %in% input$datacheck)
      })

      yrdata <- reactive({
        filter(bindata(), Year %in% input$yearcheck)
      })

      specdata <- reactive({
        subset(yrdata(), Species %in% input$speccheck)
      })

      sexdata <- reactive({
        filter(specdata(), Sex %in% input$sexcheck) 
      })

      timedata <- reactive({
        filter(sexdata(), Time.of.Kill %in% input$timecheck)
      })

      agedata <- reactive({
        filter(timedata(), Age %in% input$agecheck)
      })

      #Does the date range filter. Selects min and max from the two inputs of the observed indaterange filter.

      data1 <- reactive({ filter(agedata(),
                                 Accident.Date >= input$inDateRange[[1]], #### Tried to debounce both of the final input for filtering so they will calculate after a second or so, but wasn't successful.
                                 Accident.Date <= input$inDateRange[[2]])
      })

####Also tried to debounce the reactive dataframe but it appears thats not how debounce works either.

# data1 <- reactive({data1()}) %>% debounce(1000)

      #If statement for choosing between current and historical datasets. If current is selected, year is set to 0 and the selection box is hidden.

      observe({ if (input$datacheck == 'Current')
        updateSelectInput(session, "yearcheck", choices = c("0"), selected = c("0"))
        else
          updateSelectizeInput(session, "yearcheck", choices = sort(unique(bindata()$Year), decreasing = TRUE), server=TRUE)

      })

      observe({

        req((input$datacheck == 'Historical'))

        updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)

      })


      #Creates the observed Species

      observe({

        x  <- input$yearcheck
        if (is.null(x))
          x <- character(0)

        updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)

      })


      #Creates the observed Sex

      observe({

        x  <- input$speccheck
        if (is.null(x))
          x <- character(0)

        updateCheckboxGroupInput(session, inputId = "sexcheck",
                                 choices = unique(specdata()$Sex),
                                 selected = unique(specdata()$Sex),
                                 inline = TRUE)
      })


      #Creates the observed Time

      observe({

        x  <- input$sexcheck
        if (is.null(x))
          x <- character(0)

        updateCheckboxGroupInput(session, inputId = "timecheck",
                                 choices = unique(sexdata()$Time.of.Kill),
                                 selected = unique(sexdata()$Time.of.Kill),
                                 inline = TRUE)
      })

      #Creates the observed Age

      observe({

        x  <- input$timecheck
        if (is.null(x))
          x <- character(0)

        updateCheckboxGroupInput(session, inputId = "agecheck",
                                 choices = unique(timedata()$Age),
                                 selected = unique(timedata()$Age),
                                 inline = TRUE)
      })

      #Creates the observed dates and suppresses warnings from the min max

      observe({

        x  <- input$agecheck
        if (is.null(x))
          x <- character(0)

        #And update the date range values to match those of the dataset

        updateDateRangeInput(
          session = session,
          inputId = "inDateRange",
          start = suppressWarnings(min(agedata()$Accident.Date)),
          end = suppressWarnings(max(agedata()$Accident.Date))
        )
      })


      output$txt <-  renderText({nrow(data1())})


      output$bar <- renderPlot({ 

        P <- ggplot(data = data1(), aes(x = reorder(factor(Species),factor(Species),function(x)-length(x)), fill = factor(Species)))+
          geom_bar(stat="count", width=0.7) + guides(fill=FALSE, color=FALSE) + theme_minimal()
        cols <- c("Deer" = "#BAA7A2", "Bear" = "#F3923F", "Cougar" = "#FEE3C0", "Beaver" = "#FCCF31", "Skunk" = "#E6E7E8", "Moose" = "#8AC04B", "Elk" = "#D3CB8D", "Badger" = "#C1E3D8", "Bobcat" = "#EE5C30", "Buffalo" = "#7F2F8B", "Caribou" = "#C59FC8", "Coyote" = "#927E7A", "Eagle" = "#DCDDDE", "Fox" = "#32A7DC", "Gbear" = "#AD2147", "Horned" = "#F5C2D7", "Lynx" = "#91632D", "Marten" = "#808083", "Mule" = "#CBBDB9", "Muskrat" = "#A3C497", "Otter" = "#0C6F47", "Porcupine" = "#4C5FA7", "Possum" = "#A3B5DB", "Rabbit" = "#EA212E", "Raccoon" = "#BE953B", "Sheep" = "#008D82", "WhiteTailed_Deer" = "#E0D8D6", "Wolf" = "#8A5A7C")
        P + scale_fill_manual(values = cols) + labs(x = "Species") + labs(y = "Total Count") + 
          geom_text(stat='count', aes(label=..count..), vjust=-1) + theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
      }) 

    })

ui:

navbarPage("Test", id="nav",

           tabPanel("Map",

                        absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
                                      draggable = FALSE, top = 200, left = 5, right = "auto", bottom = "auto",
                                      width = "auto", height = "auto",


                                      radioButtons("datacheck", label = tags$div( HTML("<b>Dataset</b>")),
                                                   choices = c("Current" = "Current", "Historical" = "Historical"),
                                                   selected = c("Current"), inline = TRUE),



                                      conditionalPanel(condition = "input.datacheck != 'Current'",

                                                       #Only displays yearcheck for historical as there is no year column on current dataset. Current dataset has had all year values set to 0.             

                                                       selectizeInput("yearcheck", label = "Select Year (Only Available for Historical)", choices = NULL, options = list(placeholder = 'Select Year:', maxOptions = 40, maxItems = 40))),

                                      selectizeInput("speccheck", h3("Select Species:"), choices = NULL, options = list(placeholder = 'Select Species: (Max 12) ', maxOptions = 36, maxItems = 12)),


                                      conditionalPanel(condition = "input.speccheck >= '1'",
                                                       dateRangeInput("inDateRange", "Date range input:"),

                                                       checkboxGroupInput("sexcheck", label = tags$div( HTML("<b>Sex</b><br>"))),

                                                       checkboxGroupInput("agecheck", label = tags$div( HTML("<b>Age</b><br>"))),

                                                       checkboxGroupInput("timecheck", label = tags$div( HTML("<b>Time of Accident</b><br>"))),

                                                       plotOutput("bar")
                                      ),
                                      verbatimTextOutput("txt")


)))

1 个答案:

答案 0 :(得分:0)

这对我有用。我不得不更新一些软件包,它开始工作。

data1 <- reactive({data1()}) %>% debounce(1000)