Geomarketing é um campo interessante de pesquisa que objetiva auxiliar os analistas de marketing em suas decisões através do GIS (Geographic Information Systems).
A proposta desse post é apresentar o mesmo processo de modelagem desenvolvido no trabalhos Mercado de comida japonesa no Distrito Federal : análise das oportunidades de negócio por meio de Geomarketing e Máquinas de Suporte Vetorial.
Basicamente, o processe de modelagem envolve os seguintes passos baseados no trabalho de Silva, C.A (2014) [pág. 70]:
O primeiro passo é obter as variáveis de interesse na mesma unidade observacional da malha digital que será utilizada no Geomarketing:
#Limpa o workspace
rm(list=ls())
### Define o Working Directory
setwd("C:\\Users\\Dados\\POF 2008")
source("LeBasesPosicaoFixa.R")
### Cria um novo arquivo somente com as informações necessárias
# Seleciona tudo:
fselpr<-function(x) x
#Seleciona somente UF 53: fselpr <- function(x) x[substring(x,3,4)==53]
rcsel.pfix(file.inp="T_MORADOR_S.txt", file.out="MORADOR.txt",
first=c(3,5,8,9,11,12,60,112),
last=c(4,7,8,10,11,13,62,127),
fselpr)
###Lê os dados do arquivo de interesse
dados<-read.table("MORADOR.txt")
###Deleta o arquivo MORADOR.txt
file.remove("MORADOR.txt")
#Coloca os nomes das variáveis
colnames(dados)<-c("COD_UF","NUM_SEQ","NUM_DV","COD_DOMC","NUM_UC","NUM_INFORMANTE",
"IDADE_ANOS","RENDA_BRUTA_MONETARIA")
#Coloca os labels nas variáveis
library(Hmisc)
label(dados$COD_UF)<-'CÓDIGO DA UF'
label(dados$NUM_SEQ)<-'NÚMERO SEQUENCIAL'
label(dados$NUM_DV)<-'DV DO SEQUENCIAL'
label(dados$COD_DOMC)<-'NÚMERO DO DOMICÍLIO'
label(dados$NUM_UC)<-'NÚMERO DA UC'
label(dados$NUM_INFORMANTE)<-'NÚMERO DO INFORMANTE'
label(dados$IDADE_ANOS)<-'IDADE CALCULADA EM ANOS'
label(dados$RENDA_BRUTA_MONETARIA)<-'RENDA MONETÁRIA MENSAL DA UC'
describe(dados)
##Lê os dados do arquivo T_DESPESA_INDIVIDUAL_S.txt
rcsel.pfix(file.inp="T_DESPESA_INDIVIDUAL_S.txt", file.out="DESPESA.txt",
first=c(3,5,8,9,11,12,44,46,53),
last=c(4,7,8,10,11,13,45,50,63), fselpr)
###Lê os dados do arquivo de interesse
desp<-read.table("DESPESA.txt")
###Deleta o arquivo DESPESA.txt
file.remove("DESPESA.txt")
#Coloca os nomes das variáveis
colnames(desp)<-c("COD_UF","NUM_SEQ","NUM_DV","COD_DOMC","NUM_UC",
"NUM_INF","NUM_QUADRO","COD_ITEM","VAL_DESPESA")
#Coloca os labels nas variáveis
label(desp$COD_UF)<-'CÓDIGO DA UF'
label(desp$NUM_SEQ)<-'NÚMERO SEQUENCIAL'
label(desp$NUM_DV)<-'DV DO SEQUENCIAL'
label(desp$COD_DOMC)<-'NÚMERO DO DOMICÍLIO'
label(desp$NUM_UC)<-'NÚMERO DA UC'
label(desp$NUM_INF)<-'NÚMERO DO INFORMANTE'
label(desp$NUM_QUADRO)<-'NÚMERO DO QUADRO'
label(desp$COD_ITEM)<-'CÓDIGO DO ITEM'
label(desp$VAL_DESPESA)<-'VALOR DA DESPESA / AQUISIÇÃO'
O código anterior utiliza as bases da Pesquisa de Orçamentos Familiares de 2008: T_DESPESA_INDIVIDUAL_S.txt e T_MORADOR_S.txt além da função de leitura LeBasesPosicaoFixa.R.
Em seguida, as bases de morador e despesas são unidas através do merge entre os dados:
#Mostrar até 8 casas decimais
options("scipen" = 8)
##Faz o merge entre as bases
#Renomeia a variável NUM_INFORMANTE
colnames(dados)[6]<-"NUM_INF"
#Faz o merge
tudo<-merge(dados,desp,by=c("COD_UF","NUM_SEQ","NUM_DV","COD_DOMC",
"NUM_UC","NUM_INF"),all=TRUE)
#Obtêm a base somente com os itens 101 e 102 do quadro 28
ingresso<-tudo[which(tudo$NUM_QUADRO==28&
tudo$COD_ITEM%in%c(101,201)),]
As últimas linhas obtêm somente os registros para o gasto com ingressos para cinema e teatro. Esses valores podem ser consultados na documentação da POF 2008. Como os dados de interesse estão por Setor Censitário ou Área de Ponderação, precisamos estudar quais variáveis já existem nessas bases para padronizar com as variáveis da POF. Para isso, é necessário consultar o documento Descrição das variáveis - Microdados da amostra do Censo. Nesse exercício, vamos trabalhar com as variáveis V6036 – Idade calculada em anos e V5070 - Rendimento familiar per capita em julho de 2010 assim a leitura dos dados é feito de maneira similar:
### Cria um novo arquivo somente com as informações necessárias
# Seleciona tudo:
fselpr<-function(x) x
rcsel.pfix(file.inp="Amostra_Pessoas_53.txt", file.out="CENSO.txt",
first=c(8,62,406),
last=c(20,64,413),
fselpr)
###Lê os dados do arquivo de interesse
censo<-read.table("CENSO.txt")
###Deleta o arquivo CENSO.txt
file.remove("CENSO.txt")
#Coloca os nomes das variáveis
colnames(censo)<-c("CD_APONDE","IDADE_ANOS","RENDA_BRUTA_MONETARIA")
#Arruma a renda pois tem duas casas decimais
censo$RENDA_BRUTA_MONETARIA<-censo$RENDA_BRUTA_MONETARIA/100
Note que o arquivo Amostra_Pessoas_53.txt pode ser obtido diretamente do sítio do IBGE. Nesse exercício não utilizaremos os pesos amostrais fornecidos para que a abordagem seja a mais simples possível, dessa forma, precisamos obter por Área de Ponderação a idade média e a renda média:
#Remove outliers
censo<-censo[which(censo$RENDA_BRUTA_MONETARIA<999999),]
#Calcula a média da idade e renda por área de ponderação:
library(dplyr)
by_pes <- group_by(censo,CD_APONDE)
geo<-summarise(by_pes,
IDADE_ANOS=mean(IDADE_ANOS),
RENDA_BRUTA_MONETARIA=mean(RENDA_BRUTA_MONETARIA)
)
Em seguida, precisamos treinar a Máquina de Suporte Vetorial para que reconheça o padrão de consumo médio nas regiões, para isso fazemos:
#Junta os dads com quem incluisve não gatsou com ingresso
#Faz o merge
pof<-merge(dados,ingresso,
by=c("COD_UF","NUM_SEQ","NUM_DV","COD_DOMC",
"NUM_UC","NUM_INF"),all=TRUE)
#Quando VAL_DESPESA==NA então não gastou com ingresso
pof$VAL_DESPESA[is.na(pof$VAL_DESPESA)]<-0
#Treina a máquina
library(kernlab)
svm<-ksvm(VAL_DESPESA~IDADE_ANOS.x+RENDA_BRUTA_MONETARIA.x,data=pof,
C = 1, epsilon = 0.1,type="eps-svr",kernel="rbfdot",
kpar=list(sigma=4),cross=3)
Aqui novamente por simplicidade, não faremos uma busca exaustiva nos parâmetros ótimos do SVM para tentar manter a abordagem o mais simples possível. Uma vez treinada a máquina, fazemos a previsão do valor gasto com ingressos na base do CENSO:
#Faz a previsão:
colnames(geo)<-c("CD_APONDE","IDADE_ANOS.x","RENDA_BRUTA_MONETARIA.x")
VAL_DESPESA<-predict(svm,geo)
#Junta com a base do CENSo o valor predito
geo<-cbind(geo,VAL_DESPESA)
Pronto!! Apesar do modelo não ter se ajustado muito bem (pois não procuramos pelos parâmetros ótimos e nem utilizamos o peso amostral para ponderar as estatísticas) podemos agora esboçar o mapa com as previsões de gasto com ingressos:
#Baixa a imagem do mapa
library(ggmap)
library(RgoogleMaps)
CenterOfMap <- geocode("Brasilia, DF")
#Pode usar terrain, toner, satellite
BSB <- get_map(c(lon=CenterOfMap$lon, lat=CenterOfMap$lat),zoom = 12, maptype = "satellite", source = "google")
BSB <- ggmap(BSB)
BSB
#Abre a malha
library(rgdal)
library(rgeos)
library(ggplot2)
library(plyr)
sfn <- readOGR(".","BRASILIA_area_de_ponderacao")
#Bounding box
b <- bbox(sfn)
#Junta o mapa com os dados de previsão
sfn@data$id <- rownames(sfn@data)
sfn@data <- join(sfn@data, geo, by="CD_APONDE")
#Cria a projeção
sfn <- spTransform(sfn, CRS("+proj=longlat +datum=WGS84"))
#Cria o objeto ggplot
sfn.df <- fortify(sfn)
sfn.df <- join(sfn.df,sfn@data, by="id")
#Faz o mapa
BSB<-BSB + geom_polygon(data = sfn.df, aes(x = long, y = lat, group = group, fill = VAL_DESPESA),
colour = 'grey', alpha = .4, size = .1) +
theme(legend.position = "left", title = element_blank())
BSB
Nenhum comentário:
Postar um comentário