1 Análise Premilimar de dados ALPR
1.1 Escopo
Porto Alegre conta atualmente com controladores eletrônicos de velocidade do tipo pardal e lombada eletrônica, que além de monitorarem e fiscalizar a velocidade de tráfego nos principais eixos da cidade, podem ser utilizados para outros fins. Atualmente tais equipamentos são utilizados para monitoramento, fiscalização de velocidade, cálculo de volume veicular e cercamento eletrônico por meio de tecnologia de Optical Character Recognition (OCR).
Uma vez que o OCR permite identificar veículos, classificá-los e rastreá-los, o escopo do presente estudo consistiu em avaliar a possibilidade de utilizar as informações de OCR para estimar matrizes de Origem/Destino e tempo médio de percurso entre pares O/D.
1.2 Metodologia
Inicialmente foi gerada uma matriz OD formada por pares OD tendo como centróides os endereços de controladores. A partir dos endereços dos pontos de OD foi obtida através da API do Google Maps a matriz de tempos médios entre os diferentes pontos considerados para ser utilizada como comparativo com os dados de tempo obtido em campo. Os dados obtidos pela APi foram configurados para retornar dados de horário e dia típico correspondente ao dia e horário da amostra obtida.
Dado o volume considerável de registros gerados diariamente, foi extraída uma amostra de dados do horário do pico da manhã de trës quintas-feiras de julho e agosto de 2020. Como o interesse do estudo consiste em mapear trajetos, faz-se necessário que o conjunto de placas veiculares tenha registro de passagem em pelo menos dois pares OD. Após obtida a amostra, foram eliminados registros de placas que possuíssem apenas uma passagem pelos pontos de controle, além de registros onde o intervalo entre passagens consecutivas fosse superior a 5400 segundos.
Após a limpeza de dados a amostra passou a conter dados de veículos com trajetos de pelo menos duas passagens por diferentes pares OD em trajetos de no máximo 90 minutos. Após consolidada a amostra, os dados foram ordenados por placa e hora, permitindo identificar a sequência de passagens de cada veículo.
Após definida a ordem de passagens, foi aplicada uma regra de sequenciamento de rota onde foram descartadas passagens consecutivas de sentidos opostos. Com a regra de sequenciamento, sequencias de pares como (norte/sul - sul/norte) ou (centro/bairro – bairro/centro) foram descartadas por representarem movimentos de ida e volta e não uma única viagem.
Como não é possível garantir que as passagens entre dois pontos constituam uma viagem sem desvios ou paradas os dados de tempo entre pares OD apresentam grande variabilidade. Buscando reduzir os ruídos gerados pela variabilidade verificada, foram obtidos para cada par OD os valores de média, mediana e moda do tempo de percurso para que estes pudessem fornecer uma estimativa do valor médio do tempo de viagem. Após obtidos os dados de média, mediana e moda, foram criados três conjuntos de dados com registros de tempo de percurso contidos no intervalo de dados 25% menores ou maiores que o valor de média, mediana e moda e que resultassem para cada par OD pelo menos 30 registros. Com esta abordagem foram gerados três conjuntos de dados, sendo o primeiro com registros de valores em torno da média, o segundo com valores em torno da mediana e o terceiro com valores em torno da moda e que contivessem um número mínimo de registros que permitisse fornecer uma distribuição Gaussiana.
Após obtidos os três conjuntos de pares OD, foram obtidos a cada conjunto os tempos médios de viagem para cada par OD que atendesse ao critério de pelo menos 30 registros. Os valores médios considerados foram pareados com o tempo médio de viagem estimado pela API do Google Maps para que se obtivesse os coeficientes de correlação com a média, mediana e moda. Os valores fornecidos pela API do Google Maps são tempo médio em tráfego e tempo médio fluxo livre estimados pela plataforma do Google Maps. Como os dados do Google Maps fornecem apenas o valor médio e não amostras de viagens, não foram aplicadas análises pareadas de comparação de médias e variância.
library(stringr)
library(xlsx)
library(ggplot2)
grafico = 1
#carrega vias de controladores kopp e perkons
vias = read.xlsx2(file = "../data/ENDEREÇOS PARDAIS E LOMBADAS.xlsx", sheetIndex = 3)
#Elimina variaveis desnecessárias
vias$SOBRA = NULL
vias$EPTC = NULL
vias$ALPR = as.character(vias$ALPR)
vias = vias[nchar(vias$ALPR)> 1, ]
head(vias, 25)1.3 Cleaning Data
padroes <- c(" Faixa 1| Faixa 2| Faixa 3| Faixa 4| esquerda| direita| central| Central| Esquerda| Direita")
#Elimina padrões
vias$ALPR = str_replace_all(vias$ALPR, padroes, '')
vias$ALPR = str_replace_all(vias$ALPR, " -", '')
vias$ALPR = str_trim(vias$ALPR)
# cria uma lista das vis de interesse
listavias = unique(vias$ALPR)
listavias## [1] "Av. Antonio de Carvalho 2320 N/S"
## [2] "Av. Antonio de Carvalho a 10M do N. 2079 S/N"
## [3] "Av. Baltazar de Oliveira Garcia 1981"
## [4] "Av. Baltazar de Oliveira Garcia 1956"
## [5] "AV. Icarai N 1719,"
## [6] "Av. Icarai DF 38 metros do N. 1949"
## [7] "Av. Juca Batista 3151 C/B"
## [8] "Av. Juca Batista 3156 B/C"
## [9] "Estrada Joao de Oliveira Remiao DF 6500 C/B"
## [10] "Av Joao de Oliveira Remiao 6609 B/C"
## [11] "Rua Otavio Santos 330,"
## [12] "Rua Otavio Santos 257,"
## [13] "Av. Prof. Oscar Pereira 4445 C/B"
## [14] "Av. Prof. Oscar Pereira 4821 C/B"
## [15] "Av. Prof. Oscar Pereira 4836,"
## [16] "Rua Paul Harris 415"
## [17] "Rua Paul Harris 467 S/N"
## [18] "Av. Plinio Brasil Milano 365"
## [19] "Av. Saturnino de Brito 1400 S/N"
## [20] "Rua Voluntarios da Patria 1819,"
## [21] "Rua Voluntarios da Patria DF1981"
## [22] "Assis Brasil 8207"
## [23] "Av. Assis Brasil 8292 B/C"
## [24] "Av. Assis Brasil 4935 C/B"
## [25] "Av. Assis Brasil DF 4945 B/C"
## [26] "Bento Goncalves 9519 faixa 1"
## [27] "Bento Goncalves 9519 faixa 2"
## [28] "Bento Goncalves 9519 faixa 3"
## [29] "Av. Bento Goncalves 9535 B/C"
## [30] "Av. Bento Gonçalves 9535 B/C"
## [31] "Av. Edvaldo Pereira Paiva 3500"
## [32] "Av. Edvaldo Pereira Paiva 3500 B/C"
## [33] "Av. da Cavalhada DF a 30m do 4530"
## [34] "Av. da Cavalhada a 30m do nro 4414"
## [35] "Av. da Cavalhada 3696 B/C"
## [36] "Av. Edgar Pires de Castro 9331 C/B"
## [37] "Av. Eduardo Prado DF 10m do 1270"
## [38] "Av. Ipiranga DF 15m do nro 8185"
## [39] "Av. Ipiranga a 16m do nro 2860"
## [40] "Av. Juca Batista a 200m do nro 8455 C/B"
## [41] "Av. Juca Batista a 200m do nro 8455 B/C"
## [42] "Av. Pres. Castello Branco 1000"
## [43] "Av. Joao de Oliveira Remiao 5989 C/B"
## [44] "Av. Joao de Oliveira Remiao nro 702"
## [45] "Av. Joao de Oliveira Remiao DF nro 702"
## [46] "Av. Manoel Elias defronte 1830"
## [47] "Av. Manoel Elias 1822"
## [48] "Av. Manoel Elias 768 S/N"
## [49] "Av. Dr. Nilo Pecanha 350 C/B"
## [50] "Av. Dr. Nilo Pecanha 350 B/C"
## [51] "Av. Dr. Nilo Pecanha 2715"
## [52] "Av. Nonoai 849"
## [53] "Av. Padre Cacique a 19m do nro 1804"
## [54] "Protasio Alves DF 10564"
## [55] "Av. Protasio Alves 10835 B/C"
## [56] "Av. Wenceslau Escobar DF 1657"1.4 Dados ALPR
#alpr = read.csv(file = "../data/ALPR/data-1597846960421.csv", header = T, sep = ",", fileEncoding = "UTF-8")
alpr = read.csv(file = paste("../data/ALPR/", dia, ".csv", sep = ""), header = T, sep = ",", fileEncoding = "UTF-8")
#Transforma factor em character
alpr$endereco = as.character(alpr$endereco)
class(alpr$endereco)## [1] "character"alpr$endereco = str_replace_all(alpr$endereco, padroes, '')
alpr$endereco = str_replace_all(alpr$endereco, " -", '')
alpr$endereco = str_replace_all(alpr$endereco, ", Entrada,", '')
alpr$endereco = str_trim(alpr$endereco)
alpr$endereco = str_replace(alpr$endereco, "Km 1", "1000")
alpr$endereco = str_replace(alpr$endereco, "km 3,5", "3500")
head(alpr[,-2])1.4.1 Dados Monitorados
original = dim(alpr)
original## [1] 859062 7head(alpr[,-2])class(alpr$datamonitoramento)## [1] "factor"alpr$data = substring(as.character(alpr$datamonitoramento), 1, 10)
alpr$datamonitoramento = as.POSIXct(as.character(alpr$datamonitoramento))
head(alpr[,-2])class(alpr$datamonitoramento)## [1] "POSIXct" "POSIXt"1.4.2 Manutenção de Veiculos passantes em Dois Trechos ou Mais
Foram mantidas na amostra apenas as placas de veículos que passaram em melo menos dois pontos de verificação em um intervalo de tempo não superior e 5400 segundos.
dupe = alpr[,c('placa','data')]
alpr = alpr[duplicated(dupe) | duplicated(dupe, fromLast=TRUE),]
head(alpr[,-2], 50)OS registros foram ordenados por placa e data de registro para identificar a sequência de passagens.
alpr = alpr[with(alpr, order(placa, datamonitoramento)), ]
dim(alpr)## [1] 754764 8head(alpr[, c(3, 6)], 5)1.5 Tranformação de Dados
OS dados de endereços foram tratados para ficarem de acordo com a numeração utilizada pela API do Google para mapeamento de rotas. Numeros defronte (DF) foram somados a +1 para identificarem uma numeração fictícia no sentido correto da viagem.
alpr$dif = 0
alpr$numeros = as.numeric(gsub('.* ([0-9]+).*','\\1', alpr$endereco))
alpr$numerosold = alpr$numeros
alpr$numeros = ifelse((grepl(" DF ", alpr$endereco, fixed = T)), alpr$numeros+1, alpr$numeros)
alpr$endereco = str_replace(alpr$endereco, " DF ", " ")
# Obtem dados de percurso de at? 1,5 h
alpr = alpr[alpr$dif <= 5400,]
#alpr = alpr[1:50000,]
# obtem primeiros pontos de passagem
zeros = dim(alpr[alpr$dif == 0,])
zeros## [1] 754764 111.6 Regras
Foram estabelicidades regras de controle para se certificar que viagens de retorno (ida e volta) fossem desconsideradas.
# obtem mudança de sentido
uns = dim(alpr[alpr$dif == 1,])
uns## [1] 0 11#obtem total de passagens em sequencia
dim(alpr) - (zeros+uns)## [1] 0 -11#visualiza os 50 primeiros registros
head(alpr[,-2])names(vias) = c("concessao", "endereco")
head(vias)library(dplyr)
alpr = left_join(alpr, vias)
alpr = unique(alpr)
head(alpr, 10)alpr$concessao = as.character(alpr$concessao)
class(alpr$concessao)## [1] "character"alpr = alpr[!is.na(alpr$concessao), ]
head(alpr[,-2], 10)dupe = alpr[,c('placa','data')]
alpr = alpr[duplicated(dupe) | duplicated(dupe, fromLast=TRUE),]load("geoalpr.Rda")
alpr$placa = as.character(alpr$placa)alpr$dist = 0
alpr$duracaoTrafego = 0
alpr$duracaoFluxoLivre = 0for (i in 2:length(alpr$idveiculo)) {
if ( (alpr$placa[i] == alpr$placa[i-1]) & (alpr$endereco[i] != alpr$endereco[i-1]) ) {
#print(paste(alpr$placa[i] == alpr$placa[i-1]))
#print(paste(alpr$endereco[i], alpr$endereco[i-1], sep = "->"))
alpr$dif[i] = ifelse((alpr$sentido[i] == "Centro Bairro" & alpr$sentido[i-1] == "Bairro Centro"),1,
ifelse((alpr$sentido[i] == "Bairro Centro" & alpr$sentido[i-1] == "Centro Bairro"),1,
ifelse((alpr$sentido[i] == "N/S" & alpr$sentido[i-1] == "S/N"),1,
ifelse((alpr$sentido[i] == "S/N" & alpr$sentido[i-1] == "N/S"),1,
as.numeric(difftime(alpr$datamonitoramento[i], alpr$datamonitoramento[i-1], units = "secs"))
)
)
)
)
alpr$dist[i] = ifelse((alpr$sentido[i] == "Centro Bairro" & alpr$sentido[i-1] == "Bairro Centro"),1,
ifelse((alpr$sentido[i] == "Bairro Centro" & alpr$sentido[i-1] == "Centro Bairro"),1,
ifelse((alpr$sentido[i] == "N/S" & alpr$sentido[i-1] == "S/N"),1,
ifelse((alpr$sentido[i] == "S/N" & alpr$sentido[i-1] == "N/S"),1,
as.character(head(df[(df$Origem == alpr$endereco[i-1]) & (df$Destino == alpr$endereco[i]), "Distancia"], 1))
)
)
)
)
alpr$duracaoTrafego[i] = ifelse((alpr$sentido[i] == "Centro Bairro" & alpr$sentido[i-1] == "Bairro Centro"),1,
ifelse((alpr$sentido[i] == "Bairro Centro" & alpr$sentido[i-1] == "Centro Bairro"),1,
ifelse((alpr$sentido[i] == "N/S" & alpr$sentido[i-1] == "S/N"),1,
ifelse((alpr$sentido[i] == "S/N" & alpr$sentido[i-1] == "N/S"),1,
as.character(head(df[(df$Origem == alpr$endereco[i-1]) & (df$Destino == alpr$endereco[i]), "DuracaoEmTrafego"], 1))
)
)
)
)
alpr$duracaoFluxoLivre[i] = ifelse((alpr$sentido[i] == "Centro Bairro" & alpr$sentido[i-1] == "Bairro Centro"),1,
ifelse((alpr$sentido[i] == "Bairro Centro" & alpr$sentido[i-1] == "Centro Bairro"),1,
ifelse((alpr$sentido[i] == "N/S" & alpr$sentido[i-1] == "S/N"),1,
ifelse((alpr$sentido[i] == "S/N" & alpr$sentido[i-1] == "N/S"),1,
as.character(head(df[(df$Origem == alpr$endereco[i-1]) & (df$Destino == alpr$endereco[i]), "Segundos"], 1))
)
)
)
)
}else{
#print(paste(alpr$placa[i] == alpr$placa[i-1], alpr$dif[i]))
}
}
alpr = alpr[alpr$dif <= 5400, ]
head(alpr[,-2], 10)dupe = alpr[,c('placa','data')]
alpr = alpr[duplicated(dupe) | duplicated(dupe, fromLast=TRUE),]alprfinal = alpr
alprfinal = alprfinal[alprfinal$dif != 1 , ]
head(alprfinal[,-2], 10)library(tibble)
alprfinal = add_column(alprfinal, d = 0, .before = "datamonitoramento")df = matrix(0, nrow = 0, ncol =dim(alprfinal)[2])
df## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [,15] [,16]for (indice in 1:length(alprfinal$idveiculo)) {
if (alprfinal$dif[indice] > 0) {
alprfinal$idcamera[indice] = alprfinal$endereco[indice-1]
alprfinal$d[indice] = as.character(alprfinal$datamonitoramento[indice-1])
df = rbind(df, alprfinal[indice, ])
}
}
df = as.data.frame(df)
names(df) = names(alprfinal)
df$idveiculo = NULL
df$data = NULL
df$idveiculo = NULL
df$numeros = NULL
df$numerosold = NULL
names(df) = c("Placa", "instanteOrigem", "instanteDestino", "Classe", "Origem", "Destino", "Sentido", "tempoVerificado", "Concessao", "Distancia", "TempoPercursoTrafegoGoogle", "TempoPercursoFluxoLivreGoogle")
df = df[!is.na(df$Distancia), ]
head(df[,-1])df = df[]
plot(df$TempoPercursoTrafegoGoogle, df$tempoVerificado, col="blue")
plot(df$TempoPercursoFluxoLivreGoogle, df$tempoVerificado, col="orange")
1.7 Subseting
Soram considerados dias apenas do pico da manhã para o dia da extração e descartados valores referentes a motocicletas e veículos pesados.
df = df[df$instanteOrigem > paste(dia, "06:00:00", sep = " "),]
df = df[df$instanteOrigem < paste(dia, "09:00:00", sep = " "),]
df = df[df$Classe != "Carreta",]
df = df[df$Classe != "Moto",]
df = df[df$Classe != "Onibus",]
df = df[df$Classe != "Caminhao",]
unique(df$Classe)## [1] Veiculo Carro de Passeio Van Indefinido
## 9 Levels: Caminhao Carreta Carro de Passeio Indefinido Moto Onibus ... Veiculomin(df$instanteOrigem)## [1] "2020-07-23 06:00:02"max(df$instanteOrigem)## [1] "2020-07-23 08:59:59"library(dplyr)
library(modeest)
df$Placa = NULL
df$instanteOrigem = NULL
df$instanteDestino = NULL
df$Classe = NULL
df$Sentido = as.character(df$Sentido)
save(df, file = paste(dia, "df.Rda", sep = "_"))
dftemp = df[0, ]
dfs = list.files(pattern = "_df.Rda")
for (variable in dfs) {
load(variable)
dftemp = rbind(dftemp, df)
}
df = dftemp
save(df, file = "df.Rda")
df1 = df[df$Concessao == "KOPP", ]
df2 = df[df$Concessao == "PERKONS", ]load("df.Rda")
df1 = df[df$Concessao == "KOPP", ]
df2 = df[df$Concessao == "PERKONS", ]head(df1)class(df1)## [1] "data.frame"moda <- function(codes){
which.max(tabulate(codes))
}
dim(df)## [1] 53758 8library(DT)1.8 Dados de Pardais e Lombadas
DadosSumarisados <- df %>%
group_by(Origem, Destino, Sentido) %>%
summarise(mean = mean(tempoVerificado),
median=median(tempoVerificado),
mode = moda(tempoVerificado),
total.count=n())DadosSumarisados = DadosSumarisados[with(DadosSumarisados, order(-total.count)), ]
head(DadosSumarisados, 50) save(DadosSumarisados, file = "DadosSumarisados.Rda")load("df.Rda")
temp = df
load("DadosSumarisados.Rda")
load("geoalpr.Rda")
geo = df[df$Hora == 8, ]
df = temp
rm(temp)
DadosSumarisados = as.data.frame(DadosSumarisados)1.8.1 Mediana
base = df[0,]
for (i in 1:length(DadosSumarisados$Origem)) {
mediana = DadosSumarisados[i, 5]
medmin = mediana * 0.75
medmax = mediana * 1.25
temp = df[(df$Origem == DadosSumarisados[i,1]) & (df$Destino == DadosSumarisados[i,2]) & (df$Sentido == DadosSumarisados[i,3]) & (df$tempoVerificado > medmin) & (df$tempoVerificado < medmax), ]
base=rbind(base, temp)
}DadosSumarisadosMediana <- base %>%
group_by(Origem, Destino, Sentido) %>%
summarise(mean = mean(tempoVerificado),
median=median(tempoVerificado),
mode = moda(tempoVerificado),
total.count=n())joinmediana = merge( DadosSumarisadosMediana, geo, by.x = c("Origem", "Destino"), by.y = c("Origem", "Destino"))library(DT)1.8.1.1 Correlações
joinmediana$DuracaoEmTrafego = as.numeric(as.character(joinmediana$DuracaoEmTrafego))
joinmediana$Segundos = as.numeric(as.character(joinmediana$Segundos))
cor(joinmediana$median, joinmediana$DuracaoEmTrafego)## [1] 0.5552428cor(joinmediana$median, joinmediana$Segundos)## [1] 0.55824131.8.1.2 Distribuição
ggplot(joinmediana, aes(x=median, y=DuracaoEmTrafego)) +
geom_point(color='#2980B9', size = 4) +
geom_smooth(method=lm, color='#2C3E50') +
theme(axis.text.x=element_text(angle=45, hjust=1)) +
ggtitle(paste("Gráfico", grafico, "Comparativo tempo médio de percurso em Tráfego")) +
xlab("Tempo de Percurso ALPR [-25% mediana + 25%]") +
ylab("Tempo Médio Google API") +
guides(fill=guide_legend(title="New Legend Title"))+
annotate("text", x = mean(joinmediana$median)*1.8, y = mean(joinmediana$Segundos), label = paste("Correlação: ",cor(joinmediana$median, joinmediana$DuracaoEmTrafego)))
grafico = grafico + 1ggplot(joinmediana, aes(x=median, y=Segundos)) +
geom_point(color='#00AFBB', size = 4) +
geom_smooth(method=lm, color='#2C3E50')+
theme(axis.text.x=element_text(angle=45, hjust=1)) +
ggtitle(paste("Gráfico", grafico, "Comparativo tempo médio de percurso Fluxo Livre")) +
xlab("Tempo de Percurso ALPR [-25% mediana + 25%]") +
ylab("Tempo Médio Google API") +
guides(fill=guide_legend(title="New Legend Title")) +
annotate("text", x = mean(joinmediana$median)*1.8, y = mean(joinmediana$Segundos), label = paste("Correlação: ",cor(joinmediana$median, joinmediana$Segundos)))
grafico = grafico + 11.8.2 Média
base = df[0,]
for (i in 1:length(DadosSumarisados$Origem)) {
media = DadosSumarisados[i, 4]
medmin = media * 0.75
medmax = media * 1.25
temp = df[(df$Origem == DadosSumarisados[i,1]) & (df$Destino == DadosSumarisados[i,2]) & (df$Sentido == DadosSumarisados[i,3]) & (df$tempoVerificado > medmin) & (df$tempoVerificado < medmax), ]
base=rbind(base, temp)
}DadosSumarisadosMedia <- base %>%
group_by(Origem, Destino, Sentido) %>%
summarise(mean = mean(tempoVerificado),
median=median(tempoVerificado),
mode = moda(tempoVerificado),
total.count=n())joinmedia = merge( DadosSumarisadosMedia, geo, by.x = c("Origem", "Destino"), by.y = c("Origem", "Destino"))1.8.2.1 Correlações
joinmedia$DuracaoEmTrafego = as.numeric(as.character(joinmedia$DuracaoEmTrafego))
joinmedia$Segundos = as.numeric(as.character(joinmedia$Segundos))
cor(joinmedia$median, joinmedia$DuracaoEmTrafego)## [1] 0.6036298cor(joinmedia$median, joinmedia$Segundos)## [1] 0.61437071.8.2.2 Distribuição
ggplot(joinmedia, aes(x=median, y=DuracaoEmTrafego)) +
geom_point(color='#2980B9', size = 4) +
geom_smooth(method=lm, color='#2C3E50') +
theme(axis.text.x=element_text(angle=45, hjust=1)) +
ggtitle(paste("Gráfico", grafico, "Comparativo tempo médio de percurso em Tráfego")) +
xlab("Tempo de Percurso ALPR [-25% média + 25%]") +
ylab("Tempo Médio Google API") +
guides(fill=guide_legend(title="New Legend Title"))+
annotate("text", x = mean(joinmedia$median)*1.8, y = mean(joinmedia$Segundos), label = paste("Correlação: ",cor(joinmedia$median, joinmedia$DuracaoEmTrafego)))
grafico = grafico + 1ggplot(joinmedia, aes(x=median, y=Segundos)) +
geom_point(color='#00AFBB', size = 4) +
geom_smooth(method=lm, color='#2C3E50')+
theme(axis.text.x=element_text(angle=45, hjust=1)) +
ggtitle(paste("Gráfico", grafico, "Comparativo tempo médio de percurso Fluxo Livre")) +
xlab("Tempo de Percurso ALPR [-25% média + 25%]") +
ylab("Tempo Médio Google API") +
guides(fill=guide_legend(title="New Legend Title")) +
annotate("text", x = mean(joinmedia$median)*1.8, y = mean(joinmedia$Segundos), label = paste("Correlação: ",cor(joinmedia$median, joinmedia$Segundos)))
grafico = grafico + 11.8.3 Moda
base = df[0,]
for (i in 1:length(DadosSumarisados$Origem)) {
modas = DadosSumarisados[i, 6]
medmin = modas * 0.75
medmax = modas * 1.25
temp = df[(df$Origem == DadosSumarisados[i,1]) & (df$Destino == DadosSumarisados[i,2]) & (df$Sentido == DadosSumarisados[i,3]) & (df$tempoVerificado > medmin) & (df$tempoVerificado < medmax), ]
base=rbind(base, temp)
}DadosSumarisadosModa <- base %>%
group_by(Origem, Destino, Sentido) %>%
summarise(mean = mean(tempoVerificado),
median=median(tempoVerificado),
mode = moda(tempoVerificado),
total.count=n())joinmoda = merge( DadosSumarisadosMediana, geo, by.x = c("Origem", "Destino"), by.y = c("Origem", "Destino"))1.8.3.1 Correlações
joinmoda$DuracaoEmTrafego = as.numeric(as.character(joinmoda$DuracaoEmTrafego))
joinmoda$Segundos = as.numeric(as.character(joinmoda$Segundos))
cor(joinmoda$median, joinmoda$DuracaoEmTrafego)## [1] 0.5552428cor(joinmoda$median, joinmoda$Segundos)## [1] 0.55824131.8.3.2 Distribuição
ggplot(joinmoda, aes(x=median, y=DuracaoEmTrafego)) +
geom_point(color='#2980B9', size = 4) +
geom_smooth(method=lm, color='#2C3E50') +
theme(axis.text.x=element_text(angle=45, hjust=1)) +
ggtitle(paste("Gráfico", grafico, "Comparativo tempo médio de percurso em Tráfego")) +
xlab("Tempo de Percurso ALPR [-25% moda + 25%]") +
ylab("Tempo Médio Google API") +
guides(fill=guide_legend(title="New Legend Title"))+
annotate("text", x = mean(joinmoda$median)*1.8, y = mean(joinmoda$Segundos), label = paste("Correlação: ",cor(joinmoda$median, joinmoda$DuracaoEmTrafego)))
grafico = grafico + 1ggplot(joinmoda, aes(x=median, y=Segundos)) +
geom_point(color='#00AFBB', size = 4) +
geom_smooth(method=lm, color='#2C3E50')+
theme(axis.text.x=element_text(angle=45, hjust=1)) +
ggtitle(paste("Gráfico", grafico, "Comparativo tempo médio de percurso Fluxo Livre")) +
xlab("Tempo de Percurso [-25% moda + 25%]") +
ylab("Tempo Médio Google API") +
guides(fill=guide_legend(title="New Legend Title")) +
annotate("text", x = mean(joinmoda$median)*1.8, y = mean(joinmoda$Segundos), label = paste("Correlação: ",cor(joinmoda$median, joinmoda$Segundos)))
grafico = grafico + 11.9 Resultados
Os dados comparativos foram plotados em gráficos de dispersão e suas respectivas correlações foram obtidas para média, mediana e moda. A hipótese inicial do estudo foi de que a moda poderia ser mais aderente ao tempo médio de viagem da plataforma Google Maps, no entanto os resultados contrastam com essa ideia.
Ao comparar os dados ao redor da mediana com o tempo médio de percurso da API do Google Maps em situação de tráfego carregado a correlação obtida foi de 0.55 (Gráfico 1), bem como a comparação do tempo médio de percurso da API do Google com fluxo livre foi de 0.55 (Gráfico 2). Quando comparados os dados ao redor da média com o tempo médio de percurso da API do Google com tráfego carregado a correlação obtida foi de 0.60 (Gráfico 3), já a comparação do tempo médio de percurso da API do Google com fluxo livre foi de 0.61 (Gráfico 4). Por fim, ao comparar os dados ao redor da moda com o tempo médio de percurso da API do Google com tráfego carregado a correlação obtida foi de 0.55 (Gráfico 5) e a comparação do tempo médio de percurso da API do Google com fluxo livre foi de 0.55 (Gráfico 6).
2 Conclusão
Para comparação das estimativas de tempo de viagem da plataforma Google Maps e tempos de viagem verificados pelo monitoramento, os dados demonstram que o uso de moda e mediana apresentam os mesmos coeficientes de correlação (0.55) tanto para fluxo em tráfego como fluxo livre. Quando, aplicada a comparação para a média, a correlação para tráfego carregado é de 0.6 e para fluxo livre de 0.61.
Os dados demonstram resultados satisfatórios quando utilizados os valores constituídos pelo conjunto de viagens com tempo não inferior ou superior a 25% do tempo médio de viagem verificados pelo monitoramento. Percebe-se pelos gráficos de dispersão, que o tempo médio de viagem verificado pelo monitoramento é inferior ao tempo médio estimado pela plataforma do Google Maps; esta diferença pode ser resultante da mudança de comportamento durante a pandemia, que resulta na redução do volume veicular durante os dias de monitoramento considerados e uma possível redução nos atrasos dos deslocamentos.
Os dados utilizados são referentes de três quintas-feiras nos meses de julho e agosto de 2020 e demonstram ser promissores para estimativas de tempos de viagens. Quanto à utilização dos mesmos para estimação de matrizes OD, os dados referentes aos dias 23 e 30 de julho de 2020 e 06 de agosto de 2020 durante o pico da manhã entre 6h e 9h somam 438628 registros de passagens em controladores, consolidando 48827 viagens entre pares 1285 OD, sendo que os 255 pares OD com mais de 30 viagens realizadas constituem 41177 viagens realizadas. Também foram identificadas 31420 viagens com tempo médio superior a 10 minutos entre 1140 pares OD, 17794 viagens com tempo superior a 20 minutos entre 910 pares OD, 7829 viagens com duração superior a 30 minutos entre 617 pares OD e 230 viagens com duração de viagem superior a uma hora entre 106 pares OD.
Os dados encontrados são promissores em relação ao uso de dados da base ALPR para estimativas de tempos de percurso entre regiões. Quanto a utilização para cobtenção de matrizes OD, os dados demonstram potencial para tanto; embora os pontos considerados como origem/destino estão localizados ao longo de grandes eixos de ligação entre zonas e não em zonas produtoras e atratoras de tráfego.
Recomenda-se que a mesma análise seja reproduzida em um período sem restrições como as resultantes da pandemia do COVID-19. Esta replicação do estudo permitirá capturar um número maior de viagens e estimar valores mais realizas para tempos de viagem entre pares OD.