Interactive map of traffic accidents in the metropolitan region of São Paulo, clustered by region and type, during the year 2015.

Thanks to the project Código Urbano for making public access to this data.

Summary:

Appendix I - Source Code

Made with R and Leaflet, source code:

# load libraries
# install.packages("leaflet")
# install.packages("dplyr")
suppressPackageStartupMessages(library(leaflet))
suppressPackageStartupMessages(library(stringr))
suppressPackageStartupMessages(library(dplyr))

#load and clean
data2015 <- read.csv("./dados/2015/ocorrencias-transito-pmsp-2015.csv")
data2015$lng <- as.numeric(str_match(data2015$WKT, ".*\\((.*)\\s(.*)\\)")[,2])
data2015$lat <- as.numeric(str_match(data2015$WKT, ".*\\((.*)\\s(.*)\\)")[,3])
data2015 <- data2015[complete.cases(data2015[,c("lat","lng")]),]

# add legenda com o TIPO_ACIDE
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CO"] <- "Colisão"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CF"] <- "Colisão frontal"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CT"] <- "Colisão traseira"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CL"] <- "Colisão lateral"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CV"] <- "Colisão Transversa"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CP"] <- "Capotamento"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="TB"] <- "Tombamento"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="AT"] <- "Atropelamento"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="AA"] <- "Atropelamento animal"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="CH"] <- "Choque"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="QM"] <- "Queda moto/bicicleta"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="QV"] <- "Queda veículo"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="QD"] <- "Queda ocupante dentro"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="QF"] <- "Queda ocupante fora"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="OU"] <- "Outros"
data2015$TIPO_ACIDE_DESCR[data2015$TIPO_ACIDE=="SI"] <- "Sem informação"

# normaliza numero de vitimas
data2015$VITIMAS_NORM[data2015$VITIMAS < 100] <- data2015[data2015$VITIMAS < 100,17]
data2015$VITIMAS_NORM[data2015$VITIMAS >= 100] <- data2015[data2015$VITIMAS >= 100,17] %/% 100
data2015$VITIMAS_MORTE <- 0
data2015$VITIMAS_MORTE[data2015$VITIMAS >= 100] <- data2015[data2015$VITIMAS >= 100,17] %% 100

# popup
data2015$popup <- paste(data2015$TIPO_ACIDE_DESCR, "<br><br>vitimas feridas:", data2015$VITIMAS_NORM, "<br>vitimas fatais:", data2015$VITIMAS_MORTE, "<br>cod. localização: ", data2015$CADLOGA);

# color
data2015$color[data2015$COD_ACID==2] <- "blue"
data2015$color[data2015$COD_ACID==4] <- "red" 

# top 10 locations
locations <- data2015 %>%
  group_by(WKT) %>%
  summarize(n=n(), vitimas=sum(VITIMAS_NORM), vitimas_morte=sum(VITIMAS_MORTE))

locations$lng <- as.numeric(str_match(locations$WKT, ".*\\((.*)\\s(.*)\\)")[,2])
locations$lat <- as.numeric(str_match(locations$WKT, ".*\\((.*)\\s(.*)\\)")[,3])

locations <- arrange(locations, desc(n))

top10 <- head(locations, 10)

top10$popup <- paste("<b>TOP 10 in number of accidents</b><br><br>total accidents: ", top10$n, "<br>victims: ", top10$vitimas, "<br>deaths: ", top10$vitimas_morte)

locations <- arrange(locations, desc(vitimas_morte))
deadly <- head(locations, 10)
deadly$popup <- paste("<b>Deadly Location</b><br><br>total accidents: ", deadly$n, "<br>victims: ", deadly$vitimas, "<br>deaths: ", deadly$vitimas_morte)

# most run over
run_over <- data2015[data2015$COD_ACID==4,] %>%
  group_by(WKT) %>%
  summarize(n=n(), vitimas=sum(VITIMAS_NORM), vitimas_morte=sum(VITIMAS_MORTE))

run_over$lng <- as.numeric(str_match(run_over$WKT, ".*\\((.*)\\s(.*)\\)")[,2])
run_over$lat <- as.numeric(str_match(run_over$WKT, ".*\\((.*)\\s(.*)\\)")[,3])

run_over <- arrange(run_over, desc(n))
run_over <- head(run_over, 5)
run_over$popup <- paste("<b>Top 5 in run over</b><br><br>total accidents: ", run_over$n, "<br>victims: ", run_over$vitimas, "<br>deaths: ", run_over$vitimas_morte)

# cruza dados dos logradouros
logradouros <- read.csv("./dados/logradouros.csv")
# levels(logradouros$classificacao)
logradouros <- logradouros %>% 
  filter(classificacao == "Transito Rápido", codlog5 != "NULL") %>%
  group_by(codlog5) %>%
  summarize(n=n())
  
run_over_rapido <- data2015 %>%
  filter(COD_ACID==4, CADLOGA %in% logradouros$codlog5)

# factpal <- colorFactor(topo.colors(17), data2015$TIPO_ACIDE, alpha = FALSE, ordered = TRUE)

data2015 %>% leaflet(width=800, height=500, padding=5) %>% addTiles() %>% 
  addCircleMarkers(data = data2015, popup=~popup, clusterOptions = markerClusterOptions(), group="all accidents", color=~color, radius = ~VITIMAS_NORM * 4, weight = 3,  fillOpacity = ~VITIMAS_MORTE + 0.2 ) %>%
  addCircleMarkers(data = run_over_rapido, popup=~popup, group="atropelamentos nas vias expressas", color=~color, radius = 8, weight = 3,  fillOpacity = ~VITIMAS_MORTE + 0.2 ) %>%
  addCircleMarkers(data = data2015[data2015$COD_ACID==4,], popup=~popup, clusterOptions = markerClusterOptions(), group="somente atropelamentos", color=~color, radius = ~VITIMAS_NORM * 4, weight = 3, fillOpacity = ~VITIMAS_MORTE + 0.2 ) %>%
  addMarkers(data=top10, group="worst location", popup=~popup)%>%
  addMarkers(data=deadly, group="deadly", popup=~popup)%>%
  addMarkers(data=run_over, group="somente atropelamentos", popup=~popup)%>%
  addLayersControl(
     baseGroups = c("all accidents", "somente atropelamentos", "atropelamentos nas vias expressas"),
     overlayGroups = c("worst location", "deadly"),
     options = layersControlOptions(collapsed = FALSE),
     position="bottomleft"
  )