rr-sfr-maptools

Use elide to rotate multiple polylines


I would like to rotate multiple polylines based on their given bearing to magnetic north, or 0 degrees. I can do it for a single polyline, but need to run the code on hundreds of polylines. See the code below for a short example.

library(sf)
library(maptools)


lines_shp<-new("SpatialLinesDataFrame", data = structure(list(RowID = 1:5, 
    Bearing = c(143.817279280965, -1.20941649325459, -91.9533892717001, 
    89.3253276817375, 123.131276176)), class = "data.frame", row.names = c(NA, 
-5L)), lines = list(new("Lines", Lines = list(new("Line", coords = structure(c(-104.24245, 
-104.241159999999, 32.7751099999999, 32.77362), .Dim = c(2L, 
2L)))), ID = "1"), new("Lines", Lines = list(new("Line", coords = structure(c(-104.60852, 
-104.60875, 32.80252, 32.81172), .Dim = c(2L, 2L)))), ID = "2"), 
    new("Lines", Lines = list(new("Line", coords = structure(c(-104.68331, 
    -104.6937, 32.71653, 32.71623), .Dim = c(2L, 2L)))), ID = "3"), 
    new("Lines", Lines = list(new("Line", coords = structure(c(-104.14878, 
    -104.14174, 32.57155, 32.57162), .Dim = c(2L, 2L)))), ID = "4"), 
    new("Lines", Lines = list(new("Line", coords = structure(c(-103.972, 
    -103.9526, 32.4403399999999, 32.4296), .Dim = c(2L, 2L)))), 
        ID = "5")), bbox = structure(c(-104.6937, 32.4296, -103.9526, 
32.81172), .Dim = c(2L, 2L), .Dimnames = list(c("x", "y"), c("min", 
"max"))), proj4string = new("CRS", projargs = "+proj=tmerc +lat_0=31 +lon_0=-104.3333333333333 +k=0.999909091 +x_0=165000 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=us-ft +no_defs"))

st_as_sf(maptools::elide(lines_shp,center=c(lines_shp$mid_long,lines_shp$mid_lat), 
rotate= -lines_shp$Bearing))

###does not work on multiple lines

Solution

  • Below is the solution.

    ## split by id
    lst <- split(lines_shp, lines_shp$RowID)
    
    ## create 'SpatialLines' obects
    sln <- foreach(i = lst, id = names(lst), .combine = rbind) %do% {
     st_as_sf(elide(i,center=c(i$mid_long,i$mid_lat), 
    rotate=-i$Bearing))
    }
    
    sln<- as(sln,"Spatial")
    sln<- st_as_sf(sln)
    
    plot(sln)