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