地图链接(缓存需约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)
})
})