Я запропоную Rрішення, яке кодується дещо не Rтак, щоб проілюструвати, як можна підійти до інших платформ.
Занепокоєння R(як і деяких інших платформ, особливо тих, які надають перевагу функціональному стилю програмування) полягає в тому, що постійне оновлення великого масиву може бути дуже дорогим. Натомість, цей алгоритм підтримує свою власну структуру приватних даних, в якій (a) перераховані всі досі заповнені осередки та (b) всі осередки, доступні для вибору (по всьому периметру заповнених комірок) перераховані. Хоча маніпулювання цією структурою даних є менш ефективною, ніж безпосередньо індексація в масив, зберігаючи змінені дані невеликого розміру, це, швидше за все, займе набагато менше часу на обчислення. (Не було докладено жодних зусиль для його оптимізації R. Попереднє виділення державних векторів повинно економити деякий час виконання, якщо ви хочете продовжувати працювати всередині R.)
Код коментується і його слід читати просто. Щоб алгоритм був максимально повним, він не використовує будь-яких доповнень, за винятком кінця для побудови результату. Єдина складна частина полягає в тому, що для ефективності та простоти вона віддає перевагу індексуванню в 2D-сітки за допомогою 1D-індексів. Перетворення відбувається у neighborsфункції, якій потрібна 2D-індексація, щоб зрозуміти, якими можуть бути доступні сусіди комірки, а потім перетворити їх у індекс 1D. Ця конверсія є стандартною, тому я не буду коментувати її далі, крім того, щоб зазначити, що в інших GIS-платформах ви можете змінити ролі індексів стовпців і рядків. (У R, індекси рядків змінюються до того, як роблять індекси стовпців.)
Для ілюстрації цей код приймає сітку, що xпредставляє сушу та річкову особливість важкодоступних точок, починається з певного місця (5, 21) у цій сітці (біля нижнього вигину річки) і розширює її випадковим чином, щоб охопити 250 точок . Загальний час - 0,03 секунди. (Коли розмір масиву збільшується в 10 000 - 3000 рядків на 5000 стовпців, час збільшується лише до 0,09 секунди - коефіцієнт лише 3 або близько того - демонструє масштабованість цього алгоритму.) Замість цього щойно виводить сітку 0, 1 та 2, вона виводить послідовність, з якою були виділені нові комірки. На малюнку найдавніші клітини зелені, що перетворюються через золото в кольори лосося.
Повинно бути очевидним, що використовується восьмиточкове сусідство кожної комірки. Для інших мікрорайонів просто змініть 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, ... і т.д.
По-перше, змініть expandна повернення (a) NAна першому рядку, якщо є помилка та (b) значення в indicesматриці 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 на 500 (зроблений достатньо малим і грубим, щоб кластери були видимими). На виконання потрібно дві секунди; на сітці 3100 на 5000 (в 100 разів більше) потрібно більше часу (24 секунди), але терміни масштабування досить добре. (На інших платформах, таких як C ++, терміни навряд чи залежать від розміру сітки.)
