1 2get_groups <- function(x, y) { 3 j <- 1 4 outx <- outy <- list() 5 6 for (i in 1:length(x)) { 7 if (is.na(x[i])) next 8 gx <- na.omit(x[x[i] == x] ) 9 gy <- y[x %in% gx] 10 nx <- ny <- 0 11 while(TRUE) { 12 if (nx == length(gx)) break 13 ny <- length(gy) 14 nx <- length(gx) 15 if ((ny == length(y) || (nx == length(x)))) break 16 ux <- unique( x[y %in% gy] ) 17 gy <- y[x %in% ux] 18 gx <- x[y %in% gy] 19 } 20 x[x %in% gx] <- NA 21 y[y %in% gy] <- NA 22 outx[[j]] <- gx 23 outy[[j]] <- gy 24 j <- j + 1 25 } 26 list(outx, outy) 27} 28 29 30connect_dateline <- function(x) { 31 east <- west <- c() 32 for (i in 1:nrow(x)) { 33 e <- ext(x[i,]) 34 if (xmin(e) <= -180) { 35 west <- c(west, i) 36 } else if (xmax(e) >= 180) { 37 east <- c(east, i) 38 } 39 } 40 if ((length(east) == 0) || (length(west) == 0)) { 41 return(x) 42 } 43 44 xx <- shift(x[west,], 360, 0) 45 yy <- x[east, ] 46 px <- py <- c() 47 hasDF <- ncol(x) > 0 48 for (i in 1:nrow(xx)) { 49 for (j in 1:nrow(yy)) { 50 if (hasDF) { 51 if (all(as.data.frame(xx[i,]) != as.data.frame(yy[j,]))) { 52 next 53 } 54 } 55 if (relate(xx[i,], yy[j,], "touches")) { 56 px <- c(px, i) 57 py <- c(py, j) 58 } 59 } 60 } 61 if ((length(px) == 0)) { 62 return(x) 63 } 64 65 px <- west[px] 66 py <- east[py] 67 68 groups <- get_groups(px, py) 69 xg <- groups[[1]] 70 yg <- groups[[2]] 71 vvv <- list() 72 for (i in 1:length(xg)) { 73 vvv[[i]] <- aggregate(x[unique(c(xg[[i]], yg[[i]])), ], dissolve=TRUE) 74 } 75 out <- x[-(unique(unlist(groups))), ] 76 out <- c(vvv, out) 77 do.call(rbind, out) 78} 79 80