How do you split a multilinestring into x lines of equal length in R

Question

If you have a multilinestring:

multiline <- MULTILINESTRING ((12.573769564824442 55.67932019039465, 12.573664593749626 55.67929917900955, 12.572916898811318 55.679149506755245, 12.5722100725459 55.679011254788364, 12.572044628054563 55.678978898110536))

Is there a smart way to, split that into X lines of equal length?

lines_of_equal_length <- cool_function(multiline)

Or do you have to code such a function all the way from zero, e.g. by calculating the length of the line, and then dividing the length by X, and then running along the line and cleaving it ever y meters?

Is that a string? It looks like coordinates. Also what is `MULTILINESTRING`?? Is it some sort of function? — Sotos, Nov 15 '17 at 08:14
MULTILINESTRING is a GIS term, where: A LINESTRING object consists of one and only one line with n vertices. A MULTILINESTRING object consists of 1 to m LINESTRINGs. — Esben Eickhardt, Nov 15 '17 at 08:16

score 1 · Answer 1 · answered Nov 15 '17 at 09:22

I found a nice blog post that goes over it in detail, Segmentation of spatial lines. Basically you convert your multilinestring into spatial lines, and then in the blog a lot of nice functions are described that do the magic.

Converting to spatial lines:

library(rgeos)
spatialLines <- readWKT(multiline)

Function 1: Creates a line segment

CreateSegment <- function(coords, from, to) {
    distance <- 0
    coordsOut <- c()
    biggerThanFrom <- F
    for (i in 1:(nrow(coords) - 1)) {
        d <- sqrt((coords[i, 1] - coords[i + 1, 1])^2 + (coords[i, 2] - coords[i + 
            1, 2])^2)
        distance <- distance + d
        if (!biggerThanFrom && (distance > from)) {
            w <- 1 - (distance - from)/d
            x <- coords[i, 1] + w * (coords[i + 1, 1] - coords[i, 1])
            y <- coords[i, 2] + w * (coords[i + 1, 2] - coords[i, 2])
            coordsOut <- rbind(coordsOut, c(x, y))
            biggerThanFrom <- T
        }
        if (biggerThanFrom) {
            if (distance > to) {
                w <- 1 - (distance - to)/d
                x <- coords[i, 1] + w * (coords[i + 1, 1] - coords[i, 1])
                y <- coords[i, 2] + w * (coords[i + 1, 2] - coords[i, 2])
                coordsOut <- rbind(coordsOut, c(x, y))
                break
            }
            coordsOut <- rbind(coordsOut, c(coords[i + 1, 1], coords[i + 1, 
                2]))
        }
    }
    return(coordsOut)
}

Function 2: Creates line segments

CreateSegments <- function(coords, length = 0, n.parts = 0) {
    stopifnot((length > 0 || n.parts > 0))
    # calculate total length line
    total_length <- 0
    for (i in 1:(nrow(coords) - 1)) {
        d <- sqrt((coords[i, 1] - coords[i + 1, 1])^2 + (coords[i, 2] - coords[i + 
            1, 2])^2)
        total_length <- total_length + d
    }

    # calculate stationing of segments
    if (length > 0) {
        stationing <- c(seq(from = 0, to = total_length, by = length), total_length)
    } else {
        stationing <- c(seq(from = 0, to = total_length, length.out = n.parts), 
            total_length)
    }

    # calculate segments and store the in list
    newlines <- list()
    for (i in 1:(length(stationing) - 1)) {
        newlines[[i]] <- CreateSegment(coords, stationing[i], stationing[i + 
            1])
    }
    return(newlines)
}

Function 3: Merges to last line segments

MergeLast <- function(lst) {
    l <- length(lst)
    lst[[l - 1]] <- rbind(lst[[l - 1]], lst[[l]])
    lst <- lst[1:(l - 1)]
    return(lst)
}

Function 4: Puts it all toghether and can cut a spatial lines into either n-1 lines or into lines of certain lengths

SegmentSpatialLines <- function(sl, length = 0, n.parts = 0, merge.last = FALSE) {
    stopifnot((length > 0 || n.parts > 0))
    id <- 0
    newlines <- list()
    sl <- as(sl, "SpatialLines")
    for (lines in sl@lines) {
        for (line in lines@Lines) {
            crds <- line@coords
            # create segments
            segments <- CreateSegments(coords = crds, length, n.parts)
            if (merge.last && length(segments) > 1) {
                # in case there is only one segment, merging would result into error
                segments <- MergeLast(segments)
            }
            # transform segments to lineslist for SpatialLines object
            for (segment in segments) {
                newlines <- c(newlines, Lines(list(Line(unlist(segment))), ID = as.character(id)))
                id <- id + 1
            }
        }
    }
    return(SpatialLines(newlines))
}

Again, all credit goes to the creator of the functions: Creator

How do you split a multilinestring into x lines of equal length in R

1 Answers1