Tôi sẽ đưa ra một Rgiải pháp được mã hóa theo cách hơi phi Rthường để minh họa cách nó có thể được tiếp cận trên các nền tảng khác.
Mối quan tâm trong R(cũng như một số nền tảng khác, đặc biệt là những nền tảng thiên về phong cách lập trình chức năng) là việc liên tục cập nhật một mảng lớn có thể rất tốn kém. Thay vào đó, thuật toán này duy trì cấu trúc dữ liệu riêng của nó, trong đó (a) tất cả các ô đã được điền cho đến nay được liệt kê và (b) tất cả các ô có sẵn để được chọn (xung quanh chu vi của các ô được lấp đầy) được liệt kê. Mặc dù thao tác cấu trúc dữ liệu này kém hiệu quả hơn so với việc lập chỉ mục trực tiếp vào một mảng, bằng cách giữ dữ liệu được sửa đổi ở kích thước nhỏ, có thể sẽ mất ít thời gian tính toán hơn. (Không có nỗ lực nào được thực hiện để tối ưu hóa nó cho Rcả. Việc phân bổ trước các vectơ trạng thái phải tiết kiệm thời gian thực hiện, nếu bạn muốn tiếp tục làm việc bên trong R.)
Mã được nhận xét và nên đơn giản để đọc. Để làm cho thuật toán hoàn chỉnh nhất có thể, nó không sử dụng bất kỳ tiện ích bổ sung nào ngoại trừ ở phần cuối để vẽ kết quả. Phần khó khăn duy nhất là về tính hiệu quả và đơn giản, nó thích lập chỉ mục vào lưới 2D bằng cách sử dụng các chỉ mục 1D. Một chuyển đổi xảy ra trong neighborshàm, cần lập chỉ mục 2D để tìm ra các hàng xóm có thể truy cập của một ô có thể là gì và sau đó chuyển đổi chúng thành chỉ mục 1D. Chuyển đổi này là tiêu chuẩn, vì vậy tôi sẽ không bình luận gì thêm về nó ngoại trừ chỉ ra rằng trong các nền tảng GIS khác, bạn có thể muốn đảo ngược vai trò của các chỉ mục cột và hàng. (Trong R, chỉ mục hàng thay đổi trước khi chỉ mục cột thực hiện.)
Để minh họa, mã này lấy một lưới xbiểu thị đất và một đặc điểm giống như sông của các điểm không thể tiếp cận, bắt đầu tại một vị trí cụ thể (5, 21) trong lưới đó (gần khúc quanh dưới của dòng sông) và mở rộng ngẫu nhiên để bao phủ 250 điểm . Tổng thời gian là 0,03 giây. (Khi kích thước của mảng được tăng lên theo hệ số 10.000 đến 3000 hàng bằng 5000 cột, thời gian chỉ tăng lên 0,09 giây - hệ số chỉ 3 hoặc hơn - thể hiện khả năng mở rộng của thuật toán này.) Thay vì chỉ cần xuất ra một lưới 0, 1 và 2, nó sẽ tạo ra chuỗi các ô mới được phân bổ. Trên hình, các tế bào sớm nhất có màu xanh lá cây, chuyển dần qua vàng thành màu cá hồi.
Rõ ràng là một vùng lân cận tám điểm của mỗi ô đang được sử dụng. Đối với các vùng lân cận khác, chỉ cần sửa đổi nbrhoodgiá trị ở gần đầu expand: đó là danh sách các chỉ số bù trừ liên quan đến bất kỳ ô đã cho nào. Ví dụ, một vùng lân cận "D4" có thể được chỉ định là matrix(c(-1,0, 1,0, 0,-1, 0,1), nrow=2).
Rõ ràng là phương pháp lây lan này có vấn đề của nó: nó để lại những lỗ hổng phía sau. Nếu đó không phải là những gì đã được dự định, có nhiều cách khác nhau để khắc phục vấn đề này. Ví dụ, giữ các ô có sẵn trong hàng đợi để các ô sớm nhất được tìm thấy cũng là các ô sớm nhất được lấp đầy. Một số ngẫu nhiên vẫn có thể được áp dụng, nhưng các ô có sẵn sẽ không còn được chọn với xác suất đồng nhất (bằng). Một cách khác, phức tạp hơn, sẽ là chọn các ô có sẵn với xác suất phụ thuộc vào số lượng hàng xóm mà họ có. Khi một ô được bao quanh, bạn có thể làm cho cơ hội lựa chọn của nó cao đến mức sẽ không còn lỗ nào.
Tôi sẽ kết thúc bằng cách nhận xét rằng đây không hoàn toàn là một máy tự động di động (CA), sẽ không tiến hành tế bào theo tế bào, mà thay vào đó sẽ cập nhật toàn bộ các ô của mỗi thế hệ. Sự khác biệt là tinh tế: với CA, xác suất lựa chọn cho các ô sẽ không đồng nhất.
#
# 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)
Với những sửa đổi nhỏ, chúng tôi có thể lặp lại expandđể tạo nhiều cụm. Nên phân biệt các cụm bằng một mã định danh, ở đây sẽ chạy 2, 3, ..., v.v.
Đầu tiên, thay đổi expandđể trả về (a) NAở dòng đầu tiên nếu có lỗi và (b) các giá trị indicesthay vì ma trận y. (Đừng lãng phí thời gian để tạo một ma trận mới yvới mỗi cuộc gọi.) Với thay đổi này được thực hiện, việc lặp lại rất dễ dàng: chọn một khởi đầu ngẫu nhiên, cố gắng mở rộng xung quanh nó, tích lũy các chỉ mục cụm indicesnếu thành công và lặp lại cho đến khi hoàn thành. Một phần quan trọng của vòng lặp là giới hạn số lần lặp trong trường hợp không thể tìm thấy nhiều cụm liền kề: điều này được thực hiện với count.max.
Dưới đây là một ví dụ trong đó 60 trung tâm cụm được chọn thống nhất ngẫu nhiên.
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=" "))
Đây là kết quả khi được áp dụng cho lưới 310 x 500 (được tạo ra đủ nhỏ và thô cho các cụm rõ ràng). Phải mất hai giây để thực hiện; trên lưới 3100 x 5000 (lớn hơn 100 lần) sẽ mất nhiều thời gian hơn (24 giây) nhưng thời gian được điều chỉnh hợp lý. (Trên các nền tảng khác, chẳng hạn như C ++, thời gian hầu như không phụ thuộc vào kích thước lưới.)
