Converting (alpha) hulls to spatial polygon - r

In R, I wish to convert the alpha shape polygon surrounding a bunch of points into one single spatial polygon object.
library(sf)
library(alphahull)
To start out, I create the point random points distribution
dat <- matrix(c(1,2,3,4,5, 3,3,5,6,9), ncol = 2)
I find the alpha shape covering the points (i.e. a polygon encompassing all points). I am particularly interested in this function as it has the feature to find a more or less tight polygon shape according to the given alpha
dat.ashape<- ashape(dat, alpha= 7)
I take the coordinates of the extreme
coords<- dat.ashape$x[dat.ashape$alpha.extreme,]
I make the last point same as the first (to have a closed shape)
coords<- rbind(coords, coords[1,])
To make things to work I need to order the point in sequence
coords<- cbind(coords, NA)
coords[,3]<- c(1, 5, 3, 2, 4, 6)
coords<- coords[order(coords[,3]),]
I create the simple spatial point feature from the coordinate matrix
dat.sf <- st_multipoint(coords, dim = "XYZ")
... and create the polygon
tst<- dat.sf %>% #
st_cast('POLYGON')
Finally, comparing the point and shape distribution and the polygon, I was able to build the polygon correctly, but this is rather easy with six points! (Because I made myself manually the right order)
plot(dat.ashape)
plot(tst, add=T, col=adjustcolor('red', alpha.f=.3), border=2)
In a more sophisticated example with say 100 points, I get stuck in the part where I should get the sequence of points right, before st_cast into polygon.
set.seed(1)
dat <- matrix(stats::rnorm(100), ncol = 2)
dat.ashape<- ashape(dat, alpha=7)
coords<- dat.ashape$x[dat.ashape$alpha.extreme,]
coords<- rbind(coords, coords[1,])
dat.sf <- st_multipoint(coords, dim = "XY")
tst <- dat.sf %>%
st_cast('POLYGON')
plot(dat.ashape)
plot(tst, add=T, col=adjustcolor('red', alpha.f=.3), col.line='red', border=2)
.... and I obviously do not get trick done.
I am grateful for any help!

