2016-11-24 51 views
1

我有一個閃亮的應用程序運行here。它在小冊子交互式地圖上繪製大約12,000套公寓和房間供出租,並根據用戶輸入的地址在地圖上添加一個標記。這裏是code。對不起,如果它沒有很好的文件。Shiny:如何根據用戶輸入數據的位置過濾數據

有兩個不同的數據框對象:一個是公寓(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") 
    }) 

回答

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_reactivedf.quartos相同的過程)

+0

你的解決方案是相當不錯的,但仍然存在問題。每當用戶改變距離範圍時,一個新的地圖將由'renderLeaflet()'渲染,這會降低應用的速度。有什麼辦法可以讓光滑?我想知道這與'leafletProxy()'有什麼關係。 – iatowks

+0

是的,但因爲渲染點數少得多,所以速度會非常快。但是你是對的,可能使用'leafletProxy'。我會看看這個(新對我來說)功能 – HubertL

+0

所以,我在這裏做了很多測試,看起來我想要的是根本不可能的。想象一下,你選擇3公里作爲距離範圍。它只會繪製該範圍內的數據。如果我使用滑塊將此範圍增加到10公里,它將繪製包含在此新範圍內的新數據。但問題是,如果將其滑回3公里,10公里範圍內的數據不會消失。相反,它會繪製已經繪製的數據。如果我不清楚,請告訴我。 – iatowks

相關問題