[R-sig-Geo] SLDF to a segment data frame

[Roger Bivand]

On Tue, 17 May 2005, Short, Tom wrote:

> 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. 

With regard to speeds, could you say what OS and R version you are using, 
because the different devices behave differently on different systems (in 
particular the Windows segment drawing function seems to have been impared 
by a recent patch I think to XP). Otherwise, the work you are showing on 
Rpad is quite remarkable, far beyond anything I'd anticipated! 

Best wishes,

Roger

> 
> 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]]
> 
> _______________________________________________
> R-sig-Geo mailing list
> R-sig-Geo at stat.math.ethz.ch
> https://stat.ethz.ch/mailman/listinfo/r-sig-geo
> 

-- 
Roger Bivand
Economic Geography Section, Department of Economics, Norwegian School of
Economics and Business Administration, Helleveien 30, N-5045 Bergen,
Norway. voice: +47 55 95 93 55; fax +47 55 95 95 43
e-mail: Roger.Bivand at nhh.no