Diğer platformlarda nasıl ele alınabileceğini göstermek R
için biraz da olsa kodlanmamış bir çözüm sunacağım R
.
R
(Diğer bazı platformların yanı sıra, özellikle işlevsel bir programlama stilini tercih edenler) endişesi, büyük bir dizinin sürekli güncellenmesinin çok pahalı olabileceğidir. Bunun yerine, bu algoritma, (a) şimdiye kadar doldurulmuş tüm hücrelerin listelendiği ve (b) seçilebilecek tüm hücrelerin (doldurulmuş hücrelerin çevresinde) bulunduğu kendi özel veri yapısını korur. listelendi. Bu veri yapısının manipüle edilmesi, bir diziye doğrudan endekslenmekten daha az verimli olmasına rağmen, değiştirilen verileri küçük bir boyutta tutarak, muhtemelen çok daha az hesaplama süresi alacaktır. (Bunu R
da optimize etmek için hiçbir çaba gösterilmedi . Durum vektörlerinin önceden tahsis edilmesi, içinde çalışmaya devam etmeyi tercih ederseniz, bazı yürütme sürelerinden tasarruf etmelidir R
.)
Kod yorumlanır ve okunması kolay olmalıdır. Algoritmayı olabildiğince eksiksiz hale getirmek için, sonucu çizmek için sonunda hiçbir eklenti kullanılmaz. Zor olan tek nokta, verimlilik ve basitlik için 1D dizinleri kullanarak 2D ızgaralara endekslemeyi tercih etmesidir. Bir neighbors
hücrenin erişilebilir komşularının ne olabileceğini anlamak ve daha sonra bunları 1D indeksine dönüştürmek için 2D indekslemeye ihtiyaç duyan fonksiyonda bir dönüşüm gerçekleşir . Bu dönüşüm standart, bu yüzden diğer GIS platformlarında sütun ve satır dizinlerinin rollerini ters çevirmek isteyebileceğinize işaret etmek dışında daha fazla yorum yapmayacağım. (In R
, satır dizinleri sütun dizinleri değişmeden önce değişir.)
Bunu göstermek için, bu kod x
araziyi temsil eden bir ızgarayı ve erişilemeyen noktaların nehir benzeri bir özelliğini alır, bu ızgarada (nehrin alt kıvrımının yakınında) belirli bir yerde (5, 21) başlar ve 250 noktayı kapsayacak şekilde rastgele genişletir. . Toplam zamanlama 0.03 saniyedir. (Dizinin boyutu, 5000 sütun ile 10.000 ila 3000 satır arasında bir faktör artırıldığında, zamanlama yalnızca 0.09 saniyeye kadar yükselir - sadece 3 veya daha fazla bir faktör - bu algoritmanın ölçeklenebilirliğini gösterir.) Bunun yerine sadece 0, 1 ve 2'lik bir ızgara çıkarır, yeni hücrelerin tahsis edildiği sırayı verir. Şekilde en eski hücreler yeşildir, altınlardan somon renklerine geçer.
Her bir hücrenin sekiz noktalı bir mahallesinin kullanıldığı açık olmalıdır. Diğer mahalleler için, nbrhood
değeri yalnızca başlangıcına yakın bir yerde değiştirin expand
: belirli bir hücreye göre dizin ofsetleri listesidir. Örneğin, bir "D4" mahallesi olarak belirtilebilir matrix(c(-1,0, 1,0, 0,-1, 0,1), nrow=2)
.
Bu yayılma yönteminin problemleri olduğu da açıktır: arkada delikler bırakır. Amaçlanan bu değilse, bu sorunu çözmenin çeşitli yolları vardır. Örneğin, bulunan hücreleri ilk sırada tutun, böylece bulunan en eski hücreler de doldurulan en eski hücreler olur. Yine de bazı randomizasyonlar uygulanabilir, ancak mevcut hücreler artık tekdüze (eşit) olasılıklarla seçilmeyecektir. Başka, daha karmaşık bir yol, kaç dolu komşuya sahip olduklarına bağlı olasılıkları olan mevcut hücreleri seçmek olacaktır. Bir hücre çevrelendiğinde, seçim şansını o kadar yüksek yapabilirsiniz ki birkaç delik dolmadan bırakılacaktır.
Bunun, hücre hücre ilerlemeyecek, ancak her nesildeki tüm hücre alanlarını güncelleyecek bir hücresel otomat (CA) olmadığını yorumlayarak bitireceğim. Fark incedir: CA ile hücreler için seçim olasılıkları aynı olmaz.
#
# 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)
Küçük değişikliklerle, expand
birden çok küme oluşturmak için döngü yapabiliriz . Kümeleri burada 2, 3, ..., vb. Çalıştıracak bir tanımlayıcı ile ayırmanız önerilir.
İlk olarak, bir değişiklik expand
, (a) geri dönmek için NA
, bir hata ve (b) değerleri vardır, ilk satırında indices
yerine bir matris y
. ( y
Her çağrıda yeni bir matris oluşturmak için zaman kaybetmeyin .) Bu değişiklik yapıldığında, döngü kolaydır: rastgele bir başlangıç seçin, etrafında genişlemeyi deneyin, indices
başarılıysa küme dizinlerini biriktirin ve bitene kadar tekrarlayın. Döngünün önemli bir parçası, birçok bitişik kümenin bulunamaması durumunda yineleme sayısını sınırlamaktır: bu ile yapılır count.max
.
İşte 60 küme merkezinin rasgele bir şekilde seçildiği bir örnek.
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 ızgaraya uygulandığında sonuç (kümelerin görünür olması için yeterince küçük ve kaba yapılır). Yürütülmesi iki saniye sürer; 3100 x 5000 ızgarada (100 kat daha büyük) daha uzun (24 saniye) sürer, ancak zamanlama oldukça iyi ölçeklenir. (C ++ gibi diğer platformlarda, zamanlama neredeyse ızgara boyutuna bağlı olmamalıdır.)