File: rbind.R

package info (click to toggle)
r-cran-sp 1%3A0.9-66-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,696 kB
  • ctags: 123
  • sloc: ansic: 1,475; sh: 6; makefile: 5
file content (88 lines) | stat: -rw-r--r-- 2,615 bytes parent folder | download | duplicates (2)
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
checkCRSequal = function(dots) {
	if (length(dots) > 1) {
		p1 = proj4string(dots[[1]])
		res = unlist(lapply(dots[-1], function(x) identical(proj4string(x), p1)))
		if (any(!res))
		#if (!isTRUE(all.equal(proj4string(obj), proj4string(x))))
			stop("coordinate reference systems differ")
	}
}

makeUniqueIDs <- function(lst) {
	ids = sapply(lst, function(i) slot(i, "ID"))
	if (any(duplicated(ids))) {
		ids <- make.unique(as.character(unlist(ids)), sep = "")
		for (i in seq(along = ids))
			lst[[i]]@ID = ids[i]
	}
	lst
}

rbind.SpatialPoints <- function(...) {
	dots = list(...)
	names(dots) <- NULL
	checkCRSequal(dots)
	SpatialPoints(do.call("rbind", lapply(list(...), coordinates)), CRS(proj4string(dots[[1]])))
}

rbind.SpatialPointsDataFrame <- function(...) {
	dots = list(...)
        names(dots) <- NULL # bugfix Clement Calenge 100417
	sp = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPoints")))
	df = do.call("rbind", lapply(dots, function(x) x@data))
	SpatialPointsDataFrame(sp, df, coords.nrs = dots[[1]]@coords.nrs)
}

rbind.SpatialPixels = function(...) {
	dots = list(...)
	names(dots) <- NULL
	sp = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPoints")))
	gridded(sp) = T
	sp
}

rbind.SpatialPixelsDataFrame = function(...) {
	dots = list(...)
	names(dots) <- NULL
	sp = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPointsDataFrame")))
	gridded(sp) = T
	sp
}

rbind.SpatialPolygons = function(..., makeUniqueIDs = FALSE) {
	dots = list(...)
	names(dots) <- NULL
	checkCRSequal(dots)
	# checkIDSclash(dots)
	pl = do.call("c", lapply(dots, function(x) slot(x, "polygons")))
	if (makeUniqueIDs)
		pl = makeUniqueIDs(pl)
	SpatialPolygons(pl, proj4string = CRS(proj4string(dots[[1]])))
}

rbind.SpatialPolygonsDataFrame <- function(...) {
	dots = list(...)
        names(dots) <- NULL # bugfix Clement Calenge 100417
	pl = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPolygons")))
	df = do.call("rbind", lapply(dots, function(x) x@data))
	SpatialPolygonsDataFrame(pl, df)
}


rbind.SpatialLines = function(..., makeUniqueIDs = FALSE) {
	dots = list(...)
	names(dots) <- NULL
	checkCRSequal(dots)
	ll = do.call("c", lapply(dots, function(x) slot(x, "lines")))
	if (makeUniqueIDs)
		ll = makeUniqueIDs(ll)
	SpatialLines(ll, proj4string = CRS(proj4string(dots[[1]])))
}

rbind.SpatialLinesDataFrame <- function(...) {
	dots = list(...)
        names(dots) <- NULL # bugfix Clement Calenge 100417
	ll = do.call("rbind", lapply(dots, function(x) as(x, "SpatialLines")))
	df = do.call("rbind", lapply(dots, function(x) x@data))
	SpatialLinesDataFrame(ll, df)
}