R‎ > ‎Gráficas‎ > ‎

Mapa de calor con Señales de Tránsito en Toronto usando RGoogleMaps

publicado a la‎(s)‎ 14 abr. 2014 14:25 por Daniel Loera

Se que el objetivo de esta web es dar ejemplos de datos mexicanos o latinoamericanos, pero que le vamos hacer si los mejores ejemplos están en el extranjero, pero esperemos tomar sus ejemplos para aplicarlos en nuestros países. Y aquí está uno.



Poco tiempo atrás había un artículo en blogTO sobre cómo un usuario de reddit había utilizado los datos de la iniciativa Open Data de Toronto (o aquí) para producir un mapa de todas las ubicaciones de todas las señales de tráfico, en la ciudad.

Es ordenado, como el autor de las notas blogTO, es reconocible como Toronto sin otros datos geográficos se representan gráficamente - la estructura de la ciudad sale en los datos por sí solos.

Sin embargo, pensé que sería interesante ver como un mapa de calor geográfica, y también una buena excusa para pasar el tiempo con el mapeo usando Rgooglemaps.

El producto acabado se muestra a continuación:


La imagen sin el Google maps, y las coordenadas rotado , muestra la densidad un poco mejor en las áreas de color amarillo- verde:


El código R esta abajo. En la interpolación se utiliza la función kde2d de la biblioteca MASS y una rotación se aplica para la última figura, de manera que la red de las calles de Toronto se encuentran con el mapa original.

Para mas fácil, aquí dejo los datos.

# Toronto Traffic Signals Heat Map
# Myles Harrison
# http://www.everydayanalytics.ca
# Data from Toronto Open Data Portal:
# http://www.toronto.ca/open

library(MASS)
library(RgoogleMaps)
library(RColorBrewer)

# addalpha()
addalpha <- function(colors, alpha=1.0) {
  r <- col2rgb(colors, alpha=T)
  # Apply alpha
  r[4,] <- alpha*255
  r <- r/255.0
  return(rgb(r[1,], r[2,], r[3,], r[4,]))
}

# colorRampPaletteAlpha()
colorRampPaletteAlpha <- function(colors, n=32, interpolate='linear') {
  # Create the color ramp normally
  cr <- colorRampPalette(colors, interpolate=interpolate)(n)
  # Find the alpha channel
  a <- col2rgb(colors, alpha=T)[4,]
  # Interpolate
  if (interpolate=='linear') {
    l <- approx(a, n=n)
  } else {
    l <- spline(a, n=n)
  }
  l$y[l$y > 255] <- 255 # Clamp if spline is > 255
  cr <- addalpha(cr, l$y/255.0)
  return(cr)
}


# Leer los datos
data <- read.csv(file="traffic_signalsall.csv", skip=1, header=T, stringsAsFactors=F)
# Mantener los datos lon y lat
rawdata <- data.frame(as.numeric(data$Longitude), as.numeric(data$Latitude))
names(rawdata) <- c("lon", "lat")
data <- as.matrix(rawdata)

# Gire las coordenadas lat - lon utilizando una matriz de rotación
# Ensayo y error conduce a pi/15.0 = 12 grados
theta = pi/15.0
m = matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), nrow=2)
data <- as.matrix(data) %*% m

# mapa original reproducido por William's
par(bg='black')
plot(data, cex=0.1, col="white", pch=16)

# Crear mapa de calor con kde2d y overplot
k <- kde2d(data[,1], data[,2], n=500)
# Intensidad de verde a rojo
cols <- rev(colorRampPalette(brewer.pal(8, 'RdYlGn'))(100))
par(bg='white')
image(k, col=cols, xaxt='n', yaxt='n')
points(data, cex=0.1, pch=16)

# Asignación a través de RgoogleMaps
# Encontrar centro del mapa y obtener un mapa
center <- rev(sapply(rawdata, mean))
map <- GetMap(center=center, zoom=11)
# Convertir los datos originales
coords <- LatLon2XY.centered(map, rawdata$lat, rawdata$lon, 11)
coords <- data.frame(coords)

# Rerun heatmap
k2 <- kde2d(coords$newX, coords$newY, n=500)

# Crear vector de transparencia exponencial y añadir
alpha <- seq.int(0.5, 0.95, length.out=100)
alpha <- exp(alpha^6-1)
cols2 <- addalpha(cols, alpha)

# Gráfico
PlotOnStaticMap(map)
image(k2, col=cols2, add=T)
points(coords$newX, coords$newY, pch=16, cex=0.3)


ċ
TorontoMap.R
(2k)
Daniel Loera,
14 abr. 2014 14:25
Comments