snapPointsToLines не может хранить атрибуты в R - PullRequest
Новая
       86

snapPointsToLines не может хранить атрибуты в R

2 голосов
/ 31 марта 2020

Недавно я обнаружил проблему с snapPointsToLines. Он не может сохранить атрибуты пространственного точечного кадра данных. Пример приведен ниже: 

# Generate a spatial line dataframe
l1 = cbind(c(1,2,3),c(3,2,2))
l1a = cbind(l1[,1]+.05,l1[,2]+.05)
l2 = cbind(c(1,2,3),c(1,1.5,1))
Sl1 = Line(l1)
Sl1a = Line(l1a)
Sl2 = Line(l2)
S1 = Lines(list(Sl1, Sl1a), ID="a")
S2 = Lines(list(Sl2), ID="b")
Sl = SpatialLines(list(S1,S2))
df = data.frame(z = c(1,2), row.names=sapply(slot(Sl, "lines"), function(x) slot(x, "ID")))
Sldf = SpatialLinesDataFrame(Sl, data = df)

# Generate a spatial point dataframe
xc = c(1.2,1.5,2.5)
yc = c(1.5,2.2,1.6)
Spoints = SpatialPoints(cbind(xc, yc))
Spdf <- SpatialPointsDataFrame(Spoints, data = data.frame(value = 1:length(Spoints)))

#use the function SpatialPointsDataFrame 
res <- snapPointsToLines(Spdf, Sldf)

res имеет только «near_line_id» и «snap_dist». У него нет поля «значение» из Spdf, которое мне нужно. 

#use the function SpatialPointsDataFrame with "withAttrs = TRUE" parameter
res <- snapPointsToLines(Spdf, Sldf, withAttrs = TRUE)

Сообщается об ошибке: 

"Error in snapPointsToLines(Spdf, Sldf, withAttrs = TRUE) : 
  A SpatialPoints object has no attributes! Please set withAttrs as FALSE."

Но Spdf - это пространственный точечный кадр с атрибутом. Я не знаю, в чем проблема. Когда я использовал эту функцию несколько недель go, у нее не было этой проблемы.

1 Ответ

1 голос
/ 09 апреля 2020

Я думаю, что проблема может быть связана с самой функцией. Когда вы смотрите на коды этой функции, мы можем видеть коды в начальной части, как показано ниже. 

if (class(points) == "SpatialPoints" && missing(withAttrs)) 
    withAttrs = FALSE
if (class(points) == "SpatialPoints" && withAttrs == TRUE) 
    stop("A SpatialPoints object has no attributes! Please set withAttrs as FALSE.")

Иногда SpatialPointsDataFrame может быть идентифицирован как SpatialPoints. Таким образом, функция будет обрабатывать ваш SpatialPointsDataFrame как SpatialPoints и не будет сохранять атрибуты в функции. Вы можете внести небольшие изменения в коды функции, как показано ниже. 

snapPointsToLines1 <-  function (points, lines, maxDist = NA, withAttrs = TRUE, idField = NA) 
{
  if (rgeosStatus()) {
    if (!requireNamespace("rgeos", quietly = TRUE)) 
      stop("package rgeos required for snapPointsToLines")
  }
  else stop("rgeos not installed")
  if (is(points, "SpatialPointsDataFrame")==FALSE && missing(withAttrs)) 
    withAttrs = FALSE
  if (is(points, "SpatialPointsDataFrame")==FALSE && withAttrs == TRUE) 
    stop("A SpatialPointsDataFrame object is needed! Please set withAttrs as FALSE.")
  d = rgeos::gDistance(points, lines, byid = TRUE)
  if (!is.na(maxDist)) {
    distToLine <- apply(d, 2, min, na.rm = TRUE)
    validPoints <- distToLine <= maxDist
    distToPoint <- apply(d, 1, min, na.rm = TRUE)
    validLines <- distToPoint <= maxDist
    points <- points[validPoints, ]
    lines = lines[validLines, ]
    d = d[validLines, validPoints, drop = FALSE]
    distToLine <- distToLine[validPoints]
    if (!any(validPoints)) {
      if (is.na(idField)) {
        idCol = character(0)
      }
      else {
        idCol = lines@data[, idField][0]
      }
      newCols = data.frame(nearest_line_id = idCol, snap_dist = numeric(0))
      if (withAttrs) 
        df <- cbind(points@data, newCols)
      else df <- newCols
      res <- SpatialPointsDataFrame(points, data = df, 
                                    proj4string = CRS(proj4string(points)), match.ID = FALSE)
      return(res)
    }
  }
  else {
    distToLine = apply(d, 2, min, na.rm = TRUE)
  }
  nearest_line_index = apply(d, 2, which.min)
  coordsLines = coordinates(lines)
  coordsPoints = coordinates(points)
  mNewCoords = vapply(1:length(points), function(x) nearestPointOnLine(coordsLines[[nearest_line_index[x]]][[1]], 
                                                                       coordsPoints[x, ]), FUN.VALUE = c(0, 0))
  if (!is.na(idField)) {
    nearest_line_id = lines@data[, idField][nearest_line_index]
  }
  else {
    nearest_line_id = sapply(slot(lines, "lines"), 
                             function(i) slot(i, "ID"))[nearest_line_index]
  }
  if (withAttrs) 
    df = cbind(points@data, data.frame(nearest_line_id, snap_dist = distToLine))
  else df = data.frame(nearest_line_id, snap_dist = distToLine, 
                       row.names = names(nearest_line_index))
  SpatialPointsDataFrame(coords = t(mNewCoords), data = df, 
                         proj4string = CRS(proj4string(points)))
}

Затем, используя эту новую функцию snapPointsToLines1, вы можете получить нужные атрибуты.

...