OK, I was not happy with the concaveman. I really wanted the Delaunay triangulation as basis of my hull computation as I like alphahull a lot. Also, after reading this I wanted to find a (or my) viable way for converting the hull retrieved from alphahull package to a spatial polygon, which I could further use for my broader spatial analysis. Therefore I wrote the following function to do the job:
hull2poly <- function(my.ashape){
require(sf)
if(class(my.ashape) != "ashape") {stop('error, your input must be
ashape class')} else
my.edge<- data.frame(my.ashape$edges)[,c( 'x1', 'y1', 'x2', 'y2')]
x<- my.edge[,1:2]
y<- my.edge[,3:4]
my.edge2<- matrix(t(cbind(x,y)), byrow=T,ncol=2)
my.edge2<- as.data.frame(my.edge2)
names(my.edge2)<- c('x','y')
my.edge2$id <- unlist(lapply((1: (nrow(my.edge2)/2)),
FUN=function(x){c(rep(x,2))}))
start.edge<- 1
new.id<- start.edge
new.edges<- my.edge2[which(my.edge2$id== start.edge ),]
while(length(new.id)<= length(unique(my.edge2$id))-1){
internal.id<- new.id[length(new.id)]
edge <- my.edge2[which(my.edge2$id== internal.id ),]
where.to.search <- my.edge2[which(my.edge2$id %in% new.id ==F ),]
index1<- apply(where.to.search[,1:2], 1, function(x){x == edge[1,1:2]})
index1<- as.numeric(names(which(apply(index1,2, sum)>0)))[1]
index2<- apply(where.to.search[,1:2], 1, function(x){x == edge[2,1:2]})
index2<- as.numeric(names(which(apply(index2,2, sum)>0)))[1]
main.index<- c(index1, index2)
ifelse(all(!is.na(main.index)),
# yes
{flag<- c(T,T)
main.index<- main.index[2]
point.coord<- my.edge2[main.index,]
segment<- my.edge2[my.edge2$id==my.edge2[main.index,'id'],]
new.id<- c( new.id, my.edge2[main.index,]$id) },
# no
ifelse(which(!is.na(main.index))==1,
# yes
{flag<- c(T,F)
main.index<- main.index[flag]
point.coord<- my.edge2[main.index,]
segment<-
my.edge2[my.edge2$id==my.edge2[main.index,'id'],]
new.id<- c( new.id, my.edge2[main.index,]$id)},
# no
{flag<- c(F,T)
main.index<- main.index[flag]
point.coord<- my.edge2[main.index,]
segment<- my.edge2[my.edge2$id==my.edge2[main.index,'id'],]
new.id<- c( new.id, my.edge2[main.index,]$id)} ) )
index3<- t(apply(segment, 1, function(x){x ==point.coord}))
new.edges<- rbind(new.edges, rbind(point.coord, segment[which(apply(index3,1, sum)<3),]))
}
tst <- st_multipoint(as.matrix(new.edges), dim = "XYZ")
poly<- tst %>% #
st_cast('POLYGON')
return(poly)}
So, if you wish to give a try with a cloud of 1000 points:
library(alphahull)
set.seed(1)
dat <- matrix(stats::rnorm(1000), ncol = 2)
dat <- as.data.frame(dat)
dat.ashape<- ashape(dat, alpha= 2)
tmp<- hull2poly(dat.ashape)
plot(tmp)
I hope, it comes useful for someone.

Searching for further alternatives to packages alphahull, rgeos, sf for computing the hull surrounding a bunch of points, I finally found concaveman thanks to this post, which does the trick, being compatible with sf objects.
library(concaveman)
library(sf)
set.seed(1)
dat <- matrix(stats::rnorm(100), ncol = 2)
dat <- as.data.frame(dat)
names(dat)<- c('x', 'y')
dat.sf<-st_as_sf(dat, coords=c("x","y"))
polygon <- concaveman(dat.sf)
plot(dat.sf, pch=16)
plot(polygon, add=T, col=adjustcolor('red', alpha.f=.3), col.line='red', border=2)

The other answer wouldn't work for my dataset so I found another way.
First I used the coordinate pairs to create the line segments of the alpha shape. Then I just bound those line segments together and converted that to a polygon.
library(sp)
library(sf)
library(alphahull)
dat.ashape<- ashape(dat, alpha=7)
a<- data.frame(dat.ashape$edges)[,c( 'x1', 'y1', 'x2', 'y2')]
# create first line segment to initialize the object
i=1
line_obj <- sp::Line(cbind( c(a$x1[i], a$x2[i]),c(a$y1[i], a$y2[i]) ))
lines_obj <- sp::Lines(list(line_obj),ID=i)
myLines <- sp::SpatialLines(list(lines_obj))
for (i in 2:nrow(a)){
line_obj <- sp::Line(cbind( c(a$x1[i], a$x2[i]),c(a$y1[i], a$y2[i]) ))
lines_obj <- sp::Lines(list(line_obj),ID=i)
myLines <- rbind(myLines, sp::SpatialLines(list(lines_obj))) #bind the line to the rest
}
sfL<-as(myLines, "sf") #convert lines to sf
alphapoly = st_collection_extract(st_polygonize(st_union(sfL))) # union the lines and convert to polygon
apol<-as_Spatial(alphapoly) #if you want to convert back to sp
library(leaflet) #plot the line segments and polygon in Leaflet
leaflet() %>% addTiles() %>% addPolygons(data=apol) %>% addPolylines(data=myLines, color="yellow")

Related

How to define an area at +- 1 along a road?

Considering a geographical line defined by the following spatiallinedataframe
library(sp)
library(rgeos)
## from the sp vignette:
l1 <- cbind(c(1, 2, 3), c(3, 2, 2))
Sl1 <- Line(l1)
S1 <- Lines(list(Sl1), ID = "a")
Sl <- SpatialLines(list(S1))
## sample data: line lengths
df <- data.frame(len = sapply(1:length(Sl), function(i) gLength(Sl[i, ])))
rownames(df) <- sapply(1:length(Sl), function(i) Sl#lines[[i]]#ID)
## SpatialLines to SpatialLinesDataFrame
Sldf <- SpatialLinesDataFrame(Sl, data = df)
plot(Sldf)
I want to build a spatialpolygon that reaches exactly 1 all around this line, like an "area of influence".
My first guess was to use elide() from the maptools package and shift the line by +-1, but I need to have every corner taken care of. Second guess was to build discs of array one along the line and merge them, but that sounds too much 'gas-factory' to be good.
Using gBuffer from rgeos (thanks Henrik), it works
surf <- gBuffer(spgeom=Sldf,width=1)
plot(surf,add=T)

Reverse cluster analysis; identifying empty space or a lack of density in R with longitude and latitude?

I'm working on a project where I have a very large amount of points and I am looking to identify regions (defined by a lack of clustering) where the density of these points is statistically significantly less relative to others. Normally a visual would be enough but I have so many points that it is to difficult to tell where these empty spaces are and a density heat map doesn't help me zero in on smaller regions. Maybe I'm missing something very simpler here, but I am hoping someone can at least send me in the right direction of where to look. Below is a reproducible sample quick and dirty lets take these points from open data and map them to the borough file for NYC:
#libraries--------------------------
library(ggplot2)
library(ggmap)
library(sp)
library(jsonlite)
library(RJSONIO)
library(rgdal)
#call api data--------------------------
df = fromJSON("https://data.cityofnewyork.us/resource/24t3-xqyv.json?$query= SELECT Lat, Long_")
df <- data.frame(t(matrix(unlist(df),nrow=length(unlist(df[1])))))
names(df)[names(df) == 'X2'] = 'x'
names(df)[names(df) == 'X1'] = 'y'
df = df[, c("x", "y")]
df$x = as.numeric(as.character(df$x))
df$y = as.numeric(as.character(df$y))
df$x = round(df$x, 4)
df$y = round(df$y, 4)
df$x[df$x < -74.2] = NA
df$y[df$y < 40.5] = NA
df = na.omit(df)
#map data----------------------------
cd = readOGR("nybb.shp", layer = "nybb")
cd = spTransform(cd, CRS("+proj=longlat +datum=WGS84"))
cd_f = fortify(cd)
#map data
nyc = ggplot() +
geom_polygon(aes(x=long,
y=lat, group=group), fill='grey',
size=.2,color='black', data=cd_f, alpha=1)
nyc + geom_point(aes(x = x, y = y), data = df, size = 1)
#how would I go about finding the empty spaces? That is the regions where there are no clusters?
In this case there aren't a lot of points but for the sake of demonstration, how would I:
identify pockets of low density
potentially draw polygon boundaries on those pockets?
Appreciate the help!
One way to get polygonal areas of low density would be to construct the
Dirichlet/Voronoi tesselation and choose the largest ones.
Below I use spatstat and deldir (loaded by spatstat) to do this.
It is not so fast so with many more points I don't know how well it will
go.
To use the results in ggmap and other spatial packages you can convert
back from owin and ppp to the spatial classes from sp and use
spTransform to get lat, long coordinates.
First load the packages:
library(maptools)
library(spatstat)
library(jsonlite)
Map and points in coordinates of shapefile (note I read in data from
local files downloaded from www):
cd = readOGR("nybb.shp", layer = "nybb")
#> OGR data source with driver: ESRI Shapefile
#> Source: "nybb.shp", layer: "nybb"
#> with 5 features
#> It has 4 fields
df <- fromJSON("NYC_data.json")
df <- as.data.frame(matrix(as.numeric(unlist(df)), ncol = 2, byrow = TRUE))
df <- df[, c(2, 1)]
names(df) <- c("x", "y")
df <- df[df$x > -74.2 & df$y > 40.5, ]
coordinates(df) <- ~x+y
proj4string(df) <- CRS("+proj=longlat +datum=WGS84")
df2 <- spTransform(df, proj4string(cd))
Switch to spatstat classes:
cd2 <- as(cd, "SpatialPolygons")
W <- as(cd2, "owin")
X <- as(df2, "ppp")
Window(X) <- W
plot(X, main = "")
Compute Dirichlet tessellation and areas and plot the tessellation:
d <- dirichlet(X)
#> Warning: 96 duplicated points were removed
a <- tile.areas(d)
plot(d, main = "")
Combine the n_areas biggest areas of the tessellation:
n_areas <- 30
empty <- tess(tiles = d$tiles[tail(order(a), n = n_areas)])
empty2 <- as.owin(empty)
Plot the result:
plot(W, main = "")
plot(empty2, col = "red", add = TRUE)
plot(X, add = TRUE)

Calculate the distance between two points of two datasets (nearest neighbor)

I want to calculate the distance between two points in two different datasets. I don't want to calculate the distance between all points - just to the nearest point of datasetB.
Some examples:
Dataset A - Persons
http://pastebin.com/HbaeqACi
Dataset B - Waterfeatures:
http://pastebin.com/UdDvNtHs
Dataset C - City:
http://pastebin.com/nATnkMRk
So...I want to calculate the distance of each person to the nearest waterfeature point.
I've already tried to work with the rgeos package and after struggling with some projections errors, I've got it to work. But this calculate (at least I assume it) all distances to every point, but, as already said, I've only interested in the distance to the nearest waterfeature point.
# load csv files
persons = read.csv("persons.csv", header = TRUE)
water = read.csv("water.csv", header = TRUE)
# change dataframes to SpatialPointDataFrame and assign a projection
library(sp)
library(rgeos)
coordinates(persons) <- c("POINT_X", "POINT_Y")
proj4string(persons) <- CRS("+proj=utm +datum=WGS84")
coordinates(water) <- c("POINT_X", "POINT_Y")
proj4string(water) <- CRS("+proj=utm +datum=WGS84")
# use rgoes package to calculate the distance
distance <- gDistance(persons, water, byid=TRUE)
# works, but calculates a huge number of distances
Is there any parameter, which I've missed. Or do I need to use another package or function? I've also looked at spatstat, which is able to calculate the distance to the nearest neighbor, but not of two different datasets: http://hosho.ees.hokudai.ac.jp/~kubo/Rdoc/library/spatstat/html/nndist.html
Edit:
The complete R-Script including plotting of the datasets:
library(RgoogleMaps)
library(ggplot2)
library(ggmap)
library(sp)
library(fossil)
#load data
persons = read.csv("person.csv", header = TRUE, stringsAsFactors=FALSE)
water = read.csv("water.csv", header =TRUE, stringsAsFactors=FALSE)
city = read.csv("city.csv", header =TRUE)
# plot data
persons_ggplot2 <- persons
city_ggplot2 <- city
water_ggplot2 <- water
gc <- geocode('new york, usa')
center <- as.numeric(gc)
G <- ggmap(get_googlemap(center = center, color = 'bw', scale = 1, zoom = 11, maptype = "terrain", frame=T), extent="device")
G1 <- G + geom_point(aes(x=POINT_X, y=POINT_Y ),data=city, shape = 22, color="black", fill = "yellow", size = 4) + geom_point(aes(x=POINT_X, y=POINT_Y ),data=persons, shape = 8, color="red", size=2.5) + geom_point(aes(x=POINT_X, y=POINT_Y ),data=water_ggplot2, color="blue", size=1)
plot(G1)
#### calculate distance
# Generate unique coordinates dataframe
UniqueCoordinates <- data.frame(unique(persons[,4:5]))
UniqueCoordinates$Id <- formatC((1:nrow(UniqueCoordinates)), width=3,flag=0)
# Generate a function that looks for the closest waterfeature for each id coordinates
NearestW <- function(id){
tmp <- UniqueCoordinates[UniqueCoordinates$Id==id, 1:2]
WaterFeatures <- rbind(tmp,water[,2:3])
tmp1 <- earth.dist(WaterFeatures, dist=TRUE)[1:(nrow(WaterFeatures)-1)]
tmp1 <- which.min(tmp1)
tmp1 <- water[tmp1,1]
tmp1 <- data.frame(tmp1, WaterFeature=tmp)
return(tmp1)
}
#apply to each id and the merge
CoordinatesWaterFeature <- ldply(UniqueCoordinates$Id, NearestW)
persons <- merge(persons, CoordinatesWaterFeature, by.x=c(4,5), by.y=c(2,3))
What about writing a function that looks for the nearest waterfeature for every person?
#requires function earth.dist from "fossil" package
require(fossil)
#load data
persons = read.csv("person.csv", header = TRUE, stringsAsFactors=FALSE)
water = read.csv("water.csv", header =TRUE, stringsAsFactors=FALSE)
#Generate unique coordinates dataframe
UniqueCoordinates <- data.frame(unique(persons[,4:5]))
UniqueCoordinates$Id <- formatC((1:nrow(UniqueCoordinates)), width=3,flag=0)
#Generate a function that looks for the closest waterfeature for each id coordinates
NearestW <- function(id){
tmp <- UniqueCoordinates[UniqueCoordinates$Id==id, 1:2]
WaterFeatures <- rbind(tmp,water[,2:3])
tmp1 <- earth.dist(WaterFeatures, dist=TRUE)[1:(nrow(WaterFeatures)-1)]
tmp1 <- min(tmp1)
tmp1 <- data.frame(tmp1, WaterFeature=tmp)
return(tmp1)
}
#apply to each id and the merge
CoordinatesWaterFeature <- ldply(UniqueCoordinates$Id, NearestW)
persons <- merge(persons, CoordinatesWaterFeature, by.x=c(4,5), by.y=c(2,3))
NOTE: I've added a stringsAsFactors parameter to the original read.csv , it make the merging easier at the end
NOTE:Column tmp1 notes the number of METERS to the nearest water feature
Maybe I'm a little too late, but you can use spatstat to compute distances between two different datasets. The command is nncross. The arguments you have to use are two objects of type ppp, which you can create using the as.ppp() function.

get coordinates of a patch in a raster map (raster package in R)

I have a raster map with many patches (clumps of continguous cells with the same value). What I need to do is to obtain the coordinates of the center (or close to the center) of each patch.
I am very unexperienced with raster package but it seems I can get coordinates only if I know the position of the cells in the map. Is there any way to get coordinates giving a value of the cells instead? Thank you
If by patch you mean clumps, Raster package allows you to find , and isolate, clumps. Taking the clump() raster package example, and extending it:
library(raster)
library(igraph)
detach("package:coin", unload=TRUE)
r <- raster(ncols=12, nrows=12)
set.seed(0)
r[] <- round(runif(ncell(r))*0.7 )
rc <- clump(r)
clump_id <- getValues(rc)
xy <- xyFromCell(rc,1:ncell(rc))
df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1])
df[df$is_clump == T, ]
plot(r)
plot(rc)
text(df[df$is_clump == T, 1:2], labels = df[df$is_clump == T, 3])
May not be as interesting as you could expect.
You do it all over with directions = 4
rc <- clump(r, directions = 4)
clump_id <- getValues(rc)
xy <- xyFromCell(rc,1:ncell(rc))
df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1])
df[df$is_clump == T, ]
to get
and maybe clump 'centroids'
dfm <- ddply(df[df$is_clump == T, ], .(clump_id), summarise, xm = mean(x), ym = mean(y))
plot(rc)
text(dfm[, 2:3], labels = dfm$clump_id)
Notes:
There will be an error if you try to use clump() without first
detach modeltools library. modeltools is called by coin and maybe
other statistical libraries.
You could take the mean of the coordinates of each patch:
# some dummy data
m <- matrix(c(
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,
0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,
0,0,2,3,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), nrow=20, byrow=T)
# create a raster
r <- raster(m)
# convert raster to points
p <- data.frame(rasterToPoints(r))
# filter out packground
p <- p[p$layer > 0,]
# for each patch calc mean coordinates
sapply(split(p[, c("x", "y")], p$layer), colMeans)

