[R-br] Fwd: Representação de gráfico tipo torta em um shapefile [RESOLVIDO]
ASANTOS
alexandresantosbr em yahoo.com.br
Sexta Maio 30 15:36:38 BRT 2014
Boa tarde Éder,
GENIAL!!!!! Era isso mesmo que eu precisava, muito clara e
limpa sua programação, tinha conseguido achar o erro e usar
bacias em data$LEVEL2, mas na hora de desenhar as tortas, estava tentando
calcular os centroides das bacias com trueCentroids =
gCentroid(bacias2,byid=TRUE) do pacote GISTools e convertendo para um
novo shape e depois novamente para polígonos espaciais, tava ficando uma
gambiarra para desenhar as tortas, fico com a sua opção,
Muito Obrigado!!!
Alexandre
Em 30/05/2014 08:14, Éder Comunello escreveu:
> Alexandre, bom dia!
>
> Basicamente o erro está no vetor de identificadores que você definiu
> para unionSpatialPolygons(). Ao invés de 'Dissolve_bacia', bastaria
> entrar com "bacias em data$LEVEL2".
>
> Resolvi rodar o procedimento todo e obtive a figura abaixo. Obtive
> 'tortas' sem subdivisão, provavelmente porque tem bacias com a
> ocorrência de apenas um valor do atributo $CT.
>
>
>
>
>
> Disponibilizo o código que produzi e se for de ajuda, peço que
> disponibilize o produto final pra vermos como ficou. Comentei na
> medida do possível...
>
>
> ### <code r>
> setwd("C:/LAB/RGIS/maps/bacias")
> pkgs <- c("maptools", "shapefiles", "rgdal", "mapplots", "RColorBrewer")
> sapply(pkgs, require, character=T)
>
> ### Download
> ---------------------------------------------------------------- #
> links <- c(
> "https://www.dropbox.com/s/enrdm739ts4eba0/sa_bas_ll_r500m.shp",
> "https://www.dropbox.com/s/fnnumaix0v88jo1/sa_bas_ll_r500m.shx",
> "https://www.dropbox.com/s/o152vc0n15w54em/sa_bas_ll_r500m.dbf",
> "https://www.dropbox.com/s/2l24sso20645511/indv_atributos.csv")
>
> newLinks <- gsub("^.*/s/", "http://dl.dropbox.com/s/", links); newLinks
>
> vDown <- sum(sapply(newLinks, function(x) file.exists(basename(x))))
>
> if (vDown<4) {
> sapply(newLinks, function(a) {
> tryCatch(download.file(a, dest=basename(a), mode='wb'),
> error=function(...) print("Falha no download!"))})}
>
> sapply(basename(newLinks), file.info <http://file.info>)[1,] ### sizes
>
> ### Carregando shapefile
> ---------------------------------------------------- #
> CRS.new <- CRS("+proj=longlat +datum=WGS84")
> bacias.ori <- readOGR(".", "sa_bas_ll_r500m")
> proj4string(bacias.ori) <- CRS.new
>
> ### Visualização excessivamente demorada! Melhor utilizar o vetor
> simplificado!
> ### Os tempos anotados (s) foram tomados num netbook de configuração
> modesta.
> # system.time(plot(bacias.ori, col=topo.colors(32), border=NA)) ### 44s
>
> ### Entendendo os dados
> ----------------------------------------------------- #
> t(names(bacias.ori em data)) ### LEVELS c(5:10)
> sapply(bacias.ori em data[,c(3:10)], function(x) length(unique(x)))
> # SA_BAS_ SA_BAS_ID LEVEL1 LEVEL2 LEVEL3 LEVEL4 LEVEL5
> LEVEL6
> # 5339 5339 11 92 569 1775 2374
> 2430
> # ^ ^ ^ ^ ^ ^ ^
> ^
> # | | | | | | |
> |
> # Elementos Elementos MegaBacias Bacias Sub-Bacias Mini-Bacias
> Micro-Bacias Nano-Bacias
> # Lembrando que a escala acima é só uma brincadeira... :)
> #
> # São 5339 elementos (possivelmente todos polígonos) que podem ser
> retratados como 11 Grandes # Bacias ou 92 Bacias.
> # Quando você usa o cut() pra atribuir cor, na verdade o R desenha os
> 5339 elementos e
> # 'pinta' os que tem o mesmo rótulo com a mesma cor. Usando o
> unionSpatialPolygons() com
> # $LEVEL2 você passará a ter 92 polígonos.
> #
> # Na hora de locar as 'tortas' é outro problema, pois cada bacia do
> LEVEL2 é representada por
> # diversos polígonos, por vezes centenas, e você teria que escolher um
> desses polígonos ou #
> # obter a coordenda média desses.
>
> ### Simplificando
> ----------------------------------------------------------- #
> bacias.mod <- unionSpatialPolygons(bacias.ori, bacias.ori$LEVEL2) ###
> modIFICADO
> bacias <- rgeos::gSimplify(bacias.mod, .4, topologyPreserve=TRUE)
> # .4 degrees
> length(bacias.ori); length(bacias.mod); length(bacias)
> # system.time(plot(bacias.ori, col=topo.colors(32), border=NA)) ### 44s
> # system.time(plot(bacias.mod, col=topo.colors(32), border=NA)) ### 30s
> system.time(plot(bacias, col=topo.colors(32), border=NA)) ### 18s
>
> ### Info
> -------------------------------------------------------------------- #
> str(bacias, max=2)
> str(bacias em data) ### "SpatialPolygons" - Não tem @data!!!
> ### Podemos utilizar o @data original (bacias.ori)
> str(bacias.ori em data) ### "SpatialPolygonsDataFrame" - DATA!!!
> ### Continuaremos a utilizar bacia.ori para quantificações!
>
> ### Remover Polígonos menores
> ----------------------------------------------- #
> ### Esse trecho é para eliminar polígonos menores para fins de
> agilizar a visualização
> ### Deixo apenas pra referência. pois não teve muito efeito
> # subPolys <-sapply(bacias em polygons, function(a)
> sum(sapply(a em Polygons, length)))
> # table(subPolys)
> # subAreas <- lapply(bacias em polygons, function(a) sapply(a em Polygons,
> function(b) b em area))
> # sapply(subAreas, sum)
> # sum(sapply(subAreas, sum)<2)
> # str(bacias, max.level=3)
> # bigPolys <- which(sapply(subAreas, sum) >= 2); length(bigPolys)
> # BIG <- lapply(bigPolys, function(a) {bacias em polygons[[a]]});
> length(BIG)
> # bacias2 <- SpatialPolygons(BIG)
> # system.time(plot(bacias2, col=topo.colors(32), border=NA)) ### 18s
>
> ### Coordenadas dos pontos + atributos
> pontos <- read.csv("indv_atributos.csv", sep=";", head=T)
> names(pontos) <- c("num_loc", "LAT", "LON", "CT")
> coordinates(pontos) <- ~LON+LAT
> proj4string(pontos) <- CRS.new
>
> ### Pontos no mapa
> system.time(plot(bacias, col=topo.colors(32), border=NA)) ### 18s
> points(pontos)
>
> ### Pontos pertencentes a cada bacia nível 2 (LEVEL2)
> bacias em bbox; pontos em bbox
> id2 <- over(pontos, bacias.ori)$LEVEL2
> id2i <- id2[!is.na <http://is.na>(id2)] ### Inside Points; if outside
> == NA
>
> newData <- reshape2::dcast(pontos em data, id2i~CT, length,
> value.var='CT'); newData
> coords <- coordinates(bacias)
> coords.df <- data.frame(id2i=as.numeric(row.names(coords)), coords)
>
> newData2 <- merge(newData, coords.df); newData2
> ### Observe que em vários casos a torta terá apenas um valor!!!
>
> ### Adiciono o gráfico torta para cada pontos$LEVEL2 a frequencia de
> pontos$CT
> x11()
> system.time(plot(bacias, col=topo.colors(32), border=NA, axes=T)) ### 18s
> lapply(1:nrow(newData2), function(x)
> add.pie(z=as.numeric(newData[x,2:7]), x=newData2$X1[x],
> y=newData2$X2[x], radius=3, labels=" "))
>
> ### </code>
>
>
>
>
> Éder Comunello <c
> <mailto:comunello.eder em gmail.com>omunello.eder em gmail.com
> <mailto:omunello.eder em gmail.com>>
> Dourados, MS - [22 16.5'S, 54 49'W]
>
>
>
>
> _______________________________________________
> R-br mailing list
> R-br em listas.c3sl.ufpr.br
> https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br
> Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.
--
======================================================================
Alexandre dos Santos
Proteção Florestal
IFMT - Instituto Federal de Educação, Ciência e Tecnologia de Mato Grosso
Campus Cáceres
Caixa Postal 244
Avenida dos Ramires, s/n
Bairro: Distrito Industrial
Cáceres - MT CEP: 78.200-000
Fone: (+55) 65 8132-8112 (TIM) (+55) 65 9686-6970 (VIVO)
e-mails:alexandresantosbr em yahoo.com.br
alexandre.santos em cas.ifmt.edu.br
Lattes: http://lattes.cnpq.br/1360403201088680
======================================================================
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20140530/10767b45/attachment.html>
-------------- Próxima Parte ----------
Um anexo não-texto foi limpo...
Nome: não disponível
Tipo: image/png
Tamanho: 11110 bytes
Descrição: não disponível
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20140530/10767b45/attachment.png>
Mais detalhes sobre a lista de discussão R-br