if (getRversion() >= "3.1.0") {
utils::globalVariables(c("from", "id", "to"))
}
################################################################################
#' Diffuse values in a `world`
#'
#' Each `patch` gives an equal share of a portion of its value to its neighbor `patches`.
#'
#' @inheritParams fargs
#'
#' @param share Numeric. Value between 0 and 1 representing the portion of
#' the `patches` values to be diffused among the neighbors.
#'
#' @return `WorldMatrix` or `worldArray` object with `patches` values updated.
#'
#' @details What is given is lost for the patches.
#'
#' If `torus = TRUE`, all `patches` have `nNeighbors` `patches` around
#' them, which
#' some may be on the other sides of the `world`. If `torus = FALSE`,
#' `patches` located on the edges of the `world` have less than
#' `nNeighbors` `patches` around them.
#' However, each neighbor still gets 1/4 or 1/8 of the shared amount
#' and the diffusing
#' patch keeps the leftover.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#diffuse>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#diffuse4>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(
#' minPxcor = 0, maxPxcor = 4, minPycor = 0, maxPycor = 4,
#' data = sample(1:3, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' # Diffuse 50% of each patch value to its 8 neighbors
#' if (requireNamespace("SpaDES.tools", quietly = TRUE)) {
#' w2 <- diffuse(world = w1, share = 0.5, nNeighbors = 8)
#' plot(w2)
#' }
#'
#' @export
#' @importFrom data.table data.table ':='
#' @importFrom data.table setkey
#' @rdname diffuse
#'
#' @author Sarah Bauduin
#'
setGeneric(
"diffuse",
function(world, pVar, share, nNeighbors, torus = FALSE) {
standardGeneric("diffuse")
}
)
#' @export
#' @rdname diffuse
setMethod(
"diffuse",
signature = c(
world = "worldMatrix", pVar = "missing", share = "numeric",
nNeighbors = "numeric"
),
definition = function(world, share, nNeighbors, torus) {
val <- as.numeric(t(world@.Data))
cellNum <- seq_along(val)
toGive <- (val * share) / nNeighbors
if (!requireNamespace("SpaDES.tools")) {
stop("Please install.packages('SpaDES.tools')")
}
df <- SpaDES.tools::adj(world@.Data, cells = cellNum, directions = nNeighbors, torus = torus)
# nNeigh <- plyr::count(df[, "from"])
nNeigh <- as.data.frame(table(df[, "from"]))
# if (!identical(nNeigh2[[2]], nNeigh[[2]])) stop("count and table error 1")
toGiveNeigh <- rep(toGive, nNeigh$Freq)
df <- df[order(df[, "from"]), ]
dt <- data.table(df, toGiveNeigh)
setkey(dt, from)
dt <- dt[, loose := sum(toGiveNeigh), by = from] # how much each patch give
loose <- unique(dt[, c(1, 4), with = FALSE]) # from and loose
setkey(dt, to)
dt <- dt[, win := sum(toGiveNeigh), by = to] # how much each patch receive
win <- unique(dt[, c(2, 5), with = FALSE]) # to and win
newVal <- val - loose[, loose] + win[, win]
world[] <- newVal
return(world)
}
)
#' @export
#' @rdname diffuse
setMethod(
"diffuse",
signature = c(
world = "worldArray", pVar = "character", share = "numeric",
nNeighbors = "numeric"
),
definition = function(world, pVar, share, nNeighbors, torus) {
layer <- match(pVar, dimnames(world)[[3]])
val <- as.numeric(t(world@.Data[, , layer]))
cellNum <- seq_along(val)
toGive <- (val * share) / nNeighbors
if (!requireNamespace("SpaDES.tools")) {
stop("Please install.packages('SpaDES.tools')")
}
df <- SpaDES.tools::adj(world@.Data[, , layer],
cells = cellNum, directions = nNeighbors,
torus = torus
)
# nNeigh <- plyr::count(df[, "from"])
nNeigh <- as.data.frame(table(df[, "from"]))
# if (!identical(nNeigh2[[2]], nNeigh[[2]])) stop("count and table error 2")
toGiveNeigh <- rep(toGive, nNeigh$Freq)
df <- df[order(df[, "from"]), ]
dt <- data.table(df, toGiveNeigh)
setkey(dt, from)
dt <- dt[, loose := sum(toGiveNeigh), by = from] # how much each patch give
loose <- unique(dt[, c(1, 4), with = FALSE]) # from and loose
setkey(dt, to)
dt <- dt[, win := sum(toGiveNeigh), by = to] # how much each patch receive
win <- unique(dt[, c(2, 5), with = FALSE]) # to and win
newVal <- val - loose[, loose] + win[, win]
world@.Data[, , layer] <- matrix(newVal, ncol = dim(world)[2], byrow = TRUE)
return(world)
}
)
################################################################################
#' Distances between agents
#'
#' Report the distances between `agents` and `agents2`.
#'
#' @inheritParams fargs
#'
#' @param allPairs Logical. Only relevant if the number of agents/locations in
#' `agents` and in `agents2` are the same. If
#' `allPairs = FALSE`,
#' the distance between each `agents` with the
#' corresponding `agents2` is returned. If
#' `allPairs = TRUE`, a full
#' distance matrix is returned. Default is `allPairs = FALSE`.
#'
#' @return Numeric. Vector of distances between `agents` and `agents2` if
#' `agents` and/or `agents2` contained
#' one agent/location, or if `agents` and `agents2` contained the same
#' number of agents/locations and `allPairs = FALSE`, or
#'
#' Matrix of distances between `agents` (rows) and
#' `agents2` (columns)
#' if `agents` and `agents2` are of different lengths,
#' or of same length
#' and `allPairs = TRUE`.
#'
#' @details Distances from/to a patch are measured from/to its center.
#'
#' If `torus = FALSE`, `world` does not need to be provided.
#'
#' If `torus = TRUE`, a distance around the sides of the `world` is
#' reported only if smaller than the one across the `world`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#distance>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#distancexy>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' NLdist(agents = patch(w1, 0, 0), agents2 = patch(w1, c(1, 9), c(1, 9)))
#' NLdist(
#' agents = patch(w1, 0, 0), agents2 = patch(w1, c(1, 9), c(1, 9)),
#' world = w1, torus = TRUE
#' )
#' t1 <- createTurtles(n = 2, coords = randomXYcor(w1, n = 2))
#' NLdist(agents = t1, agents2 = patch(w1, c(1, 9), c(1, 9)), allPairs = TRUE)
#'
#' @export
#' @rdname NLdist
#' @aliases dist
#'
#' @author Sarah Bauduin
#'
setGeneric(
"NLdist",
function(agents, agents2, world, torus = FALSE, allPairs = FALSE) {
standardGeneric("NLdist")
}
)
#' @export
#' @rdname NLdist
setMethod(
"NLdist",
signature = c(agents = "matrix", agents2 = "matrix"),
definition = function(agents, agents2, world, torus, allPairs) {
if (inherits(agents, "agentMatrix")) {
agents <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
}
if (inherits(agents2, "agentMatrix")) {
agents2 <- agents2@.Data[, c("xcor", "ycor"), drop = FALSE]
}
# dist <- pointDistance(p1 = agents, p2 = agents2, lonlat = FALSE, allpairs = allPairs)
dist <- terra::distance(x = agents, y = agents2, lonlat = FALSE, pairwise = !allPairs)
# dist <- raster::pointDistance(p1 = agents, p2 = agents2, lonlat = FALSE, allpairs = FALSE)
if (torus == TRUE) {
if (missing(world)) {
stop("A world must be provided as torus = TRUE")
}
# Need to create coordinates for "agents2" in a wrapped world
# For all the 8 possibilities of wrapping (to the left, right, top, bottom and 4 corners)
exts <- extents(world@extent)
to1 <- cbind(
pxcor = agents2[, 1] - (exts$xmax - exts$xmin),
pycor = agents2[, 2] + (exts$ymax - exts$ymin)
)
to2 <- cbind(pxcor = agents2[, 1], pycor = agents2[, 2] +
(exts$ymax - exts$ymin))
to3 <- cbind(
pxcor = agents2[, 1] + (exts$xmax - exts$xmin),
pycor = agents2[, 2] + (exts$ymax - exts$ymin)
)
to4 <- cbind(
pxcor = agents2[, 1] - (exts$xmax - exts$xmin),
pycor = agents2[, 2]
)
to5 <- cbind(
pxcor = agents2[, 1] + (exts$xmax - exts$xmin),
pycor = agents2[, 2]
)
to6 <- cbind(
pxcor = agents2[, 1] - (exts$xmax - exts$xmin),
pycor = agents2[, 2] - (exts$ymax - exts$ymin)
)
to7 <- cbind(pxcor = agents2[, 1], pycor = agents2[, 2] -
(exts$ymax - exts$ymin))
to8 <- cbind(
pxcor = agents2[, 1] + (exts$xmax - exts$xmin),
pycor = agents2[, 2] - (exts$ymax - exts$ymin)
)
# dist1 <- raster::pointDistance(p1 = agents, p2 = to1, lonlat = FALSE, allpairs = allPairs)
# dist2 <- raster::pointDistance(p1 = agents, p2 = to2, lonlat = FALSE, allpairs = allPairs)
# dist3 <- raster::pointDistance(p1 = agents, p2 = to3, lonlat = FALSE, allpairs = allPairs)
# dist4 <- raster::pointDistance(p1 = agents, p2 = to4, lonlat = FALSE, allpairs = allPairs)
# dist5 <- raster::pointDistance(p1 = agents, p2 = to5, lonlat = FALSE, allpairs = allPairs)
# dist6 <- raster::pointDistance(p1 = agents, p2 = to6, lonlat = FALSE, allpairs = allPairs)
# dist7 <- raster::pointDistance(p1 = agents, p2 = to7, lonlat = FALSE, allpairs = allPairs)
# dist8 <- raster::pointDistance(p1 = agents, p2 = to8, lonlat = FALSE, allpairs = allPairs)
dist1 <- terra::distance(x = agents, y = to1, lonlat = FALSE, pairwise = !allPairs)
dist2 <- terra::distance(x = agents, y = to2, lonlat = FALSE, pairwise = !allPairs)
dist3 <- terra::distance(x = agents, y = to3, lonlat = FALSE, pairwise = !allPairs)
dist4 <- terra::distance(x = agents, y = to4, lonlat = FALSE, pairwise = !allPairs)
dist5 <- terra::distance(x = agents, y = to5, lonlat = FALSE, pairwise = !allPairs)
dist6 <- terra::distance(x = agents, y = to6, lonlat = FALSE, pairwise = !allPairs)
dist7 <- terra::distance(x = agents, y = to7, lonlat = FALSE, pairwise = !allPairs)
dist8 <- terra::distance(x = agents, y = to8, lonlat = FALSE, pairwise = !allPairs)
dist <- pmin(dist, dist1, dist2, dist3, dist4, dist5, dist6, dist7, dist8)
}
return(dist)
}
)
################################################################################
#' Do the patches exist?
#'
#' Report `TRUE` if a patch exists inside the `world`'s extent, report
#' `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @return Logical.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#member>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' pExist(world = w1, pxcor = -1, pycor = 2)
#'
#' @export
#' @rdname pExist
#'
#' @author Sarah Bauduin
#'
setGeneric(
"pExist",
function(world, pxcor, pycor) {
standardGeneric("pExist")
}
)
#' @export
#' @rdname pExist
setMethod(
"pExist",
signature = c("worldNLR", "numeric", "numeric"),
definition = function(world, pxcor, pycor) {
if (length(pxcor) == 1 & length(pycor) != 1) {
pxcor <- rep(pxcor, length(pycor))
}
if (length(pycor) == 1 & length(pxcor) != 1) {
pycor <- rep(pycor, length(pxcor))
}
pxcorIn <- pxcor >= world@minPxcor & pxcor <= world@maxPxcor
pycorIn <- pycor >= world@minPycor & pycor <= world@maxPycor
pExist <- pxcorIn & pycorIn
return(pExist)
}
)
################################################################################
#' Neighbors `patches`
#'
#' Report the coordinates of the neighbors `patches` around the `agents`.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 3) with the first column `pxcor`
#' and the second column `pycor` representing the coordinates of the neighbors
#' `patches` around the `agents` and the third column `id` representing
#' the `id` of the `agents` in the order provided.
#'
#' @details The `patch` around which the neighbors are identified, or the `patch` where
#' the `turtle` is located on around which the neighbors are identified, is not
#' returned.
#'
#' If `torus = FALSE`, `agents` located on the edges of the
#' `world` have less than `nNeighbors` patches around them.
#' If `torus = TRUE`, all `agents` located on the edges of the
#' `world` have `nNeighbors` patches around them,
#' which some may be on the other sides of the `world`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#neighbors>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' if (requireNamespace("SpaDES.tools", quietly = TRUE)) {
#' neighbors(world = w1, agents = patch(w1, c(0, 9), c(0, 7)), nNeighbors = 8)
#' t1 <- createTurtles(n = 3, coords = randomXYcor(w1, n = 3))
#' neighbors(world = w1, agents = t1, nNeighbors = 4)
#' }
#'
#' @export
#' @importFrom data.table data.table setkey
#' @rdname neighbors
#'
#' @author Sarah Bauduin
#'
setGeneric(
"neighbors",
function(world, agents, nNeighbors, torus = FALSE) {
standardGeneric("neighbors")
}
)
#' @export
#' @rdname neighbors
setMethod(
"neighbors",
signature = c(world = "worldNLR", agents = "matrix", nNeighbors = "numeric"),
definition = function(world, agents, nNeighbors, torus) {
if (inherits(agents, "agentMatrix")) {
agents <- patch(
world = world, x = agents@.Data[, "xcor"],
y = agents@.Data[, "ycor"], duplicate = TRUE
)
}
# To be used with adj()
if (inherits(world, "worldMatrix")) {
worldMat <- world@.Data
} else {
# worldArray
worldMat <- world@.Data[, , 1]
}
if (!requireNamespace("SpaDES.tools")) {
stop("Please install.packages('SpaDES.tools')")
}
cellNum <- cellFromPxcorPycor(world = world, pxcor = agents[, 1], pycor = agents[, 2])
largeForDT <- NROW(agents) >= 100000
neighbors <- SpaDES.tools::adj(worldMat,
cells = cellNum, directions = nNeighbors,
torus = torus, id = seq_along(cellNum), returnDT = largeForDT
)
if (!largeForDT) {
# df is faster below 10000 agents, DT faster above
pCoords <- PxcorPycorFromCell(world = world, cellNum = neighbors[, 2])
neighborsDf <- data.frame(neighbors, pCoords)
# Output as a matrix
neighbors <- neighborsDf[order(neighborsDf$id), ]
} else {
pCoords <- PxcorPycorFromCell(world = world, cellNum = neighbors[, to])
data.table::set(neighbors, NULL, "pxcor", pCoords[, 1])
data.table::set(neighbors, NULL, "pycor", pCoords[, 2])
setkey(neighbors, id)
}
neighborsID <- cbind(
pxcor = neighbors$pxcor,
pycor = neighbors$pycor,
id = neighbors$id
)
return(neighborsID)
}
)
################################################################################
#' `Patches` coordinates
#'
#' Report the coordinates of the `patches` at the given `[x, y]` locations.
#'
#' @inheritParams fargs
#'
#' @param x Numeric. Vector of `x` coordinates. Must be of same
#' length as `y`.
#'
#' @param y Numeric. Vector of `y` coordinates. Must be of same
#' length as `x`.
#'
#' @param duplicate Logical. If more than one location `[x, y]`
#' fall into the same `patch` and `duplicate == TRUE`, the
#' `patch` coordinates are returned the number of times the locations.
#' If `duplicate == FALSE`, the `patch` coordinates
#' are only returned once.
#' Default is `duplicate == FALSE`.
#'
#' @param out Logical. If `out = FALSE`, no `patch` coordinates are returned
#' for `patches` outside of the `world`'s extent, if `out = TRUE`,
#' `NA` are returned.
#' Default is `out = FALSE`.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the `patches` coordinates at `[x, y]`.
#'
#' @details If a location `[x, y]` is outside the `world`'s extent and
#' `torus = FALSE` and `out = FALSE`, no `patch` coordinates are returned;
#' if `torus = FALSE` and `out = TRUE`, `NA` are returned;
#' if `torus = TRUE`, the `patch` coordinates from a wrapped `world` are
#' returned.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' patch(world = w1, x = c(0, 9.1, 8.9, 5, 5.3), y = c(0, 0, -0.1, 12.4, 12.4))
#' patch(
#' world = w1, x = c(0, 9.1, 8.9, 5, 5.3), y = c(0, 0, -0.1, 12.4, 12.4),
#' duplicate = TRUE
#' )
#' patch(
#' world = w1, x = c(0, 9.1, 8.9, 5, 5.3), y = c(0, 0, -0.1, 12.4, 12.4),
#' torus = TRUE
#' )
#' patch(
#' world = w1, x = c(0, 9.1, 8.9, 5, 5.3), y = c(0, 0, -0.1, 12.4, 12.4),
#' torus = TRUE, duplicate = TRUE
#' )
#'
#' @export
#' @rdname patch
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patch",
function(world, x, y, duplicate = FALSE, torus = FALSE, out = FALSE) {
standardGeneric("patch")
}
)
#' @export
#' @rdname patch
setMethod(
"patch",
signature = c(world = "worldNLR", x = "numeric", y = "numeric"),
definition = function(world, x, y, duplicate, torus, out) {
pxcor <- round(x)
pycor <- round(y)
if (torus == TRUE) {
pCoords <- wrap(cbind(x = pxcor, y = pycor), world@extent)
pxcor <- pCoords[, 1]
pycor <- pCoords[, 2]
}
pxcor[pxcor < world@minPxcor | pxcor > world@maxPxcor] <- NA
pycor[pycor < world@minPycor | pycor > world@maxPycor] <- NA
pxcor[is.na(pycor)] <- NA
pycor[is.na(pxcor)] <- NA
if (out == FALSE) {
pxcor <- pxcor[!is.na(pxcor)]
pycor <- pycor[!is.na(pycor)]
}
pCoords <- matrix(
data = c(pxcor, pycor), ncol = 2,
nrow = length(pxcor), dimnames = list(NULL, c("pxcor", "pycor"))
)
if (duplicate == FALSE) {
pCoords <- unique(pCoords)
}
return(pCoords)
}
)
################################################################################
#' No `patches`
#'
#' Report an empty `patch` `agentset`.
#'
#' @return Matrix (`ncol` = 2, `nrow` = 0) with the first column `pxcor` and the
#' second column `pycor`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#no-patches>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' p1 <- noPatches()
#' NLcount(p1)
#'
#' @export
#' @rdname noPatches
#'
#' @author Sarah Bauduin
#'
noPatches <- function() {
return(matrix(0, nrow = 0, ncol = 2, dimnames = list(NULL, c("pxcor", "pycor"))))
}
################################################################################
#' `Patches` at
#'
#' Report the coordinates of the `patches` at `(dx, dy)` distances of the `agents`.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the coordinates of the `patches` at `(dx, dy)`
#' distances of the `agents`. The order of the `patches` follows the order
#' of the `agents`.
#'
#' @details If the `patch` at distance `(dx, dy)`
#' of an `agent` is outside of the `world`'s extent and `torus = FALSE`,
#' `NA` are returned
#' for the `patch` coordinates;
#' if `torus = TRUE`, the `patch` coordinates from a wrapped `world` are
#' returned.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-at>
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#at-points>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' patchCorner <- patchAt(world = w1, agents = patch(w1, 0, 0), dx = 1, dy = 1)
#' t1 <- createTurtles(n = 1, coords = cbind(xcor = 0, ycor = 0))
#' patchCorner <- patchAt(world = w1, agents = t1, dx = 1, dy = 1)
#'
#' @export
#' @rdname patchAt
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchAt",
function(world, agents, dx, dy, torus = FALSE) {
standardGeneric("patchAt")
}
)
#' @export
#' @rdname patchAt
setMethod(
"patchAt",
signature = c(world = "worldNLR", agents = "matrix", dx = "numeric", dy = "numeric"),
definition = function(world, agents, dx, dy, torus) {
if (inherits(agents, "agentMatrix")) {
agents <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
}
pxcor <- agents[, 1] + dx
pycor <- agents[, 2] + dy
pAt <- patch(
world = world, x = pxcor, y = pycor, duplicate = TRUE,
torus = torus, out = TRUE
)
return(pAt)
}
)
################################################################################
#' `Patches` at given distances and directions
#'
#' Report the coordinates of the `patches` at the given
#' distances and directions from the `agents`.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances from the `agents`. Must be
#' of length 1 or of the same length as the number of `agents`.
#'
#' @param angle Numeric. Absolute directions from the `agents`. `angle`
#' must be of length 1 or of the same length as the number of
#' `agents`. Angles are in degrees with 0 being North.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the coordinates of the `patches` at the distances
#' `dist` and directions `angle` of `agents`.
#' The order of the `patches` follows the order of the `agents`.
#'
#' @details If `torus = FALSE` and the `patch` at distance `dist` and
#' direction `angle` of an `agent` is outside the `world`'s extent,
#' `NA` are returned for the `patch` coordinates.
#' If `torus = TRUE`, the `patch` coordinates from a wrapped `world`
#' are returned.
#'
#' If `agents` are `turtles`, their `headings` are not taken into account;
#' the given directions `angle` are used. To find a `patch` at certain
#' distance from a `turtle` using the `turtle`'s `heading`, look at `pacthAhead()`,
#' `patchLeft()` or `patchRight()`.
#'
#' @seealso
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-at-heading-and-distance>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' p1 <- patchDistDir(world = w1, agents = patch(w1, 0, 0), dist = 1, angle = 45)
#' t1 <- createTurtles(n = 1, coords = cbind(xcor = 0, ycor = 0), heading = 315)
#' p2 <- patchDistDir(world = w1, agents = t1, dist = 1, angle = 45)
#'
#' @export
#' @rdname patchDistDir
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchDistDir",
function(world, agents, dist, angle, torus = FALSE) {
standardGeneric("patchDistDir")
}
)
#' @export
#' @rdname patchDistDir
setMethod(
"patchDistDir",
signature = c(world = "worldNLR", agents = "matrix", dist = "numeric", angle = "numeric"),
definition = function(world, agents, dist, angle, torus) {
if (inherits(agents, "agentMatrix")) {
agents <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
}
radAngle <- rad(angle)
pxcor <- agents[, 1] + sin(radAngle) * dist
pycor <- agents[, 2] + cos(radAngle) * dist
pDistHead <- patch(
world = world, x = pxcor, y = pycor, torus = torus,
duplicate = TRUE, out = TRUE
)
return(pDistHead)
}
)
################################################################################
#' All the `patches` in a `world`
#'
#' Report the coordinates of all the `patches` in the `world`.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the `patches` coordinates. The order of the `patches`
#' follows the order of the cells numbers as defined for a `Raster*` object.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' allPatches <- patches(world = w1)
#' NLcount(allPatches) # 100 patches
#'
#' @author Sarah Bauduin
#' @export
#' @rdname patches
setGeneric(
"patches",
function(world) {
standardGeneric("patches")
}
)
#' @export
#' @rdname patches
setMethod(
"patches",
signature = "worldNLR",
definition = function(world) {
return(world@pCoords)
}
)
################################################################################
#' `Patch` set
#'
#' Report the `patch` coordinates of all the unique `patches` contained in the inputs.
#'
#' @param ... Matrices (`ncol` = 2) of `patches` coordinates with the first column
#' `pxcor` and the second column `pycor`.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the `patches` coordinates.
#'
#' @details Duplicate `patches` among the inputs are removed in the returned matrix.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-set>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' p1 <- patchAt(world = w1, agents = patch(w1, c(0, 1, 2), c(0, 0, 0)), dx = 1, dy = 1)
#' p2 <- patchDistDir(world = w1, agents = patch(w1, 0, 0), dist = 1, angle = 45)
#' p3 <- patch(world = w1, x = 4.3, y = 8)
#' p4 <- patchSet(p1, p2, p3)
#'
#' @export
#' @rdname patchSet
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchSet",
function(...) {
standardGeneric("patchSet")
}
)
#' @export
#' @rdname patchSet
setMethod(
"patchSet",
signature = "matrix",
definition = function(...) {
dots <- list(...)
pCoords <- unique(do.call(rbind, dots))
return(pCoords)
}
)
################################################################################
#' Random `pxcor`
#'
#' Report `n` random `pxcor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Integer. Vector of length `n` of `pxcor` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-pcor>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' pxcor <- randomPxcor(world = w1, n = 10)
#'
#' @export
#' @rdname randomPxcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomPxcor",
function(world, n) {
standardGeneric("randomPxcor")
}
)
#' @export
#' @rdname randomPxcor
setMethod(
"randomPxcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
pxcor <- sample(minPxcor(world):maxPxcor(world), size = n, replace = TRUE)
return(pxcor)
}
)
################################################################################
#' Random `pycor`
#'
#' Report `n` random `pycor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Integer. Vector of length `n` of `pycor` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-pcor>
#'
#' @references Wilensky, U. 1999. NetLogo. <http://ccl.northwestern.edu/netlogo/>.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' pycor <- randomPycor(world = w1, n = 10)
#'
#' @export
#' @rdname randomPycor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomPycor",
function(world, n) {
standardGeneric("randomPycor")
}
)
#' @export
#' @rdname randomPycor
setMethod(
"randomPycor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
pycor <- sample(minPycor(world):maxPycor(world), size = n, replace = TRUE)
return(pycor)
}
)
rad <- function(degree) (degree * pi) / 180
deg <- function(radian) (radian * 180) / pi
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.