server.R

Question

我有一个运行here的闪亮应用。它在小册子交互式地图上绘制了大约1.2万套公寓和房间，并根据用户输入的地址在地图上添加标记。这是code。对不起，如果没有详细记录。

有两个不同的数据框对象：一个用于公寓（df.apt），另一个用于房间（df.quartos）。

但是，由于应用加载了大量数据，因此速度有点慢。我想添加一个资源，只有在用户插入地址后才会绘制数据，并选择一个接近范围（比如，只显示距离输入地址10公里范围内的公寓）。我应该怎么做呢？

library(leaflet)
library(shiny)
library(ggmap)


source("post4-prepararshiny.R") #loads data and helper functions


 ui = bootstrapPage(
   div(class = "outer",
       tags$head(
         # Include our custom CSS
         includeCSS("styles.css"),
         includeScript("gomap.js")
       ),

   tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
   leafletOutput("mymap", width = "100%", height = "100%"),

   absolutePanel(id = "controls",# class = "panel panel-default",
                 fixed = TRUE,
                 draggable = TRUE,
                 top = 60, left = "auto", right = 20, bottom = "auto",
                 width = 330, height = "auto",

                 h2("Buscador OLX"),
                 textInput(inputId = "userlocation",
                           label = "Digite um endereço\n com pelo menos rua, número, bairro e cidade",
                           value = ""),
                 helpText("Exemplo: Rua Dias da Rocha, 85 - Copacabana, Rio de Janeiro - RJ"),

                 sliderInput(inputId = "distancia", label = "Escolha a distância em km:",
                             min = 0, max = 30, value = 15),

                 actionButton("go", "Buscar"),
                 helpText("Encontre imóveis para alugar perto de onde você quiser!"),

                 helpText("Cada ponto no mapa representa um imóvel para alugar.",
                          "A cor de um ponto é determinada pelo valor do aluguel.",
                          "Clique em um ponto para ter mais informações sobre o imóvel."),

                 helpText("Mais informações sobre este app em sillasgonzaga.github.io")

                 )

   ),
   tags$div(id="cite",
            'Dados extraídos do OLX em 12/11/2016.', ' Contato: sillasgonzaga.github.io'
   )
)

server.R

server = function(input, output, session){

  #browser()
  output$mymap <- renderLeaflet({
    map <- leaflet() %>%
    addTiles() %>%
    addProviderTiles("OpenStreetMap.BlackAndWhite") %>%
    # coordenadas de um ponto em específico
    addMarkers(lat = -22.911872, lng = -43.230184,
               popup = "Estádio do Maracanã! <br> Apenas um exemplo!") %>%


    # plotar apartamentos
    addCircleMarkers(data = df.apt,
                     lng = ~lon, lat = ~lat,
                     color = ~vetorCoresApt(preco),
                     opacity = 1.5,
                     popup = textoPopup(df.apt, "apartamento"),
                     # Definir nome do grupo para ser usado na camada
                     group = "Apartamentos") %>%
    # plotar quartos
    addCircleMarkers(data = df.quartos,
                     lng = ~lon, lat = ~lat,
                     color = ~vetorCoresQuarto(preco),
                     opacity = 1.5,
                     popup = textoPopup(df.quartos, "quarto"),
                     group = "Quartos") %>%
    addLayersControl(
      overlayGroups = c("Apartamentos", "Quartos"),
      options = layersControlOptions(collapsed = FALSE),
      position = "bottomright"
    ) %>%
    addLegend(pal = vetorCoresApt, values = df.apt$preco,
              position = "bottomright")
    map
  })


   observeEvent(input$go, {
     v <- geocode(input$userlocation)
     leafletProxy('mymap', session) %>% addMarkers(lng = v$lon,lat = v$lat)
   })


}

我知道我可以使用函数geosphere::distm()来计算数据矩阵和数据点之间的距离，如：

coord <- matrix(data = c(df.apt$lon, df.apt$lat), ncol = 2)
distance_vector <- distm(x = coord, y = c(lon = -43.183447, lat = -22.913912), fun = distVincentySphere)
# insert vector into data frame
df.apt$distance <- distance_vector

但是，如何以反应方式执行此操作，以便每次用户单击按钮并更改将用于指示范围的distance时，我都可以更改sliderInput()列接近？

P.S。：对于葡萄牙语的代码和评论感到抱歉。

编辑：已解决

@HubertL回复后，我能够找到解决方案。这是我在server.R所做的：

  distance_apt_reactive <- eventReactive(input$go, { 
    address_latlon <- geocode(input$userlocation)
    dist <- distm(x = matrix(data = c(df.apt$lon, df.apt$lat), ncol = 2), 
                  y = c(lon = address_latlon$lon, lat = address_latlon$lat), 
                  fun = distVincentySphere)
    dist <- dist/1000

  })

  apt_reactive <- reactive({df.apt[distance_reactive() < input$distancia,]})

  output$mymap <- renderLeaflet({
    map <- leaflet() %>%
      addTiles() %>%
      addProviderTiles("OpenStreetMap.BlackAndWhite") %>%
      setView(lng = mean(df.apt$lon), lat = mean(df.apt$lat), zoom = 11) %>%
      addLegend(pal = vetorCoresApt, values = df.apt$preco,
                position = "bottomright",
                layerId = "legend")

  map  
  })

     observe({
       leafletProxy("mymap") %>%
         clearMarkers() %>%
         #addMarkers(lng = myadress()$lon, lat = myadress()$lat) %>%
         addCircleMarkers(data = apt_reactive(),
                          lng = ~lon, lat = ~lat,
                          color = ~vetorCoresQuarto(preco),
                          opacity = 1.5,
                          # adicionar popup
                          popup = textoPopup(apt_reactive(), "apartamento"),
                          group = "Apartamentos")
    })

Answer 1

您可以根据与地址的距离添加reactive来过滤data.frame：

apt_reactive <- reactive({ 
    address_latlon <- geocode(input$userlocation)
    dist <- distm(x = matrix(data = c(df.apt$lon, df.apt$lat), ncol = 2), 
                  y = c(lon = address_latlon$lon, lat = address_latlon$lat), 
                  fun = distVincentySphere)
    apt.df[dist < input$distancia,]
})

然后替换

addCircleMarkers(data = df.apt

通过

addCircleMarkers(data = apt_reactive()

（并对quartos_reactive）

重复df.quartos的相同流程

闪亮：如何根据用户输入数据的位置过滤数据

server.R

编辑：已解决

1 个答案: