1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
readShapeLines <- function(fn, proj4string=CRS(as.character(NA)),
verbose=FALSE, repair=FALSE, delete_null_obj=FALSE) {
.Deprecated("", package="maptools", msg="shapelib support is provided by GDAL through the sf and terra packages among others")
suppressWarnings(Map <- read.shape(filen=fn, verbose=verbose,
repair=repair))
suppressWarnings(.shp2LinesDF(Map, proj4string=proj4string,
delete_null_obj=delete_null_obj))
}
writeLinesShape <- function(x, fn, factor2char = TRUE, max_nchar=254) {
.Deprecated("", package="maptools", msg="shapelib support is provided by GDAL through the sf and terra packages among others")
stopifnot(is(x, "SpatialLinesDataFrame"))
df <- as(x, "data.frame")
df <- data.frame(SL_ID=I(row.names(df)), df)
pls <- .SpL2lineslist(as(x, "SpatialLines"))
suppressWarnings(write.linelistShape(pls, df, file=fn,
factor2char = factor2char, max_nchar=max_nchar))
}
.shp2LinesDF <- function(shp, proj4string=CRS(as.character(NA)), IDs,
delete_null_obj=FALSE) {
if (!inherits(shp, "Map")) stop("shp not a Map object")
shp.type <- attr(shp$Shapes, "shp.type")
if (!shp.type %in% c("arc", "poly"))
stop("not an arc or poly Map object")
# birds NULL part Allen H. Hurlbert 090610 copied from .Map2PolyDF
# Harlan Harris 100907
nullParts <- sapply(shp$Shapes, function(x) x$nParts) == 0
if (delete_null_obj) {
nullParts <- which(nullParts)
if (length(nullParts) > 0L) {
for (i in length(nullParts):1)
shp$Shapes[[nullParts[i]]] <- NULL
attr(shp$Shapes,'nshps') <- attr(shp$Shapes,'nshps') -
length(nullParts)
shp$att.data <- shp$att.data[-nullParts,]
warning(paste("Null objects with the following",
"indices deleted:", paste(nullParts, collapse=", ")))
}
} else {
# birds NULL part Allen H. Hurlbert 090610
# Harlan Harris 100907
if (any(nullParts))
stop(paste("NULL geometry found:", paste(which(nullParts),
collapse=", "),
"\n consider using delete_null_obj=TRUE"))
}
df <- shp$att.data
shapes <- shp$Shapes
n <- length(shapes)
LinesList <- vector(mode="list", length=n)
if (missing(IDs)) IDs <- as.character(sapply(shapes,
function(x) x$shpID))
if (length(IDs) != n) stop("IDs length differs from number of lines")
row.names(df) <- IDs
for (i in 1:n) {
LinesList[[i]] <- .shapes2LinesList(shapes[[i]], ID=IDs[i])
}
SL <- SpatialLines(LinesList, proj4string=proj4string)
res <- SpatialLinesDataFrame(SL, data=df)
res
}
.shapes2LinesList <- function(shape, ID) {
nParts <- attr(shape, "nParts")
Pstart <- shape$Pstart
nVerts <- nrow(shape$verts)
from <- integer(nParts)
to <- integer(nParts)
from[1] <- 1
for (j in 1:nParts) {
if (j == nParts) to[j] <- nVerts
else {
to[j] <- Pstart[j+1]
from[j+1] <- to[j]+1
}
}
res <- vector(mode="list", length=nParts)
for (i in 1:nParts) {
res[[i]] <- Line(coords=shape$verts[from[i]:to[i],,drop=FALSE])
}
Lines <- Lines(res, ID=ID)
Lines
}
.SpL2lineslist <- function(x) {
pls <- slot(x, "lines")
n <- length(pls)
res <- vector(mode="list", length=n)
for (i in 1:n) {
xyL <- lapply(slot(pls[[i]], "Lines"),
coordinates)
nP <- length(xyL)
nVs <- sapply(xyL, nrow)
res[[i]] <- .xyList2NAmat(xyL)
attr(res[[i]], "nParts") <- as.integer(nP)
from <- integer(nP)
to <- integer(nP)
from[1] <- 1
to[1] <- nVs[1]
if (nP > 1) for (j in 2:nP) {
from[j] <- to[(j-1)] + 2
to[j] <- from[j] + nVs[j] - 1
}
attr(res[[i]], "pstart") <- list(from=as.integer(from),
to=as.integer(to))
}
class(res) <- "lineslist"
invisible(res)
}
|
