Skip to content

Commit

Permalink
geocoding and routing
Browse files Browse the repository at this point in the history 
#5
  • Loading branch information
@temospena
temospena committed Feb 10, 2020
1 parent 88b72b6 commit 7b2cb41
Show file tree
Hide file tree
Showing 5 changed files with 272 additions and 66 deletions.
Binary file modified .RData
View file
Binary file not shown.
86 changes: 43 additions & 43 deletions .Rhistory
View file
Original file line number Diff line number Diff line change
@@ -1,46 +1,3 @@
point1<-2
point2<-((numlevels)/2)+1
point3<-point2+1
point4<-numlevels+1
mymin<-(ceiling(max(rowSums(tab2[,point1:point2]))*4)/4)*-100
mymax<-(ceiling(max(rowSums(tab2[,point3:point4]))*4)/4)*100
numlevels<-length(tab[1,])-1
temp.rows<-length(tab2[,1])
pal<-brewer.pal((numlevels-1),"RdBu")
pal[ceiling(numlevels/2)]<-"#DFDFDF"
legend.pal<-pal
pal<-c(pal[1:(ceiling(numlevels/2)-1)], pal[ceiling(numlevels/2)],
pal[ceiling(numlevels/2)], pal[(ceiling(numlevels/2)+1):(numlevels-1)])
tab3<-melt(tab2,id="outcome")
tab3$col<-rep(pal,each=temp.rows)
tab3$value<-tab3$value*100
tab3$outcome<-str_wrap(tab3$outcome, width = 40)
tab3$outcome<-factor(tab3$outcome, levels = tab2$outcome[order(-(tab2[,5]+tab2[,6]+tab2[,7]))])
highs<-na.omit(tab3[(length(tab3[,1])/2)+1:length(tab3[,1]),])
lows<-na.omit(tab3[1:(length(tab3[,1])/2),])
lows <- lows[rev(rownames(lows)),]
lows$col <- factor(lows$col, levels = c("#CA0020","#F4A582", "#DFDFDF"))
ggplot() + geom_bar(data=highs, aes(x = outcome, y=value, fill=col), position="stack", stat="identity") +
geom_bar(data=lows, aes(x = outcome, y=-value, fill=col), position="stack", stat="identity") +
geom_hline(yintercept = 0, color =c("white")) +
scale_fill_identity("",labels = mylevels, breaks=legend.pal, guide="legend") +
theme_fivethirtyeight() +
coord_flip() +
labs(title=mytitle, y="Percent",x="") +
theme(plot.title = element_text(size=14, hjust=0.5)) +
theme(axis.text.y = element_text(hjust=0)) +
theme(legend.position = "bottom") +
theme(rect=element_rect(fill ="White", linetype = 0, colour = NA)) +
theme(axis.title = element_text(size=8,hjust=1)) +
scale_y_continuous(breaks=seq(mymin,mymax,25), limits=c(-62,mymax)) #substituí mymin por -62 para cortar um pouco à esquerda
tab<-tab[,-c(7)]
tab <- read.delim("D:/GIS/Rosix/tab.txt", row.names=1)
View(tab)
library(tidyverse)
library(ggplot2)
library(RColorBrewer)
library(reshape2)
library(ggthemes)
mytitle<-"How do you assess the travel experience \nof the following modes of transportation?"
mylevels<-c("Strongly dislike", "Dislike", "Indifferent", "Like", "Strongly like")
numlevels<-length(tab[1,])-1
Expand Down Expand Up @@ -510,3 +467,46 @@ library(devtools)
install_version("stplanr", version = "0.3.1", repos = "http://cran.us.r-project.org")
install_version("stplanr", version = "0.3.1", repos = "http://cran.us.r-project.org")
citation(package = 'stplanr')
VIAGENSamlGAMA <- readRDS("D:/GIS/Rosix/VIAGENSamlGAMA.Rds")
#gráfico barras verticais com dois valores, e x como factor
ggplot(VIAGENSamlGAMA, aes(gama, viagens/1000, fill=inter) ) + geom_bar(stat="identity")+
theme_classic()+
labs(title="Viagens AML",
subtitle="Número de viagens por gamas de distâncias",
x="Gama de distâncias [km]",
y="x1000 viagens")
library(ggplot2)
#gráfico barras verticais com dois valores, e x como factor
ggplot(VIAGENSamlGAMA, aes(gama, viagens/1000, fill=inter) ) + geom_bar(stat="identity")+
theme_classic()+
labs(title="Viagens AML",
subtitle="Número de viagens por gamas de distâncias",
x="Gama de distâncias [km]",
y="x1000 viagens")
library(tidyverse)
#gráfico barras verticais com dois valores, e x como factor
ggplot(VIAGENSamlGAMA, aes(gama, viagens/1000, fill=inter) ) + geom_bar(stat="identity")+
theme_classic()+
labs(title="Viagens AML",
subtitle="Número de viagens por gamas de distâncias",
x="Gama de distâncias [km]",
y="x1000 viagens")
# saveRDS(TABELA, "D:/R/Tabela.Rds")
save.image(".RData")
#gráfico barras verticais com dois valores, e x como factor
ggplot(VIAGENSamlGAMA, aes(gama, viagens/1000, fill=inter) ) + geom_bar(stat="identity")+
theme_classic()+
labs(title="Viagens AML",
subtitle="Número de viagens por gamas de distâncias",
x="Gama de distâncias [km]",
y="x1000 viagens")
names(VIAGENSamlGAMA[VIAGENSamlGAMA=="viagens aml"]) <- "viagens"
names(VIAGENSamlGAMA)[3]<-"viagens"
save.image(".RData")
#gráfico barras verticais com dois valores, e x como factor
ggplot(VIAGENSamlGAMA, aes(gama, viagens/1000, fill=inter) ) + geom_bar(stat="identity")+
theme_classic()+
labs(title="Viagens AML",
subtitle="Número de viagens por gamas de distâncias",
x="Gama de distâncias [km]",
y="x1000 viagens")
87 changes: 79 additions & 8 deletions COMPILACAO.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -376,6 +376,9 @@ MCBARRIERS <-left_join(MCBARRIERSMEAN,MCBARRIERSFREQ) #assume as variáveis que
MCBARRIERS <-left_join(MCBARRIERSMEAN,MCBARRIERSFREQ, by=c("nomeA"="nomeB")) #declarar as variáveis que quero que faça o mach, em ambas as tabelas
MCBARRIERS <-right_join(MCBARRIERSMEAN,MCBARRIERSFREQ)
#ficar com uma tabela com as linhas que não estão em ambas
CP7not<-anti_join(CP7CML, CP7, by = c("CP74" = "CP7")) #ver os que estavam na CML que ainda não tinhamos no nosso CP7
#remover linhas exactamente iguais (duplicados)
VIAGENS<-unique(VIAGENS)
VIAGENS<-distinct(VIAGENS) #usa o tidyverse. pode-de declarar à frente quais as variáveis a inspeccionar
Expand Down Expand Up @@ -1605,6 +1608,12 @@ st_write(GridORD,"D:\\GIS\\Pedro\\GRID_colunasCount.shp")
st_write(TaxisORD,"D:\\GIS\\Pedro\\TaxisViagens.shp")
st_write(CicloviasActual,"CicloviasActual.shp")
#gravar 2 shapefiles de Origem e Destino, a partir de uma só tabela
Origens<- st_as_sf(Moradas,wkt = "wkt", crs=4326)
Destinos<- st_as_sf(Moradas,wkt = "wkttrabalho", crs=4326)
st_write(Origens,"Origens.shp")
st_write(Destinos,"Destinos.shp")
#gravar csv, separado por TAB - MUITO MAIS LEVE, grava uma coluna com a geometria em formato WKT, e o ficheiro pode ser importato em qualquer SIG com esse campo de geometria
write.table(GridORD,"GridORD.txt",sep="\t",row.names=FALSE)
write.table(TaxisORD,"TaxisORD.txt",sep="\t",row.names=FALSE)
Expand Down Expand Up @@ -1643,21 +1652,52 @@ PontoD <- st_as_sf(PontoD,coords = c("longitude", "latitude"), crs=4326)
###Localizar pontos, através de morada
_Por completar_
>__Dica__: ver [CP7](https://github.com/temospena/CP7) no github e juntar aos códigos postais com um `left_join`
Coordenadas a partir de um nome de rua ou POI
```{r geocoding moradas, eval=F}
library(ggmap)
register_google(key = "YOUR_API_KEY_HERE")
### Calcular percursos ou distâncias e tempos, por determinado modo de transporte
```{r geocoding routes, eval=F}
#especificar o país ou cidade, para limitar os resultados no google
TRAna$CP7 #a lista de moradas sem lat/lon
TRAna$cidade<-"Lisboa"
TRAna$morada<-paste(TRAna$CP7,TRAna$cidade, sep = ", ")
TRAna$lat <- NA
TRAna$lon <- NA
#ver no google maps o que inserir para que ele me encontre um único local
#exemplos
chelas <- geocode("Metro Chelas")
TRAna$lon[TRAna$morada=="metro de Chelas, Lisboa"]<-chelas$lon
TRAna$lat[TRAna$morada=="metro de Chelas, Lisboa"]<-chelas$lat
brasil <- geocode("Avenida do Brasil, Lisbon")
TRAna$lon[TRAna$morada=="Av. Brasil, Lisboa"]<-brasil$lon
TRAna$lat[TRAna$morada=="Av. Brasil, Lisboa"]<-brasil$lat
maternidade <- geocode("Maternidade Alfredo Costa, Lisbon")
TRAna$lon[TRAna$morada=="Sao Sebastiao & Av 5 Outubro, Lisboa"]<-maternidade$lon
TRAna$lat[TRAna$morada=="Sao Sebastiao & Av 5 Outubro, Lisboa"]<-maternidade$lat
catolica <- geocode("Universidade Católica Portuguesa, Lisboa")
TRAna$lon[TRAna$morada=="Universidade Catolica, Lisboa"]<-catolica$lon
TRAna$lat[TRAna$morada=="Universidade Catolica, Lisboa"]<-catolica$lat
rm(chelas,brasil,maternidade,catolica)
#quando temos as coordenadas de Lisboa genéricas (-9.1393366, 38.7222524)
lisboagen<-geocode("Lisboa")#seleccionar aqueles que têm o Lisboa genérico
TRAnaLX<-TRAna[TRAna$lon==lisboagen$lon,]
```

#pelo openrouteservice - tem cycling
lista1<-list(c(38.74684,-9.150085),
c(38.74626,-9.143990),
c(38.75649,9.137337))
x <- ors_directions(lista1,profile="cycling-regular", preference="fastest")
res <- ors_matrix(lista1,profile="driving-car", resolve_locations=T, optimized=T, metrics = "distance", units = "km")

### Calcular percursos ou distâncias e tempos, por determinado modo de transporte
```{r geocoding routes, eval=F}
#pelo google maps - tem transit, mas não calcula propriamente o percurso
library(gmapsdistance)
set.api.key("YOUR_GoogleAPI_KEY")
ODsGIRAcoord$origin<-paste(ODsGIRAcoord$Latitude,ODsGIRAcoord$Longitude, sep="+") #tem de estar separado por +
start_time <- Sys.time()
resulttransitponta <- as.data.frame(gmapsdistance(origin=ODsGIRAcoord$origin,
destination = ODsGIRAcoord$destination,
Expand All @@ -1667,9 +1707,40 @@ resulttransitponta <- as.data.frame(gmapsdistance(origin=ODsGIRAcoord$origin,
dep_time = "08:45:00")) #por transportes públicos em hora de ponta
end_time <- Sys.time()
end_time - start_time #para ver quanto tempo demorou
table(resulttransitponta$Status.status) #ver quantos não encontrou
#resulta uma tabela com Tempo[s] e Distância[m]
resulttransitponta<-resulttransitponta[,c(3,6)]
names(resulttransitponta)<-c("TimeS_TP","DistM_TP")
#mode= bicycling, walking, driving, transit (mas o bicycling não funciona em portugal)
```
####Por bicicleta
O Google maps ainda não permite calcular ODs de bicicleta em Portugal
```{r geocoding routes bici, eval=F}
#pelo openrouteservice - tem cycling
lista1<-list(c(38.74684,-9.150085),
c(38.74626,-9.143990),
c(38.75649,9.137337))
x <- ors_directions(lista1,profile="cycling-regular", preference="fastest")
res <- ors_matrix(lista1,profile="driving-car", resolve_locations=T, optimized=T, metrics = "distance", units = "km")
#quando se calcula no QGIS e vem uma shapefile
##alerta para remover os que têm O=D quando se exporta a shp para correr o ORS tools no QGIS! vai bloquear nesses
RouteBici<-st_read("RouteBici.shp")
#recalcular a distância
RouteBici$DistM_Bike<-round(as.numeric(st_length(RouteBici)))
#meter o tempo em segundos
RouteBici$TimeS_Bike<-round(RouteBici$DURATION_H*60*60)
#Ficar só com Tempo e Dist
RouteBici<-RouteBici[,c(7,10,9)]
#deixar numa data frame
RouteBici$geometry<-NULL
```

>__Dica__: ver também o [package googleway](http://symbolixau.github.io/googleway/reference/google_directions.html])
> ver ainda o [Cyclestreets package](https://www.cyclestreets.net/api/) para um grande detalhe de percursos de bicicleta
Expand Down
80 changes: 72 additions & 8 deletions COMPILACAO.html
View file
Original file line number Diff line number Diff line change
Expand Up @@ -539,6 +539,9 @@ <h2><span class="header-section-number">1.6</span> Ler e alterar colunas</h2>
MCBARRIERS &lt;-left_join(MCBARRIERSMEAN,MCBARRIERSFREQ, by=c(&quot;nomeA&quot;=&quot;nomeB&quot;)) #declarar as variáveis que quero que faça o mach, em ambas as tabelas
MCBARRIERS &lt;-right_join(MCBARRIERSMEAN,MCBARRIERSFREQ)

#ficar com uma tabela com as linhas que não estão em ambas
CP7not&lt;-anti_join(CP7CML, CP7, by = c(&quot;CP74&quot; = &quot;CP7&quot;)) #ver os que estavam na CML que ainda não tinhamos no nosso CP7

#remover linhas exactamente iguais (duplicados)
VIAGENS&lt;-unique(VIAGENS)
VIAGENS&lt;-distinct(VIAGENS) #usa o tidyverse. pode-de declarar à frente quais as variáveis a inspeccionar
Expand Down Expand Up @@ -1826,6 +1829,12 @@ <h3><span class="header-section-number">5.1.3</span> Gravar shapefiles ou tsv</h
st_write(TaxisORD,&quot;D:\\GIS\\Pedro\\TaxisViagens.shp&quot;)
st_write(CicloviasActual,&quot;CicloviasActual.shp&quot;)

#gravar 2 shapefiles de Origem e Destino, a partir de uma só tabela
Origens&lt;- st_as_sf(Moradas,wkt = &quot;wkt&quot;, crs=4326)
Destinos&lt;- st_as_sf(Moradas,wkt = &quot;wkttrabalho&quot;, crs=4326)
st_write(Origens,&quot;Origens.shp&quot;)
st_write(Destinos,&quot;Destinos.shp&quot;)

#gravar csv, separado por TAB - MUITO MAIS LEVE, grava uma coluna com a geometria em formato WKT, e o ficheiro pode ser importato em qualquer SIG com esse campo de geometria
write.table(GridORD,&quot;GridORD.txt&quot;,sep=&quot;\t&quot;,row.names=FALSE)
write.table(TaxisORD,&quot;TaxisORD.txt&quot;,sep=&quot;\t&quot;,row.names=FALSE)</code></pre>
Expand Down Expand Up @@ -1862,20 +1871,47 @@ <h2><span class="header-section-number">5.3</span> Geocoding</h2>
<div id="localizar-pontos-através-de-morada" class="section level3">
<h3><span class="header-section-number">5.3.1</span> Localizar pontos, através de morada</h3>
<p><em>Por completar</em> &gt;<strong>Dica</strong>: ver <a href="https://github.com/temospena/CP7">CP7</a> no github e juntar aos códigos postais com um <code>left_join</code></p>
<p>Coordenadas a partir de um nome de rua ou POI</p>
<pre class="r"><code>library(ggmap)
register_google(key = &quot;YOUR_API_KEY_HERE&quot;)

#especificar o país ou cidade, para limitar os resultados no google
TRAna$CP7 #a lista de moradas sem lat/lon
TRAna$cidade&lt;-&quot;Lisboa&quot;
TRAna$morada&lt;-paste(TRAna$CP7,TRAna$cidade, sep = &quot;, &quot;)
TRAna$lat &lt;- NA
TRAna$lon &lt;- NA

#ver no google maps o que inserir para que ele me encontre um único local

#exemplos
chelas &lt;- geocode(&quot;Metro Chelas&quot;)
TRAna$lon[TRAna$morada==&quot;metro de Chelas, Lisboa&quot;]&lt;-chelas$lon
TRAna$lat[TRAna$morada==&quot;metro de Chelas, Lisboa&quot;]&lt;-chelas$lat
brasil &lt;- geocode(&quot;Avenida do Brasil, Lisbon&quot;)
TRAna$lon[TRAna$morada==&quot;Av. Brasil, Lisboa&quot;]&lt;-brasil$lon
TRAna$lat[TRAna$morada==&quot;Av. Brasil, Lisboa&quot;]&lt;-brasil$lat
maternidade &lt;- geocode(&quot;Maternidade Alfredo Costa, Lisbon&quot;)
TRAna$lon[TRAna$morada==&quot;Sao Sebastiao &amp; Av 5 Outubro, Lisboa&quot;]&lt;-maternidade$lon
TRAna$lat[TRAna$morada==&quot;Sao Sebastiao &amp; Av 5 Outubro, Lisboa&quot;]&lt;-maternidade$lat
catolica &lt;- geocode(&quot;Universidade Católica Portuguesa, Lisboa&quot;)
TRAna$lon[TRAna$morada==&quot;Universidade Catolica, Lisboa&quot;]&lt;-catolica$lon
TRAna$lat[TRAna$morada==&quot;Universidade Catolica, Lisboa&quot;]&lt;-catolica$lat

rm(chelas,brasil,maternidade,catolica)

#quando temos as coordenadas de Lisboa genéricas (-9.1393366, 38.7222524)
lisboagen&lt;-geocode(&quot;Lisboa&quot;)#seleccionar aqueles que têm o Lisboa genérico
TRAnaLX&lt;-TRAna[TRAna$lon==lisboagen$lon,]</code></pre>
</div>
<div id="calcular-percursos-ou-distâncias-e-tempos-por-determinado-modo-de-transporte" class="section level3">
<h3><span class="header-section-number">5.3.2</span> Calcular percursos ou distâncias e tempos, por determinado modo de transporte</h3>
<pre class="r"><code>#pelo openrouteservice - tem cycling
lista1&lt;-list(c(38.74684,-9.150085),
c(38.74626,-9.143990),
c(38.75649,9.137337))
x &lt;- ors_directions(lista1,profile=&quot;cycling-regular&quot;, preference=&quot;fastest&quot;)
res &lt;- ors_matrix(lista1,profile=&quot;driving-car&quot;, resolve_locations=T, optimized=T, metrics = &quot;distance&quot;, units = &quot;km&quot;)

#pelo google maps - tem transit, mas não calcula propriamente o percurso
<pre class="r"><code>#pelo google maps - tem transit, mas não calcula propriamente o percurso
library(gmapsdistance)
set.api.key(&quot;YOUR_GoogleAPI_KEY&quot;)

ODsGIRAcoord$origin&lt;-paste(ODsGIRAcoord$Latitude,ODsGIRAcoord$Longitude, sep=&quot;+&quot;) #tem de estar separado por +

start_time &lt;- Sys.time()
resulttransitponta &lt;- as.data.frame(gmapsdistance(origin=ODsGIRAcoord$origin,
destination = ODsGIRAcoord$destination,
Expand All @@ -1885,14 +1921,42 @@ <h3><span class="header-section-number">5.3.2</span> Calcular percursos ou dist
dep_time = &quot;08:45:00&quot;)) #por transportes públicos em hora de ponta
end_time &lt;- Sys.time()
end_time - start_time #para ver quanto tempo demorou

table(resulttransitponta$Status.status) #ver quantos não encontrou

#resulta uma tabela com Tempo[s] e Distância[m]
resulttransitponta&lt;-resulttransitponta[,c(3,6)]
names(resulttransitponta)&lt;-c(&quot;TimeS_TP&quot;,&quot;DistM_TP&quot;)

#mode= bicycling, walking, driving, transit (mas o bicycling não funciona em portugal)</code></pre>
<div id="por-bicicleta" class="section level4">
<h4><span class="header-section-number">5.3.2.1</span> Por bicicleta</h4>
<p>O Google maps ainda não permite calcular ODs de bicicleta em Portugal</p>
<pre class="r"><code>#pelo openrouteservice - tem cycling
lista1&lt;-list(c(38.74684,-9.150085),
c(38.74626,-9.143990),
c(38.75649,9.137337))
x &lt;- ors_directions(lista1,profile=&quot;cycling-regular&quot;, preference=&quot;fastest&quot;)
res &lt;- ors_matrix(lista1,profile=&quot;driving-car&quot;, resolve_locations=T, optimized=T, metrics = &quot;distance&quot;, units = &quot;km&quot;)

#quando se calcula no QGIS e vem uma shapefile
##alerta para remover os que têm O=D quando se exporta a shp para correr o ORS tools no QGIS! vai bloquear nesses
RouteBici&lt;-st_read(&quot;RouteBici.shp&quot;)
#recalcular a distância
RouteBici$DistM_Bike&lt;-round(as.numeric(st_length(RouteBici)))
#meter o tempo em segundos
RouteBici$TimeS_Bike&lt;-round(RouteBici$DURATION_H*60*60)
#Ficar só com Tempo e Dist
RouteBici&lt;-RouteBici[,c(7,10,9)]
#deixar numa data frame
RouteBici$geometry&lt;-NULL</code></pre>
<blockquote>
<p><strong>Dica</strong>: ver também o <a href="http://symbolixau.github.io/googleway/reference/google_directions.html%5D">package googleway</a><br />
ver ainda o <a href="https://www.cyclestreets.net/api/">Cyclestreets package</a> para um grande detalhe de percursos de bicicleta</p>
</blockquote>
</div>
</div>
</div>
<div id="cálculo-da-geometria" class="section level2">
<h2><span class="header-section-number">5.4</span> Cálculo da geometria</h2>
<pre class="r"><code>#cria um campo em metros (caso a shape esteja projectada)
Expand Down
Loading

0 comments on commit 7b2cb41

Please sign in to comment.