다른 플랫폼에서 어떻게 접근 할 수 있는지 설명하기 위해 R약간의 R방식으로 코딩 된 솔루션을 제공 할 것입니다 .
R(다른 프로그래밍 플랫폼뿐만 아니라 특히 함수형 프로그래밍 스타일을 선호하는 플랫폼)에 대한 관심은 큰 배열을 지속적으로 업데이트하는 것은 매우 비쌀 수 있다는 것입니다. 대신,이 알고리즘은 (a) 지금까지 채워진 모든 셀이 나열되고 (b) 선택 가능한 모든 셀 (채워진 셀의 둘레)이있는 자체 개인 데이터 구조를 유지합니다. 나열되어 있습니다. 이 데이터 구조를 조작하는 것은 배열로 직접 인덱싱하는 것보다 비효율적이지만 수정 된 데이터를 작은 크기로 유지하면 계산 시간이 훨씬 덜 소요됩니다. (내에서 최적화하기 위해 아무 노력도하지 않았습니다 R. 상태 벡터의 사전 할당은에서 작업을 계속하려면 실행 시간을 절약해야합니다 R.)
코드는 주석 처리되어 있으며 읽기 편해야합니다. 알고리즘을 가능한 한 완벽하게 만들기 위해 결과를 플롯하기 위해 끝을 제외하고 추가 기능을 사용하지 않습니다. 유일한 까다로운 부분은 효율성과 단순성을 위해 1D 인덱스를 사용하여 2D 그리드에 인덱스하는 것을 선호한다는 것입니다. neighbors함수 에서 변환이 발생하는데, 셀의 액세스 가능한 이웃이 무엇인지 파악한 다음 1D 인덱스로 변환하려면 2D 색인이 필요합니다. 이 변환은 표준이므로 다른 GIS 플랫폼에서는 열 및 행 인덱스의 역할을 되돌릴 수 있다는 점을 제외하고는 더 이상 언급하지 않습니다. ( R에서 행 인덱스는 열 인덱스보다 먼저 변경됩니다.)
예를 들어,이 코드는 x토지와 접근 할 수없는 지점의 강과 같은 특징을 나타내는 그리드를 취하고 해당 그리드 의 특정 위치 (5, 21)에서 시작하여 (하천의 낮은 굴곡 근처) 250 포인트를 포함하도록 임의로 확장합니다. . 총 타이밍은 0.03 초입니다. (배열의 크기가 5000 행 x 10,000 행에서 3000 행으로 증가하면 타이밍은이 알고리즘의 확장 성을 나타내는 0.09 초 (3 정도 정도)까지 증가합니다.) 대신 0, 1, 2의 그리드 만 출력하면 새 셀이 할당 된 순서를 출력합니다. 그림에서 가장 오래된 세포는 녹색이며 금을 통해 연어 색으로 졸업합니다.
각 셀의 8 포인트 이웃이 사용되고 있음이 분명해야합니다. 다른 이웃의 경우 간단히 nbrhood시작 부분 근처 의 값을 수정하십시오 expand. 주어진 셀과 관련된 인덱스 오프셋 목록입니다. 예를 들어 "D4"이웃은로 지정할 수 있습니다 matrix(c(-1,0, 1,0, 0,-1, 0,1), nrow=2).
이 살포 방법에는 문제가 있음이 명백합니다. 이것이 의도 한 것이 아닌 경우이 문제를 해결하는 다양한 방법이 있습니다. 예를 들어 사용 가능한 셀을 대기열에 보관하여 가장 오래된 셀도 가장 빠른 셀이되도록합니다. 일부 무작위 화는 여전히 적용 할 수 있지만 사용 가능한 셀은 더 이상 균일 한 (같은) 확률로 선택되지 않습니다. 더 복잡한 또 다른 방법은 채워진 이웃 수에 따라 확률이있는 사용 가능한 셀을 선택하는 것입니다. 셀이 둘러싸인 후에는 선택 가능성이 너무 높아서 홀이 채워지지 않을 수 있습니다.
나는 이것이 셀 단위로 진행하지는 않지만 각 세대에서 셀의 전체 엉킴을 업데이트 할 것입니다. 차이점은 미묘합니다. CA의 경우 셀의 선택 확률이 균일하지 않습니다.
#
# Expand a patch randomly within indicator array `x` (1=unoccupied) by
# `n.size` cells beginning at index `start`.
#
expand <- function(x, n.size, start) {
if (x[start] != 1) stop("Attempting to begin on an unoccupied cell")
n.rows <- dim(x)[1]
n.cols <- dim(x)[2]
nbrhood <- matrix(c(-1,-1, -1,0, -1,1, 0,-1, 0,1, 1,-1, 1,0, 1,1), nrow=2)
#
# Adjoin one more random cell and update `state`, which records
# (1) the immediately available cells and (2) already occupied cells.
#
grow <- function(state) {
#
# Find all available neighbors that lie within the extent of `x` and
# are unoccupied.
#
neighbors <- function(i) {
n <- c((i-1)%%n.rows+1, floor((i-1)/n.rows+1)) + nbrhood
n <- n[, n[1,] >= 1 & n[2,] >= 1 & n[1,] <= n.rows & n[2,] <= n.cols,
drop=FALSE] # Remain inside the extent of `x`.
n <- n[1,] + (n[2,]-1)*n.rows # Convert to *vector* indexes into `x`.
n <- n[x[n]==1] # Stick to valid cells in `x`.
n <- setdiff(n, state$occupied)# Remove any occupied cells.
return (n)
}
#
# Select one available cell uniformly at random.
# Return an updated state.
#
j <- ceiling(runif(1) * length(state$available))
i <- state$available[j]
return(list(index=i,
available = union(state$available[-j], neighbors(i)),
occupied = c(state$occupied, i)))
}
#
# Initialize the state.
# (If `start` is missing, choose a value at random.)
#
if(missing(start)) {
indexes <- 1:(n.rows * n.cols)
indexes <- indexes[x[indexes]==1]
start <- sample(indexes, 1)
}
if(length(start)==2) start <- start[1] + (start[2]-1)*n.rows
state <- list(available=start, occupied=c())
#
# Grow for as long as possible and as long as needed.
#
i <- 1
indices <- c(NA, n.size)
while(length(state$available) > 0 && i <= n.size) {
state <- grow(state)
indices[i] <- state$index
i <- i+1
}
#
# Return a grid of generation numbers from 1, 2, ... through n.size.
#
indices <- indices[!is.na(indices)]
y <- matrix(NA, n.rows, n.cols)
y[indices] <- 1:length(indices)
return(y)
}
#
# Create an interesting grid `x`.
#
n.rows <- 3000
n.cols <- 5000
x <- matrix(1, n.rows, n.cols)
ij <- sapply(1:n.cols, function(i)
c(ceiling(n.rows * 0.5 * (1 + exp(-0.5*i/n.cols) * sin(8*i/n.cols))), i))
x[t(ij)] <- 0; x[t(ij - c(1,0))] <- 0; x[t(ij + c(1,0))] <- 0
#
# Expand around a specified location in a random but reproducible way.
#
set.seed(17)
system.time(y <- expand(x, 250, matrix(c(5, 21), 1)))
#
# Plot `y` over `x`.
#
library(raster)
plot(raster(x[n.rows:1,], xmx=n.cols, ymx=n.rows), col=c("#2020a0", "#f0f0f0"))
plot(raster(y[n.rows:1,] , xmx=n.cols, ymx=n.rows),
col=terrain.colors(255), alpha=.8, add=TRUE)
약간 수정하면 expand여러 클러스터를 만들기 위해 반복 할 수 있습니다 . 여기에서 2, 3, ... 등을 실행하는 식별자로 클러스터를 구별하는 것이 좋습니다.
먼저 (a) 오류가 있으면 첫 번째 줄에서 (b) 행렬이 아닌 값 expand을 반환하도록 변경 NA하십시오 . ( 매번 호출 할 때마다 새 행렬 을 만드는 데 시간을 낭비하지 마십시오 .)이 변경으로 인해 반복이 쉬워집니다. 임의의 시작을 선택하고 주위를 확장하고 성공 하면 클러스터 인덱스를 누적 한 다음 완료 될 때까지 반복하십시오. 루프의 핵심 부분은 많은 연속 클러스터를 찾을 수없는 경우 반복 횟수를 제한하는 것입니다 .indicesyyindicescount.max
다음은 60 개의 클러스터 중심이 무작위로 균일하게 선택된 예입니다.
size.clusters <- 250
n.clusters <- 60
count.max <- 200
set.seed(17)
system.time({
n <- n.rows * n.cols
cells.left <- 1:n
cells.left[x!=1] <- -1 # Indicates occupancy of cells
i <- 0
indices <- c()
ids <- c()
while(i < n.clusters && length(cells.left) >= size.clusters && count.max > 0) {
count.max <- count.max-1
xy <- sample(cells.left[cells.left > 0], 1)
cluster <- expand(x, size.clusters, xy)
if (!is.na(cluster[1]) && length(cluster)==size.clusters) {
i <- i+1
ids <- c(ids, rep(i, size.clusters))
indices <- c(indices, cluster)
cells.left[indices] <- -1
}
}
y <- matrix(NA, n.rows, n.cols)
y[indices] <- ids
})
cat(paste(i, "cluster(s) created.", sep=" "))
310 x 500 그리드에 적용했을 때의 결과는 다음과 같습니다 (클러스터가 명확하게 보이도록 충분히 작고 굵게 표시됨). 실행하는 데 2 초가 걸립니다. 3100 x 5000 그리드 (100 배 더 큼)에서는 시간이 더 오래 걸리지 만 (24 초) 타이밍이 적절하게 조정됩니다. C ++과 같은 다른 플랫폼에서는 타이밍이 그리드 크기에 거의 의존하지 않아야합니다.
