1MapGen2SL <- function(file, proj4string=CRS(as.character(NA))) { 2 con <- file(file, "r") 3 hold <- readLines(con) 4 close(con) 5 if (length(hold) == 500000L) warning("500,000 point limit reached") 6 starts <- which(hold == "# -b") 7 n <- length(starts) 8 if (n < 1) stop("Not a Mapgen format file") 9 res <- vector(mode="list", length=n) 10 IDs <- paste("L", 1:n, sep="_") 11 for (i in 1:n) { 12 if (i < n) { 13 x <- t(sapply(strsplit(hold[(starts[i]+1): 14 (starts[i+1]-1)], "\t"), as.numeric)) 15 } else { 16 x <- t(sapply(strsplit(hold[(starts[i]+1): 17 length(hold)], "\t"), as.numeric)) 18 } 19 res[[i]] <- Lines(list(Line(x 20#, proj4string=proj4string 21)), ID=IDs[i]) 22 } 23 SL <- SpatialLines(res, proj4string=proj4string) 24 SL 25} 26 27ArcObj2SLDF <- function(arc, proj4string=CRS(as.character(NA)), IDs) { 28 df <- data.frame(arc[[1]]) 29 n <- length(arc[[2]]) 30 LinesList <- vector(mode="list", length=n) 31 if (missing(IDs)) IDs <- paste("L", 1:n, sep="_") 32 if (length(IDs) != n) stop("IDs length differs from number of arcs") 33 row.names(df) <- IDs 34 for (i in 1:n) { 35 crds <- cbind(arc[[2]][[i]][[1]], arc[[2]][[i]][[2]]) 36 LinesList[[i]] <- Lines(list(Line(coords=crds 37#, proj4string=proj4string 38)), ID=IDs[i]) 39 } 40 SL <- SpatialLines(LinesList, proj4string=proj4string) 41 res <- SpatialLinesDataFrame(SL, data=df) 42 res 43} 44 45ContourLines2SLDF <- function(cL, proj4string=CRS(as.character(NA))) { 46 if (length(cL) < 1L) stop("cL too short") 47 cLstack <- tapply(1:length(cL), sapply(cL, function(x) x[[1]]), 48 function(x) x, simplify=FALSE) 49 df <- data.frame(level=names(cLstack)) 50 m <- length(cLstack) 51 res <- vector(mode="list", length=m) 52 IDs <- paste("C", 1:m, sep="_") 53 row.names(df) <- IDs 54 for (i in 1:m) { 55 res[[i]] <- Lines(.contourLines2LineList(cL[cLstack[[i]]]#, 56# proj4string=proj4string 57), ID=IDs[i]) 58 } 59 SL <- SpatialLines(res, proj4string=proj4string) 60 res <- SpatialLinesDataFrame(SL, data=df) 61 res 62} 63.contourLines2LineList <- function(cL#, proj4string=CRS(as.character(NA)) 64) { 65 n <- length(cL) 66 res <- vector(mode="list", length=n) 67 for (i in 1:n) { 68 crds <- cbind(cL[[i]][[2]], cL[[i]][[3]]) 69 res[[i]] <- Line(coords=crds#, proj4string=proj4string 70) 71 } 72 res 73} 74 75# to be moved to glue with RarcInfo: 76 77pal2SpatialPolygons <- function(arc, pal, IDs, dropPoly1=TRUE, 78 proj4string=CRS(as.character(NA))) { 79 if (missing(IDs)) stop("IDs required") 80 if (dropPoly1) pale <- lapply(pal[[2]][-1], function(x) x[[1]]) 81 else pale <- lapply(pal[[2]], function(x) x[[1]]) 82 if (length(pale) != length(IDs)) stop("map and IDs differ in length") 83 tab <- table(factor(IDs)) 84 n <- length(tab) 85 IDss <- names(tab) 86 reg <- match(IDs, IDss) 87 belongs <- lapply(1:n, function(x) which(x == reg)) 88# assemble the list of Polygons 89 Srl <- vector(mode="list", length=n) 90 for (i in 1:n) { 91 bi <- belongs[[i]] 92 nParts <- length(bi) 93 palei_list <- list() 94 for (j in 1:nParts) { 95 this <- bi[j] 96 paleij <- pale[[this]] 97 if (any(paleij == 0)) { 98 zeros <- which(paleij == 0) 99 palei_list <- c(palei_list, 100 list(paleij[1:(zeros[1]-1)])) 101 for (k in 1:length(zeros)) { 102 if (k == length(zeros)) { 103 lp <- length(paleij) 104 lz <- zeros[length(zeros)] 105 palei_list <- c(palei_list, 106 list(paleij[(lz+1):lp])) 107 } else { 108 zk <- zeros[k] 109 zk1 <- zeros[k+1] 110 palei_list <- c(palei_list, 111 list(paleij[(zk+1):(zk1-1)])) 112 } 113 } 114 } else palei_list <- c(palei_list, list(paleij)) 115 } 116 nParts <- length(palei_list) 117 srl <- vector(mode="list", length=nParts) 118 for (j in 1:nParts) { 119 paleij <- palei_list[[j]] 120 nArcs <- length(paleij) 121 x <- NULL 122 y <- NULL 123 for (k in 1:nArcs) { 124 kk <- paleij[k] 125 if (kk > 0) { 126 x <- c(x, arc[[2]][[kk]][[1]]) 127 y <- c(y, arc[[2]][[kk]][[2]]) 128 } else { 129 x <- c(x, rev(arc[[2]][[-kk]][[1]])) 130 y <- c(y, rev(arc[[2]][[-kk]][[2]])) 131 } 132 } 133 if ((x[1] != x[length(x)]) || (y[1] != y[length(y)])) { 134 x <- c(x, x[1]) 135 y <- c(y, y[1]) 136 } 137 srl[[j]] <- Polygon(coords=cbind(x, y)) 138 } 139 Srl[[i]] <- Polygons(srl, ID=IDss[i]) 140 } 141 res <- as.SpatialPolygons.PolygonsList(Srl, proj4string=proj4string) 142 res 143} 144 145 146