他のプラットフォームでどのようにアプローチされるかを説明するためR
に、少し無意味にコーディングされたソリューションを提供しR
ます。
R
(および他のプラットフォーム、特に関数型プログラミングスタイルを好むプラットフォーム)の懸念は、大きな配列を絶えず更新すると非常に高価になる可能性があることです。代わりに、このアルゴリズムは、(a)これまでに入力されたすべてのセルがリストされ、(b)選択できるすべてのセル(入力されたセルの周囲)の独自のプライベートデータ構造を維持しますリストされています。このデータ構造の操作は、配列に直接インデックスを付けるよりも効率的ではありませんが、変更されたデータを小さなサイズに保つことで、計算時間が大幅に短縮されます。(のために最適化するための努力も行われていません。R
内で作業を続けたい場合、状態ベクトルの事前割り当ては実行時間をいくらか節約するはずですR
。)
コードはコメント化されており、読みやすくする必要があります。アルゴリズムをできるだけ完全にするために、結果をプロットするために最後を除いてアドオンを使用しません。唯一のトリッキーな部分は、効率と単純さのために、1Dインデックスを使用して2Dグリッドにインデックスを付けることを好みます。neighbors
関数内で変換が行われます。この変換では、セルのアクセス可能な隣接セルを特定し、それらを1Dインデックスに変換するために2Dインデックスが必要です。この変換は標準であるため、他のGISプラットフォームでは列と行のインデックスの役割を逆にしたい場合があることを指摘する以外は、これについてはコメントしません。(ではR
、列インデックスが変更される前に行インデックスが変更されます。)
説明のために、このコードは、x
土地とアクセスできないポイントの川のような特徴を表すグリッドを取り、そのグリッドの特定の位置(5、21)(川の下部ベンド近く)で開始し、250ポイントをカバーするようにランダムに拡張します。合計タイミングは0.03秒です。(アレイのサイズが10,000行から3000行、5000列の係数で増加した場合、タイミングは0.09秒(3倍程度)になり、このアルゴリズムのスケーラビリティを示します。) 0、1、2のグリッドを出力するだけで、新しいセルが割り当てられたシーケンスを出力します。図では、最も初期の細胞は緑色で、金色からサケ色に変化しています。
各セルの8ポイント近傍が使用されていることは明らかです。他の近傍の場合、単にnbrhood
の開始付近の値を変更しますexpand
。これは、任意のセルに関連するインデックスオフセットのリストです。たとえば、「D4」近傍はとして指定できますmatrix(c(-1,0, 1,0, 0,-1, 0,1), nrow=2)
。
この拡散方法には問題があることも明らかです。それは、穴を残します。それが意図したものではない場合、この問題を修正するさまざまな方法があります。たとえば、使用可能なセルをキューに入れて、見つかった最も古いセルが最も早く埋められるようにします。一部のランダム化は引き続き適用できますが、使用可能なセルは均一(等しい)確率で選択されなくなります。もう1つのより複雑な方法は、使用可能なセルを選択することです。使用可能なセルは、セルが満たされている隣接セルの数によって異なります。セルが囲まれると、選択の可能性が非常に高くなるため、空いている穴がほとんどなくなります。
最後に、これはセルオートマトン(CA)ではなく、セルごとに進行するのではなく、各世代のセルのスワス全体を更新するというコメントで終わります。違いは微妙です。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)エラーがある場合は最初の行expand
に戻りNA
、(b)indices
matrixではなくinの値を返すように変更しますy
。(y
呼び出しごとに新しいマトリックスを作成するのに時間を浪費しないでください。)この変更により、ループが簡単になります。ランダムな開始を選択し、その周りに拡大して、indices
成功した場合はクラスターインデックスを蓄積し、完了するまで繰り返します。ループの重要な部分は、多数の連続するクラスターが見つからない場合に反復回数を制限することcount.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 ++などの他のプラットフォームでは、タイミングはグリッドサイズにほとんど依存しません。)