I run a loop to get a map on each additional setup of my dataset and apply the appropriate palette (and corresponding legend), respectively.
People tend to dislike using for () loops and maximize the vectoriness of their approaches. I do not know how best to vectorize processes using this particular dataset.
In this particular case, I process a relatively large dataset (Atlas distribution types), which is especially complicated because different methodologies are used, and for each type it is necessary to transfer different options, taking into account a certain season, different observations, etc. Species may be present in one season and overlooked in another (they may be a breeder, resident or migrant). Maps should be created for all cases (seasons), empty if they are absent. Additional data (in addition to field work) can be accessed and used. The Legend map must take into account all options, in addition to presenting the variable as a percentage (number) in a user discrete scale.
By launching the cycle that I feel (in my limited experience), I can easily save and control several necessary objects, at the same time entering the stream that I created to create objects of interest, and, finally, creating sets of view distribution maps.
My problem is that I save every ggplot I get in the list () object. Each species in each season will be stored in a list. The problem I encountered is related to scale_fill_manual when used inside a loop .
The behavior is strange as I get cards, but with colors that apply only to the last output ggplot. However, all values āāare still correctly identified in the legend.
to illustrate:
Packages
if (!require(ggplot2)) install.packages("ggplot2",
repos = "http://cran.r-project.org"); library(ggplot2)
if (!require(grid)) install.packages("grid",
repos = "http://cran.r-project.org"); library(grid)
if (!require(RColorBrewer)) install.packages("RColorBrewer",
repos = "http://cran.r-project.org"); library(RColorBrewer)
if (!require(reshape)) install.packages("reshape",
repos = "http://cran.r-project.org"); library(reshape)
Simple example first
palette.l <- list()
palette.l[[1]] <- c('red', 'blue', 'green')
palette.l[[2]] <- c('pink', 'blue', 'yellow')
plot.l <- list()
for(i in 1:2){
plot.l[[i]] <- qplot(mpg, wt, data = mtcars, colour = factor(cyl)) +
scale_colour_manual(values = palette.l[[i]])
}
plot.l [1] .l [2].
ArrangeGraph <- function(..., nrow=NULL, ncol=NULL, as.table=FALSE) {
dots <- list(...)
n <- length(dots)
if(is.null(nrow) & is.null(ncol)) { nrow = floor(n/2) ; ncol = ceiling(n/nrow)}
if(is.null(nrow)) { nrow = ceiling(n/ncol)}
if(is.null(ncol)) { ncol = ceiling(n/nrow)}
grid.newpage()
pushViewport(viewport(layout=grid.layout(nrow,ncol)))
ii.p <- 1
for(ii.row in seq(1, nrow)) {
ii.table.row <- ii.row
if(as.table) {ii.table.row <- nrow - ii.table.row + 1}
for(ii.col in seq(1, ncol)) {
ii.table <- ii.p
if(ii.p > n) break
print(dots[[ii.table]], vp=VPortLayout(ii.table.row, ii.col))
ii.p <- ii.p + 1
}
}
}
ViewPort
VPortLayout <- function(x, y) viewport(layout.pos.row=x, layout.pos.col=y)
bd.aves.1 <- structure(list(quad = c("K113", "K114", "K114", "K114", "K114",...
due to limited body character number limit, please download entire code from
https:
list.esp.1 <- c("Sylv mela", "Saxi rube","Ocea leuc")
txcon.1 <- structure(list(id = c(156L, 359L, 387L), grupo = c("Aves", "Aves",
kSeason.1 <- c("Inverno", "Primavera", "Outono")
grid500.df.1 <- structure(list(id = c("K113", "K113", "K113", "K113", "K113",
Shoreline
coastline.df.1 <- structure(list(long = c(182554.963670234, 180518, 178865.39,
kFacx1 <- c(9000, -13000, -10000, -12000)
R
for(i in listsp.1) {
sist.i <- list()
nsist.i <- list()
breaks.nind.1 <- list()
spij.1 <- list()
classes.1 <- list()
cllevels.1 <- list()
palette.nind.1 <- list()
grid500ij.1 <- list()
map.dist.ij.1 <- NULL
for(j in 1:length(kSeason.1)) {
sist.i.tmp <- nrow(subset(bd.aves.1, esp == i & cod_tipo %in% sistematica &
periodo == kSeason.1[j]))
if (sist.i.tmp!= 0) {
sist.i[[j]]<- ddply(subset(bd.aves.1,
esp == i & cod_tipo %in% sistematica &
periodo == kSeason.1[j]),
.(periodo, quad), summarise, nind = sum(n_ind),
codnid = max(cod_nidi))
} else {
sist.i[[j]] <- data.frame('quad' = NA, 'periodo' = NA, 'nind' = NA,
'codnid' = NA, stringsAsFactors = F)
}
nsist.tmp.i = nrow(subset(bd.aves.1, esp == i & !cod_tipo %in% sistematica &
periodo == kSeason.1[j]))
if (nsist.tmp.i != 0) {
nsist.i[[j]] <- subset(bd.aves.1,
esp == i & !cod_tipo %in% sistematica &
periodo == kSeason.1[j] &
!quad %in% if (nrow(sist.i[[j]]) != 0) {
subset(sist.i[[j]],
select = quad)$quad
} else NA,
select = c(quad, periodo, cod_tipo, cod_nidi)
)
names(nsist.i[[j]])[4] <- 'codnid'
} else {
nsist.i[[j]] = data.frame('quad' = NA, 'periodo' = NA, 'cod_tipo' = NA,
'codnid' = NA, stringsAsFactors = F)
}
if (!is.na(sist.i[[j]]$nind[1])) {
breaks.nind.1[[j]] <- c(0,
unique(
ceiling(
quantile(unique(
subset(sist.i[[j]], is.na(nind) == F)$nind),
q = seq(0, 1, by = 0.25)))))
} else {
breaks.nind.1[[j]] <- 0
}
if (!is.na(sist.i[[j]]$nind[1])) {
spij.1[[j]] <- merge(unique(subset(grid500df.1, select = id)),
sist.i[[j]],
by.x = 'id', by.y = 'quad', all.x = T)
spij.1[[j]]$nind[is.na(spij.1[[j]]$nind) == T] <- 0
spij.1[[j]]$cln <- if (length(breaks.nind.1[[j]]) > 2) {
cut(spij.1[[j]]$nind, breaks = breaks.nind.1[[j]],
include.lowest = T, right = F)
} else {
cut2(spij.1[[j]]$nind, g = 2)
}
classes.1[[j]] = nlevels(spij.1[[j]]$cln)
cllevels.1[[j]] = levels(spij.1[[j]]$cln)
if (length(breaks.nind.1[[j]]) > 2) {
palette.nind.1[[paste(kSeason.1[j])]] = c("#FFFFFF", brewer.pal(length(
cllevels.1[[j]]) - 1, "YlOrRd"))
} else {
palette.nind.1[[paste(kSeason.1[j])]] = c(
"#FFFFFF", brewer.pal(3, "YlOrRd"))[1:classes.1[[j]]]
}
names(palette.nind.1[[paste(kSeason.1[j])]])[1 : length(
palette.nind.1[[paste(kSeason.1[j])]])] <- cllevels.1[[j]]
palette.nind.1[[paste(kSeason.1[j])]][length(
palette.nind.1[[paste(kSeason.1[j])]]) + 1] <- '#CCC5AF'
names(palette.nind.1[[paste(kSeason.1[j])]])[length(
palette.nind.1[[paste(kSeason.1[j])]])] <- 'Suplementar'
palette.nind.1[[paste(kSeason.1[j])]][length(
palette.nind.1[[paste(kSeason.1[j])]]) + 1] <- '#ADCCD7'
names(palette.nind.1[[paste(kSeason.1[j])]])[length(
palette.nind.1[[paste(kSeason.1[j])]])] <- 'Bibliografia'
grid500ij.1[[j]] <- subset(grid500df.1, select = c(id, long, lat, order))
grid500ij.1[[j]]$cln = merge(grid500ij.1[[j]],
spij.1[[j]],
by.x = 'id', by.y = 'id', all.x = T)$cln
levels(grid500ij.1[[j]]$cln) <- c(levels(grid500ij.1[[j]]$cln), 'Suplementar',
'Bibliografia')
if (!is.na(nsist.i[[j]]$quad[1])) {
grid500ij.1[[j]]$cln[grid500ij.1[[j]]$id %in% subset(
nsist.i[[j]], cod_tipo == 'RS1', select = quad)$quad] <- 'Suplementar'
grid500ij.1[[j]]$cln[grid500ij.1[[j]]$id %in% subset(
nsist.i[[j]], cod_tipo == 'biblio', select = quad)$quad] <- 'Bibliografia'
}
} else {
if (!is.na(nsist.i[[j]]$quad[1])) {
grid500ij.1[[j]] <- grid500df
grid500ij.1[[j]]$cln <- '0'
grid500ij.1[[j]]$cln <- factor(grid500ij.1[[j]]$cln)
levels(grid500ij.1[[j]]$cln) <- c(levels(grid500ij.1[[j]]$cln),
'Suplementar', 'Bibliografia')
grid500ij.1[[j]]$cln[grid500ij.1[[j]]$id %in% subset(
nsist.i[[j]], cod_tipo == 'RS1',
select = quad)$quad] <- 'Suplementar'
grid500ij.1[[j]]$cln[grid500ij.1[[j]]$id %in% subset(
nsist.i[[j]],cod_tipo == 'biblio',
select = quad)$quad] <- 'Bibliografia'
} else {
grid500ij.1[[j]] <- grid500df
grid500ij.1[[j]]$cln <- '0'
grid500ij.1[[j]]$cln <- factor(grid500ij.1[[j]]$cln)
levels(grid500ij.1[[j]]$cln) <- c(levels(grid500ij.1[[j]]$cln),
'Suplementar', 'Bibliografia')
}
}
if (!is.na(sist.i[[j]]$nind[1])) {
map.dist.ij.1[[paste(kSeason.1[j])]] <- ggplot(grid500ij.1[[j]],
aes(x = long, y = lat)) +
geom_polygon(aes(group = id, fill = cln), colour = 'grey80') +
coord_equal() +
scale_x_continuous(limits = c(100000, 180000)) +
scale_y_continuous(limits = c(-4000, 50000)) +
scale_fill_manual(
name = paste("LEGEND",
'\nSeason: ', kSeason.1[j],
'\n% of Occupied Cells : ',
sprintf("%.1f%%", (length(unique(
grid500ij.1[[j]]$id[grid500ij.1[[j]]$cln != levels(
grid500ij.1[[j]]$cln)[1]]))/12)*100),
sep = ""
),
limits = names(palette.nind.1[[j]])[2:length(names(palette.nind.1[[j]]))],
values = palette.nind.1[[j]][2:length(names(palette.nind.1[[j]]))],
drop = F) +
opts(
panel.background = theme_rect(),
panel.grid.major = theme_blank(),
panel.grid.minor = theme_blank(),
axis.ticks = theme_blank(),
title = txcon.1$especie[txcon.1$esp == i],
plot.title = theme_text(size = 10, face = 'italic'),
axis.text.x = theme_blank(),
axis.text.y = theme_blank(),
axis.title.x = theme_blank(),
axis.title.y = theme_blank(),
legend.title = theme_text(hjust = 0,size = 10.5),
legend.text = theme_text(hjust = -0.2, size = 10.5)
) +
geom_path(inherit.aes = F, aes(x = long, y = lat),
data = coastline.df.1, colour = "#997744") +
geom_point(inherit.aes = F, aes(x = x, y = y), colour = 'grey20',
data = localidades, size = 2) +
geom_text(inherit.aes = F, aes(x = x, y = y, label = c('Burgau',
'Sagres')),
colour = "black",
data = data.frame(x = c(142817 + kFacx1[1], 127337 + kFacx1[4]),
y = c(11886, 3962), size = 3))
} else {
map.dist.ij.1[[paste(kSeason.1[j])]] <- ggplot(grid500ij.1[[j]],
aes(x = long, y = lat)) +
geom_polygon(aes.inherit = F, aes(group = id, fill = cln),
colour = 'grey80') +
coord_equal() +
scale_x_continuous(limits = c(100000, 40000)) +
scale_y_continuous(limits = c(-4000, 180000)) +
scale_fill_manual(
name = paste('LEGENDA',
'\nSeason: ', kSeason.1[j],
'\n% of Occupied Cells :',
sprintf("%.1f%%", (length(unique(
grid500ij.1[[j]]$id[grid500ij.1[[j]]$cln != levels(
grid500ij.1[[j]]$cln)[1]]))/12 * 100)),
sep = ''),
limits = names(kPaletaNsis)[2:length(names(kPaletaNsis))],
values = kPaletaNsis[2:length(names(kPaletaNsis))],
drop = F) +
opts(
panel.background = theme_rect(),
panel.grid.major = theme_blank(),
panel.grid.minor = theme_blank(),
title = txcon.1$especie[txcon.1$esp == i],
plot.title = theme_text(size = 10, face = 'italic'),
axis.ticks = theme_blank(),
axis.text.x = theme_blank(),
axis.text.y = theme_blank(),
axis.title.x = theme_blank(),
axis.title.y = theme_blank(),
legend.title = theme_text(hjust = 0,size = 10.5),
legend.text = theme_text(hjust = -0.2, size = 10.5)
) +
geom_path(inherit.aes = F, data = coastline.df.1,
aes(x = long, y = lat),
colour = "#997744") +
geom_point(inherit.aes = F, aes(x = x, y = y),
colour = 'grey20',
data = localidades, size = 2) +
geom_text(inherit.aes = F, aes(x = x, y = y,
label = c('Burgau', 'Sagres')),
colour = "black",
data = data.frame(x = c(142817 + kFacx1[1],
127337 + kFacx1[4],),
y = c(11886, 3962)),
size = 3)
}
}
png(file = paste('panel_species',i,'.png', sep = ''), res = 96,
width = 800, height = 800)
ArrangeGraph(map.dist.ij.1[[paste(kSeason.1[3])]],
map.dist.ij.1[[paste(kSeason.1[2])]],
map.dist.ij.1[[paste(kSeason.1[1])]],
ncol = 2, nrow = 2)
dev.off()
graphics.off()
}
map.dist.ij.1 [[paste (kSeason.1 [3])]] , , j-.
R-

, , .
, . .