SLDF to a segment data frame

I'm impressed with R's plotting/mapping capabilities, especially with
the new sp package that simplifies plotting of different data
types. For a recent application with Rpad (www.rpad.org), the plotting
speed was a little slow for line data with 250,000 line segments. To
speed up plotting, I converted all of the line data to one big data
frame that holds all of the segment data. Then I just plot with
"segments". The resulting data frame contains columns x1, y1, x2, y2,
along with an indexing vector idx that points back to the appropriate
row in the attributes data frame for that line segment. 

I wrote two functions for the conversion. One converts from the sp
package SLDF object. The other converts from the maptools "Map"
representation. Both should produce the same output. The code is
enclosed if anyone has similar needs. Comments appreciated.

The following code is granted to the public domain:

SLDFtoSegment <- function(sldf) {
  # Convert line segments from the SLDF representation to vectors to 
  # plot with segments().
  # It also includes an index term "idx" to use to index the dataframe 
  # portion of the SLDF
  crd <- coordinates(sldf)
  lst <- sapply(crd,
            function(x) lapply(x, function(l) 
              cbind(l[1:(NROW(l)-1),,drop=F], l[2:NROW(l),,drop=F])))
  seg <- data.frame(x1 = unlist(lapply(lst, function(x) x[, 1])),
                    y1 = unlist(lapply(lst, function(x) x[, 2])), 
                    x2 = unlist(lapply(lst, function(x) x[, 3])), 
                    y2 = unlist(lapply(lst, function(x) x[, 4])))
  segmentidx <- array(as.integer(0), NROW(seg))
  j <- 1
  for (i in seq(along=lst)) {
    n <- NROW(lst[[i]])
    segmentidx[j:(j+n-1)] <- rep(i, n)
    j <- j + n
  }
  seg$idx <- segmentidx
  seg
}

ShapefiletoSegment <- function(map) {
  # Convert line segments from the maptools "Map" representation 
  # (from a shapefile import) to vectors to plot with segments().
  # It also includes an index term "idx" to use to index the 
  # dataframe portion.
  extractsegs <- function(l) cbind(l$verts[1:(NROW(l$verts)-1),,drop=F],
                                   l$verts[2:NROW(l$verts),,drop=F])
  lst <- lapply(map$Shapes, extractsegs)
  seg <- data.frame(x1 = unlist(lapply(lst, function(x) x[, 1])),
                    y1 = unlist(lapply(lst, function(x) x[, 2])), 
                    x2 = unlist(lapply(lst, function(x) x[, 3])), 
                    y2 = unlist(lapply(lst, function(x) x[, 4])))
  segmentidx <- array(as.integer(0), NROW(seg))
  j <- 1
  for (i in seq(along=lst)) {
    n <- NROW(lst[[i]])
    segmentidx[j:(j+n-1)] <- rep(i, n)
    j <- j + n
  }
  seg$idx <- segmentidx
  seg
}

# Here's an example of using it.
# You don't need it at all for this example
# because the data set is so small.
library(sp)
data(lnsshp) 
res <- shp2SLDF(lns)
plot(res) # plot SLDF data

# faster plotting with segments:
seg <- SLDFtoSegment(res)
plot.new()
plot.window(xlim=range(seg$x1, seg$x2),
            ylim=range(seg$y1, seg$y2),
            asp=1)
segments(seg$x1,seg$y1,seg$x2,seg$y2)

# to vary line color by some attribute, you could do:
res[["length.factor"]] <- cut(res[["LENGTH"]], 
                              breaks=quantile(res[["LENGTH"]]))
color = as.numeric(res[["length.factor"]][seg$idx])
segments(seg$x1, seg$y1, seg$x2, seg$y2,
         col = color)

- Tom

Tom Short
EPRI Solutions, Inc.

	[[alternative HTML version deleted]]