Случайно выбрать линии заданной длины в дорожной сети

Question

Я хочу случайным образом выбрать отрезки дороги из дорожной сети.Я думал, что это не будет слишком сложно, но я никуда не денусь.Идея состоит в том, чтобы отобрать отрезки дорог (линий) из сети линий.Я хочу, чтобы эти отрезки были определенной длины, и я хочу, чтобы эти отрезки выбирались случайным образом из сети.Я нашел способы сегментировать SpatialLines на сегменты заданной длины ЗДЕСЬ , но это не позволяет делать это случайным образом и не позволяет объединять сегменты разных линий.Я мог бы использовать spsample из пакета sp для размещения точек на равных расстояниях вдоль линий.Тогда я смогу случайным образом выбрать точку в качестве начальной.Теоретически я думаю, что можно добавить соседние точки к линии, но я не уверен, как это сделать, и не знаю, как мне поступить со случайным выбором направления, когда дорога разделяется (2 пересекающиеся линии),

Вот некоторые данные.

    data <- data.frame(
  x = c(1,2,3,3,3,3,1,2,3),
  y = c(1,2,2,3,4,5,4,4,4),
  id = c(rep("A",6), rep("B",3))
) 


#with Kyle Walker's functions I convert the points to lines
#https://rpubs.com/walkerke/points_to_line 

library(sp)
library(maptools)

points_to_line <- function(data, long, lat, id_field = NULL, sort_field = NULL) {

  # Convert to SpatialPointsDataFrame
  coordinates(data) <- c(long, lat)

  # If there is a sort field...
  if (!is.null(sort_field)) {
    if (!is.null(id_field)) {
      data <- data[order(data[[id_field]], data[[sort_field]]), ]
    } else {
      data <- data[order(data[[sort_field]]), ]
    }
  }

  # If there is only one path...
  if (is.null(id_field)) {

    lines <- SpatialLines(list(Lines(list(Line(data)), "id")))

    return(lines)

    # Now, if we have multiple lines...
  } else if (!is.null(id_field)) {  

    # Split into a list by ID field
    paths <- sp::split(data, data[[id_field]])

    sp_lines <- SpatialLines(list(Lines(list(Line(paths[[1]])), "line1")))

    # I like for loops, what can I say...
    for (p in 2:length(paths)) {
      id <- paste0("line", as.character(p))
      l <- SpatialLines(list(Lines(list(Line(paths[[p]])), id)))
      sp_lines <- spRbind(sp_lines, l)
    }

    return(sp_lines)
  }
}

lines <- points_to_line(data = data, 
                        long = "x", 
                        lat = "y", 
                        id_field = "id")

#plot it
ori.plot <- plot(lines, col = rep(c(1, 2), length.out = length(lines)), axes = T, main="original",
     ylim=c(0,5), xlim=c(0,5))

Это дает мне график с двумя простыми линиями.

Я хотел бы, чтобы результаты могли быть такими:

или

или

Я могу разбить его на сегменты заданной длины, как указано выше, что дает что-то вроде этого (length = 0.3):

Но эти сегменты ограничены одной линией и не начинаются в случайных точках.

Есть идеи?

Answer 1

Я закончил тем, что сделал следующее: разбить линию на точки с определенным интервалом. Поскольку я знаю длину отрезков, я знаю, сколько точек должно быть включено в отрезок.Я также знаю, сколько трансектов мне понадобится.Таким образом, я буферизовал точку и случайно выбрал следующую точку в буфере, пока у меня не будет достаточно точек в разрезе, а затем перешел к следующему разрезу.Если в буфере нет точек, еще не назначенных для трансекта, мне нужно сбросить точки, включенные в создаваемый мной трансект, и начать заново, случайно выбрав новую начальную точку.

Код по-прежнемунемного грязно, но работает на моей стороне:

#Convert the SpatialLines into SpatialPoints with regularly spaced points
points_spdf <- spsample(lines, n = 30, type = "regular")

#In my case I would need to calculate the total distance of the road network, then divide that so that I get
#a point for every XX meter

#Convert the spatialpointsdataframe to dataframe

points.df <- as.data.frame(points_spdf)
#add an ID column
points.df$ID <- seq(from=1, to=nrow(points.df), by=1)

library(sf)
#convert to an sf data.frame
points_sf <- st_as_sf(x = points.df, 
                      coords = c("x", "y"),
                      crs = "+proj=utm +zone=32 +datum=WGS84")

#add transect colum
points_sf$transect <- 0 #adds transect column and fills those with zeroes
th <- 4 #sets nr of points which are needed to form total distance of each transect

library(dplyr) #for function sample_n

plot(points_sf)

i <-1 #counter for transects, these are used as transectIDs


#####################################
#function
#This function resets transectIDs to 0 if there are no un-assigned points in the buffer and the number of 
#points with the buffer aren't enough. It also then draws a new random point.
#####################################

reset_and_sample <- function() {
  points_sf$transect <- tryCatch(points_in_poly[sample_n(subset(points_in_poly, transect.x == 0 & transect.y == i),1),1], 
                                 error=function(e) ifelse(points_sf$transect==i, 
                                                          points_sf$transect[points_sf$transect == i] <-0, 
                                                          points_sf$transect <- points_sf$transect)) 
  points_sf <<- points_sf #to retun points_sf to global ennvironment
  pt <- points_sf[ sample_n(subset(points_sf, transect == 0),1 ) ,1 ] 
  pt <<- pt
}
#####################################
pt <- NULL


while(i < 5){ #to create 4 transects
pt <- if(sum(points_sf$transect == i) < th) {
           tryCatch(points_in_poly[sample_n(subset(points_in_poly, transect.x == 0 & transect.y == i),1),1], 
            error=function(e) (reset_and_sample()))
  }else{
  pt <- (points_sf[ sample_n(subset(points_sf, transect == 0),1 ) ,1 ])
}


#put the transectID in the dataframe
ifelse((sum(points_sf$transect == i) < th),
       points_sf$transect[points_sf$ID==pt[[1]]]<-i,
       points_sf$transect[points_sf$ID==pt[[1]]]<-i+1) #puts 1 in row where ID is from pt

#this is the place where the counter for the transects is set
ifelse((sum(points_sf$transect == i) < th),
       i <- i,
       i <- i+1)

#buffers point with the ID of the selected point
buf_poly <- st_buffer((points_sf[points_sf$ID[pt[[1]]],]), dist = 0.31) 

plot(points_sf, add=TRUE)
plot(buf_poly, add=TRUE)

points_in_poly <- st_join(points_sf, buf_poly, join = st_intersects) #only points in polygons have polygon info in columns

}