Я не могу получить ползунки, чтобы изменить карту в блестящем - PullRequest
0 голосов
/ 01 мая 2020

Я не могу заставить карту реагировать с ползунками. Данные были от https://www.kaggle.com/nasa/meteorite-landings/data#, когда я перемещаю ползунки, карта «обновляется», как будто она сбрасывается, как будто что-то должно было измениться, но все точки данных отображаются на графике. любая помощь будет оценена.

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

Meteor <- read.csv()
#to take all NA values out
ReMeteor <- na.omit(Meteor) #from now on using ReMeteor instead of Meteor

ui <- shinyUI(fluidPage(

       titlePanel("Meteorite Landings"),

    # Sidebar with a sliders and checkbox
    sidebarLayout( position = "right",
        sidebarPanel(
                        #1st slider year range
                     sliderInput("years","The year the meteorite fell, or the year it was found ",
                                 min = min(ReMeteor$year),
                                 max = max(ReMeteor$year),
                                 step = 1,value = c(1399,2013),
                                 animate = TRUE),
                        #2nd slider mass range
                     sliderInput("masss","The mass of the meteorite, in grams", 
                                 min = min(ReMeteor$mass),
                                 max = max(ReMeteor$mass),
                                 step = 100,value = c(.010,60000000), 
                                 animate = TRUE),

                        #checkbox

                     selectInput("fall", 
                                        "Was meteorite seen falling or found?", 
                                        choices = sort(unique(ReMeteor$fall))),
                                         ),     


        mainPanel( leafletOutput("my_leaf",height = 650, width = 605),textOutput("text1"),textOutput("text2")


        ))))




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

     #i think this block of four was letting it refresh, although no changes

      filtered <- reactive({ 

          ReMeteor[ReMeteor$year >= input$years[1] & ReMeteor$year <= input$years[2],]
        ReMeteor[ReMeteor$mass >= input$masss[1] & ReMeteor$mass <= input$masss[2],]
     })
       #need last checkbox


       # filter(ReMeteor >= input$year[1] &
       #                  ReMeteor <= input$year[2]) %>%
       #       filter(ReMeteor >= input$mass[1] &
       #                  ReMeteor <= input$mass[2])%>%
       #   filter(ReMeteor = sort(unique(ReMeteor$fall)))


     # fitBounds()#here it is !!! https://rstudio.github.io/leaflet/shiny.html search : fitbounds --- this too https://rstudio.github.io/leaflet/markers.html




     output$my_leaf <- renderLeaflet({
         leaflet(data = filtered()) %>%
             addMiniMap(zoomLevelOffset = -4) %>%
             addProviderTiles("Esri.NatGeoWorldMap") 
         })
             #fitBounds(ReMeteor, ReMeteor$reclong,ReMeteor$reclat,ReMeteor$reclong,ReMeteor$reclat)


     observe({
         # year_ <-input$year
         # mass_ <-input$mass
         # fall_ <-input$fall
         # 
         leafletProxy("my_leaf", data = filtered()) %>% 
           clearShapes() %>%
           clearMarkers() %>% 
           clearPopups() %>%
                        addMarkers(lat = ReMeteor$reclat, 
                        lng = ReMeteor$reclong,
                        clusterOptions = markerClusterOptions(),
                        popup = as.character(ReMeteor$name,ReMeteor$recclass))

     })

 output$text1 <- renderText({
     paste("You have chosen a range from the year", input$years[1], "to", input$years[2])
 })

 output$text2 <- renderText({
     paste("You have chosen a range of mass from", input$masss[1], "to", input$masss[2], "grams")
 })

})

 shinyApp(ui, server)

1 Ответ

0 голосов
/ 01 мая 2020

Проблема здесь в том, что, хотя вы правильно использовали реактивное значение filtered() в вашем leafletProxy вызове, вы используете нереактивную версию ReMeteor в вашем addMarkers вызове.

     observe({

         leafletProxy("my_leaf", data = filtered()) %>% 
           clearShapes() %>%
           clearMarkers() %>% 
           clearPopups() %>%
                        addMarkers(lat = filtered()$reclat, 
                        lng = filtered()$reclong,
                        clusterOptions = markerClusterOptions(),
                        popup = as.character(filtered()$name,filtered()$recclass))
     })

enter image description here

...