Estudo de Receitas AAE
library(xlsx)
library(dplyr)
library(mapview)
library(leaflet)
library(leaflet.extras)
library(DT)dadosaae = read.xlsx(file = "Faturamento PAs.xls", sheetIndex = 1, encoding="UTF-8")
dadosaae = dadosaae[!is.na(dadosaae$LATITUDE), ]
totalmaio = 747501.4
fator = 1/(0.4888)
dadosaae$VALOR.ARRECADADO = dadosaae$VALOR.ARRECADADO * fator
maio = dadosaaedadosaae = read.xlsx(file = "Faturamento PAs.xls", sheetIndex = 2, encoding="UTF-8")
dadosaae = dadosaae[!is.na(dadosaae$LATITUDE), ]
totaldez = 871111.05
fator = 1/(0.4776)
dadosaae$VALOR.ARRECADADO = dadosaae$VALOR.ARRECADADO * fator
dez = dadosaaedadosaae = read.xlsx(file = "Faturamento PAs.xls", sheetIndex = 3, encoding="UTF-8")
dadosaae = dadosaae[!is.na(dadosaae$LATITUDE), ]
totalset = 864974.3
fator = 1/(0.4605)
dadosaae$VALOR.ARRECADADO = dadosaae$VALOR.ARRECADADO * fator
set = dadosaaeaae = left_join(maio, dez, by=c("ID..PARQUIMETRO" = "ID..PARQUIMETRO"))
aae[, c(9:15, 17)] = NULL
aae = aae[!is.na(aae$VALOR.ARRECADADO.y), ]
aae$LATITUDE.x = sub( '(?<=.{3})', '.', aae$LATITUDE.x, perl=TRUE )
aae$LONGITUDE.x = sub( '(?<=.{3})', '.', aae$LONGITUDE.x, perl=TRUE )
aae$lat = as.numeric(aae$LATITUDE.x)
aae$lon = as.numeric(aae$LONGITUDE.x)
aae = left_join(aae, set, by=c("ID..PARQUIMETRO" = "ID..PARQUIMETRO"))
aae[, c(13:17, 19)] = NULL
aae$media = round(rowMeans(aae[, 8:9, 13]), 2) Varição da Receita por Setor
aae$SETOR.x = as.factor(aae$SETOR.x)
plot(aae$SETOR.x, aae$media, col = "green", xlab = "Setor", ylab = "Receita",las=2)
Faixas de Receita dos Equipamentos
hist(as.numeric(aae$media), col = "green", xlab = "Receita", ylab = "Parquímetros", main = "Frequencia de parquímetros por Faixa de Receita")
Mapa da AAE
Receita por Decis
aae = aae[order(aae$media),]
aae$decis <- ntile(aae$media, 10) *10
pal <- colorBin(
palette = "BuPu"
, domain = aae$decis
, bins = 10
, reverse = FALSE
)
leaflet(aae) %>%
addTiles(group="Mapa") %>%
addCircles(group="aae", lat = ~lat, lng=~lon, weight = 0.1, radius=50,
color=~pal(decis), popup=~paste("Id: ", ID..PARQUIMETRO, "<br>Local: ", ENDEREÇO.x, "<br>Setor: ", SETOR.x, "<br>Receita Média: ", media, "<br>Decil: ", decis, sep = " "),
stroke = TRUE, fillOpacity = 0.8)%>%
addLegend("bottomright", pal = pal, values = ~decis,
title = "Decis de Receita",
labFormat = labelFormat(prefix = "[" ,suffix = "]"),
opacity = 1
)Receita Média
pal <- colorBin(
palette = "BuPu"
, domain = aae$media
, bins = 10
, reverse = FALSE
)
leaflet(aae) %>%
addTiles(group="Mapa") %>%
addCircles(group="aae", lat = ~lat, lng=~lon, weight = 0.1, radius=50,
color=~pal(media), popup=~paste("Id: ", ID..PARQUIMETRO, "<br>Local: ", ENDEREÇO.x, "<br>Setor: ", SETOR.x, "<br>Receita Média: ", media, "<br>Decil: ", decis, sep = " "),
stroke = TRUE, fillOpacity = 0.95)%>%
addLegend("bottomright", pal = pal, values = ~media,
title = "Receita Média",
labFormat = labelFormat(prefix = "R$"),
opacity = 1
)Dados
aae$LATITUDE.x = NULL
aae$LONGITUDE.x = NULL
#aae$lat = NULL
#aae$lon = NULL
aae$VALOR.ARRECADADO.x = NULL
aae$VALOR.ARRECADADO.y = NULL
aae$APELIDO.x = NULL
aae$ATIVO.x = NULL
aae$APELIDO = NULL
aae$VALOR.ARRECADADO = NULL
names(aae) = c("Id", "Local", "Setor", "V2", "V1","Receita Média", "Decil")
DT::datatable(aae, filter = 'top', options = list(
language = list(url = '//cdn.datatables.net/plug-ins/1.10.11/i18n/Portuguese.json'),
pageLength = 20, autoWidth = TRUE
))Clusters
library(apcluster)
load(file = "../../TCC/apres2-25000.rda")
load(file = "../../TCC/x2-25000.rda")
#head(x2)
#dim(x2)
summary(apres)## Length Class Mode
## 136 APResult S4predict.apcluster <- function(s, exemplars, newdata)
{
simMat <- s(rbind(exemplars, newdata), sel=(1:nrow(newdata)) + nrow(exemplars))[1:nrow(exemplars), ]
unname(apply(simMat, 2, which.max))
}
resultado = predict.apcluster(negDistMat(r=2), x2[apres@exemplars, ], aae[1:length(aae$Id), 4:5])
aae$cluster[1:length(aae$Id)] = resultadoplot(apres, x2)
Dados
# aae$cluster = as.numeric(aae$cluster)
# pal <- colorBin(
# palette = "BuPu"
# , domain = aae$cluster
# , bins = 20
# , reverse = FALSE
# )
# colnames(aae)[6] = "Receita"
#
# leaflet(aae) %>%
# addTiles(group="Mapa") %>%
# addCircles(group="aae", lat = ~V2, lng=~V1, weight = 0.1, radius=50,
# color=~pal(cluster), popup=~paste("Id: ", Id, "<br>Local: ", Local, "<br>Setor: ", Setor, "<br>Receita Média: ", Receita, "<br>Cluster: ", cluster, sep = " "),
# stroke = TRUE, fillOpacity = 0.95)%>%
# addLegend("bottomright", pal = pal, values = ~cluster,
# title = "Receita Média",
# opacity = 1
# )
#
# colnames(aae)[1] = "Parq"
# colnames(aae)[4] = "Lat"
# colnames(aae)[5] = "Lon"
# colnames(aae)[8] = "box_id"
# colnames(aae)[3] = "id"
# aae$id = 0
# aae$id = (aae$box_id * 11)
# aae$group = aae$box_idclusters_encontrados = unique(aae$cluster)
clusters_encontrados = sort(clusters_encontrados)
library(contoureR)
poly = data.frame()
for (i in clusters_encontrados){
temp = aae[aae$"cluster" == i, ]
ch1 = convexHullAM_Indexes(temp[,"V2"],temp[,"V1"], includeColinear=FALSE,zeroBased = FALSE)
for (ii in ch1) {
polying = temp[ii,]
poly = rbind(poly, polying)
}
}
poly#dim(poly)
dados = poly
#head(dados)
names(dados) = c("log", "Local", "Setor", "lon", "lat", "ReceitaMedia", "dens", "box_id")
dados$id = (dados$box_id * 11)
dados$group = dados$id
#head(dados)#realizamos a criação dos objetos necessários
library(sp)
coordinates(dados)=c("lat","lon")
df = dados
#head(df)library(sp)
data <- data.frame(box_id=unique(df$box_id),row.names=unique(df$id))
#head(data)points2polygons <- function(df,data) {
get.grpPoly <- function(group,ID,df) {
Polygon(coordinates(df[df$id==ID & df$group==group,]))
}
get.spPoly <- function(ID,df) {
Polygons(lapply(unique(df[df$id==ID,]$group),get.grpPoly,ID,df),ID)
}
spPolygons <- SpatialPolygons(lapply(unique(df$id),get.spPoly,df))
SpatialPolygonsDataFrame(spPolygons,match.ID=T,data=data)
}Polígonos
spDF <- points2polygons(df,data)
#spDF[1]
#class(spDF)
plot(spDF,col=spDF$box_id+1)
#Salvamos o SpatialPolygonsDataFrame
library(rgdal)
rgdal::writeOGR(obj = spDF,
dsn = "myParq.json",
layer = "myParq.json",
driver = "GeoJSON",
overwrite_layer = TRUE)#carregamos os dados SpatialPolygonsDataFrame
parqs <- geojsonio::geojson_read("myParq.json",
what = "sp")CRS
#Verificamos o objeto
#head(parqs, 1)
#dim(parqs)
library(raster)
projection(parqs)## [1] "+proj=longlat +datum=WGS84 +no_defs"Polígonos de Parquímetros por Cluster
#Verificamos os dados espaciais no mapa
library(mapview)
mapviewPalette(name = "Viridis")
mapview(parqs)Abrangência dos Polígonos de Parquímetros
#Como os parquímetros possuem uma área de abrangencia e os polígonos se limitam à posição
#dos parquímetros, assim criamos um buffer para expandir o tamanho do polígono
library(rgeos)
AAE = gBuffer(parqs, width = 0.0004)
mapview(AAE)#fazemos a carga dos dados dosclusters
load("clusters_centroids.rda")
head(dadostemp)dados = as.data.frame(dados)
head(dados)names(dados) = c("log", "Local", "Setor", "Lat", "Lon","ReceitaMedia", "Dens", "cluster", "clusterx11", "box_id")
head(dados)#realizamos typecast
dadostemp$cluster = as.numeric(as.character(dadostemp$cluster))
dados$cluster = as.numeric(as.character(dados$cluster))#Realizamos um bind tipo "left outer join"
dados[,"centroide_lat"]<-dadostemp[dados[ ,"cluster"], "centroide_lat"]
dados[,"centroide_lon"]<-dadostemp[dados[ ,"cluster"], "centroide_lon"]
dados[,"medoide_lat"]<-dadostemp[dados[ ,"cluster"], "medoide_lat"]
dados[,"medoide_lon"]<-dadostemp[dados[ ,"cluster"], "medoide_lon"]
dados[,"area"]<-dadostemp[dados[ ,"cluster"], "area"]
dados[,"ocorrencias"]<-dadostemp[dados[ ,"cluster"], "ocorrencias"]
dados[,"alvara_km2"]<-dadostemp[dados[ ,"cluster"], "id"]
dados[,"exemplar_lon"]<-dadostemp[dados[ ,"cluster"], "exemplars_lat"]
dados[,"exemplar_lat"]<-dadostemp[dados[ ,"cluster"], "exemplars_lon"]
#head(dados)parquimetros_clusterizados = dados
save(parquimetros_clusterizados, file = "parquimetros_clusterizados.Rda")Modelo
names(parquimetros_clusterizados) = c("log", "Local", "Setor", "Lat", "Lon", "ReceitaMedia", "Dens", "cluster", "clusterx11", "box_id", "centroide_lat", "centroide_lon", "medoide_lat", "medoide_lon", "area", "ocorrencias", "alvara_km2", "exemplar_lat", "exemplar_lon" )
head(parquimetros_clusterizados)Calcula as distancias dos parquímetros em relaçãp à centróides, medoides e exemplares.
library(data.table)
library(geosphere)
setDT(parquimetros_clusterizados)
parquimetros_clusterizados[, distancia_medoide := distHaversine(matrix(c(parquimetros_clusterizados$Lon, parquimetros_clusterizados$Lat), ncol = 2), matrix(c(parquimetros_clusterizados$medoide_lon, parquimetros_clusterizados$medoide_lat), ncol = 2))]
parquimetros_clusterizados[, distancia_cemtroide := distHaversine(matrix(c(parquimetros_clusterizados$Lon, parquimetros_clusterizados$Lat), ncol = 2), matrix(c(parquimetros_clusterizados$centroide_lon, parquimetros_clusterizados$centroide_lat), ncol = 2))]
parquimetros_clusterizados[, distancia_exemplars := distHaversine(matrix(c(parquimetros_clusterizados$Lon, parquimetros_clusterizados$Lat), ncol = 2), matrix(c(parquimetros_clusterizados$exemplar_lon, parquimetros_clusterizados$exemplar_lat), ncol = 2))]
head(parquimetros_clusterizados)load("alvaras.rda")
dim(alvaras)## [1] 177106 6head(alvaras)coord = alvaras[,1:2]
names(coord) = c("longitude", "latitude" )
head(coord)str(coord) ## 'data.frame': 177106 obs. of 2 variables:
## $ longitude: num -51.2 -51.2 -51.2 -51.2 -51.2 ...
## $ latitude : num -30.1 -30 -30 -30 -30 ...servico = alvaras[alvaras$V5 == "Servico", ]
names(servico) = c("longitude", "latitude" )
servico = servico[,1:2]
head(servico)dim(servico)## [1] 108449 2comercio = alvaras[alvaras$V5 == "Comercio", ]
comercio = comercio[,1:2]
names(comercio) = c("longitude", "latitude" )
head(comercio)dim(comercio)## [1] 68657 2alvaras_m = alvaras[,1:2]
names(alvaras_m) = c("longitude", "latitude" )
head(alvaras_m)Realiza as iterações para identificar o número de alvaras de comércio e serviço num raio de 100 metros de cada parquímetro.
for(i in 1:length(parquimetros_clusterizados$log)){
alvaras_df <- data.frame(alvaras_m,
resultado = geosphere::distHaversine(
alvaras_m,
c(parquimetros_clusterizados$Lon[i], parquimetros_clusterizados$Lat[i])
) / 1000 < 0.1)
alv = as.data.frame(table(alvaras_df$resultado))
parquimetros_clusterizados$alvaras[i] = alv[2,2]
}for(i in 1:length(parquimetros_clusterizados$log)){
comercio_df <- data.frame(comercio,
resultado = geosphere::distHaversine(
comercio,
c(parquimetros_clusterizados$Lon[i], parquimetros_clusterizados$Lat[i])
) / 1000 < 0.1)
com = as.data.frame(table(comercio_df$resultado))
parquimetros_clusterizados$comercio[i] = com[2,2]
}for(i in 1:length(parquimetros_clusterizados$log)){
servico_df <- data.frame(servico,
resultado = geosphere::distHaversine(
servico,
c(parquimetros_clusterizados$Lon[i], parquimetros_clusterizados$Lat[i])
) / 1000 < 0.1)
ser = as.data.frame(table(servico_df$resultado))
parquimetros_clusterizados$servico[i] = ser[2,2]
}head(parquimetros_clusterizados)parquimetros_clusterizados[,c("log", "Setor", "clusterx11", "box_id")] = NULL
head(parquimetros_clusterizados)levels(parquimetros_clusterizados$ReceitaMedia) <- c(1:10)
perc_oc = parquimetros_clusterizados$ReceitaMedia
parquimetros_clusterizados = cbind(perc_oc, parquimetros_clusterizados)
head(parquimetros_clusterizados)parquimetros_clusterizados$servico = parquimetros_clusterizados$servico/parquimetros_clusterizados$alvaras
parquimetros_clusterizados$comercio = parquimetros_clusterizados$comercio/parquimetros_clusterizados$alvaras
head(parquimetros_clusterizados)threshold = quantile(parquimetros_clusterizados$perc_oc, probs = c(0.35))
parquimetros_clusterizados$perc_oc = if_else(parquimetros_clusterizados$perc_oc > threshold, 1, 0)
table(parquimetros_clusterizados$perc_oc)##
## 0 1
## 45 84parquimetros_clusterizados$ReceitaMedia = NULL
parquimetros_clusterizados$Dens = NULLlibrary(caTools)
set.seed(1)
divisao = sample.split(parquimetros_clusterizados$perc_oc, SplitRatio = 0.70)
treino = subset(parquimetros_clusterizados, divisao == TRUE)
teste = subset(parquimetros_clusterizados, divisao == FALSE)
dim(treino)## [1] 90 20dim(teste)## [1] 39 20save(parquimetros_clusterizados, file = "parquimetros_clusterizados.Rda")
save(treino, file = "treino.Rda")
save(teste, file = "teste.Rda")load("treino.Rda")
load("teste.Rda")
library(e1071)
classificador = naiveBayes(x = treino[, c(3:4,10:12, 17:20)], y = treino$perc_oc, laplace = 3)
print(classificador)##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = treino[, c(3:4, 10:12, 17:20)], y = treino$perc_oc,
## laplace = 3)
##
## A-priori probabilities:
## treino$perc_oc
## 0 1
## 0.3444444 0.6555556
##
## Conditional probabilities:
## Lat
## treino$perc_oc [,1] [,2]
## 0 -30.03685 0.02263576
## 1 -30.04217 0.02454342
##
## Lon
## treino$perc_oc [,1] [,2]
## 0 -51.21452 0.02093226
## 1 -51.21740 0.01844361
##
## area
## treino$perc_oc [,1] [,2]
## 0 0.5841291 0.3641783
## 1 0.6229541 0.4169484
##
## ocorrencias
## treino$perc_oc [,1] [,2]
## 0 2778.355 1212.158
## 1 2849.814 1498.972
##
## alvara_km2
## treino$perc_oc [,1] [,2]
## 0 6732.909 6142.446
## 1 7858.572 9298.488
##
## distancia_exemplars
## treino$perc_oc [,1] [,2]
## 0 240.5310 92.01057
## 1 246.9606 109.19963
##
## alvaras
## treino$perc_oc [,1] [,2]
## 0 224.9310 195.1210
## 1 302.9322 390.7461
##
## comercio
## treino$perc_oc [,1] [,2]
## 0 0.3224603 0.1431056
## 1 0.2829655 0.1594480
##
## servico
## treino$perc_oc [,1] [,2]
## 0 0.6775397 0.1431056
## 1 0.7218305 0.1623035classificador$apriori## treino$perc_oc
## 0 1
## 31 59previsoes = predict(classificador, newdata = teste[, c(3:4,10:12, 17:20)])
previsoes## [1] 0 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 0 0 0 0
## [39] 1
## Levels: 0 1cm = table(previsoes, teste$perc_oc, dnn=c("Predito", "Atual"))
cm## Atual
## Predito 0 1
## 0 10 14
## 1 4 11library(caret)
cm_nb = confusionMatrix(cm)
cm_nb## Confusion Matrix and Statistics
##
## Atual
## Predito 0 1
## 0 10 14
## 1 4 11
##
## Accuracy : 0.5385
## 95% CI : (0.3718, 0.6991)
## No Information Rate : 0.641
## P-Value [Acc > NIR] : 0.93156
##
## Kappa : 0.1333
##
## Mcnemar's Test P-Value : 0.03389
##
## Sensitivity : 0.7143
## Specificity : 0.4400
## Pos Pred Value : 0.4167
## Neg Pred Value : 0.7333
## Prevalence : 0.3590
## Detection Rate : 0.2564
## Detection Prevalence : 0.6154
## Balanced Accuracy : 0.5771
##
## 'Positive' Class : 0
## source('matriz_confusao.R')
matriz(cm_nb)
fourfoldplot(cm_nb$table)
cm_nb = c("Naive Bayes", cm_nb$overall[1], cm_nb$byClass[1:4])
resultados = as.data.frame(cm_nb)