#2 Aula espacial================================================================ require(maptools) ## funçes para importaçãoo/exportaçãoo e manipulação de mapas e dados geográficos require(sp) ## (classes) para representação de dados espaciais no R require(spdep) ## funções de análises de dados de áreas (Prob Map) require(classInt) ## rotinas para faclitar a divis?o de dados em classes por v?rios crit?rios require(RColorBrewer) ## usada aqui para criar palhetas de cores nas visualiza??es em mapas getwd() pr <- readShapePoly("./Shape Parana/parana.shp",IDvar="CodIBGE") #pacote Maptools #IDvar =Variável identificador dos dados #3 Arquivos essenciais #ShP = Limites geográficos (Cordenadas) #SHX = Qual poligono vai em qual local #DBF = Dados geográficos (Munícipio, Código) slotNames(pr) #pr@plotOrder #pr@bbox = Retangulo da figura #proj4string = Sistema de representação de coordenada str(pr) #Estrutura dos dados str(pr@data) pr@data$NOME pr@proj4string pr@bbox class(pr) #Spatial polygons dataframe #Forma de selecionar @ $ str(pr@data) str(pr@polygons) #pr@data$CodIBGE pr@data$ plot(pr,xa) length(pr@polygons) pr@polygons[1] #Mudando caracter pr@data$NOME <- as.character(pr@data$NOME) #Acetuação Encoding(pr@data$NOME) Encoding(pr@data$NOME) <- "latin1" pr@data$NOME <- enc2native(pr@data$NOME) #Emparelhar o mapa com dados socieoeconômico............................................................. #Dados do IDH 2010 require(gdata) idh10<-read.table("./dados/idh2010.txt",sep="\t",dec=",") str(idh10) names(idh10)<-c("Cod","Cid","IDH") #Para emparelhar é preciso um vetor comum a ambos os dados # idh10[,1] e str(pr@data) #Código do IBGE #Verificar se está na mesma ordem sum(pr@data[,1]==idh10[,1]) # Apenas 11 #Reordenando ind<-match(pr@data[,1],idh10[,1]) ind pr@data[6,1] idh10[9,1] idh10<-idh10[ind,] row.names(idh10) <- row.names(pr@data) pr <- spCbind(pr, idh10)#package head(pr@data) #display.brewer.pal() #pr@data[,12] #Construindo mapa IBGE CORES.5<-c("red", "black","purple","blue","yellow") INT <- classIntervals(pr@data[,9], n=5, style="quantile") COL <- findColours(INT, CORES.5) x11() plot(pr, col=COL) title("IDH 2010") str(COL) TB <- attr(COL, "table") legtext <- paste(names(TB)) #, " (", TB, ")", sep="") legend("bottomright", fill=attr(COL, "palette"), legend=legtext, bty="y") #Categorias de cores display.brewer.all() #3 Grupos mypalette<-brewer.pal(9,"Greens") image(1:7,1,as.matrix(1:7),col=mypalette,xlab="Greens (sequential)", ylab="",xaxt="n",yaxt="n",bty="n") mypalette<-brewer.pal(9,"Paired") image(1:9,1,as.matrix(1:9),col=mypalette,xlab="Paired", ylab="",xaxt="n",yaxt="n",bty="n") mypalette<-brewer.pal(9,"Spectral") image(1:9,1,as.matrix(1:9),col=mypalette,xlab="Spectral", ylab="",xaxt="n",yaxt="n",bty="n") #Criando paleta pŕopria do verde para o laranja mypalette<-c(rev(brewer.pal(3,"Greens")),brewer.pal(3,"Oranges")) image(1:6,1,as.matrix(1:6),col=mypalette,xlab="Greens (sequential) to Oranges", ylab="",xaxt="n",yaxt="n",bty="n") #Dados IDH 10 com os 3 fatiamento de cores diferente.................................................. x11() par(mfrow=c(2,2)) #Cores sequenciais CORES.5<-brewer.pal(5,"Greens") INT <- classIntervals(pr@data[,9], n=5, style="quantile") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Cores Sequenciais") TB <- attr(COL, "table") legtext <- paste(names(TB)) #, " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Cores Aleatórias CORES.5<-brewer.pal(5,"Paired") INT <- classIntervals(pr@data[,9], n=5, style="quantile") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Cores Aleatórias") TB <- attr(COL, "table") legtext <- paste(names(TB)) #, " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Cores Adversas CORES.5<-brewer.pal(5,"Spectral") INT <- classIntervals(pr@data[,9], n=5, style="quantile") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Cores Adversas") TB <- attr(COL, "table") legtext <- paste(names(TB)) #, " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Variação no intervalo das classes................................................................. #package = ClassInt #Possíveis formas de fatiamento de cores INT <- classIntervals(pr@data[,9], n=5, style="quantile")#Mesma porcentagem de agrupamento INT <- classIntervals(pr@data[,9], n=5, style="equal")#Interavalo com a mesma distancia INT<-classIntervals(pr@data[,9], n=5, style="sd")#Desvios padrão (Recomendo dados Normais) INT<-classIntervals(pr@data[,9], n=5, style="fixed",fixedBreaks=c(0.4, 0.5, 0.7, 0.8, 0.9))#Fixado pelo pesquisador INT<-classIntervals(pr@data[,9], n=5, style="kmeans")#Método de clusterização (kmeans) INT<-classIntervals(pr@data[,9], style="hclust", method="complete")#Método de clusterização x11() par(mfrow=c(2,2)) #Intervalo Quantil CORES.5<-brewer.pal(5,"Spectral") INT <- classIntervals(pr@data[,9], n=5, style="quantile") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Intervalo Quantil") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Intervalo Igual CORES.5<-brewer.pal(5,"Spectral") INT <- classIntervals(pr@data[,9], n=5, style="equal") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Intervalo Igual") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Desvio Padrão CORES.5<-brewer.pal(5,"Spectral") INT <- classIntervals(pr@data[,9], n=5, style="sd") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Intervalo Desvio-Padrão") TB <- attr(COL, "table") legtext <- paste(names(TB), " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Fixado pelo pesquisador INT<-classIntervals(pr@data[,9], n=5, style="fixed",fixedBreaks=c(0.4,0.5,0.6,0.7, 0.8, 0.9)) CORES.5<-brewer.pal(5,"Spectral") COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("IDH 2010 - Intervalo Pesquisador") TB <- attr(COL, "table") legtext <- paste(names(TB), " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Criando o mapa de Probabilidade.......................................................................... #Acidente de Trânsito Paraná - Fonte Ipardes at<-read.table("./dados/At.csv",sep=";",header=T,encoding="latin1",dec=";") str(at) at<-at[,-2] #Nomes iguais? ld<-which(pr@data[,2]%in%at[,1]) pr@data[-ld,] #sim #Ordenando ind<-match(pr@data[,2],at[,1]) ind at<-at[ind,] row.names(at) <- row.names(pr@data) #pr <- spCbind(pr, at)#package #str(pr@data) #head(pr@data) #Dados de população load("./dados/pop.RData") str(pop) #Será usada a população de 2010 #Calculando o risco relativo (Acidentes de transito/Pop)........................................... #Verificando se estão na mesma ordem sum(at[,1]==rownames(pop)) #0? #Acentuação e Maiúscula at[,1]<-toupper(at[,1]) at[,1]<-iconv(at[,1], to = "ASCII//TRANSLIT") #Verificando de novo sum(at[,1]==rownames(pop))#9 - errado #Alguns ind<-match(at[,1],rownames(pop)) ind #Valores NA at[is.na(ind),1] rownames(pop)[which(is.na(ind))+2] #Igualando rownames(pop)[which(is.na(ind))+2]<-at[is.na(ind),1] #Todos na mesma ordem ind<-match(at[,1],rownames(pop)) ind pop<-pop[ind,] sum(at[,1]==rownames(pop))#399 - certo #Mapa com o risco relativo............................................... #utilizando a função Probmap do pacote spdep #probmap(Contagem,população, Significância) #help ?probmap head(at) mat<-probmap(at[,2],pop[,31],alternative="greater") x11() par(mfrow=c(2,2)) #Contagem Acidente CORES.5<-brewer.pal(5,"Reds") INT <- classIntervals(at[,2], n=5, style="fixed",fixedBreaks=c(0,10,100,500,1000,30000)) COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("Acidentes de trânsito 2010 - Intervalo Pesquisador") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Risco Relativo Contagem(i)/POP(i).......................................................... CORES.5<-brewer.pal(5,"Reds") INT <- classIntervals(mat[,1]*10000, n=5, style="fixed",fixedBreaks=c(0,5,10,25,50,200)) COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("Taxa Relativa por 10000 habitantes - Intervalo Pesquisador") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Risco estimado (Sum(Contagem)/Sum(POP))*POP(i) em que i = 1,.....399.......................... #mat[,2]#Risco estimado #summary(mat[,2]) CORES.5<-brewer.pal(5,"Reds") INT <- classIntervals(mat[,2], n=5, style="fixed",fixedBreaks=c(10,50,100,500,1000,15000)) COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("Risco Estimado - Intervalo Pesquisador") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Mapas Razão entre observado e esperado....................................................................... #summary(mat[,3]) CORES.5<-brewer.pal(5,"Reds") INT <- classIntervals(mat[,3], n=5, style="fixed",fixedBreaks=c(0,1,10,50,100,250)) COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("Risco relativo - Intervalo Pesquisador") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Mapa de Probabilidade - Poisson........................................... mat[,4]#Teste feito para probabilidades maiores da média str(mat) summary(at[,2]) plot(density(at[,2]),main="Densidade") #Outra palheta de cores mypalette<-rev(brewer.pal(3,"Greys"))[-3] mypalette2<-brewer.pal(3,"PuBu") cor<-c(mypalette,mypalette2) #?probmap #summary(at[,2]) #display.brewer.all() x11() par(mfrow=c(2,2)) CORES.5<-col INT <- classIntervals(mat[,4], n=5, style="fixed",fixedBreaks=c(0,0.05,0.1,0.9,0.95,1)) COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("Mapa de Probabilidade - Maior") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Mapa de probabilidade para valores baixos significativos................................................ matp<-probmap(at[,2],pop[,31],alternative="less") #matp[,4]# Teste feito para probabilidades menores head(at) CORES.5<-cor INT <- classIntervals(matp[,4], n=5, style="fixed",fixedBreaks=c(0,0.05,0.1,0.9,0.95,1)) COL <- findColours(INT, CORES.5) plot(pr, col=COL) title("Mapa de Probabilidade - Menor") TB <- attr(COL, "table") legtext <- paste(names(TB) , " (", TB, ")", sep="") legend("topright", fill=attr(COL, "palette"), legend=legtext, bty="n") #Método mapa de probabilidade tanto para baixos e altos siginifcativo ............................................ resCh <- choynowski(at[,2],pop[,31]) #str(resCh) #head(resCh) cols <- rep("white", length(resCh$pmap)) #Significativo cols[(resCh$pmap < 0.05) & (resCh$type)] <- "grey35" cols[(resCh$pmap < 0.05) & (!resCh$type)] <- "grey75" #resCh[,1] plot(pr, col=cols) title(main="Mapa de probabilidade de Choynowski") legend("bottomleft", fill=c("grey35", "white", "grey75"), legend=c("Abaixo", "N/S", "Acima"), bty="n") str(mat)