<div dir="ltr">Alexandre, bom dia!<div><br></div><div>Basicamente o erro está no vetor de identificadores que você definiu para unionSpatialPolygons(). Ao invés de '<span style="font-family:arial,sans-serif;font-size:13px">Dissolve_bacia', bastaria entrar com "</span><span style="font-family:arial,sans-serif;font-size:13px">bacias@data$LEVEL2".</span></div>
<div><span style="font-family:arial,sans-serif;font-size:13px"><br></span></div><div><font face="arial, sans-serif">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. </font></div>
<div><font face="arial, sans-serif"><br></font></div><div><br></div><div><font face="arial, sans-serif"><div><img src="cid:ii_hvtg1j480_1464d04fec19ffbb" width="471.99999999999994" height="471.99999999999994"><br></div><div>
<br></div><div><br></div></font><span style="font-family:arial,sans-serif">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...</span></div>
<div><font face="arial, sans-serif"><br></font></div><div><font face="arial, sans-serif"><br></font></div><div><font face="courier new, monospace">### <code r></font></div><div><font face="courier new, monospace">setwd("C:/LAB/RGIS/maps/bacias")</font></div>
<div><font face="courier new, monospace">pkgs <- c("maptools", "shapefiles", "rgdal", "mapplots", "RColorBrewer")</font></div><div><font face="courier new, monospace">sapply(pkgs, require, character=T)</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Download ---------------------------------------------------------------- #</font></div><div><font face="courier new, monospace">links <- c(</font></div>
<div><font face="courier new, monospace">"<a href="https://www.dropbox.com/s/enrdm739ts4eba0/sa_bas_ll_r500m.shp">https://www.dropbox.com/s/enrdm739ts4eba0/sa_bas_ll_r500m.shp</a>",</font></div><div><font face="courier new, monospace">"<a href="https://www.dropbox.com/s/fnnumaix0v88jo1/sa_bas_ll_r500m.shx">https://www.dropbox.com/s/fnnumaix0v88jo1/sa_bas_ll_r500m.shx</a>",</font></div>
<div><font face="courier new, monospace">"<a href="https://www.dropbox.com/s/o152vc0n15w54em/sa_bas_ll_r500m.dbf">https://www.dropbox.com/s/o152vc0n15w54em/sa_bas_ll_r500m.dbf</a>",</font></div><div><font face="courier new, monospace">"<a href="https://www.dropbox.com/s/2l24sso20645511/indv_atributos.csv">https://www.dropbox.com/s/2l24sso20645511/indv_atributos.csv</a>")</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">newLinks <- gsub("^.*/s/", "<a href="http://dl.dropbox.com/s/">http://dl.dropbox.com/s/</a>", links); newLinks</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">vDown <- sum(sapply(newLinks, function(x) file.exists(basename(x))))</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">if (vDown<4) {</font></div><div><font face="courier new, monospace">sapply(newLinks, function(a) {</font></div><div><font face="courier new, monospace"> tryCatch(download.file(a, dest=basename(a), mode='wb'),</font></div>
<div><font face="courier new, monospace"> error=function(...) print("Falha no download!"))})}</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">sapply(basename(newLinks), <a href="http://file.info">file.info</a>)[1,] ### sizes</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Carregando shapefile ---------------------------------------------------- #</font></div><div><font face="courier new, monospace">CRS.new <- CRS("+proj=longlat +datum=WGS84")</font></div>
<div><font face="courier new, monospace">bacias.ori <- readOGR(".", "sa_bas_ll_r500m")</font></div><div><font face="courier new, monospace">proj4string(bacias.ori) <- CRS.new</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">### Visualização excessivamente demorada! Melhor utilizar o vetor simplificado!</font></div><div><font face="courier new, monospace">### Os tempos anotados (s) foram tomados num netbook de configuração modesta.</font></div>
<div><font face="courier new, monospace"># system.time(plot(bacias.ori, col=topo.colors(32), border=NA)) ### 44s</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Entendendo os dados ----------------------------------------------------- #</font></div>
<div><font face="courier new, monospace">t(names(bacias.ori@data)) ### LEVELS c(5:10)</font></div><div><font face="courier new, monospace">sapply(bacias.ori@data[,c(3:10)], function(x) length(unique(x)))</font></div><div>
<font face="courier new, monospace"># SA_BAS_ SA_BAS_ID LEVEL1 LEVEL2 LEVEL3 LEVEL4 LEVEL5 LEVEL6 </font></div><div><font face="courier new, monospace"># 5339 5339 11 92 569 1775 2374 2430 </font></div>
<div><font face="courier new, monospace"># ^ ^ ^ ^ ^ ^ ^ ^</font></div><div><font face="courier new, monospace"># | | | | | | | |</font></div>
<div><font face="courier new, monospace"># Elementos Elementos MegaBacias Bacias Sub-Bacias Mini-Bacias Micro-Bacias Nano-Bacias</font></div><div><font face="courier new, monospace"># Lembrando que a escala acima é só uma brincadeira... :)</font></div>
<div><font face="courier new, monospace">#</font></div><div><font face="courier new, monospace"># São 5339 elementos (possivelmente todos polígonos) que podem ser retratados como 11 Grandes # Bacias ou 92 Bacias.</font></div>
<div><font face="courier new, monospace"># Quando você usa o cut() pra atribuir cor, na verdade o R desenha os 5339 elementos e </font></div><div><font face="courier new, monospace"># 'pinta' os que tem o mesmo rótulo com a mesma cor. Usando o unionSpatialPolygons() com </font></div>
<div><font face="courier new, monospace"># $LEVEL2 você passará a ter 92 polígonos.</font></div><div><font face="courier new, monospace">#</font></div><div><font face="courier new, monospace"># Na hora de locar as 'tortas' é outro problema, pois cada bacia do LEVEL2 é representada por</font></div>
<div><font face="courier new, monospace"># diversos polígonos, por vezes centenas, e você teria que escolher um desses polígonos ou # </font></div><div><font face="courier new, monospace"># obter a coordenda média desses.</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Simplificando ----------------------------------------------------------- #</font></div><div><font face="courier new, monospace">bacias.mod <- unionSpatialPolygons(bacias.ori, bacias.ori$LEVEL2) ### modIFICADO</font></div>
<div><font face="courier new, monospace">bacias <- rgeos::gSimplify(bacias.mod, .4, topologyPreserve=TRUE) # .4 degrees</font></div><div><font face="courier new, monospace">length(bacias.ori); length(bacias.mod); length(bacias)</font></div>
<div><font face="courier new, monospace"># system.time(plot(bacias.ori, col=topo.colors(32), border=NA)) ### 44s</font></div><div><font face="courier new, monospace"># system.time(plot(bacias.mod, col=topo.colors(32), border=NA)) ### 30s</font></div>
<div><font face="courier new, monospace">system.time(plot(bacias, col=topo.colors(32), border=NA)) ### 18s</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Info -------------------------------------------------------------------- #</font></div>
<div><font face="courier new, monospace">str(bacias, max=2)</font></div><div><font face="courier new, monospace">str(bacias@data) ### "SpatialPolygons" - Não tem @data!!!</font></div><div><font face="courier new, monospace">### Podemos utilizar o @data original (bacias.ori)</font></div>
<div><font face="courier new, monospace">str(bacias.ori@data) ### "SpatialPolygonsDataFrame" - DATA!!!</font></div><div><font face="courier new, monospace">### Continuaremos a utilizar bacia.ori para quantificações!</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Remover Polígonos menores ----------------------------------------------- #</font></div><div><font face="courier new, monospace">### Esse trecho é para eliminar polígonos menores para fins de agilizar a visualização</font></div>
<div><font face="courier new, monospace">### Deixo apenas pra referência. pois não teve muito efeito</font></div><div><font face="courier new, monospace"># subPolys <-sapply(bacias@polygons, function(a) sum(sapply(a@Polygons, length)))</font></div>
<div><font face="courier new, monospace"># table(subPolys)</font></div><div><font face="courier new, monospace"># subAreas <- lapply(bacias@polygons, function(a) sapply(a@Polygons, function(b) b@area))</font></div><div>
<font face="courier new, monospace"># sapply(subAreas, sum)</font></div><div><font face="courier new, monospace"># sum(sapply(subAreas, sum)<2)</font></div><div><font face="courier new, monospace"># str(bacias, max.level=3)</font></div>
<div><font face="courier new, monospace"># bigPolys <- which(sapply(subAreas, sum) >= 2); length(bigPolys)</font></div><div><font face="courier new, monospace"># BIG <- lapply(bigPolys, function(a) {bacias@polygons[[a]]}); length(BIG)</font></div>
<div><font face="courier new, monospace"># bacias2 <- SpatialPolygons(BIG)</font></div><div><font face="courier new, monospace"># system.time(plot(bacias2, col=topo.colors(32), border=NA)) ### 18s</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">### Coordenadas dos pontos + atributos</font></div><div><font face="courier new, monospace">pontos <- read.csv("indv_atributos.csv", sep=";", head=T)</font></div>
<div><font face="courier new, monospace">names(pontos) <- c("num_loc", "LAT", "LON", "CT")</font></div><div><font face="courier new, monospace">coordinates(pontos) <- ~LON+LAT</font></div>
<div><font face="courier new, monospace">proj4string(pontos) <- CRS.new</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Pontos no mapa</font></div><div>
<font face="courier new, monospace">system.time(plot(bacias, col=topo.colors(32), border=NA)) ### 18s</font></div><div><font face="courier new, monospace">points(pontos)</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">### Pontos pertencentes a cada bacia nível 2 (LEVEL2)</font></div><div><font face="courier new, monospace">bacias@bbox; pontos@bbox</font></div><div><font face="courier new, monospace">id2 <- over(pontos, bacias.ori)$LEVEL2</font></div>
<div><font face="courier new, monospace">id2i <- id2[!<a href="http://is.na">is.na</a>(id2)] ### Inside Points; if outside == NA</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">newData <- reshape2::dcast(pontos@data, id2i~CT, length, value.var='CT'); newData</font></div>
<div><font face="courier new, monospace">coords <- coordinates(bacias)</font></div><div><font face="courier new, monospace">coords.df <- data.frame(id2i=as.numeric(row.names(coords)), coords)</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">newData2 <- merge(newData, coords.df); newData2</font></div><div><font face="courier new, monospace">### Observe que em vários casos a torta terá apenas um valor!!!</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### Adiciono o gráfico torta para cada pontos$LEVEL2 a frequencia de pontos$CT</font></div><div><font face="courier new, monospace">x11()</font></div>
<div><font face="courier new, monospace">system.time(plot(bacias, col=topo.colors(32), border=NA, axes=T)) ### 18s</font></div><div><font face="courier new, monospace">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=" "))</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">### </code></font></div><div><font face="arial, sans-serif"><br></font><div class="gmail_extra"><br></div><div class="gmail_extra">
<br></div><div class="gmail_extra"><br clear="all"><div><div dir="ltr">Éder Comunello <<a href="mailto:comunello.eder@gmail.com" target="_blank">c</a><a href="mailto:omunello.eder@gmail.com" target="_blank">omunello.eder@gmail.com</a>> <br>
Dourados, MS - [22 16.5'S, 54 49'W]<br></div></div>
<br><br></div></div></div>