world map - map halves of countries to different colors

I am using the example here for discussion:
ggplot map with l
library(rgdal)
library(ggplot2)
library(maptools)
# Data from http://thematicmapping.org/downloads/world_borders.php.
# Direct link: http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip
# Unpack and put the files in a dir 'data'
gpclibPermit()
world.map <- readOGR(dsn="data", layer="TM_WORLD_BORDERS_SIMPL-0.3")
world.ggmap <- fortify(world.map, region = "NAME")
n <- length(unique(world.ggmap$id))
df <- data.frame(id = unique(world.ggmap$id),
growth = 4*runif(n),
category = factor(sample(1:5, n, replace=T)))
## noise
df[c(sample(1:100,40)),c("growth", "category")] <- NA
ggplot(df, aes(map_id = id)) +
geom_map(aes(fill = growth, color = category), map =world.ggmap) +
expand_limits(x = world.ggmap$long, y = world.ggmap$lat) +
scale_fill_gradient(low = "red", high = "blue", guide = "colorbar")
Gives the following results:
I would like to map one variable to the left "half" of a country and a different variable to the right "half" of the country. I put "half" in quotes because it's not clearly defined (or at least I'm not clearly defining it). The answer by Ian Fellows might help (which gives an easy way to get the centroid). I'm hoping for something so that I can do aes(left_half_color = growth, right_half_color = category) in the example. I'm also interested in top half and bottom half if that is different.
If possible, I would also like to map the individual centroids of the halves to something.
This is a solution without ggplot that relies on the plot function instead. It also requires the rgeos package in addition to the code in the OP:
EDIT Now with 10% less visual pain
EDIT 2 Now with centroids for east and west halves
library(rgeos)
library(RColorBrewer)
# Get centroids of countries
theCents <- coordinates(world.map)
# extract the polygons objects
pl <- slot(world.map, "polygons")
# Create square polygons that cover the east (left) half of each country's bbox
lpolys <- lapply(seq_along(pl), function(x) {
lbox <- bbox(pl[[x]])
lbox[1, 2] <- theCents[x, 1]
Polygon(expand.grid(lbox[1,], lbox[2,])[c(1,3,4,2,1),])
})
# Slightly different data handling
wmRN <- row.names(world.map)
n <- nrow(world.map#data)
world.map#data[, c("growth", "category")] <- list(growth = 4*runif(n),
category = factor(sample(1:5, n, replace=TRUE)))
# Determine the intersection of each country with the respective "left polygon"
lPolys <- lapply(seq_along(lpolys), function(x) {
curLPol <- SpatialPolygons(list(Polygons(lpolys[x], wmRN[x])),
proj4string=CRS(proj4string(world.map)))
curPl <- SpatialPolygons(pl[x], proj4string=CRS(proj4string(world.map)))
theInt <- gIntersection(curLPol, curPl, id = wmRN[x])
theInt
})
# Create a SpatialPolygonDataFrame of the intersections
lSPDF <- SpatialPolygonsDataFrame(SpatialPolygons(unlist(lapply(lPolys,
slot, "polygons")), proj4string = CRS(proj4string(world.map))),
world.map#data)
##########
## EDIT ##
##########
# Create a slightly less harsh color set
s_growth <- scale(world.map#data$growth,
center = min(world.map#data$growth), scale = max(world.map#data$growth))
growthRGB <- colorRamp(c("red", "blue"))(s_growth)
growthCols <- apply(growthRGB, 1, function(x) rgb(x[1], x[2], x[3],
maxColorValue = 255))
catCols <- brewer.pal(nlevels(lSPDF#data$category), "Pastel2")
# and plot
plot(world.map, col = growthCols, bg = "grey90")
plot(lSPDF, col = catCols[lSPDF#data$category], add = TRUE)
Perhaps someone can come up with a good solution using ggplot2. However, based on this answer to a question about multiple fill scales for a single graph ("You can't"), a ggplot2 solution seems unlikely without faceting (which might be a good approach, as suggested in the comments above).
EDIT re: mapping centroids of the halves to something: The centroids for the east ("left") halves can be obtained by
coordinates(lSPDF)
Those for the west ("right") halves can be obtained by creating an rSPDF object in a similar way:
# Create square polygons that cover west (right) half of each country's bbox
rpolys <- lapply(seq_along(pl), function(x) {
rbox <- bbox(pl[[x]])
rbox[1, 1] <- theCents[x, 1]
Polygon(expand.grid(rbox[1,], rbox[2,])[c(1,3,4,2,1),])
})
# Determine the intersection of each country with the respective "right polygon"
rPolys <- lapply(seq_along(rpolys), function(x) {
curRPol <- SpatialPolygons(list(Polygons(rpolys[x], wmRN[x])),
proj4string=CRS(proj4string(world.map)))
curPl <- SpatialPolygons(pl[x], proj4string=CRS(proj4string(world.map)))
theInt <- gIntersection(curRPol, curPl, id = wmRN[x])
theInt
})
# Create a SpatialPolygonDataFrame of the western (right) intersections
rSPDF <- SpatialPolygonsDataFrame(SpatialPolygons(unlist(lapply(rPolys,
slot, "polygons")), proj4string = CRS(proj4string(world.map))),
world.map#data)
Then information could be plotted on the map according to the centroids of lSPDF or rSPDF:
points(coordinates(rSPDF), col = factor(rSPDF#data$REGION))
# or
text(coordinates(lSPDF), labels = lSPDF#data$FIPS, cex = .7)

Resources