Offrirò una Rsoluzione codificata in modo leggermente non R-illustrativo per illustrare come potrebbe essere affrontata su altre piattaforme.
La preoccupazione in R(così come in alcune altre piattaforme, in particolare quelle che favoriscono uno stile di programmazione funzionale) è che l'aggiornamento costante di un array di grandi dimensioni può essere molto costoso. Invece, quindi, questo algoritmo mantiene la propria struttura di dati privata in cui sono elencati (a) tutte le celle che sono state riempite finora e (b) tutte le celle disponibili per essere scelte (attorno al perimetro delle celle riempite) sono elencati. Sebbene la manipolazione di questa struttura di dati sia meno efficiente rispetto all'indicizzazione diretta in un array, mantenendo i dati modificati su dimensioni ridotte, probabilmente richiederà molto meno tempo di calcolo. (Non è stato fatto Ralcuno sforzo per ottimizzarlo . La pre-allocazione dei vettori statali dovrebbe risparmiare un po 'di tempo di esecuzione, se si preferisce continuare a lavorare all'interno R.)
Il codice è commentato e dovrebbe essere semplice da leggere. Per rendere l'algoritmo il più completo possibile, non utilizza alcun componente aggiuntivo se non alla fine per tracciare il risultato. L'unica parte complicata è che per efficienza e semplicità preferisce indicizzare nelle griglie 2D usando gli indici 1D. Si verifica una conversione nella neighborsfunzione, che necessita dell'indicizzazione 2D per capire quali potrebbero essere i vicini accessibili di una cella e quindi li converte nell'indice 1D. Questa conversione è standard, quindi non commenterò ulteriormente se non per sottolineare che in altre piattaforme GIS potresti voler invertire i ruoli degli indici di colonna e riga. (In R, gli indici di riga cambiano prima degli indici di colonna.)
Per illustrare, questo codice prende una griglia che xrappresenta la terra e una caratteristica simile a un fiume di punti inaccessibili, inizia in una posizione specifica (5, 21) in quella griglia (vicino alla curva inferiore del fiume) e la espande in modo casuale per coprire 250 punti . Il tempo totale è di 0,03 secondi. (Quando la dimensione dell'array viene aumentata di un fattore compreso tra 10.000 e 3000 righe per 5000 colonne, la temporizzazione sale solo a 0,09 secondi - un fattore di soli 3 o giù di lì - dimostrando la scalabilità di questo algoritmo.) Invece di semplicemente emettendo una griglia di 0, 1 e 2, genera la sequenza con cui sono state allocate le nuove celle. Sulla figura le prime cellule sono verdi, che si laureano in oro color salmone.
Dovrebbe essere evidente che viene utilizzato un quartiere di otto punti di ogni cella. Per altri quartieri, modifica semplicemente il nbrhoodvalore vicino all'inizio di expand: è un elenco di offset dell'indice relativi a una determinata cella. Ad esempio, un quartiere "D4" potrebbe essere specificato come matrix(c(-1,0, 1,0, 0,-1, 0,1), nrow=2).
È anche evidente che questo metodo di diffusione ha i suoi problemi: lascia buchi dietro. Se questo non è ciò che si intendeva, ci sono vari modi per risolvere questo problema. Ad esempio, mantenere le celle disponibili in una coda in modo che le prime celle trovate siano anche le prime riempite. È ancora possibile applicare una certa randomizzazione, ma le celle disponibili non saranno più scelte con probabilità uniformi (uguali). Un altro modo più complicato sarebbe selezionare le celle disponibili con probabilità che dipendono dal numero di vicini pieni che hanno. Una volta che una cella viene circondata, puoi fare la sua possibilità di selezione così in alto che pochi buchi rimarrebbero vuoti.
Concluderò commentando che questo non è proprio un automa cellulare (CA), che non procederebbe cellula per cellula, ma aggiornerebbe invece intere fasce di cellule in ogni generazione. La differenza è sottile: con la CA, le probabilità di selezione per le celle non sarebbero uniformi.
#
# 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)
Con lievi modifiche, possiamo expandcreare un loop per creare più cluster. Si consiglia di differenziare i cluster da un identificatore, che qui eseguirà 2, 3, ..., ecc.
Innanzitutto, cambia expandper restituire (a) NAalla prima riga se c'è un errore e (b) i valori in indicespiuttosto che una matrice y. (Non perdere tempo a creare una nuova matrice ycon ogni chiamata.) Con questa modifica, il looping è facile: scegli un avvio casuale, prova ad espandersi attorno ad esso, accumula gli indici del cluster in indicescaso di successo e ripeti fino a quando non hai finito. Una parte fondamentale del ciclo è limitare il numero di iterazioni nel caso in cui non sia possibile trovare molti cluster contigui: questo viene fatto count.max.
Ecco un esempio in cui 60 centri di cluster vengono scelti in modo uniforme a caso.
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=" "))
Ecco il risultato quando applicato a una griglia di 310 per 500 (reso sufficientemente piccolo e ruvido perché i cluster siano evidenti). Ci vogliono due secondi per eseguire; su una griglia da 3100 per 5000 (100 volte più grande) ci vuole più tempo (24 secondi) ma i tempi si stanno ridimensionando ragionevolmente bene. (Su altre piattaforme, come C ++, i tempi non dovrebbero dipendere dalle dimensioni della griglia.)
