可视化:Airbnb纽约房源数据交互式地图

地图链接(缓存需约20秒):https://lisiyi.shinyapps.io/airbnb_newyork/

#Global
library(dplyr)

airbnb <- read.csv("data/AB_NYC_2019.csv")
row.names(airbnb) <- airbnb$id
airbnb$reviews_per_month <- ifelse(is.na(airbnb$reviews_per_month), 0, airbnb$reviews_per_month)

cleantable <- airbnb %>% filter(
  price <= 500 & number_of_reviews <= 200 & reviews_per_month <= 5 
) %>% select(
    id = id,
    Neighbourhood = neighbourhood,
    Neighbourhood_Group = neighbourhood_group,
    Price = price,
    Number_of_reviews = number_of_reviews,
    Minumun_Nights = minimum_nights,
    Review_Per_Month = reviews_per_month,
    Availability = availability_365,
    Host_Listings_Count = calculated_host_listings_count,
    lat = latitude,
    lng = longitude
  )
row.names(cleantable) <- cleantable$id
#Server
library(leaflet)
library(RColorBrewer)
library(scales)
library(lattice)
library(dplyr)

# Leaflet bindings are a bit slow; for now we'll just sample to compensate
#set.seed(100)
# By ordering by centile, we ensure that the (comparatively rare) SuperZIPs
# will be drawn last and thus be easier to see

function(input, output, session) {
  
  ## Interactive Map ###########################################
  
  # Create the map
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles(
        urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
        attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>',
      ) %>%
      setView(lng = -73.95, lat = 40.73, zoom = 12)
  })
  
  # A reactive expression that returns the set of zips that are
  # in bounds right now
  zipsInBounds <- reactive({
    if (is.null(input$map_bounds))
      return(cleantable[FALSE,])
    bounds <- input$map_bounds
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)
    
    subset(cleantable,
           lat >= latRng[1] & lat <= latRng[2] &
             lng >= lngRng[1] & lng <= lngRng[2])
  })
  
 

  # This observer is responsible for maintaining the circles and legend,
  # according to the variables the user has chosen to map to color and size.
  observe({
    colorBy <- input$color
    sizeBy <- input$size
    
    
    leafletProxy("map", data = cleantable) %>%
      clearShapes() %>%
      addCircles(~lng, ~lat, radius = radius, layerId=~Neighbourhood,weight = 5,
                 stroke=FALSE, fillOpacity=0.4, fillColor=pal(colorData)) %>%
      addLegend("bottomleft", pal=pal, values=colorData, title=colorBy,
                layerId="colorLegend")
  })
  
  # Show a popup at the given location
  showZipcodePopup <- function(id, lat, lng) {
    selectedZip <- cleantable[cleantable$lat == lat & cleantable$lng == lng,]
    content <- as.character(tagList(
      tags$h4("Price:", dollar(selectedZip$Price)),
      tags$strong(HTML(sprintf("%s, %s",
                               selectedZip$Neighbourhood, selectedZip$Neighbourhood_Group
      ))), tags$br(),
      sprintf("Minumun Nights: %s", selectedZip$Minumun_Nights),tags$br(),
      sprintf("Number of Reviews: %s", selectedZip$Number_of_reviews),tags$br(),
      sprintf("Review per Month: %s", selectedZip$Review_Per_Month),tags$br(),
      sprintf("Number of Days Available for Booking: %s", selectedZip$Availability),tags$br()
    ))
    leafletProxy("map") %>% addPopups(lng, lat, content, layerId = id)
  }
  
  
#  When map is clicked, show a popup with city info
  observe({
    leafletProxy("map") %>% clearPopups()
    event <- input$map_shape_click
    if (is.null(event))
      return()
    
    isolate({
      showZipcodePopup(event$id, event$lat, event$lng)
    })
  })
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
平台声明:文章内容(如有图片或视频亦包括在内)由作者上传并发布,文章内容仅代表作者本人观点,简书系信息发布平台,仅提供信息存储服务。