ฉันจะเสนอRวิธีแก้ไขปัญหาที่เขียนในRวิธีที่ไม่ชัดเจนเพื่อแสดงให้เห็นถึงวิธีการที่อาจเข้าหาบนแพลตฟอร์มอื่น ๆ
ความกังวลในR(เช่นเดียวกับแพลตฟอร์มอื่น ๆ โดยเฉพาะอย่างยิ่งผู้ที่ชื่นชอบสไตล์การเขียนโปรแกรมการทำงาน) คือการปรับปรุงอาร์เรย์ขนาดใหญ่อย่างต่อเนื่องอาจมีราคาแพงมาก แต่อัลกอริทึมนี้จะรักษาโครงสร้างข้อมูลส่วนตัวของตัวเองซึ่ง (a) เซลล์ทั้งหมดที่ถูกเติมจนถึงตอนนี้มีการระบุไว้และ (b) เซลล์ทั้งหมดที่มีให้เลือก (รอบปริมณฑลของเซลล์ที่เติม) มีการระบุไว้ แม้ว่าการจัดการโครงสร้างข้อมูลนี้จะมีประสิทธิภาพน้อยกว่าการจัดทำดัชนีลงในอาร์เรย์โดยตรงโดยการรักษาข้อมูลที่แก้ไขให้มีขนาดเล็ก แต่ก็อาจใช้เวลาในการคำนวณน้อยลง (ไม่มีความพยายามในการปรับให้เหมาะสมRเช่นกันการจัดสรรล่วงหน้าของเวกเตอร์ของรัฐควรประหยัดเวลาดำเนินการบางอย่างหากคุณต้องการทำงานภายในRต่อไป)
รหัสมีความคิดเห็นและควรจะตรงไปตรงมาอ่าน เพื่อทำให้อัลกอริทึมสมบูรณ์ที่สุดเท่าที่จะทำได้จึงไม่ใช้โปรแกรมเสริมใด ๆ ยกเว้นในตอนท้ายเพื่อพล็อตผลลัพธ์ ส่วนที่ยุ่งยากเท่านั้นคือเพื่อประสิทธิภาพและความเรียบง่ายมันต้องการสร้างดัชนีลงในกริด 2D โดยใช้ดัชนี 1D การแปลงเกิดขึ้นในneighborsฟังก์ชั่นซึ่งต้องการการทำดัชนี 2D เพื่อที่จะเข้าใจว่าเพื่อนบ้านที่สามารถเข้าถึงได้ของเซลล์นั้นสามารถแปลงเป็นดัชนี 1D ได้อย่างไร การแปลงนี้เป็นมาตรฐานดังนั้นฉันจะไม่แสดงความคิดเห็นเพิ่มเติมยกเว้นเพื่อชี้ให้เห็นว่าในแพลตฟอร์ม GIS อื่น ๆ คุณอาจต้องการย้อนกลับบทบาทของคอลัมน์และดัชนีแถว (ในRดัชนีแถวเปลี่ยนไปก่อนที่ดัชนีคอลัมน์จะทำ)
เพื่อแสดงให้เห็นว่ารหัสนี้ใช้ตารางที่xเป็นตัวแทนของที่ดินและลักษณะคล้ายแม่น้ำของจุดที่เข้าถึงไม่ได้เริ่มต้นที่ตำแหน่งเฉพาะ (5, 21) ในตารางนั้น (ใกล้กับโค้งล่างของแม่น้ำ) และขยายแบบสุ่มเพื่อครอบคลุม 250 คะแนน . เวลาทั้งหมดคือ 0.03 วินาที (เมื่อขนาดของอาเรย์เพิ่มขึ้นจากระดับ 10,000 ถึง 3,000 แถวโดย 5000 คอลัมน์เวลาจะเพิ่มขึ้นเพียง 0.09 วินาที - ซึ่งเป็นเพียง 3 หรือมากกว่าเท่านั้น - แสดงให้เห็นถึงความสามารถในการปรับขนาดของอัลกอริธึมนี้) แทน เพียงแค่แสดงตารางของ 0, 1, และ 2 ของมันก็จะส่งออกลำดับที่มีการจัดสรรเซลล์ใหม่ ในภาพเซลล์ที่เก่าแก่ที่สุดเป็นสีเขียวจบการศึกษาจากทองคำเป็นสีปลาแซลมอน
มันควรจะเห็นได้ว่ามีการใช้พื้นที่ใกล้เคียงแปดจุดของแต่ละเซลล์ สำหรับละแวกใกล้เคียงอื่น ๆ เพียงแค่ปรับเปลี่ยนnbrhoodค่าใกล้กับจุดเริ่มต้นของexpand: มันเป็นรายการของดัชนีชดเชยที่เกี่ยวข้องกับเซลล์ใด ๆ ที่ได้รับ ยกตัวอย่างเช่นย่าน "D4" matrix(c(-1,0, 1,0, 0,-1, 0,1), nrow=2)อาจจะระบุเป็น
เห็นได้ชัดว่าวิธีการแพร่กระจายนี้มีปัญหา: มันทิ้งไว้ข้างหลัง หากนั่นไม่ใช่สิ่งที่ตั้งใจไว้มีหลายวิธีในการแก้ไขปัญหานี้ ตัวอย่างเช่นเก็บเซลล์ที่มีอยู่ในคิวเพื่อให้เซลล์ที่เก่าที่สุดที่พบนั้นเป็นเซลล์ที่เก่าที่สุด การสุ่มบางอย่างยังสามารถใช้ได้ แต่เซลล์ที่มีอยู่จะไม่ถูกเลือกด้วยความน่าจะเป็นชุด (เท่ากับ) อีกต่อไป อีกวิธีที่ซับซ้อนกว่าคือการเลือกเซลล์ที่มีความน่าจะเป็นซึ่งขึ้นอยู่กับจำนวนเพื่อนบ้านที่มี เมื่อเซลล์ล้อมรอบคุณสามารถสร้างโอกาสในการเลือกสูงจนไม่กี่หลุมที่ไม่ได้บรรจุจนเต็ม
ฉันจะเสร็จสิ้นโดยแสดงความคิดเห็นว่านี่ไม่ใช่หุ่นยนต์อัตโนมัติ (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, ... , ฯลฯ
ประการแรกการเปลี่ยนแปลงexpandที่จะกลับมา (ก) NAในบรรทัดแรกถ้ามีข้อผิดพลาดและ (ข) ค่าในมากกว่าเมทริกซ์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 x 500 (ทำให้มีขนาดเล็กและหยาบพอที่จะทำให้กระจุกเกิดขึ้นได้) ใช้เวลาสองวินาทีในการดำเนินการ บนกริด 3100 คูณ 5,000 (ใหญ่กว่า 100 เท่า) ใช้เวลานานกว่า (24 วินาที) แต่ระยะเวลาปรับขยายได้ดีพอสมควร (บนแพลตฟอร์มอื่น ๆ เช่น C ++ ระยะเวลาแทบจะไม่ขึ้นกับขนาดกริด)
