R/turtle-functions.R
In PredictiveEcology/NetLogoR: Build and Run Spatially Explicit Agent-Based Models
Defines functions
extents
noTurtles
Documented in
noTurtles
################################################################################
#' Create `turtles`
#'
#' Create `n` moving `agents` with a set of defined variables.
#'
#' @inheritParams fargs
#'
#' @param coords Matrix (`ncol` = 2) with the first column `xcor` and the second
#' column `ycor` representing the `turtles` initial locations.
#' `nrow(coords)` must be equal to 1 or to `n`.
#' Given coordinates must be inside the `world`'s extent. If missing,
#' `turtles` are put in the center of the `world`.
#'
#' @param heading Numeric. Vector of values between 0 and 360. Must be of length 1 or
#' of length `n`. If missing, a random `heading` is assigned to
#' each `turtle`.
#'
#' @param breed Character. Vector of `breed` names. Must be of length 1 or of length
#' `n`. If missing, `breed = "turtle"` for all `turtles`.
#'
#' @return `AgentMatrix` object of length `n` with data for the
#' `turtles` being: `xcor`, `ycor`, `who`, `heading`, `prevX`, `prevY`,
#' `breed`, and `color`.
#'
#' @details If `coords` is provided, `world` must not be provided.
#'
#' The identity of the `turtles` is defined by their `who` number. This
#' numbering starts at 0 and increments by 1.
#'
#' The coordinates from the previous time step are stored in `prevX` and
#' `prevY`. The initial values are `NA`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname createTurtles
#'
#' @author Sarah Bauduin
setGeneric(
"createTurtles",
function(n, coords, world, heading, breed, color) {
standardGeneric("createTurtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname createTurtles
setMethod(
"createTurtles",
signature = c("numeric", "matrix", "missing", "ANY", "ANY", "ANY"),
definition = function(n, coords, world, heading, breed, color) {
if (missing(heading)) heading <- runif(n = n, min = 0, max = 360)
if (missing(breed)) breed <- "turtle"
if (missing(color)) color <- rainbow(n)
repNA <- rep(NA, n)
turtles <- new("agentMatrix",
coords = coords,
who = seq_len(n) - 1,
heading = heading,
prevX = repNA,
prevY = repNA,
breed = breed,
color = color
)
return(turtles)
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname createTurtles
setMethod(
"createTurtles",
signature = c("numeric", "missing", "ANY", "ANY", "ANY", "ANY"),
definition = function(n, coords, world, heading, breed, color) {
coords <- cbind(
xcor = rep(((maxPxcor(world) - minPxcor(world)) / 2) + minPxcor(world), n),
ycor = rep(((maxPycor(world) - minPycor(world)) / 2) + minPycor(world), n)
)
if (missing(heading)) {
heading <- runif(n = n, min = 0, max = 360)
}
if (missing(breed)) {
breed <- "turtle"
}
if (missing(color)) {
color <- rainbow(n)
}
turtles <- new("agentMatrix",
coords = coords, who = seq(from = 0, to = n - 1, by = 1),
heading = heading, prevX = rep(NA, n), prevY = rep(NA, n),
breed = breed, color = color
)
return(turtles)
}
)
################################################################################
#' Create ordered `turtles`
#'
#' Create `n` `turtles` at the center of the `world` with their `headings` evenly
#' distributed.
#'
#' @inheritParams createTurtles
#'
#' @return `AgentMatrix` object of length `n` with data for the
#' turtles being: `xcor`, `ycor`, `who`, `heading`, `prevX`, `prevY`, `breed`,
#' and `color`.
#'
#' @details The identity of the `turtles` is defined by their `who` number. This
#' numbering starts at 0 and increments by 1.
#'
#' The coordinates from the previous time step are stored in `prevX` and
#' `prevY`. The initial values are `NA`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-ordered-turtles>
#'
#' @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 = runif(25)
#' )
#' t1 <- createOTurtles(n = 10, world = w1)
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- fd(turtles = t1, dist = 1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname createOTurtles
#'
#' @author Sarah Bauduin and Eliot McIntire
#'
setGeneric(
"createOTurtles",
function(n, world, breed, color) {
standardGeneric("createOTurtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @rdname createOTurtles
setMethod(
"createOTurtles",
signature = c(n = "numeric", world = "ANY"),
definition = function(n, world, breed, color) {
heading <- numeric(n)
heading[1] <- 0
if (n > 1) {
heading[2:n] <- heading[1:(n - 1)] + (360 / n) * (1:(n - 1))
}
li <- lapply(names(match.call()[-1]), function(x) eval(parse(text = x)))
names(li) <- names(match.call())[-1]
if (missing(breed)) {
li$breed <- rep("turtle", n)
}
if (length(li$breed) == 1) {
li$breed <- rep(li$breed, n)
}
if (missing(color)) {
li$color <- rainbow(n)
}
createTurtles(
n = n, world = world, heading = heading, breed = li$breed,
color = li$color
)
}
)
################################################################################
#' Move forward
#'
#' Move the `turtles` forward with their `headings` as directions.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances to move. Must
#' be of length 1 or of length `turtles`.
#'
#' @param out Logical. Determine if a `turtle` should move when
#' `torus = FALSE` and its ending position will be outside of
#' the `world`'s extent. Default is `out = TRUE`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If `torus = FALSE` and `out = TRUE`, `world`
#' does not need to be provided.
#'
#' If a distance to move leads a `turtle` outside of the `world`'s extent
#' and `torus = TRUE`, the `turtle` is
#' relocated on the other side of the `world`, inside its extent; if
#' `torus = FALSE` and `out = TRUE`, the `turtle` moves past the
#' `world`'s extent; if `torus = FALSE` and `out = FALSE`, the
#' `turtle` does not move at all. In the event that a `turtle` does not move,
#' its previous coordinates are still updated with its position before
#' running `fd()` (i.e., its current position).
#'
#' If a given `dist` value is negative, then the `turtle` moves
#' backward.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#jump>
#'
#' @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 = runif(25)
#' )
#' t1 <- createOTurtles(n = 10, world = w1)
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- fd(turtles = t1, dist = 1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname fd
#'
#' @author Sarah Bauduin
#'
setGeneric(
"fd",
function(turtles, dist, world, torus = FALSE, out = TRUE) {
standardGeneric("fd")
}
)
#' @export
#' @rdname fd
setMethod(
"fd",
signature = c(turtles = "agentMatrix", dist = "numeric"),
definition = function(turtles, dist, world, torus, out) {
turtles@.Data[, c("prevX", "prevY")] <- turtles@.Data[, 1:2]
inRads <- rad(turtles@.Data[, "heading"])
fdXcor <- turtles@.Data[, "prevX"] + sin(inRads) * dist
fdYcor <- turtles@.Data[, "prevY"] + cos(inRads) * dist
if (torus == TRUE) {
if (missing(world)) {
stop("A world must be provided as torus = TRUE")
}
coords <- c(fdXcor, fdYcor)
dim(coords) <- c(length(fdXcor), 2L)
colnames(coords) <- c("x", "y")
tCoords <- wrap(coords, extent(world))
fdXcor <- tCoords[, 1]
fdYcor <- tCoords[, 2]
}
if (torus == FALSE & out == FALSE) {
if (missing(world)) {
stop("A world must be provided as torus = FALSE and out = FALSE")
}
exts <- extents(world@extent)
outX <- fdXcor < exts$xmin | fdXcor > exts$xmax
outY <- fdYcor < exts$ymin | fdYcor > exts$ymax
outXY <- which(outX | outY) # position of turtles out of the world's extent
fdXcor[outXY] <- turtles@.Data[, "prevX"][outXY]
fdYcor[outXY] <- turtles@.Data[, "prevY"][outXY]
}
turtles@.Data[, 1:2] <- c(
round(fdXcor, digits = 5),
round(fdYcor, digits = 5)
)
return(turtles)
}
)
################################################################################
#' Move backward
#'
#' Move the `turtles` backward of their headings' directions.
#'
#' @inheritParams fargs
#'
#' @inheritParams fd
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If `torus = FALSE` and `out = TRUE`, `world`
#' does not need to be provided.
#'
#' If a distance to move leads a `turtle` outside of the `world`'s extent
#' and `torus = TRUE`, the `turtle` is
#' relocated on the other side of the `world`, inside its extent; if
#' `torus = FALSE` and `out = TRUE`, the `turtle` moves past the
#' `world`'s extent; if `torus = FALSE` and `out = FALSE`, the
#' `turtle` does not move at all. In the event that a `turtle` does not move,
#' its previous coordinates are still updated with its position before
#' running `bk()` (i.e., its current position).
#'
#' If a given `dist` value is negative, then the `turtle` moves
#' forward.
#'
#' The `turtles`' headings are not affected by the function (i.e., the
#' `turtles` do not face backward).
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#back>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#jump>
#'
#' @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 = runif(25)
#' )
#' t1 <- createOTurtles(n = 10, world = w1)
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- fd(turtles = t1, dist = 2)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' t1 <- bk(turtles = t1, dist = 1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' t1 <- fd(turtles = t1, dist = 0.5)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname bk
#'
#' @author Sarah Bauduin
#'
setGeneric(
"bk",
function(turtles, dist, world, torus = FALSE, out = TRUE) {
standardGeneric("bk")
}
)
#' @export
#' @rdname bk
setMethod(
"bk",
signature = c(turtles = "agentMatrix", dist = "numeric"),
definition = function(turtles, dist, world, torus, out) {
fd(turtles = turtles, dist = -dist, world = world, torus = torus, out = out)
}
)
################################################################################
#' Return home
#'
#' Move the `turtles` back `home`.
#'
#' @inheritParams fargs
#'
#' @param home Character. Can take one of the following options to define where
#' to relocate the `turtles`:
#'
#' `home = "home0"` will place the `turtles` at the location
#' `x = 0, y = 0`.
#'
#' `home = "center"` will place the `turtles` at the center of
#' the `world`.
#'
#' `home = "pCorner"` will place the `turtles` at the center of
#' the `patch` located in the left bottom corner of the `world`.
#'
#' `home = "corner"` will place the `turtles` at the left bottom
#' corner of the `world`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their previous coordinates `prevX`
#' and `prevY`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#home>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = "black", pch = 16)
#'
#' t1 <- home(world = w1, turtles = t1, home = "pCorner")
#' points(t1, col = "red", pch = 16)
#'
#' @export
#' @rdname home
#'
#' @author Sarah Bauduin
#'
setGeneric(
"home",
function(world, turtles, home) {
standardGeneric("home")
}
)
#' @export
#' @rdname home
setMethod(
"home",
signature = c("worldNLR", "agentMatrix", "character"),
definition = function(world, turtles, home) {
if (home == "home0") {
exts <- extents(world@extent)
if (exts$xmin <= 0 & exts$xmax >= 0 &
exts$ymin <= 0 & exts$ymax >= 0) {
newTurtles <- setXY(turtles = turtles, xcor = 0, ycor = 0, world = world, torus = FALSE)
} else {
stop("The world provided does not contain the location [x = 0, y = 0]")
}
}
if (home == "center") {
exts <- extents(world@extent)
newTurtles <- setXY(
turtles = turtles,
xcor = ((exts$xmax - exts$xmin) / 2) +
exts$xmin,
ycor = ((exts$ymax - exts$ymin) / 2) +
exts$ymin,
world = world, torus = FALSE
)
}
if (home == "pCorner") {
newTurtles <- setXY(
turtles = turtles, xcor = world@minPxcor,
ycor = world@minPycor, world = world, torus = FALSE
)
}
if (home == "corner") {
exts <- extents(world@extent)
newTurtles <- setXY(
turtles = turtles, xcor = exts$xmin,
ycor = exts$ymin, world = world, torus = FALSE
)
}
return(newTurtles)
}
)
################################################################################
#' x-increment
#'
#' Report the amount by which the `turtles`' coordinates `xcor` would change
#' if the `turtles` were
#' to move forward the given distances with their current `headings`.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances the `turtles` would have to
#' move forward to
#' compute the increment values. Must be of length 1 or of length
#' `turtles`. The default value is `dist = 1`.
#'
#' @return Numeric. Vector of length `turtles`.
#'
#' @details Report the sine of the `turtles`' `heading` multiplied by the `dist`
#' values. Heading 0 is north and angles are calculated in degrees in a
#' clockwise manner.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#dxy>
#'
#' @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)
#' t1 <- createOTurtles(world = w1, n = 10)
#' dx(turtles = t1)
#'
#' @export
#' @rdname dx
#'
#' @author Sarah Bauduin
#'
setGeneric(
"dx",
function(turtles, dist = 1) {
standardGeneric("dx")
}
)
#' @export
#' @rdname dx
setMethod(
"dx",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, dist) {
xIncr <- round(sin(rad(turtles@.Data[, "heading"])) * dist, digits = 5)
return(xIncr)
}
)
#' @export
#' @rdname dx
setMethod(
"dx",
signature = c("agentMatrix", "missing"),
definition = function(turtles) {
dx(turtles = turtles, dist = 1)
}
)
################################################################################
#' y-increment
#'
#' Report the amount by which the `turtles`' coordinates `ycor` would change
#' if the `turtles` were
#' to move forward the given distances with their current `headings`.
#'
#' @inheritParams fargs
#'
#' @inheritParams dx
#'
#' @return Numeric. Vector of length `turtles`.
#'
#' @details Report the cosine of the `turtles`' `heading` multiplied by the `dist`
#' values. Heading 0 is north and angles are calculated in degrees in a
#' clockwise manner.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#dxy>
#'
#' @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)
#' t1 <- createOTurtles(world = w1, n = 10)
#' dy(turtles = t1)
#'
#' @export
#' @rdname dy
#'
#' @author Sarah Bauduin
#'
setGeneric(
"dy",
function(turtles, dist = 1) {
standardGeneric("dy")
}
)
#' @export
#' @rdname dy
setMethod(
"dy",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, dist) {
yIncr <- round(cos(rad(turtles@.Data[, "heading"])) * dist, digits = 5)
return(yIncr)
}
)
#' @export
#' @rdname dy
setMethod(
"dy",
signature = c("agentMatrix", "missing"),
definition = function(turtles) {
dy(turtles = turtles, dist = 1)
}
)
################################################################################
#' Kill `turtles`
#'
#' Kill selected `turtles`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with the selected
#' ones removed.
#'
#' @details The `who` numbers of the remaining `turtles` are unchanged.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#die>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' NLcount(t1)
#' t1 <- die(turtles = t1, who = c(2, 3, 4))
#' NLcount(t1)
#'
#' @export
#' @rdname die
#'
#' @author Sarah Bauduin
#'
setGeneric(
"die",
function(turtles, who) {
standardGeneric("die")
}
)
#' @export
#' @importFrom stats na.omit
#' @rdname die
setMethod(
"die",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, who) {
if (length(who) != 0) {
turtles <- turtles[-na.omit(match(who, turtles@.Data[, "who"])), , drop = FALSE]
}
return(turtles)
}
)
################################################################################
#' Hatch new `turtles`
#'
#' Create new `turtles` from parent `turtles`.
#'
#' @inheritParams fargs
#'
#' @param n Integer. Vector of length 1 or of length `who`. Number of new `turtles`
#' to create for each parent.
#'
#' @param breed Character. One `breed` name. If missing,
#' the created `turtles` are of the same `breed` as their parent `turtle`.
#'
#' @return `AgentMatrix` representing the `turtles` with the new
#' hatched ones.
#'
#' @details The parent `turtle` must be contained in the `turtles`.
#'
#' The created `turtles` inherit of all the data from the parent `turtle`,
#' except for the `breed` if specified otherwise, and for the `who` numbers.
#' The `who`" numbers of the `turtles` created take on following the highest
#' `who` number among the `turtles`.
#'
#' All new hatched `turtles` are placed at the end of the `agentMatrix` object.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' NLcount(t1)
#' t1 <- hatch(turtles = t1, who = 0, n = 2)
#' NLcount(t1)
#'
#' @export
#' @rdname hatch
#'
#' @author Sarah Bauduin
#'
setGeneric(
"hatch",
function(turtles, who, n, breed) {
standardGeneric("hatch")
}
)
#' @export
#' @rdname hatch
setMethod(
"hatch",
signature = c("agentMatrix", "numeric", "numeric", "ANY"),
definition = function(turtles, who, n, breed) {
iTurtle <- match(who, turtles@.Data[, "who"])
newData <- turtles@.Data[iTurtle, , drop = FALSE]
# Allow n to be different
if (length(n) != length(iTurtle)) {
n <- rep(n, length(iTurtle))
}
if (any(n == 0)) {
iTurtle <- iTurtle[n != 0]
newData <- newData[n != 0, , drop = FALSE]
n <- n[n != 0]
}
newData <- newData[rep(seq_len(nrow(newData)), n), , drop = FALSE]
newData[, "who"] <- (max(turtles@.Data[, "who"]) + 1):(max(turtles@.Data[, "who"]) + sum(n))
if (!missing(breed)) {
if (!breed %in% turtles@levels$breed) {
turtles@levels$breed <- c(turtles@levels$breed, breed)
}
newData[, "breed"] <- match(breed, turtles@levels$breed)
}
turtles@.Data <- rbind(turtles@.Data, newData)
return(turtles)
}
)
################################################################################
#' Can the `turtles` move?
#'
#' Report `TRUE` if a `turtle` can move the given distance without leaving
#' the `world`'s extent, report `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @inheritParams fd
#'
#' @return Logical. Vector of length `turtles`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#can-move>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' canMove(world = w1, turtles = t1, dist = 1:10)
#'
#' @export
#' @rdname canMove
#'
#' @author Sarah Bauduin
#'
setGeneric(
"canMove",
function(world, turtles, dist) {
standardGeneric("canMove")
}
)
#' @export
#' @rdname canMove
setMethod(
"canMove",
signature = c("worldNLR", "agentMatrix", "numeric"),
definition = function(world, turtles, dist) {
wrapFalse <- fd(world = world, turtles = turtles, dist = dist, torus = FALSE)
wrapTrue <- fd(world = world, turtles = turtles, dist = dist, torus = TRUE)
testX <- wrapFalse@.Data[, "xcor"] == wrapTrue@.Data[, "xcor"]
testY <- wrapFalse@.Data[, "ycor"] == wrapTrue@.Data[, "ycor"]
return(testX & testY)
}
)
################################################################################
#' Random `xcor`
#'
#' Report `n` random `xcor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Numeric. Vector of length `n` of `xcor` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = cbind(
#' xcor = randomXcor(world = w1, n = 10),
#' ycor = randomYcor(world = w1, n = 10)
#' ))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname randomXcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomXcor",
function(world, n) {
standardGeneric("randomXcor")
}
)
#' @export
#' @importFrom stats runif
#' @rdname randomXcor
setMethod(
"randomXcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
if (n == 0) {
return(xcor = numeric())
} else {
xcor <- round(runif(
n = n, min = terra::xmin(world@extent),
max = terra::xmax(world@extent)
), digits = 5)
return(xcor)
}
}
)
################################################################################
#' Random `ycor`
#'
#' Report `n` random `ycor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Numeric. Vector of length `n` of `ycor` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = cbind(
#' xcor = randomXcor(world = w1, n = 10),
#' ycor = randomYcor(world = w1, n = 10)
#' ))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname randomYcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomYcor",
function(world, n) {
standardGeneric("randomYcor")
}
)
#' @export
#' @importFrom stats runif
#' @rdname randomYcor
setMethod(
"randomYcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
if (n == 0) {
return(ycor = numeric())
} else {
exts <- extents(world@extent)
ycor <- round(runif(
n = n, min = exts$ymin,
max = exts$ymax
), digits = 5)
return(ycor)
}
}
)
################################################################################
#' Directions towards
#'
#' Report the directions of each `agents` towards each corresponding `agents2`.
#'
#' @inheritParams fargs
#'
#' @return Numeric. Vector of angles in degrees of length equal to the largest
#' number of agents/locations between `agents` and `agents2`.
#'
#' @details `agents` and `agents2` must have the same number of agents/locations
#' or if different, one of them must have only one agent/location. If
#' `agents` and `agents2` have the same number of agents/locations,
#' the directions are calculated for each pair `agents[i]` and `agents2[i]`
#' and not for each `agents` towards every single `agents2`.
#'
#' If `torus = FALSE`, `world` does not need to be provided.
#'
#' If `torus = TRUE` and the distance from one `agents` to
#' its corresponding `agents2` is smaller around the
#' sides of the `world` than across it, then the direction to `agents2`
#' going around the sides of the `world` is returned.
#'
#' The direction from a patch to its location returns 0; the direction from
#' a turtle to its location returns the turtle's heading.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#towards>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#towardsxy>
#'
#' @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)
#' towards(agents = patches(w1), agents2 = cbind(x = 0, y = 0))
#' t1 <- createTurtles(n = 10, world = w1)
#' towards(agents = t1, agents2 = cbind(x = 0, y = 0))
#'
#' @export
#' @rdname towards
#'
#' @author Sarah Bauduin
#'
setGeneric(
"towards",
function(agents, agents2, world, torus = FALSE) {
standardGeneric("towards")
}
)
#' @export
#' @rdname towards
setMethod(
"towards",
signature = c(agents = "matrix", agents2 = "matrix"),
definition = function(agents, agents2, world, torus) {
if (!inherits(agents, "agentMatrix") & !inherits(agents2, "agentMatrix")) {
# patches to patches
if (torus == FALSE) {
heading <- deg(atan2(agents2[, 1] - agents[, 1], agents2[, 2] - agents[, 2]))
# angles between -180 and 180
heading[heading < 0] <- heading[heading < 0] + 360
} else {
if (missing(world)) {
stop("A world must be provided as torus = TRUE")
}
if (NROW(agents2) == 1 & NROW(agents) != 1) {
agents2 <- c(rep(agents2[, 1], NROW(agents)), rep(agents2[, 2], NROW(agents)))
dim(agents2) <- c(NROW(agents), 2L)
}
if (NROW(agents) == 1 & NROW(agents2) != 1) {
agents <- c(rep(agents[, 1], NROW(agents2)), rep(agents[, 2], NROW(agents2)))
dim(agents) <- c(NROW(agents2), 2L)
}
# 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)
# Find the smallest distances across or around the world
exts <- extents(world@extent)
to1 <- cbind(
agents2[, 1] - (exts$xmax - exts$xmin),
agents2[, 2] + (exts$ymax - exts$ymin)
)
to2 <- cbind(agents2[, 1], agents2[, 2] + (exts$ymax - exts$ymin))
to3 <- cbind(
agents2[, 1] + (exts$xmax - exts$xmin),
agents2[, 2] + (exts$ymax - exts$ymin)
)
to4 <- cbind(agents2[, 1] - (exts$xmax - exts$xmin), agents2[, 2])
to5 <- cbind(agents2[, 1] + (exts$xmax - exts$xmin), agents2[, 2])
to6 <- cbind(
agents2[, 1] - (exts$xmax - exts$xmin),
agents2[, 2] - (exts$ymax - exts$ymin)
)
to7 <- cbind(agents2[, 1], agents2[, 2] - (exts$ymax - exts$ymin))
to8 <- cbind(
agents2[, 1] + (exts$xmax - exts$xmin),
agents2[, 2] - (exts$ymax - exts$ymin)
)
# All distances in a wrapped world
distAgents2 <- terra::distance(x = agents, y = agents2, lonlat = FALSE, pairwise = TRUE)
# distAgents3 <- raster::pointDistance(p1 = agents, p2 = agents2, lonlat = FALSE,
# allpairs = FALSE)
# distTo1 <- raster::pointDistance(p1 = agents, p2 = to1, lonlat = FALSE, allpairs = FALSE)
# distTo2 <- raster::pointDistance(p1 = agents, p2 = to2, lonlat = FALSE, allpairs = FALSE)
# distTo3 <- raster::pointDistance(p1 = agents, p2 = to3, lonlat = FALSE, allpairs = FALSE)
# distTo4 <- raster::pointDistance(p1 = agents, p2 = to4, lonlat = FALSE, allpairs = FALSE)
# distTo5 <- raster::pointDistance(p1 = agents, p2 = to5, lonlat = FALSE, allpairs = FALSE)
# distTo6 <- raster::pointDistance(p1 = agents, p2 = to6, lonlat = FALSE, allpairs = FALSE)
# distTo7 <- raster::pointDistance(p1 = agents, p2 = to7, lonlat = FALSE, allpairs = FALSE)
# distTo8 <- raster::pointDistance(p1 = agents, p2 = to8, lonlat = FALSE, allpairs = FALSE)
distTo1 <- terra::distance(x = agents, y = to1, lonlat = FALSE, pairwise = TRUE)
distTo2 <- terra::distance(x = agents, y = to2, lonlat = FALSE, pairwise = TRUE)
distTo3 <- terra::distance(x = agents, y = to3, lonlat = FALSE, pairwise = TRUE)
distTo4 <- terra::distance(x = agents, y = to4, lonlat = FALSE, pairwise = TRUE)
distTo5 <- terra::distance(x = agents, y = to5, lonlat = FALSE, pairwise = TRUE)
distTo6 <- terra::distance(x = agents, y = to6, lonlat = FALSE, pairwise = TRUE)
distTo7 <- terra::distance(x = agents, y = to7, lonlat = FALSE, pairwise = TRUE)
distTo8 <- terra::distance(x = agents, y = to8, lonlat = FALSE, pairwise = TRUE)
# Which distance is the minimum
allDist <- cbind(
distAgents2, distTo1, distTo2, distTo3, distTo4, distTo5,
distTo6, distTo7, distTo8
)
distMin <- apply(allDist, 1, min)
toShortest <- agents2
for (i in seq_len(NROW(agents))) {
# All the possibilities for each agents (i.e., agents2 and the wrapped agents2)
allToCoords <- rbind(
agents2[i, ], to1[i, ], to2[i, ], to3[i, ], to4[i, ], to5[i, ],
to6[i, ], to7[i, ], to8[i, ]
)
toShortest[i, ] <- allToCoords[match(distMin[i], allDist[i, ]), ]
# if ties, take the first match (good because favor the non wrapped distances)
}
heading <- deg(atan2(toShortest[, 1] - agents[, 1], toShortest[, 2] - agents[, 2]))
# angles between -180 and 180
heading[heading < 0] <- heading[heading < 0] + 360
}
} else if (inherits(agents, "agentMatrix") & !inherits(agents2, "agentMatrix")) {
# turtles to patches
tCoords <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
heading <- towards(agents = tCoords, agents2 = agents2, world = world, torus = torus)
sameLoc <- tCoords[, 1] == agents2[, 1] & tCoords[, 2] == agents2[, 2]
if (NROW(tCoords) == 1) {
heading[sameLoc] <- agents@.Data[, "heading"]
} else {
heading[sameLoc] <- agents@.Data[, "heading"][sameLoc]
}
} else if (!inherits(agents, "agentMatrix") & inherits(agents2, "agentMatrix")) {
# patches to turtles
heading <- towards(
agents = agents,
agents2 = agents2@.Data[, c("xcor", "ycor"), drop = FALSE],
world = world, torus = torus
)
} else if (inherits(agents, "agentMatrix") & inherits(agents2, "agentMatrix")) {
# turtles to turtles
t1Coords <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
t2Coords <- agents2@.Data[, c("xcor", "ycor"), drop = FALSE]
heading <- towards(agents = t1Coords, agents2 = t2Coords, world = world, torus = torus)
sameLoc <- t1Coords[, 1] == t2Coords[, 1] & t1Coords[, 2] == t2Coords[, 2]
if (NROW(t1Coords) == 1) {
heading[sameLoc] <- agents@.Data[, "heading"]
} else {
heading[sameLoc] <- agents@.Data[, "heading"][sameLoc]
}
}
return(heading)
}
)
################################################################################
#' Face something
#'
#' Set the `turtles`' `heading` towards `agents2`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated `headings`.
#'
#' @details The number of agents/locations in `agents2` must be equal to 1 or
#' to the length of `turtles`.
#'
#' If `torus = FALSE`, `world` does not need to be provided.
#'
#' If `torus = TRUE` and the distance from one `turtles` to
#' its corresponding agent/location `agents2` is smaller around the
#' sides of the `world` than across it, then the direction to the agent/location
#' `agents2` going around the sides of the `world` is given to the `turtle`.
#'
#' If a turtle is facing its own location, its heading does not change.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#face>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#facexy>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- face(turtles = t1, agents2 = cbind(x = 0, y = 0))
#' t1 <- fd(turtles = t1, dist = 0.5)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname face
#'
#' @author Sarah Bauduin
#'
setGeneric(
"face",
function(turtles, agents2, world, torus = FALSE) {
standardGeneric("face")
}
)
#' @export
#' @rdname face
setMethod(
"face",
signature = c(turtles = "agentMatrix", agents2 = "matrix"),
definition = function(turtles, agents2, world, torus) {
newHeading <- towards(agents = turtles, agents2 = agents2, world = world, torus = torus)
turtles@.Data[, "heading"] <- newHeading
return(turtles)
}
)
################################################################################
#' Rotate to the left
#'
#' Rotate the `turtles`'s headings to the left of `angle` degrees.
#'
#' @inheritParams fargs
#'
#' @param angle Numeric. Vector of angles in degrees by which to rotate the `turtles`'
#' headings. Must be of length 1 or of length `turtles`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated `heading` values.
#'
#' @details If a given `angle` value is negative, then the `turtle` rotates to the right.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#left>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' of(agents = t1, var = "heading")
#' t1 <- left(turtles = t1, angle = 180)
#' of(agents = t1, var = "heading")
#'
#' @export
#' @rdname left
#'
#' @author Sarah Bauduin
#'
setGeneric(
"left",
function(turtles, angle) {
standardGeneric("left")
}
)
#' @export
#' @rdname left
setMethod(
"left",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, angle) {
newHeading <- turtles@.Data[, "heading"] - angle
newHeading[newHeading < 0] <- newHeading[newHeading < 0] + 360
newHeading[newHeading >= 360] <- newHeading[newHeading >= 360] - 360
turtles@.Data[, "heading"] <- newHeading
return(turtles)
}
)
################################################################################
#' Rotate to the right
#'
#' Rotate the `turtles`'s headings to the right of `angle` degrees.
#'
#' @inheritParams fargs
#'
#' @inheritParams left
#'
#' @return `AgentMatrix` representing the `turtles` with updated `heading` values.
#'
#' @details If a given `angle` value is negative, then the turtle rotates to the left.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#right>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' of(agents = t1, var = "heading")
#' t1 <- right(turtles = t1, angle = 180)
#' of(agents = t1, var = "heading")
#'
#' @export
#' @rdname right
#'
#' @author Sarah Bauduin
#'
setGeneric(
"right",
function(turtles, angle) {
standardGeneric("right")
}
)
#' @export
#' @rdname right
setMethod(
"right",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, angle) {
left(turtles = turtles, angle = -angle)
}
)
################################################################################
#' Move downhill
#'
#' Move the `turtles` to their neighboring patch with the lowest value.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their `heading` values and
#' previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If no neighboring `patch` has a smaller value than the `patch` where the
#' `turtle` is currently located on, the `turtle` stays on this `patch`. It still
#' moves to the `patch` center if it was not already on it.
#'
#' If there are multiple neighboring `patches` with the same lowest value,
#' the `turtle` chooses one `patch` randomly.
#'
#' If a `turtle` is located on a `patch` on the edge
#' of the `world` and `torus = FALSE`, it has fewer
#' neighboring `patches` as options to move than `nNeighbors`; if
#' `torus = TRUE`, the `turtle` can move on the other side of the `world` to
#' move downhill and its choice of neighboring `patches` is always equals to
#' `nNeighbors`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#downhill>
#'
#' @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 = 1, maxPxcor = 10, minPycor = 1, maxPycor = 10,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' if (requireNamespace("SpaDES.tools", quietly = TRUE)) {
#' t1 <- downhill(world = w1, turtles = t1, nNeighbors = 8)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' }
#'
#' @export
#' @rdname downhill
#'
#' @author Sarah Bauduin
#'
setGeneric(
"downhill",
function(world, pVar, turtles, nNeighbors, torus = FALSE) {
standardGeneric("downhill")
}
)
#' @export
#' @rdname downhill
setMethod(
"downhill",
signature = c(
world = "worldMatrix", pVar = "missing", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, turtles, nNeighbors, torus) {
# Output neighbors() as a matrix
pNeighbors <- neighbors(
world = world, agents = turtles, nNeighbors = nNeighbors,
torus = torus
)
pValues <- as.numeric(t(world@.Data)) # ordered by cellNumbers
tDF <- data.frame(patchHere(world, turtles), id = 1:NLcount(turtles))
allPatches <- rbind(pNeighbors, tDF) # neighbors patches + patches under the turtles
allPatches$cellNum <- cellFromPxcorPycor(
world = world, pxcor = allPatches$pxcor,
pycor = allPatches$pycor
)
allPatches$pVal <- pValues[allPatches$cellNum]
rows <- split(seq_len(nrow(allPatches)), allPatches$id)
rowMin <- sapply(rows, function(rowi) rowi[which.min(allPatches$pVal[rowi])])
# minimum patch value per id
pMinCoords <- allPatches[rowMin, ]
pMinCoords1 <- if (length(unique(pMinCoords$id)) == NROW(pMinCoords)) {
pMinCoords
} else {
pMinCoords[tapply(seq_len(nrow(pMinCoords)), pMinCoords$id, resample, 1), ]
}
pMinCoords1 <- pMinCoords1[order(pMinCoords1$id), ] # order by turtles
pMinCoords2 <- cbind(pxcor = pMinCoords1[, 1], pycor = pMinCoords1[, 2])
newTurtles <- face(world = world, turtles = turtles, agents2 = pMinCoords2, torus = torus)
newTurtles <- moveTo(turtles = newTurtles, agents = pMinCoords2)
return(newTurtles)
}
)
#' @export
#' @rdname downhill
setMethod(
"downhill",
signature = c(
world = "worldArray", pVar = "character", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, pVar, turtles, nNeighbors, torus) {
# Output neighbors() as a matrix
pNeighbors <- neighbors(
world = world, agents = turtles, nNeighbors = nNeighbors,
torus = torus
)
## Only difference with method for worldMatrix
layer <- match(pVar, dimnames(world)[[3]])
pValues <- as.numeric(t(world@.Data[, , layer])) # ordered by cellNumbers
##
tDF <- data.frame(patchHere(world, turtles), id = 1:NLcount(turtles))
allPatches <- rbind(pNeighbors, tDF) # neighbors patches + patches under the turtles
allPatches$cellNum <- cellFromPxcorPycor(
world = world, pxcor = allPatches$pxcor,
pycor = allPatches$pycor
)
allPatches$pVal <- pValues[allPatches$cellNum]
rows <- split(seq_len(nrow(allPatches)), allPatches$id)
rowMin <- sapply(rows, function(rowi) rowi[which.min(allPatches$pVal[rowi])])
# minimum patch value per id
pMinCoords <- allPatches[rowMin, ]
pMinCoords1 <- pMinCoords[tapply(seq_len(nrow(pMinCoords)), pMinCoords$id, resample, 1), ]
# select randomly one row per id
pMinCoords1 <- pMinCoords1[order(pMinCoords1$id), ] # order by turtles
pMinCoords2 <- cbind(pxcor = pMinCoords1[, 1], pycor = pMinCoords1[, 2])
newTurtles <- face(world = world, turtles = turtles, agents2 = pMinCoords2, torus = torus)
newTurtles <- moveTo(turtles = newTurtles, agents = pMinCoords2)
return(newTurtles)
}
)
################################################################################
#' Move uphill
#'
#' Move the `turtles` to their neighboring `patch` with the highest value.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their `heading` values and
#' previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If no neighboring `patch` has a larger value than the `patch` where the
#' `turtle` is currently located on, the `turtle` stays on this `patch`. It still
#' moves to the `patch` center if it was not already on it.
#'
#' If there are multiple neighboring `patches` with the same highest value,
#' the `turtle` chooses one `patch` randomly.
#'
#' If a `turtle` is located on a `patch` on the edge
#' of the `world` and `torus = FALSE`, it has fewer
#' neighboring `patches` as options to move than `nNeighbors`; if
#' `torus = TRUE`, the `turtle` can move on the other side of the `world` to
#' move uphill and its choice of neighboring `patches` is always equals to
#' `nNeighbors`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#uphill>
#'
#' @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 = 1, maxPxcor = 10, minPycor = 1, maxPycor = 10,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' if (requireNamespace("SpaDES.tools", quietly = TRUE)) {
#' t1 <- uphill(world = w1, turtles = t1, nNeighbors = 8)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' }
#'
#' @export
#' @rdname uphill
#'
#' @author Sarah Bauduin
#'
setGeneric(
"uphill",
function(world, pVar, turtles, nNeighbors, torus = FALSE) {
standardGeneric("uphill")
}
)
#' @export
#' @rdname uphill
setMethod(
"uphill",
signature = c(
world = "worldMatrix", pVar = "missing", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, turtles, nNeighbors, torus) {
# Uphill is the inverse of downhill
world[] <- 1 / world[]
downhill(world = world, turtles = turtles, nNeighbors = nNeighbors, torus = torus)
}
)
#' @export
#' @rdname uphill
setMethod(
"uphill",
signature = c(
world = "worldArray", pVar = "character", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, pVar, turtles, nNeighbors, torus) {
world[] <- 1 / world[]
downhill(
world = world, pVar = pVar, turtles = turtles, nNeighbors = nNeighbors,
torus = torus
)
}
)
################################################################################
#' `Patches` ahead
#'
#' Report the coordinates of the `patches` at the given
#' distances of the `turtles` in the direction of their `headings`.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances from the `turtles`. `dist` must be
#' of length 1 or of length `turtles`.
#'
#' @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 `turtles`'s `headings` directions
#' of `turtles`. The order of the `patches` follows the order of the `turtles`.
#'
#' @details If `torus = FALSE` and the `patch` at distance `dist` of a `turtle`
#' 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.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-ahead>
#'
#' @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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' patchAhead(world = w1, turtles = t1, dist = 1)
#'
#' @export
#' @rdname patchAhead
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchAhead",
function(world, turtles, dist, torus = FALSE) {
standardGeneric("patchAhead")
}
)
#' @export
#' @rdname patchAhead
setMethod(
"patchAhead",
signature = c(world = "worldNLR", turtles = "agentMatrix", dist = "numeric"),
definition = function(world, turtles, dist, torus) {
radHeading <- rad(turtles@.Data[, "heading"])
xcor <- round(turtles@.Data[, "xcor"] + sin(radHeading) * dist, digits = 5)
ycor <- round(turtles@.Data[, "ycor"] + cos(radHeading) * dist, digits = 5)
pAhead <- patch(
world = world, x = xcor, y = ycor, duplicate = TRUE,
torus = torus, out = TRUE
)
return(pAhead)
}
)
################################################################################
#' `Patches` here
#'
#' Report the coordinates of the `patches` under the `turtles`
#' locations.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the coordinates of the `patches` at the `turtles`
#' location. The order of the `patches` follows the order of the `turtles`.
#'
#' @details If a `turtle` is located outside of the `world`'s extent,
#' `NA` are returned
#' for the `patch` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-here>
#'
#' @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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' patchHere(world = w1, turtles = t1)
#'
#' @export
#' @rdname patchHere
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchHere",
function(world, turtles) {
standardGeneric("patchHere")
}
)
#' @export
#' @rdname patchHere
setMethod(
"patchHere",
signature = c("worldNLR", "agentMatrix"),
definition = function(world, turtles) {
pTurtles <- patch(
world = world, x = turtles@.Data[, 1], y = turtles@.Data[, 2],
duplicate = TRUE, out = TRUE
)
return(pTurtles)
}
)
################################################################################
#' `Patches` on the left
#'
#' Report the coordinates of the `patches` at the given distances of the `turtles`
#' and given `angle` left of their `headings`.
#'
#' @inheritParams fargs
#'
#' @inheritParams patchAhead
#'
#' @param angle Numeric. Vector of angles in degrees by which the `turtle`'s
#' `headings` should rotate to locate the patches. Must be of length 1 or of
#' length `turtles`.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the coordinates of the `patches` at `dist`
#' distances of the `turtles` and `angle` to the left of their `headings`.
#' The order of the `patches` follows the order of the `turtles`.
#'
#' @details If a given `dist` value is negative, then the `turtle` would look backward.
#' If a given `angle` value is negative, then the `turtle` would look to the right.
#'
#' If `torus = FALSE` and the `patch` at distance `dist` of a `turtle`
#' and `angle` degrees to the left of its `heading` 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.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-lr-and-ahead>
#'
#' @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)
#' t1 <- createTurtles(n = 1, coords = cbind(xcor = 2, ycor = 2), heading = 90)
#' patchLeft(world = w1, turtles = t1, dist = 2, angle = 90)
#'
#' @export
#' @rdname patchLeft
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchLeft",
function(world, turtles, dist, angle, torus = FALSE) {
standardGeneric("patchLeft")
}
)
#' @export
#' @rdname patchLeft
setMethod(
"patchLeft",
signature = c(
world = "worldNLR", turtles = "agentMatrix", dist = "numeric",
angle = "numeric"
),
definition = function(world, turtles, dist, angle, torus) {
tLeft <- left(turtles = turtles, angle = angle)
tFd <- fd(world = world, turtles = tLeft, dist = dist, torus = torus)
pLeftFd <- patchHere(world = world, turtles = tFd)
return(pLeftFd)
}
)
################################################################################
#' `Patches` on the right
#'
#' Report the coordinates of the `patches` at the given distances of the `turtles`
#' and given `angle` right of their `headings`.
#'
#' @inheritParams fargs
#'
#' @inheritParams patchLeft
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the coordinates of the `patches` at `dist`
#' distances of the `turtles` and `angle` to the right of their `headings`.
#' The order of the `patches` follows the order of the `turtles`.
#'
#' @details If a given `dist` value is negative, then the `turtle` would look backward.
#' If a given `angle` value is negative, then the `turtle` would
#' look to the left.
#'
#' If `torus = FALSE` and the `patch` at distance `dist` of a `turtle`
#' and `angle` degrees to the right of its `heading` 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.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-lr-and-ahead>
#'
#' @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)
#' t1 <- createTurtles(n = 1, coords = cbind(xcor = 2, ycor = 2), heading = 90)
#' patchRight(world = w1, turtles = t1, dist = 2, angle = 90)
#'
#' @export
#' @rdname patchRight
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchRight",
function(world, turtles, dist, angle, torus = FALSE) {
standardGeneric("patchRight")
}
)
#' @export
#' @rdname patchRight
setMethod(
"patchRight",
signature = c(
world = "worldNLR", turtles = "agentMatrix", dist = "numeric",
angle = "numeric"
),
definition = function(world, turtles, dist, angle, torus) {
patchLeft(
world = world, turtles = turtles, dist = dist, angle = -angle,
torus = torus
)
}
)
################################################################################
#' Set `turtles`' locations
#'
#' Set the `turtles` `xcor` and `ycor` coordinates.
#'
#' @inheritParams fargs
#'
#' @param xcor Numeric. Vector of `x` coordinates. Must be of length 1 or
#' of length `turtles`.
#'
#' @param ycor Numeric. Vector of `y` coordinates. Must be of length 1 or
#' of length `turtles`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated coordinates
#' and updated data for their previous coordinates `prevX` and `prevY`.
#'
#' @details `world` must be provided only if `torus = TRUE`.
#'
#' If the given coordinates `[xcor, ycor]`
#' are located outside of the `world`'s extent and `torus = TRUE`,
#' then the coordinates assigned to the `turtle`
#' are the ones from a wrapped `word`; if `torus = FALSE`, the `turtle`
#' is located outside of the `world`'s extent with the given coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 5, coords = randomXYcor(w1, n = 5))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- setXY(turtles = t1, xcor = 1:5, ycor = 1:5)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname setXY
#'
#' @author Sarah Bauduin
#'
setGeneric(
"setXY",
function(turtles, xcor, ycor, world, torus = FALSE) {
standardGeneric("setXY")
}
)
#' @export
#' @rdname setXY
setMethod(
"setXY",
signature = c("agentMatrix", "numeric", "numeric", "missing", "ANY"),
definition = function(turtles, xcor, ycor, torus) {
turtles@.Data[, "prevX"] <- turtles@.Data[, "xcor"]
turtles@.Data[, "prevY"] <- turtles@.Data[, "ycor"]
if (length(xcor) == 1 & NROW(turtles) != 1) {
xcor <- as.numeric(rep(xcor, NROW(turtles)))
}
if (length(ycor) == 1 & NROW(turtles) != 1) {
ycor <- as.numeric(rep(ycor, NROW(turtles)))
}
turtles@.Data[, "xcor"] <- xcor
turtles@.Data[, "ycor"] <- ycor
return(turtles)
}
)
#' @export
#' @rdname setXY
setMethod(
"setXY",
signature = c("agentMatrix", "numeric", "numeric", "worldNLR", "logical"),
definition = function(turtles, xcor, ycor, world, torus) {
wrapCoords <- wrap(cbind(x = xcor, y = ycor), world@extent)
setXY(
turtles = turtles, xcor = wrapCoords[, 1], ycor = wrapCoords[, 2],
torus = FALSE
)
}
)
################################################################################
#' Sprout new `turtles`
#'
#' Create `n` new `turtles` on specific `patches`.
#'
#' @param n Integer. Vector of length 1 or of length the number of `patches`.
#' Number of new `turtles`
#' to create on each `patch`.
#'
#' @param heading Numeric. Vector of values between 0 and 360.
#' Must be of length 1 or of length the number of `patches`.
#' If missing, a random `heading` is assigned to each sprouted `turtle`.
#'
#' @param breed Character. Vector of `breed` names.
#' Must be of length 1 or of length the number of `patches`.
#' If missing, `breed` = `turtle` for all the sprouted `turtles`.
#'
#' @param color Character. Vector of `color` names.
#' Must be of length 1, of length the number of `patches` or
#' of length `sum(n)`.
#' If missing, `colors` are assigned using the function `rainbow(n)`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` including the new
#' sprouted `turtles`.
#'
#' @details `nrow(patches)` must be equal to 1 or to `n`.
#'
#' If `turtles` is provided, the new `turtles` are added to
#' the `turtles` when returned. The `who` numbers of the sprouted `turtles`
#' therefore follow the ones from the `turtles`.
#' All new sprouted `turtles` are placed at the end of the `agentMatrix` object.
#' If no `turtles`
#' is provided, a new `agentMatrix` is created and the `who` numbers
#' start at 0.
#'
#' If `turtles` is provided and had additional variables created
#' with `turtlesOwn()`, `NA` is given for these variables
#' for the new sprouted `turtles`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#sprout>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' t1 <- sprout(patches = cbind(pxcor = 2, pycor = 2), n = 3)
#' t2 <- sprout(patches = cbind(pxcor = 3, pycor = 3), n = 3, turtles = t1)
#'
#' @export
#' @rdname sprout
#'
#' @author Sarah Bauduin
#'
setGeneric(
"sprout",
function(n, patches, breed, heading, color, turtles) {
standardGeneric("sprout")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname sprout
setMethod(
"sprout",
signature = c(n = "numeric", patches = "matrix"),
definition = function(n, patches, breed, heading, color, turtles) {
li <- lapply(names(match.call()[-1]), function(x) eval(parse(text = x)))
names(li) <- names(match.call())[-1]
if (length(n) == 1) {
if (nrow(li$patches) == 1 & n != 1) {
li$patches <- cbind(
as.numeric(rep(li$patches[, 1], n)),
as.numeric(rep(li$patches[, 2], n))
)
}
colnames(li$patches) <- c("xcor", "ycor")
if (missing(breed)) {
li$breed <- rep("turtle", n)
}
if (length(li$breed) == 1) {
li$breed <- rep(li$breed, n)
}
if (missing(heading)) li$heading <- runif(n = n, min = 0, max = 360)
if (length(li$heading) == 1) {
li$heading <- rep(li$heading, n)
}
if (missing(color)) li$color <- rainbow(n)
newTurtles <- createTurtles(
n = n, coords = li$patches, heading = li$heading,
breed = li$breed, color = li$color
)
} else {
# if length(n) != 0
li$patches <- cbind(
as.numeric(rep(li$patches[, 1], n)),
as.numeric(rep(li$patches[, 2], n))
)
colnames(li$patches) <- c("xcor", "ycor")
if (missing(breed)) li$breed <- rep("turtle", sum(n))
if (length(li$breed) == 1) {
li$breed <- rep(li$breed, sum(n))
} else if (length(li$breed) != sum(n)) {
li$breed <- rep(li$breed, n)
}
if (missing(heading)) li$heading <- runif(n = sum(n), min = 0, max = 360)
if (length(li$heading) == 1) {
li$heading <- rep(li$heading, sum(n))
} else if (length(li$heading) != sum(n)) {
li$heading <- rep(li$heading, n)
}
if (missing(color)) li$color <- rainbow(sum(n))
if (length(li$color) == 1) {
li$color <- rep(li$color, sum(n))
} else if (length(li$color) != sum(n)) {
li$color <- rep(li$color, n)
}
newTurtles <- createTurtles(
n = sum(n), coords = li$patches, heading = li$heading,
breed = li$breed, color = li$color
)
}
if (missing(turtles)) {
return(newTurtles)
} else {
turtles <- hatch(
turtles = turtles, who = max(turtles@.Data[, "who"]),
n = NLcount(newTurtles)
)
# Replace the locations and headings of newTurtles inside turtles
ids <- (nrow(turtles@.Data) - NLcount(newTurtles) + 1):nrow(turtles@.Data)
turtles@.Data[ids, c(1, 2, 4)] <- newTurtles@.Data[, c(1, 2, 4)]
# Replace the breed and color of the newTurtles inside turtles
ids <- (nrow(turtles@.Data) - NLcount(newTurtles) + 1):nrow(turtles@.Data)
whoNewTurtles <- turtles@.Data[ids, 3]
turtles <- NLset(
turtles = turtles, agents = turtle(turtles, who = whoNewTurtles),
var = "breed", val = of(agents = newTurtles, var = "breed")
)
turtles <- NLset(
turtles = turtles, agents = turtle(turtles, who = whoNewTurtles),
var = "color", val = of(agents = newTurtles, var = "color")
)
# Replace any other additional variables
if (ncol(turtles@.Data) > 8) {
valToReplace <- matrix(NA, ncol = (ncol(turtles@.Data) - 8), nrow = NLcount(newTurtles))
colnames(valToReplace) <- colnames(turtles@.Data)[9:ncol(turtles@.Data)]
turtles <- NLset(
turtles = turtles, agents = turtle(turtles, who = whoNewTurtles),
var = colnames(turtles@.Data)[9:ncol(turtles@.Data)],
val = valToReplace
)
}
return(turtles)
}
}
)
################################################################################
#' Inspect `turtles`
#'
#' Display all variables values for the selected individuals among the `turtles`.
#'
#' @inheritParams fargs
#'
#' @return `Dataframe` (`nrow` = `length(who)`) of the variables of the selected
#' individuals among the `turtles`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#inspect>
#'
#' @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)
#' t1 <- createOTurtles(world = w1, n = 10)
#' inspect(turtles = t1, who = c(2, 3))
#'
#' @export
#' @rdname inspect
#'
#' @author Sarah Bauduin
#'
setGeneric(
"inspect",
function(turtles, who) {
standardGeneric("inspect")
}
)
#' @export
#' @rdname inspect
setMethod(
"inspect",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, who) {
tData <- as.data.frame(turtles@.Data[turtles@.Data[, "who"] %in% who, , drop = FALSE],
stringsAsFactors = FALSE
)
tData[, names(turtles@levels)] <- do.call(cbind, lapply(seq_along(turtles@levels), function(x) {
unlist(rename(tData[, names(turtles@levels)[x]],
from = unique(tData[, names(turtles@levels)[x]]),
to = turtles@levels[names(turtles@levels)[x]][[1]][
unique(tData[, names(turtles@levels)[x]])
]
))
}))
# tData[, names(turtles@levels)] <- do.call(cbind, lapply(1:length(turtles@levels), function(x){
# unlist(mapvalues(tData[, names(turtles@levels)[x]],
# from = unique(tData[, names(turtles@levels)[x]]),
# to = turtles@levels[names(turtles@levels)[x]][[1]][
# unique(tData[, names(turtles@levels)[x]])]))}))
#
# if (!identical(unname(as.matrix(tData[, names(turtles@levels)])), a))
# stop("mapvalues replacement was wrong")
return(tData)
}
)
################################################################################
#' Move to
#'
#' Move the `turtles` to the `agents`' locations.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated coordinates
#' and updated data for their previous coordinates `prevX` and `prevY`.
#'
#' @details The number of `agents` must be equal to 1 or to
#' length `turtles`.
#'
#' The `turtle`'s `headings` are not affected with this function.
#'
#' If a `turtle` is moving to a `patch` location, it will be located at
#' the `patch` center.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#move-to>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 5, coords = randomXYcor(w1, n = 5))
#' plot(w1)
#' points(t1, col = "black", pch = 16)
#'
#' t1 <- moveTo(turtles = t1, agents = turtle(t1, who = 0))
#' points(t1, col = "red", pch = 16)
#'
#' t1 <- moveTo(turtles = t1, agents = patch(w1, 9, 9))
#' points(t1, col = "blue", pch = 16)
#'
#' @export
#' @rdname moveTo
#'
#' @author Sarah Bauduin
#'
setGeneric(
"moveTo",
function(turtles, agents) {
standardGeneric("moveTo")
}
)
#' @export
#' @rdname moveTo
setMethod(
"moveTo",
signature = c("agentMatrix", "matrix"),
definition = function(turtles, agents) {
if (!inherits(agents, "agentMatrix")) {
setXY(
turtles = turtles, xcor = as.numeric(agents[, 1]),
ycor = as.numeric(agents[, 2]), torus = FALSE
)
} else {
setXY(
turtles = turtles, xcor = agents@.Data[, "xcor"],
ycor = agents@.Data[, "ycor"], torus = FALSE
)
}
}
)
################################################################################
#' Random `turtles` coordinates
#'
#' Report `n` random `xcor` and `ycor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2, `nrow` = `n`) with the first column `xcor` and the second
#' column `ycor`.
#'
#' @examples
#' w1 <- createWorld(
#' minPxcor = 0, maxPxcor = 4, minPycor = 0, maxPycor = 4,
#' data = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(world = w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname randomXYcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomXYcor",
function(world, n) {
standardGeneric("randomXYcor")
}
)
#' @export
#' @rdname randomXYcor
setMethod(
"randomXYcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
xycor <- cbind(
xcor = randomXcor(world = world, n = n),
ycor = randomYcor(world = world, n = n)
)
return(xycor)
}
)
################################################################################
#' Do the `turtle` exist?
#'
#' Report `TRUE` if a `turtle` exists inside the `turtles`, report
#' `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @return Logical. Vector of `TRUE` or `FALSE` if the `who` numbers
#' with any of the `breed`, if provided, exist or not
#' inside the `turtles`.
#'
#' @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)
#' t1 <- createTurtles(
#' n = 10, coords = randomXYcor(w1, n = 10),
#' breed = c(rep("sheep", 5), rep("wolf", 5))
#' )
#' tExist(turtles = t1, who = 3, breed = "sheep")
#' tExist(turtles = t1, who = 9, breed = "sheep")
#' tExist(turtles = t1, who = 9, breed = c("sheep", "wolf"))
#' tExist(turtles = t1, who = c(3, 9))
#'
#' @export
#' @rdname tExist
#'
#' @author Sarah Bauduin
#'
setGeneric(
"tExist",
function(turtles, who, breed) {
standardGeneric("tExist")
}
)
#' @export
#' @rdname tExist
setMethod(
"tExist",
signature = c("agentMatrix", "numeric", "missing"),
definition = function(turtles, who) {
tExist <- who %in% turtles@.Data[, "who"]
return(tExist)
}
)
#' @export
#' @rdname tExist
setMethod(
"tExist",
signature = c("agentMatrix", "numeric", "character"),
definition = function(turtles, who, breed) {
breedFactor <- match(breed, turtles@levels$breed)
tExist <- who %in% turtles@.Data[turtles@.Data[, "breed"] %in% breedFactor, "who"]
return(tExist)
}
)
################################################################################
#' Select `turtles`
#'
#' Report the individuals among `turtles` based on their `who` numbers
#' and `breed`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` of the selected `turtles` sorted in the order of
#' the `who` numbers requested. If `breed` was provided, the
#' `turtles` selected are of one of the `breed`.
#'
#' @details If no `turtle` matches the given `who` numbers, with potentially
#' one of the given
#' `breed`, inside `turtles`, then an empty `agentMatrix` is returned.
#'
#' If there are duplicates `who` numbers among the `turtles`, the first
#' matching `turtle` with the requested `who` number is returned.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtle>
#'
#' @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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' t2 <- turtle(t1, who = 2)
#'
#' @export
#' @rdname turtle
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtle",
function(turtles, who, breed) {
standardGeneric("turtle")
}
)
#' @export
#' @importFrom stats na.omit
#' @rdname turtle
setMethod(
"turtle",
signature = c("agentMatrix", "numeric", "missing"),
definition = function(turtles, who) {
turtles[na.omit(match(who, turtles@.Data[, "who"])), , drop = FALSE]
}
)
#' @export
#' @rdname turtle
setMethod(
"turtle",
signature = c("agentMatrix", "numeric", "character"),
definition = function(turtles, who, breed) {
breedFactor <- which(turtles@levels$breed %in% breed)
if (length(breedFactor) == 0) {
noTurtles()
} else {
tBreed <- turtles[which(turtles@.Data[, "breed"] %in% breedFactor), , drop = FALSE]
turtle(tBreed, who)
}
}
)
################################################################################
#' `Turtles` on
#'
#' Report the individuals among `turtles` that are on the same `patches` as
#' the `agents`.
#'
#' @inheritParams fargs
#'
#' @param simplify Logical. If `simplify = TRUE`, all `turtles` on the same
#' `patches` as any `agents` are returned; if `simplify = FALSE`,
#' the `turtles` are evaluated for each `agents`'s `patches`
#' individually.
#'
#' @return `AgentMatrix` representing any individuals from `turtles` of
#' any of the given `breed`, if specified,
#' located on the same `patches` as any of the `agents`, if `simplify = TRUE`, or
#'
#' Matrix (`ncol` = 2) with the first column `whoTurtles` and the second column
#' `id` showing which `turtles` are on the same
#' `patches` as which `agents` represented by `id`, if `simplify = FALSE`.
#' `id` represents and follows the order of the `agents`. `id` does not represent
#' the `who` numbers
#' of the `agents` if `agents` are `turtles`.
#'
#' @details The `agents` must be located inside the
#' `world`'s extent.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-on>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 500, coords = randomXYcor(w1, n = 500))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t2 <- turtlesOn(world = w1, turtles = t1, agents = patch(w1, 2, 2))
#'
#' @export
#' @rdname turtlesOn
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtlesOn",
function(world, turtles, agents, breed, simplify = TRUE) {
standardGeneric("turtlesOn")
}
)
#' @export
#' @importFrom stats na.omit
#' @rdname turtlesOn
setMethod(
"turtlesOn",
signature = c(
world = "worldNLR", turtles = "agentMatrix",
agents = "matrix", breed = "missing"
),
definition = function(world, turtles, agents, simplify) {
if (inherits(agents, "agentMatrix")) {
agents <- patchHere(world = world, turtles = agents)
}
pTurtles <- round(turtles@.Data[, c("xcor", "ycor", "who"), drop = FALSE])
colnames(pTurtles)[1:2] <- c("pxcor", "pycor") # awkward column name change
if (simplify == TRUE) {
# Instead of merge, which is slow, make an empty matrix (of NAs)
# and use the agents coordinates directly
a <- matrix(ncol = ncol(world), nrow = nrow(world))
# pxcor and pycor do not correspond to [x;y] in a matrix
x <- attr(world, "maxPycor") - agents[, 2] + 1
y <- agents[, 1] - attr(world, "minPxcor") + 1
a[cbind(x, y)] <- 1
px <- attr(world, "maxPycor") - pTurtles[, 2] + 1
py <- pTurtles[, 1] - attr(world, "minPxcor") + 1
pOn <- na.omit(a[cbind(px, py)] * pTurtles)
if (nrow(pOn) == 0) {
return(noTurtles())
} else {
return(turtle(turtles = turtles, who = pOn[, 3]))
}
} else {
if (any(is.na(agents))) {
agents <- na.omit(agents)
} # There shouldn't be any NAs passed in here, probably
agents <- cbind(agents, id = seq_len(dim(agents)[1]))
# pxcor and pycor do not correspond to [x;y] in a matrix
x <- attr(world, "maxPycor") - agents[, 2] + 1
y <- agents[, 1] - attr(world, "minPxcor") + 1
a <- matrix(ncol = ncol(world), nrow = nrow(world))
b <- a
a[cbind(x, y)] <- 1
b[cbind(x, y)] <- agents[, 3]
px <- attr(world, "maxPycor") - pTurtles[, 2] + 1
py <- pTurtles[, 1] - attr(world, "minPxcor") + 1
pOn <- na.omit(a[cbind(px, py)] * pTurtles)
dims <- c(nrow(pOn), ncol(pOn))
colNames <- colnames(pOn)
length(pOn) <- length(pOn) + dims[1]
dim(pOn) <- dims + c(0, 1)
colnames(pOn) <- c(colNames, "id")
pOn[, "id"] <- na.omit(b[cbind(px, py)])
pOn <- pOn[order(pOn[, "id"]), , drop = FALSE]
turtlesID <- pOn[, c("who", "id"), drop = FALSE]
colnames(turtlesID)[1] <- "whoTurtles"
return(turtlesID)
}
}
)
#' @export
#' @rdname turtlesOn
setMethod(
"turtlesOn",
signature = c(
world = "worldNLR", turtles = "agentMatrix",
agents = "matrix", breed = "character"
),
definition = function(world, turtles, agents, breed, simplify) {
breedFactor <- which(turtles@levels$breed %in% breed)
if (length(breedFactor) == 0) {
tBreed <- noTurtles()
} else {
tBreed <- turtles[which(turtles@.Data[, "breed"] %in% breedFactor), drop = FALSE]
}
turtlesOn(world = world, turtles = tBreed, agents = agents, simplify = simplify)
}
)
################################################################################
#' No `turtles`
#'
#' Report an empty `turtle` `agentset`.
#'
#' @return `AgentMatrix` with the `turtle` variables defined as when using
#' `createTurtles()` but with 0 `turtle`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#no-turtles>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' t1 <- noTurtles()
#' NLcount(t1)
#'
#' @export
#' @rdname noTurtles
#'
#' @author Sarah Bauduin
#'
noTurtles <- function() {
t0 <- createTurtles(n = 1, coords = cbind(xcor = 0, ycor = 0))
empty <- t0[which(t0@.Data[, "who"] == 1), , drop = FALSE]
empty@levels$breed <- character(0)
empty@levels$color <- character(0)
return(empty)
}
################################################################################
#' `Turtles` at
#'
#' Report the individuals among `turtles` that are located on the `patches` at
#' `(dx, dy)` distances of the `agents`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the individuals among `turtles`
#' of any of the given `breed`, if specified,
#' which are located on the `patches` at `(dx, dy)` distances of the
#' `agents`.
#'
#' @details If the `patch` at distance `(dx, dy)`
#' of an `agent` is outside of the `world`'s extent and `torus = FALSE`,
#' no `turtle` is returned;
#' if `torus = TRUE`, the `turtle` located on the `patch` whose coordinates
#' are defined from the wrapped `world` is returned.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-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)
#' t1 <- createTurtles(
#' n = 10, coords = cbind(xcor = 0:9, ycor = 0:9),
#' breed = c(rep("sheep", 5), rep("wolf", 5))
#' )
#' t2 <- turtlesAt(
#' world = w1, turtles = t1, agents = turtle(t1, who = 0),
#' dx = 1, dy = 1
#' )
#' t3 <- turtlesAt(
#' world = w1, turtles = t1,
#' agents = patch(w1, c(3, 4, 5), c(3, 4, 5)), dx = 1, dy = 1,
#' breed = "sheep"
#' )
#'
#' @export
#' @rdname turtlesAt
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtlesAt",
function(world, turtles, agents, dx, dy, breed, torus = FALSE) {
standardGeneric("turtlesAt")
}
)
#' @export
#' @rdname turtlesAt
setMethod(
"turtlesAt",
signature = c(
"worldNLR", "agentMatrix", "matrix", "numeric", "numeric",
"missing", "ANY"
),
definition = function(world, turtles, agents, dx, dy, torus) {
pAt <- patchAt(world = world, agents = agents, dx = dx, dy = dy)
turtlesOn(world = world, turtles = turtles, agents = pAt)
}
)
#' @export
#' @rdname turtlesAt
setMethod(
"turtlesAt",
signature = c(
"worldNLR", "agentMatrix", "matrix", "numeric", "numeric",
"character", "ANY"
),
definition = function(world, turtles, agents, dx, dy, breed, torus) {
pAt <- patchAt(world = world, agents = agents, dx = dx, dy = dy)
turtlesOn(world = world, turtles = turtles, agents = pAt, breed = breed)
}
)
################################################################################
#' Create a `turtle` `agentset`
#'
#' Report a `turtle` `agentset` containing all unique `turtles` provided in the inputs.
#'
#' @param ... `AgentMatrix` objects representing the moving `agents`.
#'
#' @return `AgentMatrix` object containing all the unique `turtles`.
#'
#' @details Duplicated `turtles` are identified based only on their `who` numbers.
#' The `turtle` chosen for a who number is the first one given in the inputs.
#' To keep all `turtles` from the inputs, use `NLset()` to
#' reassign `who` numbers in some of the inputs, prior using
#' `turtleSet()`, to avoid `turtles` with duplicated `who` numbers.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtle-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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10), breed = "sheep")
#' t2 <- createTurtles(n = 2, coords = randomXYcor(w1, n = 2), breed = "wolf")
#' t2 <- NLset(turtles = t2, agents = t2, var = "who", val = c(10, 11))
#' t3 <- createTurtles(n = 1, coords = randomXYcor(w1, n = 1), breed = "sheperd")
#' t3 <- NLset(turtles = t3, agents = t3, var = "who", val = 12)
#' t4 <- turtleSet(t1, t2, t3)
#'
#' @export
#' @rdname turtleSet
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtleSet",
function(...) {
standardGeneric("turtleSet")
}
)
#' @export
#' @rdname turtleSet
setMethod(
"turtleSet",
signature = "agentMatrix",
definition = function(...) {
dots <- list(...)
nTurtles <- lapply(dots, function(x) NROW(x))
if (sum(unlist(nTurtles)) == 0) {
return(noTurtles())
} else {
if (any(nTurtles == 0)) {
dots <- dots[which(nTurtles != 0)] # remove the empty agentMatrix
if (length(dots) == 1) {
# if there is only one list element left
return(dots[[1]])
}
}
# if (do.call(all.equal, lapply(dots, colnames))) {
allTurtles <- do.call(rbind, lapply(dots, function(x) x))
# } else {
# allTurtles <- as.data.frame(rbindlist(lapply(dots, function(x) {
# inspect(x, who = of(agents = x, var = "who"))}), fill = TRUE))
# }
if (anyDuplicated(allTurtles$who) != 0) {
warning("Duplicated turtles based on who numbers are present among the inputs.")
allTurtles <- allTurtles[match(unique(allTurtles$who), allTurtles$who), ]
}
if (!is(allTurtles, "agentMatrix")) {
allTurtles <- as(allTurtles, "agentMatrix")
}
return(allTurtles)
}
}
)
################################################################################
#' New `turtles` variable
#'
#' Create a new variable for the `turtles`.
#'
#' @inheritParams fargs
#'
#' @param tVar Character. the name of the `turtles` variable to create.
#'
#' @param tVal Vector representing the values of `tVar`.
#' Must be of length 1 or of length `turtles`.
#' If missing, `NA` is given.
#'
#' @return `AgentMatrix` representing the `turtles` with the new
#' variable `tVar` added.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-own>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' t1 <- createTurtles(n = 5, coords = cbind(xcor = 0, ycor = 0))
#' t1 <- turtlesOwn(turtles = t1, tVar = "sex", tVal = c("F", "F", "F", "M", "M"))
#'
#' @export
#' @rdname turtlesOwn
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtlesOwn",
function(turtles, tVar, tVal) {
standardGeneric("turtlesOwn")
}
)
#' @export
#' @rdname turtlesOwn
setMethod(
"turtlesOwn",
signature = c("agentMatrix", "character", "missing"),
definition = function(turtles, tVar) {
turtles@.Data <- cbind(turtles@.Data, newCol = NA)
colnames(turtles@.Data)[ncol(turtles@.Data)] <- tVar
return(turtles)
}
)
#' @export
#' @rdname turtlesOwn
setMethod(
"turtlesOwn",
signature = c("agentMatrix", "character", "ANY"),
definition = function(turtles, tVar, tVal) {
if (inherits(tVal, "numeric") | inherits(tVal, "integer")) {
turtles@.Data <- cbind(turtles@.Data, newCol = tVal)
colnames(turtles@.Data)[ncol(turtles@.Data)] <- tVar
} else {
turtles@.Data <- cbind(turtles@.Data, newCol = as.factor(tVal))
colnames(turtles@.Data)[ncol(turtles@.Data)] <- tVar
nameLevels <- names(turtles@levels)
listLevels <- c(turtles@levels, list(levels(as.factor(tVal))))
names(listLevels) <- c(nameLevels, tVar)
turtles@levels <- listLevels
}
return(turtles)
}
)
################################################################################
#' Subtract `headings`
#'
#' Compute the difference between `headings`.
#'
#' @param angle1 `AgentMatrix` object representing the moving `agents`, or
#'
#' Numeric. Vector of angles.
#'
#' @param angle2 `AgentMatrix` object representing the moving `agents`, or
#'
#' Numeric. Vector of angles.
#'
#' @param range360 Logical. If `range360 = TRUE`, returned values are
#' between 0 and 360 degrees;
#' if `range360 = FALSE`, returned values are between
#' -180 and 180 degrees.
#' Default is `range360 = FALSE`.
#'
#' @return Numeric. Vector of the smallest angles in degrees
#' by which `angle1` could be rotated to produce `angle2`
#' (i.e., the target heading).
#'
#' @details This function does the opposite as the one in NetLogo where
#' `angle1` is the target heading.
#'
#' `angle1` and `angle2` must be of the same length or if different,
#' one of them must be of length 1.
#'
#' Positive values mean clockwise rotations, negative value mean
#' counterclockwise rotations.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#subtract-headings>
#'
#' @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)
#' t1 <- createOTurtles(n = 10, world = w1)
#' subHeadings(angle1 = t1, angle2 = 0)
#'
#' @export
#' @rdname subHeadings
#'
#' @author Sarah Bauduin
#'
setGeneric(
"subHeadings",
function(angle1, angle2, range360 = FALSE) {
standardGeneric("subHeadings")
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "numeric", angle2 = "numeric"),
definition = function(angle1, angle2, range360) {
len2 <- length(angle2)
len1 <- length(angle1)
if (len2 != len1) {
if (len2 == 1) {
angle2 <- rep(angle2, len1)
} else if (len1 == 1) {
angle1 <- rep(angle1, len2)
} else {
stop("angle1 and angle2 must be of the same length or one must be of length 1")
}
}
rad2 <- rad(angle2)
rad1 <- rad(angle1)
rads <- rad2 - rad1
angles <- deg(atan2(sin(rads), cos(rads)))
if (range360 == TRUE) {
anglesNeg <- angles < 0
angles[anglesNeg] <- angles[anglesNeg] + 360
}
return(angles)
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "agentMatrix", angle2 = "numeric"),
definition = function(angle1, angle2, range360) {
subHeadings(
angle1 = angle1@.Data[, "heading"], angle2 = angle2,
range360 = range360
)
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "numeric", angle2 = "agentMatrix"),
definition = function(angle1, angle2, range360) {
subHeadings(
angle1 = angle1, angle2 = angle2@.Data[, "heading"],
range360 = range360
)
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "agentMatrix", angle2 = "agentMatrix"),
definition = function(angle1, angle2, range360) {
subHeadings(
angle1 = angle1@.Data[, "heading"], angle2 = angle2@.Data[, "heading"],
range360 = range360
)
}
)
################################################################################
#' Others
#'
#' Report an `agentset` of the `agents` except specific ones.
#'
#' @inheritParams fargs
#'
#' @param except Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the `patches` coordinates, or
#'
#' `AgentMatrix` object representing the moving `agents`.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the `patches` in `agents` without
#' the ones in `except`, or
#'
#' `AgentMatrix` representing the `turtles` in `agents` without
#' the ones in `except`.
#'
#' @details Both `agents` and `except` must be of the same class (e.g., both
#' `patches` or both `turtles`).
#'
#' Warning: this function removes `turtles` only based on similar `who` numbers
#' and `breed` names.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#other>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' # Patches
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' p1 <- other(agents = patches(w1), except = patch(w1, 0, 0))
#' NLcount(p1) # 99 patches
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = cbind(xcor = 0, ycor = 0))
#' t2 <- other(agents = t1, except = turtle(t1, who = 0))
#' NLcount(t2) # 9 turtles
#'
#' @export
#' @rdname other
#'
#' @author Sarah Bauduin
#'
setGeneric(
"other",
function(agents, except) {
standardGeneric("other")
}
)
#' @export
#' @rdname other
setMethod(
"other",
signature = c("matrix", "matrix"),
definition = function(agents, except) {
if (inherits(agents, "agentMatrix") & inherits(except, "agentMatrix")) {
matchWho <- match(except@.Data[, "who"], agents@.Data[, "who"])
matchWho <- matchWho[!is.na(matchWho)]
matchBreed <- which(agents@.Data[matchWho, "breed"] ==
except@.Data[except@.Data[, "who"] ==
agents@.Data[matchWho, "who"], "breed"])
if (length(matchBreed) != 0) {
agents <- agents[-matchWho[matchBreed], , drop = FALSE]
}
return(agents)
} else {
pCoords <- agents[!duplicated(rbind(except, agents))[-1:-nrow(except)], , drop = FALSE]
return(pCoords)
}
}
)
################################################################################
#' Layout `turtles` on a circle
#'
#' Relocate the `turtles` on a circle centered on the `world`.
#'
#' @inheritParams fargs
#'
#' @param radius Numeric. Radius of the circle.
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their `heading` values and
#' previous coordinates `prevX`
#' and `prevY`.
#'
#' @details The `turtles` point outwards.
#'
#' If the
#' `radius` value leads `turtles` outside of the `world`'s extent
#' and `torus = TRUE`, they are
#' relocated on the other sides of the `world`, inside its extent; if
#' `torus = FALSE`, the `turtles` are located past
#' the `world`'s extent.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#layout-circle>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = "black", pch = 16)
#'
#' t1 <- layoutCircle(world = w1, turtles = t1, radius = 3)
#' points(t1, col = "red", pch = 16)
#'
#' @export
#' @rdname layoutCircle
#'
#' @author Sarah Bauduin
#'
setGeneric(
"layoutCircle",
function(world, turtles, radius, torus = FALSE) {
standardGeneric("layoutCircle")
}
)
#' @export
#' @rdname layoutCircle
setMethod(
"layoutCircle",
signature = c(world = "worldNLR", turtles = "agentMatrix", radius = "numeric"),
definition = function(world, turtles, radius, torus) {
tSurrogates <- createOTurtles(n = NLcount(turtles), world = world)
turtles@.Data[, c("xcor", "ycor")] <- tSurrogates@.Data[, c("xcor", "ycor")]
turtles@.Data[, "heading"] <- tSurrogates@.Data[, "heading"]
fd(world = world, turtles = turtles, dist = radius, torus = torus, out = TRUE)
}
)
################################################################################
#' Values of an `agents` variable
#'
#' Report the `agents` values for the requested variable.
#'
#' @inheritParams fargs
#'
#' @param var Character. Vector of the names of the selected `agents` variables.
#' If `agents` are `patches` and the `world` is a
#' `worldMatrix` object, `var` must not be provided. If
#' `agents` are `patches` and the `world` is a
#' `worldArray` object, `var` is the name of the layers to
#' use to define the `patches`
#' values. If `agents` are `turtles`, `var` is some of
#' the `turtles`' variable and can be any of the variables created
#' when `turtles` were created,
#' as well as any variable created with `turtlesOwn()`.
#'
#' @return Vector of values for the `agents` if one variable is
#' requested. The class depends
#' of the variable class. The order of the vector follows the order
#' of the `agents`, or
#'
#' Matrix or `Dataframe` (`ncol` = `length(var)`, `nrow` = `NLcount(agents)`)
#' if more than one variable is requested. The row order
#' follows the order of the `agents`.
#'
#' @details `world` must be provided only if `agents` are `patches`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#of>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' # Patches
#' w1 <- createWorld(
#' minPxcor = 0, maxPxcor = 4, minPycor = 0, maxPycor = 4,
#' data = 1:25
#' )
#' of(world = w1, agents = patch(w1, c(0, 0), c(4, 0)))
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' of(agents = t1, var = "heading")
#'
#' @export
#' @rdname of
#'
#' @author Sarah Bauduin
#'
setGeneric(
"of",
function(world, agents, var) {
standardGeneric("of")
}
)
#' @export
#' @rdname of
setMethod(
"of",
signature = c("missing", "agentMatrix", "character"),
definition = function(agents, var) {
if (any(names(agents@levels) %in% var)) {
wh <- var %in% names(agents@levels)
# if (any(wh)) {
newNames <- var[wh]
df <- do.call(data.frame, args = append(
list(stringsAsFactors = FALSE),
lapply(which(wh), function(w) {
agents@levels[[var[w]]][agents@.Data[, var[w]]]
})
))
if (!all(wh)) {
df <- as.data.frame(cbind(agents@.Data[, var[!wh], drop = FALSE], df))
newNames <- c(var[!wh], newNames)
}
colnames(df) <- newNames
return(df[, match(newNames, var)])
} else {
if (length(var) == 1) {
return(agents@.Data[, var])
} else {
return(agents@.Data[, var, drop = FALSE])
}
}
}
)
#' @export
#' @rdname of
setMethod(
"of",
signature = c("worldMatrix", "matrix", "missing"),
definition = function(world, agents) {
if (identical(patches(world), agents)) {
return(as.numeric(t(world@.Data))) # values must be returned by row
} else {
return(world[agents[, 1], agents[, 2]])
}
}
)
#' @export
#' @rdname of
setMethod(
"of",
signature = c("worldArray", "matrix", "character"),
definition = function(world, agents, var) {
if (identical(patches(world), agents)) {
allValues <- world[]
return(allValues[, var])
} else {
cellNum <- cellFromPxcorPycor(world = world, pxcor = agents[, 1], pycor = agents[, 2])
allValues <- world[]
if (length(var) == 1) {
return(allValues[cellNum, var])
} else {
return(allValues[cellNum, var, drop = FALSE])
}
}
}
)
################################################################################
#' From `SpatialPointsDataFrame` to `agentMatrix`
#'
#' Convert a `SpatialPointsDataFrame` object into an `agentMatrix` object.
#'
#' @param spdf `SpatialPointsDataFrame` object representing moving `agents`.
#'
#' @return `AgentMatrix` object representing the moving `agents` (coordinates and data)
#' as contained in `spdf`.
#'
#' @details If the `spdf` does not contain the variables created with
#' `createTurtles()`, these variables will be created with the
#' default values as in `createTurtles()`.
#'
#' @examples
#' if (requireNamespace("sp", quietly = TRUE)) {
#' sp1 <- sp::SpatialPointsDataFrame(
#' coords = cbind(x = c(1, 2, 3), y = c(1, 2, 3)),
#' data = cbind.data.frame(
#' age = c(0, 0, 3),
#' sex = c("F", "F", "M")
#' )
#' )
#' t1 <- spdf2turtles(spdf = sp1)
#' }
#'
#' @export
#' @rdname spdf2turtles
#'
#' @author Sarah Bauduin
#'
setGeneric(
"spdf2turtles",
function(spdf) {
standardGeneric("spdf2turtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname spdf2turtles
setMethod(
"spdf2turtles",
signature = c("ANY"),
definition = function(spdf) {
if (!is(spdf, "SpatialPointsDataFrame")) {
stop("spdf is not a SpatialPointsDataFrame")
}
spdfData <- spdf@data
n <- length(spdf)
if (!is.na(match("who", names(spdfData)))) {
who <- spdfData$who
} else {
who <- seq(from = 0, to = n - 1, by = 1)
}
if (!is.na(match("heading", names(spdfData)))) {
heading <- spdfData$heading
} else {
heading <- runif(n = n, min = 0, max = 360)
}
if (!is.na(match("prevX", names(spdfData)))) {
prevX <- spdfData$prevX
} else {
prevX <- rep(NA, n)
}
if (!is.na(match("prevY", names(spdfData)))) {
prevY <- spdfData$prevY
} else {
prevY <- rep(NA, n)
}
if (!is.na(match("breed", names(spdfData)))) {
breed <- spdfData$breed
} else {
breed <- rep("turtle", n)
}
if (!is.na(match("color", names(spdfData)))) {
color <- spdfData$color
} else {
color <- rainbow(n)
}
turtles <- new("agentMatrix",
coords = cbind(xcor = spdf@coords[, 1], ycor = spdf@coords[, 2]),
who = who,
heading = heading,
prevX = prevX,
prevY = prevY,
breed = breed,
color = color
)
for (i in which(!names(spdfData) %in% c(
"who", "heading", "prevX", "prevY",
"breed", "color", "stringsAsFactors"
))) {
turtles <- turtlesOwn(turtles = turtles, tVar = names(spdfData)[i], tVal = spdfData[, i])
}
return(turtles)
}
)
################################################################################
#' From `sf` to `agentMatrix`
#'
#' Convert a `sf` object into an `agentMatrix` object.
#'
#' @param turtles_sf `sf` object of `POINT geometry` representing moving `agents`.
#'
#' @return `AgentMatrix` object representing the moving `agents` (coordinates and data)
#' as contained in `turtles_sf`.
#'
#' @details If the `turtles_sf` does not contain the variables created with
#' `createTurtles()`, these variables will be created with the
#' default values as in `createTurtles()`.
#'
#' @examples
#' if (requireNamespace("sf", quietly = TRUE)) {
#' turtles_sf1 <- sf::st_as_sf(
#' cbind.data.frame(
#' x = c(1, 2, 3), y = c(1, 2, 3),
#' age = c(0, 0, 3), sex = c("F", "F", "M")
#' ),
#' coords = c("x", "y")
#' )
#' t1 <- sf2turtles(turtles_sf = turtles_sf1)
#' }
#'
#' @export
#' @rdname sf2turtles
#'
#' @author Sarah Bauduin
#'
setGeneric(
"sf2turtles",
function(turtles_sf) {
standardGeneric("sf2turtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname sf2turtles
setMethod(
"sf2turtles",
signature = c("ANY"),
definition = function(turtles_sf) {
if (!is(turtles_sf, "sf")) {
stop("To use sf2turtles, sf must be installed: install.packages('sf')")
}
sfData <- sf::st_drop_geometry(turtles_sf)
n <- nrow(turtles_sf)
if (!is.na(match("who", names(sfData)))) {
who <- sfData$who
} else {
who <- seq(from = 0, to = n - 1, by = 1)
}
if (!is.na(match("heading", names(sfData)))) {
heading <- sfData$heading
} else {
heading <- runif(n = n, min = 0, max = 360)
}
if (!is.na(match("prevX", names(sfData)))) {
prevX <- sfData$prevX
} else {
prevX <- rep(NA, n)
}
if (!is.na(match("prevY", names(sfData)))) {
prevY <- sfData$prevY
} else {
prevY <- rep(NA, n)
}
if (!is.na(match("breed", names(sfData)))) {
breed <- sfData$breed
} else {
breed <- rep("turtle", n)
}
if (!is.na(match("color", names(sfData)))) {
color <- sfData$color
} else {
color <- rainbow(n)
}
turtles <- new("agentMatrix",
coords = cbind(
xcor = sf::st_coordinates(turtles_sf)[, 1],
ycor = sf::st_coordinates(turtles_sf)[, 2]
),
who = who,
heading = heading,
prevX = prevX,
prevY = prevY,
breed = breed,
color = color
)
for (i in which(!names(sfData) %in% c(
"who", "heading", "prevX", "prevY",
"breed", "color", "stringsAsFactors"
))) {
turtles <- turtlesOwn(turtles = turtles, tVar = names(sfData)[i], tVal = sfData[, i])
}
return(turtles)
}
)
################################################################################
#' From `agentMatrix` to `SpatialPointsDataFrame`
#'
#' Convert an `agentMatrix` object into a `SpatialPointsDataFrame` object.
#'
#' @inheritParams fargs
#'
#' @return `SpatialPointsDataFrame` object representing the moving `agents`
#' (coordinates and data)
#' as contained in `turtles`.
#'
#' @examples
#' t1 <- createTurtles(n = 10, coords = cbind(xcor = 1:10, ycor = 1:10))
#' if (requireNamespace("sp", quietly = TRUE)) {
#' sp1 <- turtles2spdf(turtles = t1)
#' }
#'
#' @export
#' @rdname turtles2spdf
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtles2spdf",
function(turtles) {
standardGeneric("turtles2spdf")
}
)
#' @export
#' @rdname turtles2spdf
setMethod(
"turtles2spdf",
signature = c("agentMatrix"),
definition = function(turtles) {
if (!requireNamespace("sp", quietly = TRUE)) {
stop("Please install.packages('sp') to use sp objects")
}
spdf <- sp::SpatialPointsDataFrame(
coords = turtles@.Data[, c("xcor", "ycor"), drop = FALSE],
data = inspect(turtles, who = turtles@.Data[, "who"])
[3:ncol(turtles@.Data)]
)
return(spdf)
}
)
################################################################################
#' From `agentMatrix` to `sf`
#'
#' Convert an `agentMatrix` object into an `sf` object.
#'
#' @inheritParams fargs
#'
#' @return `sf` object of `POINT geometry` representing the moving `agents`
#' (coordinates and data)
#' as contained in `turtles`.
#'
#' @examples
#' t1 <- createTurtles(n = 10, coords = cbind(xcor = 1:10, ycor = 1:10))
#' if (requireNamespace("sf", quietly = TRUE)) {
#' sf_t1 <- turtles2sf(turtles = t1)
#' }
#'
#' @export
#' @rdname turtles2sf
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtles2sf",
function(turtles) {
standardGeneric("turtles2sf")
}
)
#' @export
#' @rdname turtles2sf
setMethod(
"turtles2sf",
signature = c("ANY"),
definition = function(turtles) {
if (!requireNamespace("sf", quietly = TRUE)) {
stop("To use turtles2sf, sf must be installed: install.packages('sf')")
}
turtles_sf <- sf::st_as_sf(inspect(turtles, who = turtles@.Data[, "who"]),
coords = c("xcor", "ycor")
)
return(turtles_sf)
}
)
extents <- function(ext) {
xmn <- terra::xmin(ext)
xmx <- terra::xmax(ext)
ymn <- terra::ymin(ext)
ymx <- terra::ymax(ext)
list(xmin = xmn, xmax = xmx, ymin = ymn, ymax = ymx)
}
PredictiveEcology/NetLogoR documentation built on Jan. 31, 2024, 9:31 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions extents noTurtles
Documented in noTurtles
################################################################################
#' Create `turtles`
#'
#' Create `n` moving `agents` with a set of defined variables.
#'
#' @inheritParams fargs
#'
#' @param coords Matrix (`ncol` = 2) with the first column `xcor` and the second
#' column `ycor` representing the `turtles` initial locations.
#' `nrow(coords)` must be equal to 1 or to `n`.
#' Given coordinates must be inside the `world`'s extent. If missing,
#' `turtles` are put in the center of the `world`.
#'
#' @param heading Numeric. Vector of values between 0 and 360. Must be of length 1 or
#' of length `n`. If missing, a random `heading` is assigned to
#' each `turtle`.
#'
#' @param breed Character. Vector of `breed` names. Must be of length 1 or of length
#' `n`. If missing, `breed = "turtle"` for all `turtles`.
#'
#' @return `AgentMatrix` object of length `n` with data for the
#' `turtles` being: `xcor`, `ycor`, `who`, `heading`, `prevX`, `prevY`,
#' `breed`, and `color`.
#'
#' @details If `coords` is provided, `world` must not be provided.
#'
#' The identity of the `turtles` is defined by their `who` number. This
#' numbering starts at 0 and increments by 1.
#'
#' The coordinates from the previous time step are stored in `prevX` and
#' `prevY`. The initial values are `NA`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname createTurtles
#'
#' @author Sarah Bauduin
setGeneric(
"createTurtles",
function(n, coords, world, heading, breed, color) {
standardGeneric("createTurtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname createTurtles
setMethod(
"createTurtles",
signature = c("numeric", "matrix", "missing", "ANY", "ANY", "ANY"),
definition = function(n, coords, world, heading, breed, color) {
if (missing(heading)) heading <- runif(n = n, min = 0, max = 360)
if (missing(breed)) breed <- "turtle"
if (missing(color)) color <- rainbow(n)
repNA <- rep(NA, n)
turtles <- new("agentMatrix",
coords = coords,
who = seq_len(n) - 1,
heading = heading,
prevX = repNA,
prevY = repNA,
breed = breed,
color = color
)
return(turtles)
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname createTurtles
setMethod(
"createTurtles",
signature = c("numeric", "missing", "ANY", "ANY", "ANY", "ANY"),
definition = function(n, coords, world, heading, breed, color) {
coords <- cbind(
xcor = rep(((maxPxcor(world) - minPxcor(world)) / 2) + minPxcor(world), n),
ycor = rep(((maxPycor(world) - minPycor(world)) / 2) + minPycor(world), n)
)
if (missing(heading)) {
heading <- runif(n = n, min = 0, max = 360)
}
if (missing(breed)) {
breed <- "turtle"
}
if (missing(color)) {
color <- rainbow(n)
}
turtles <- new("agentMatrix",
coords = coords, who = seq(from = 0, to = n - 1, by = 1),
heading = heading, prevX = rep(NA, n), prevY = rep(NA, n),
breed = breed, color = color
)
return(turtles)
}
)
################################################################################
#' Create ordered `turtles`
#'
#' Create `n` `turtles` at the center of the `world` with their `headings` evenly
#' distributed.
#'
#' @inheritParams createTurtles
#'
#' @return `AgentMatrix` object of length `n` with data for the
#' turtles being: `xcor`, `ycor`, `who`, `heading`, `prevX`, `prevY`, `breed`,
#' and `color`.
#'
#' @details The identity of the `turtles` is defined by their `who` number. This
#' numbering starts at 0 and increments by 1.
#'
#' The coordinates from the previous time step are stored in `prevX` and
#' `prevY`. The initial values are `NA`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-ordered-turtles>
#'
#' @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 = runif(25)
#' )
#' t1 <- createOTurtles(n = 10, world = w1)
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- fd(turtles = t1, dist = 1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname createOTurtles
#'
#' @author Sarah Bauduin and Eliot McIntire
#'
setGeneric(
"createOTurtles",
function(n, world, breed, color) {
standardGeneric("createOTurtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @rdname createOTurtles
setMethod(
"createOTurtles",
signature = c(n = "numeric", world = "ANY"),
definition = function(n, world, breed, color) {
heading <- numeric(n)
heading[1] <- 0
if (n > 1) {
heading[2:n] <- heading[1:(n - 1)] + (360 / n) * (1:(n - 1))
}
li <- lapply(names(match.call()[-1]), function(x) eval(parse(text = x)))
names(li) <- names(match.call())[-1]
if (missing(breed)) {
li$breed <- rep("turtle", n)
}
if (length(li$breed) == 1) {
li$breed <- rep(li$breed, n)
}
if (missing(color)) {
li$color <- rainbow(n)
}
createTurtles(
n = n, world = world, heading = heading, breed = li$breed,
color = li$color
)
}
)
################################################################################
#' Move forward
#'
#' Move the `turtles` forward with their `headings` as directions.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances to move. Must
#' be of length 1 or of length `turtles`.
#'
#' @param out Logical. Determine if a `turtle` should move when
#' `torus = FALSE` and its ending position will be outside of
#' the `world`'s extent. Default is `out = TRUE`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If `torus = FALSE` and `out = TRUE`, `world`
#' does not need to be provided.
#'
#' If a distance to move leads a `turtle` outside of the `world`'s extent
#' and `torus = TRUE`, the `turtle` is
#' relocated on the other side of the `world`, inside its extent; if
#' `torus = FALSE` and `out = TRUE`, the `turtle` moves past the
#' `world`'s extent; if `torus = FALSE` and `out = FALSE`, the
#' `turtle` does not move at all. In the event that a `turtle` does not move,
#' its previous coordinates are still updated with its position before
#' running `fd()` (i.e., its current position).
#'
#' If a given `dist` value is negative, then the `turtle` moves
#' backward.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#jump>
#'
#' @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 = runif(25)
#' )
#' t1 <- createOTurtles(n = 10, world = w1)
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- fd(turtles = t1, dist = 1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname fd
#'
#' @author Sarah Bauduin
#'
setGeneric(
"fd",
function(turtles, dist, world, torus = FALSE, out = TRUE) {
standardGeneric("fd")
}
)
#' @export
#' @rdname fd
setMethod(
"fd",
signature = c(turtles = "agentMatrix", dist = "numeric"),
definition = function(turtles, dist, world, torus, out) {
turtles@.Data[, c("prevX", "prevY")] <- turtles@.Data[, 1:2]
inRads <- rad(turtles@.Data[, "heading"])
fdXcor <- turtles@.Data[, "prevX"] + sin(inRads) * dist
fdYcor <- turtles@.Data[, "prevY"] + cos(inRads) * dist
if (torus == TRUE) {
if (missing(world)) {
stop("A world must be provided as torus = TRUE")
}
coords <- c(fdXcor, fdYcor)
dim(coords) <- c(length(fdXcor), 2L)
colnames(coords) <- c("x", "y")
tCoords <- wrap(coords, extent(world))
fdXcor <- tCoords[, 1]
fdYcor <- tCoords[, 2]
}
if (torus == FALSE & out == FALSE) {
if (missing(world)) {
stop("A world must be provided as torus = FALSE and out = FALSE")
}
exts <- extents(world@extent)
outX <- fdXcor < exts$xmin | fdXcor > exts$xmax
outY <- fdYcor < exts$ymin | fdYcor > exts$ymax
outXY <- which(outX | outY) # position of turtles out of the world's extent
fdXcor[outXY] <- turtles@.Data[, "prevX"][outXY]
fdYcor[outXY] <- turtles@.Data[, "prevY"][outXY]
}
turtles@.Data[, 1:2] <- c(
round(fdXcor, digits = 5),
round(fdYcor, digits = 5)
)
return(turtles)
}
)
################################################################################
#' Move backward
#'
#' Move the `turtles` backward of their headings' directions.
#'
#' @inheritParams fargs
#'
#' @inheritParams fd
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If `torus = FALSE` and `out = TRUE`, `world`
#' does not need to be provided.
#'
#' If a distance to move leads a `turtle` outside of the `world`'s extent
#' and `torus = TRUE`, the `turtle` is
#' relocated on the other side of the `world`, inside its extent; if
#' `torus = FALSE` and `out = TRUE`, the `turtle` moves past the
#' `world`'s extent; if `torus = FALSE` and `out = FALSE`, the
#' `turtle` does not move at all. In the event that a `turtle` does not move,
#' its previous coordinates are still updated with its position before
#' running `bk()` (i.e., its current position).
#'
#' If a given `dist` value is negative, then the `turtle` moves
#' forward.
#'
#' The `turtles`' headings are not affected by the function (i.e., the
#' `turtles` do not face backward).
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#back>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#jump>
#'
#' @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 = runif(25)
#' )
#' t1 <- createOTurtles(n = 10, world = w1)
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- fd(turtles = t1, dist = 2)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' t1 <- bk(turtles = t1, dist = 1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' t1 <- fd(turtles = t1, dist = 0.5)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname bk
#'
#' @author Sarah Bauduin
#'
setGeneric(
"bk",
function(turtles, dist, world, torus = FALSE, out = TRUE) {
standardGeneric("bk")
}
)
#' @export
#' @rdname bk
setMethod(
"bk",
signature = c(turtles = "agentMatrix", dist = "numeric"),
definition = function(turtles, dist, world, torus, out) {
fd(turtles = turtles, dist = -dist, world = world, torus = torus, out = out)
}
)
################################################################################
#' Return home
#'
#' Move the `turtles` back `home`.
#'
#' @inheritParams fargs
#'
#' @param home Character. Can take one of the following options to define where
#' to relocate the `turtles`:
#'
#' `home = "home0"` will place the `turtles` at the location
#' `x = 0, y = 0`.
#'
#' `home = "center"` will place the `turtles` at the center of
#' the `world`.
#'
#' `home = "pCorner"` will place the `turtles` at the center of
#' the `patch` located in the left bottom corner of the `world`.
#'
#' `home = "corner"` will place the `turtles` at the left bottom
#' corner of the `world`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their previous coordinates `prevX`
#' and `prevY`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#home>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = "black", pch = 16)
#'
#' t1 <- home(world = w1, turtles = t1, home = "pCorner")
#' points(t1, col = "red", pch = 16)
#'
#' @export
#' @rdname home
#'
#' @author Sarah Bauduin
#'
setGeneric(
"home",
function(world, turtles, home) {
standardGeneric("home")
}
)
#' @export
#' @rdname home
setMethod(
"home",
signature = c("worldNLR", "agentMatrix", "character"),
definition = function(world, turtles, home) {
if (home == "home0") {
exts <- extents(world@extent)
if (exts$xmin <= 0 & exts$xmax >= 0 &
exts$ymin <= 0 & exts$ymax >= 0) {
newTurtles <- setXY(turtles = turtles, xcor = 0, ycor = 0, world = world, torus = FALSE)
} else {
stop("The world provided does not contain the location [x = 0, y = 0]")
}
}
if (home == "center") {
exts <- extents(world@extent)
newTurtles <- setXY(
turtles = turtles,
xcor = ((exts$xmax - exts$xmin) / 2) +
exts$xmin,
ycor = ((exts$ymax - exts$ymin) / 2) +
exts$ymin,
world = world, torus = FALSE
)
}
if (home == "pCorner") {
newTurtles <- setXY(
turtles = turtles, xcor = world@minPxcor,
ycor = world@minPycor, world = world, torus = FALSE
)
}
if (home == "corner") {
exts <- extents(world@extent)
newTurtles <- setXY(
turtles = turtles, xcor = exts$xmin,
ycor = exts$ymin, world = world, torus = FALSE
)
}
return(newTurtles)
}
)
################################################################################
#' x-increment
#'
#' Report the amount by which the `turtles`' coordinates `xcor` would change
#' if the `turtles` were
#' to move forward the given distances with their current `headings`.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances the `turtles` would have to
#' move forward to
#' compute the increment values. Must be of length 1 or of length
#' `turtles`. The default value is `dist = 1`.
#'
#' @return Numeric. Vector of length `turtles`.
#'
#' @details Report the sine of the `turtles`' `heading` multiplied by the `dist`
#' values. Heading 0 is north and angles are calculated in degrees in a
#' clockwise manner.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#dxy>
#'
#' @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)
#' t1 <- createOTurtles(world = w1, n = 10)
#' dx(turtles = t1)
#'
#' @export
#' @rdname dx
#'
#' @author Sarah Bauduin
#'
setGeneric(
"dx",
function(turtles, dist = 1) {
standardGeneric("dx")
}
)
#' @export
#' @rdname dx
setMethod(
"dx",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, dist) {
xIncr <- round(sin(rad(turtles@.Data[, "heading"])) * dist, digits = 5)
return(xIncr)
}
)
#' @export
#' @rdname dx
setMethod(
"dx",
signature = c("agentMatrix", "missing"),
definition = function(turtles) {
dx(turtles = turtles, dist = 1)
}
)
################################################################################
#' y-increment
#'
#' Report the amount by which the `turtles`' coordinates `ycor` would change
#' if the `turtles` were
#' to move forward the given distances with their current `headings`.
#'
#' @inheritParams fargs
#'
#' @inheritParams dx
#'
#' @return Numeric. Vector of length `turtles`.
#'
#' @details Report the cosine of the `turtles`' `heading` multiplied by the `dist`
#' values. Heading 0 is north and angles are calculated in degrees in a
#' clockwise manner.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#dxy>
#'
#' @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)
#' t1 <- createOTurtles(world = w1, n = 10)
#' dy(turtles = t1)
#'
#' @export
#' @rdname dy
#'
#' @author Sarah Bauduin
#'
setGeneric(
"dy",
function(turtles, dist = 1) {
standardGeneric("dy")
}
)
#' @export
#' @rdname dy
setMethod(
"dy",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, dist) {
yIncr <- round(cos(rad(turtles@.Data[, "heading"])) * dist, digits = 5)
return(yIncr)
}
)
#' @export
#' @rdname dy
setMethod(
"dy",
signature = c("agentMatrix", "missing"),
definition = function(turtles) {
dy(turtles = turtles, dist = 1)
}
)
################################################################################
#' Kill `turtles`
#'
#' Kill selected `turtles`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with the selected
#' ones removed.
#'
#' @details The `who` numbers of the remaining `turtles` are unchanged.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#die>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' NLcount(t1)
#' t1 <- die(turtles = t1, who = c(2, 3, 4))
#' NLcount(t1)
#'
#' @export
#' @rdname die
#'
#' @author Sarah Bauduin
#'
setGeneric(
"die",
function(turtles, who) {
standardGeneric("die")
}
)
#' @export
#' @importFrom stats na.omit
#' @rdname die
setMethod(
"die",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, who) {
if (length(who) != 0) {
turtles <- turtles[-na.omit(match(who, turtles@.Data[, "who"])), , drop = FALSE]
}
return(turtles)
}
)
################################################################################
#' Hatch new `turtles`
#'
#' Create new `turtles` from parent `turtles`.
#'
#' @inheritParams fargs
#'
#' @param n Integer. Vector of length 1 or of length `who`. Number of new `turtles`
#' to create for each parent.
#'
#' @param breed Character. One `breed` name. If missing,
#' the created `turtles` are of the same `breed` as their parent `turtle`.
#'
#' @return `AgentMatrix` representing the `turtles` with the new
#' hatched ones.
#'
#' @details The parent `turtle` must be contained in the `turtles`.
#'
#' The created `turtles` inherit of all the data from the parent `turtle`,
#' except for the `breed` if specified otherwise, and for the `who` numbers.
#' The `who`" numbers of the `turtles` created take on following the highest
#' `who` number among the `turtles`.
#'
#' All new hatched `turtles` are placed at the end of the `agentMatrix` object.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' NLcount(t1)
#' t1 <- hatch(turtles = t1, who = 0, n = 2)
#' NLcount(t1)
#'
#' @export
#' @rdname hatch
#'
#' @author Sarah Bauduin
#'
setGeneric(
"hatch",
function(turtles, who, n, breed) {
standardGeneric("hatch")
}
)
#' @export
#' @rdname hatch
setMethod(
"hatch",
signature = c("agentMatrix", "numeric", "numeric", "ANY"),
definition = function(turtles, who, n, breed) {
iTurtle <- match(who, turtles@.Data[, "who"])
newData <- turtles@.Data[iTurtle, , drop = FALSE]
# Allow n to be different
if (length(n) != length(iTurtle)) {
n <- rep(n, length(iTurtle))
}
if (any(n == 0)) {
iTurtle <- iTurtle[n != 0]
newData <- newData[n != 0, , drop = FALSE]
n <- n[n != 0]
}
newData <- newData[rep(seq_len(nrow(newData)), n), , drop = FALSE]
newData[, "who"] <- (max(turtles@.Data[, "who"]) + 1):(max(turtles@.Data[, "who"]) + sum(n))
if (!missing(breed)) {
if (!breed %in% turtles@levels$breed) {
turtles@levels$breed <- c(turtles@levels$breed, breed)
}
newData[, "breed"] <- match(breed, turtles@levels$breed)
}
turtles@.Data <- rbind(turtles@.Data, newData)
return(turtles)
}
)
################################################################################
#' Can the `turtles` move?
#'
#' Report `TRUE` if a `turtle` can move the given distance without leaving
#' the `world`'s extent, report `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @inheritParams fd
#'
#' @return Logical. Vector of length `turtles`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#can-move>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' canMove(world = w1, turtles = t1, dist = 1:10)
#'
#' @export
#' @rdname canMove
#'
#' @author Sarah Bauduin
#'
setGeneric(
"canMove",
function(world, turtles, dist) {
standardGeneric("canMove")
}
)
#' @export
#' @rdname canMove
setMethod(
"canMove",
signature = c("worldNLR", "agentMatrix", "numeric"),
definition = function(world, turtles, dist) {
wrapFalse <- fd(world = world, turtles = turtles, dist = dist, torus = FALSE)
wrapTrue <- fd(world = world, turtles = turtles, dist = dist, torus = TRUE)
testX <- wrapFalse@.Data[, "xcor"] == wrapTrue@.Data[, "xcor"]
testY <- wrapFalse@.Data[, "ycor"] == wrapTrue@.Data[, "ycor"]
return(testX & testY)
}
)
################################################################################
#' Random `xcor`
#'
#' Report `n` random `xcor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Numeric. Vector of length `n` of `xcor` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = cbind(
#' xcor = randomXcor(world = w1, n = 10),
#' ycor = randomYcor(world = w1, n = 10)
#' ))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname randomXcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomXcor",
function(world, n) {
standardGeneric("randomXcor")
}
)
#' @export
#' @importFrom stats runif
#' @rdname randomXcor
setMethod(
"randomXcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
if (n == 0) {
return(xcor = numeric())
} else {
xcor <- round(runif(
n = n, min = terra::xmin(world@extent),
max = terra::xmax(world@extent)
), digits = 5)
return(xcor)
}
}
)
################################################################################
#' Random `ycor`
#'
#' Report `n` random `ycor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Numeric. Vector of length `n` of `ycor` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = cbind(
#' xcor = randomXcor(world = w1, n = 10),
#' ycor = randomYcor(world = w1, n = 10)
#' ))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname randomYcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomYcor",
function(world, n) {
standardGeneric("randomYcor")
}
)
#' @export
#' @importFrom stats runif
#' @rdname randomYcor
setMethod(
"randomYcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
if (n == 0) {
return(ycor = numeric())
} else {
exts <- extents(world@extent)
ycor <- round(runif(
n = n, min = exts$ymin,
max = exts$ymax
), digits = 5)
return(ycor)
}
}
)
################################################################################
#' Directions towards
#'
#' Report the directions of each `agents` towards each corresponding `agents2`.
#'
#' @inheritParams fargs
#'
#' @return Numeric. Vector of angles in degrees of length equal to the largest
#' number of agents/locations between `agents` and `agents2`.
#'
#' @details `agents` and `agents2` must have the same number of agents/locations
#' or if different, one of them must have only one agent/location. If
#' `agents` and `agents2` have the same number of agents/locations,
#' the directions are calculated for each pair `agents[i]` and `agents2[i]`
#' and not for each `agents` towards every single `agents2`.
#'
#' If `torus = FALSE`, `world` does not need to be provided.
#'
#' If `torus = TRUE` and the distance from one `agents` to
#' its corresponding `agents2` is smaller around the
#' sides of the `world` than across it, then the direction to `agents2`
#' going around the sides of the `world` is returned.
#'
#' The direction from a patch to its location returns 0; the direction from
#' a turtle to its location returns the turtle's heading.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#towards>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#towardsxy>
#'
#' @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)
#' towards(agents = patches(w1), agents2 = cbind(x = 0, y = 0))
#' t1 <- createTurtles(n = 10, world = w1)
#' towards(agents = t1, agents2 = cbind(x = 0, y = 0))
#'
#' @export
#' @rdname towards
#'
#' @author Sarah Bauduin
#'
setGeneric(
"towards",
function(agents, agents2, world, torus = FALSE) {
standardGeneric("towards")
}
)
#' @export
#' @rdname towards
setMethod(
"towards",
signature = c(agents = "matrix", agents2 = "matrix"),
definition = function(agents, agents2, world, torus) {
if (!inherits(agents, "agentMatrix") & !inherits(agents2, "agentMatrix")) {
# patches to patches
if (torus == FALSE) {
heading <- deg(atan2(agents2[, 1] - agents[, 1], agents2[, 2] - agents[, 2]))
# angles between -180 and 180
heading[heading < 0] <- heading[heading < 0] + 360
} else {
if (missing(world)) {
stop("A world must be provided as torus = TRUE")
}
if (NROW(agents2) == 1 & NROW(agents) != 1) {
agents2 <- c(rep(agents2[, 1], NROW(agents)), rep(agents2[, 2], NROW(agents)))
dim(agents2) <- c(NROW(agents), 2L)
}
if (NROW(agents) == 1 & NROW(agents2) != 1) {
agents <- c(rep(agents[, 1], NROW(agents2)), rep(agents[, 2], NROW(agents2)))
dim(agents) <- c(NROW(agents2), 2L)
}
# 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)
# Find the smallest distances across or around the world
exts <- extents(world@extent)
to1 <- cbind(
agents2[, 1] - (exts$xmax - exts$xmin),
agents2[, 2] + (exts$ymax - exts$ymin)
)
to2 <- cbind(agents2[, 1], agents2[, 2] + (exts$ymax - exts$ymin))
to3 <- cbind(
agents2[, 1] + (exts$xmax - exts$xmin),
agents2[, 2] + (exts$ymax - exts$ymin)
)
to4 <- cbind(agents2[, 1] - (exts$xmax - exts$xmin), agents2[, 2])
to5 <- cbind(agents2[, 1] + (exts$xmax - exts$xmin), agents2[, 2])
to6 <- cbind(
agents2[, 1] - (exts$xmax - exts$xmin),
agents2[, 2] - (exts$ymax - exts$ymin)
)
to7 <- cbind(agents2[, 1], agents2[, 2] - (exts$ymax - exts$ymin))
to8 <- cbind(
agents2[, 1] + (exts$xmax - exts$xmin),
agents2[, 2] - (exts$ymax - exts$ymin)
)
# All distances in a wrapped world
distAgents2 <- terra::distance(x = agents, y = agents2, lonlat = FALSE, pairwise = TRUE)
# distAgents3 <- raster::pointDistance(p1 = agents, p2 = agents2, lonlat = FALSE,
# allpairs = FALSE)
# distTo1 <- raster::pointDistance(p1 = agents, p2 = to1, lonlat = FALSE, allpairs = FALSE)
# distTo2 <- raster::pointDistance(p1 = agents, p2 = to2, lonlat = FALSE, allpairs = FALSE)
# distTo3 <- raster::pointDistance(p1 = agents, p2 = to3, lonlat = FALSE, allpairs = FALSE)
# distTo4 <- raster::pointDistance(p1 = agents, p2 = to4, lonlat = FALSE, allpairs = FALSE)
# distTo5 <- raster::pointDistance(p1 = agents, p2 = to5, lonlat = FALSE, allpairs = FALSE)
# distTo6 <- raster::pointDistance(p1 = agents, p2 = to6, lonlat = FALSE, allpairs = FALSE)
# distTo7 <- raster::pointDistance(p1 = agents, p2 = to7, lonlat = FALSE, allpairs = FALSE)
# distTo8 <- raster::pointDistance(p1 = agents, p2 = to8, lonlat = FALSE, allpairs = FALSE)
distTo1 <- terra::distance(x = agents, y = to1, lonlat = FALSE, pairwise = TRUE)
distTo2 <- terra::distance(x = agents, y = to2, lonlat = FALSE, pairwise = TRUE)
distTo3 <- terra::distance(x = agents, y = to3, lonlat = FALSE, pairwise = TRUE)
distTo4 <- terra::distance(x = agents, y = to4, lonlat = FALSE, pairwise = TRUE)
distTo5 <- terra::distance(x = agents, y = to5, lonlat = FALSE, pairwise = TRUE)
distTo6 <- terra::distance(x = agents, y = to6, lonlat = FALSE, pairwise = TRUE)
distTo7 <- terra::distance(x = agents, y = to7, lonlat = FALSE, pairwise = TRUE)
distTo8 <- terra::distance(x = agents, y = to8, lonlat = FALSE, pairwise = TRUE)
# Which distance is the minimum
allDist <- cbind(
distAgents2, distTo1, distTo2, distTo3, distTo4, distTo5,
distTo6, distTo7, distTo8
)
distMin <- apply(allDist, 1, min)
toShortest <- agents2
for (i in seq_len(NROW(agents))) {
# All the possibilities for each agents (i.e., agents2 and the wrapped agents2)
allToCoords <- rbind(
agents2[i, ], to1[i, ], to2[i, ], to3[i, ], to4[i, ], to5[i, ],
to6[i, ], to7[i, ], to8[i, ]
)
toShortest[i, ] <- allToCoords[match(distMin[i], allDist[i, ]), ]
# if ties, take the first match (good because favor the non wrapped distances)
}
heading <- deg(atan2(toShortest[, 1] - agents[, 1], toShortest[, 2] - agents[, 2]))
# angles between -180 and 180
heading[heading < 0] <- heading[heading < 0] + 360
}
} else if (inherits(agents, "agentMatrix") & !inherits(agents2, "agentMatrix")) {
# turtles to patches
tCoords <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
heading <- towards(agents = tCoords, agents2 = agents2, world = world, torus = torus)
sameLoc <- tCoords[, 1] == agents2[, 1] & tCoords[, 2] == agents2[, 2]
if (NROW(tCoords) == 1) {
heading[sameLoc] <- agents@.Data[, "heading"]
} else {
heading[sameLoc] <- agents@.Data[, "heading"][sameLoc]
}
} else if (!inherits(agents, "agentMatrix") & inherits(agents2, "agentMatrix")) {
# patches to turtles
heading <- towards(
agents = agents,
agents2 = agents2@.Data[, c("xcor", "ycor"), drop = FALSE],
world = world, torus = torus
)
} else if (inherits(agents, "agentMatrix") & inherits(agents2, "agentMatrix")) {
# turtles to turtles
t1Coords <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
t2Coords <- agents2@.Data[, c("xcor", "ycor"), drop = FALSE]
heading <- towards(agents = t1Coords, agents2 = t2Coords, world = world, torus = torus)
sameLoc <- t1Coords[, 1] == t2Coords[, 1] & t1Coords[, 2] == t2Coords[, 2]
if (NROW(t1Coords) == 1) {
heading[sameLoc] <- agents@.Data[, "heading"]
} else {
heading[sameLoc] <- agents@.Data[, "heading"][sameLoc]
}
}
return(heading)
}
)
################################################################################
#' Face something
#'
#' Set the `turtles`' `heading` towards `agents2`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated `headings`.
#'
#' @details The number of agents/locations in `agents2` must be equal to 1 or
#' to the length of `turtles`.
#'
#' If `torus = FALSE`, `world` does not need to be provided.
#'
#' If `torus = TRUE` and the distance from one `turtles` to
#' its corresponding agent/location `agents2` is smaller around the
#' sides of the `world` than across it, then the direction to the agent/location
#' `agents2` going around the sides of the `world` is given to the `turtle`.
#'
#' If a turtle is facing its own location, its heading does not change.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#face>
#'
#' <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#facexy>
#'
#' @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 = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- face(turtles = t1, agents2 = cbind(x = 0, y = 0))
#' t1 <- fd(turtles = t1, dist = 0.5)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname face
#'
#' @author Sarah Bauduin
#'
setGeneric(
"face",
function(turtles, agents2, world, torus = FALSE) {
standardGeneric("face")
}
)
#' @export
#' @rdname face
setMethod(
"face",
signature = c(turtles = "agentMatrix", agents2 = "matrix"),
definition = function(turtles, agents2, world, torus) {
newHeading <- towards(agents = turtles, agents2 = agents2, world = world, torus = torus)
turtles@.Data[, "heading"] <- newHeading
return(turtles)
}
)
################################################################################
#' Rotate to the left
#'
#' Rotate the `turtles`'s headings to the left of `angle` degrees.
#'
#' @inheritParams fargs
#'
#' @param angle Numeric. Vector of angles in degrees by which to rotate the `turtles`'
#' headings. Must be of length 1 or of length `turtles`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated `heading` values.
#'
#' @details If a given `angle` value is negative, then the `turtle` rotates to the right.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#left>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' of(agents = t1, var = "heading")
#' t1 <- left(turtles = t1, angle = 180)
#' of(agents = t1, var = "heading")
#'
#' @export
#' @rdname left
#'
#' @author Sarah Bauduin
#'
setGeneric(
"left",
function(turtles, angle) {
standardGeneric("left")
}
)
#' @export
#' @rdname left
setMethod(
"left",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, angle) {
newHeading <- turtles@.Data[, "heading"] - angle
newHeading[newHeading < 0] <- newHeading[newHeading < 0] + 360
newHeading[newHeading >= 360] <- newHeading[newHeading >= 360] - 360
turtles@.Data[, "heading"] <- newHeading
return(turtles)
}
)
################################################################################
#' Rotate to the right
#'
#' Rotate the `turtles`'s headings to the right of `angle` degrees.
#'
#' @inheritParams fargs
#'
#' @inheritParams left
#'
#' @return `AgentMatrix` representing the `turtles` with updated `heading` values.
#'
#' @details If a given `angle` value is negative, then the turtle rotates to the left.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#right>
#'
#' @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)
#' t1 <- createTurtles(n = 10, world = w1)
#' of(agents = t1, var = "heading")
#' t1 <- right(turtles = t1, angle = 180)
#' of(agents = t1, var = "heading")
#'
#' @export
#' @rdname right
#'
#' @author Sarah Bauduin
#'
setGeneric(
"right",
function(turtles, angle) {
standardGeneric("right")
}
)
#' @export
#' @rdname right
setMethod(
"right",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, angle) {
left(turtles = turtles, angle = -angle)
}
)
################################################################################
#' Move downhill
#'
#' Move the `turtles` to their neighboring patch with the lowest value.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their `heading` values and
#' previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If no neighboring `patch` has a smaller value than the `patch` where the
#' `turtle` is currently located on, the `turtle` stays on this `patch`. It still
#' moves to the `patch` center if it was not already on it.
#'
#' If there are multiple neighboring `patches` with the same lowest value,
#' the `turtle` chooses one `patch` randomly.
#'
#' If a `turtle` is located on a `patch` on the edge
#' of the `world` and `torus = FALSE`, it has fewer
#' neighboring `patches` as options to move than `nNeighbors`; if
#' `torus = TRUE`, the `turtle` can move on the other side of the `world` to
#' move downhill and its choice of neighboring `patches` is always equals to
#' `nNeighbors`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#downhill>
#'
#' @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 = 1, maxPxcor = 10, minPycor = 1, maxPycor = 10,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' if (requireNamespace("SpaDES.tools", quietly = TRUE)) {
#' t1 <- downhill(world = w1, turtles = t1, nNeighbors = 8)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' }
#'
#' @export
#' @rdname downhill
#'
#' @author Sarah Bauduin
#'
setGeneric(
"downhill",
function(world, pVar, turtles, nNeighbors, torus = FALSE) {
standardGeneric("downhill")
}
)
#' @export
#' @rdname downhill
setMethod(
"downhill",
signature = c(
world = "worldMatrix", pVar = "missing", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, turtles, nNeighbors, torus) {
# Output neighbors() as a matrix
pNeighbors <- neighbors(
world = world, agents = turtles, nNeighbors = nNeighbors,
torus = torus
)
pValues <- as.numeric(t(world@.Data)) # ordered by cellNumbers
tDF <- data.frame(patchHere(world, turtles), id = 1:NLcount(turtles))
allPatches <- rbind(pNeighbors, tDF) # neighbors patches + patches under the turtles
allPatches$cellNum <- cellFromPxcorPycor(
world = world, pxcor = allPatches$pxcor,
pycor = allPatches$pycor
)
allPatches$pVal <- pValues[allPatches$cellNum]
rows <- split(seq_len(nrow(allPatches)), allPatches$id)
rowMin <- sapply(rows, function(rowi) rowi[which.min(allPatches$pVal[rowi])])
# minimum patch value per id
pMinCoords <- allPatches[rowMin, ]
pMinCoords1 <- if (length(unique(pMinCoords$id)) == NROW(pMinCoords)) {
pMinCoords
} else {
pMinCoords[tapply(seq_len(nrow(pMinCoords)), pMinCoords$id, resample, 1), ]
}
pMinCoords1 <- pMinCoords1[order(pMinCoords1$id), ] # order by turtles
pMinCoords2 <- cbind(pxcor = pMinCoords1[, 1], pycor = pMinCoords1[, 2])
newTurtles <- face(world = world, turtles = turtles, agents2 = pMinCoords2, torus = torus)
newTurtles <- moveTo(turtles = newTurtles, agents = pMinCoords2)
return(newTurtles)
}
)
#' @export
#' @rdname downhill
setMethod(
"downhill",
signature = c(
world = "worldArray", pVar = "character", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, pVar, turtles, nNeighbors, torus) {
# Output neighbors() as a matrix
pNeighbors <- neighbors(
world = world, agents = turtles, nNeighbors = nNeighbors,
torus = torus
)
## Only difference with method for worldMatrix
layer <- match(pVar, dimnames(world)[[3]])
pValues <- as.numeric(t(world@.Data[, , layer])) # ordered by cellNumbers
##
tDF <- data.frame(patchHere(world, turtles), id = 1:NLcount(turtles))
allPatches <- rbind(pNeighbors, tDF) # neighbors patches + patches under the turtles
allPatches$cellNum <- cellFromPxcorPycor(
world = world, pxcor = allPatches$pxcor,
pycor = allPatches$pycor
)
allPatches$pVal <- pValues[allPatches$cellNum]
rows <- split(seq_len(nrow(allPatches)), allPatches$id)
rowMin <- sapply(rows, function(rowi) rowi[which.min(allPatches$pVal[rowi])])
# minimum patch value per id
pMinCoords <- allPatches[rowMin, ]
pMinCoords1 <- pMinCoords[tapply(seq_len(nrow(pMinCoords)), pMinCoords$id, resample, 1), ]
# select randomly one row per id
pMinCoords1 <- pMinCoords1[order(pMinCoords1$id), ] # order by turtles
pMinCoords2 <- cbind(pxcor = pMinCoords1[, 1], pycor = pMinCoords1[, 2])
newTurtles <- face(world = world, turtles = turtles, agents2 = pMinCoords2, torus = torus)
newTurtles <- moveTo(turtles = newTurtles, agents = pMinCoords2)
return(newTurtles)
}
)
################################################################################
#' Move uphill
#'
#' Move the `turtles` to their neighboring `patch` with the highest value.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their `heading` values and
#' previous coordinates `prevX`
#' and `prevY`.
#'
#' @details If no neighboring `patch` has a larger value than the `patch` where the
#' `turtle` is currently located on, the `turtle` stays on this `patch`. It still
#' moves to the `patch` center if it was not already on it.
#'
#' If there are multiple neighboring `patches` with the same highest value,
#' the `turtle` chooses one `patch` randomly.
#'
#' If a `turtle` is located on a `patch` on the edge
#' of the `world` and `torus = FALSE`, it has fewer
#' neighboring `patches` as options to move than `nNeighbors`; if
#' `torus = TRUE`, the `turtle` can move on the other side of the `world` to
#' move uphill and its choice of neighboring `patches` is always equals to
#' `nNeighbors`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#uphill>
#'
#' @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 = 1, maxPxcor = 10, minPycor = 1, maxPycor = 10,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' if (requireNamespace("SpaDES.tools", quietly = TRUE)) {
#' t1 <- uphill(world = w1, turtles = t1, nNeighbors = 8)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#' }
#'
#' @export
#' @rdname uphill
#'
#' @author Sarah Bauduin
#'
setGeneric(
"uphill",
function(world, pVar, turtles, nNeighbors, torus = FALSE) {
standardGeneric("uphill")
}
)
#' @export
#' @rdname uphill
setMethod(
"uphill",
signature = c(
world = "worldMatrix", pVar = "missing", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, turtles, nNeighbors, torus) {
# Uphill is the inverse of downhill
world[] <- 1 / world[]
downhill(world = world, turtles = turtles, nNeighbors = nNeighbors, torus = torus)
}
)
#' @export
#' @rdname uphill
setMethod(
"uphill",
signature = c(
world = "worldArray", pVar = "character", turtles = "agentMatrix",
nNeighbors = "numeric"
),
definition = function(world, pVar, turtles, nNeighbors, torus) {
world[] <- 1 / world[]
downhill(
world = world, pVar = pVar, turtles = turtles, nNeighbors = nNeighbors,
torus = torus
)
}
)
################################################################################
#' `Patches` ahead
#'
#' Report the coordinates of the `patches` at the given
#' distances of the `turtles` in the direction of their `headings`.
#'
#' @inheritParams fargs
#'
#' @param dist Numeric. Vector of distances from the `turtles`. `dist` must be
#' of length 1 or of length `turtles`.
#'
#' @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 `turtles`'s `headings` directions
#' of `turtles`. The order of the `patches` follows the order of the `turtles`.
#'
#' @details If `torus = FALSE` and the `patch` at distance `dist` of a `turtle`
#' 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.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-ahead>
#'
#' @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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' patchAhead(world = w1, turtles = t1, dist = 1)
#'
#' @export
#' @rdname patchAhead
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchAhead",
function(world, turtles, dist, torus = FALSE) {
standardGeneric("patchAhead")
}
)
#' @export
#' @rdname patchAhead
setMethod(
"patchAhead",
signature = c(world = "worldNLR", turtles = "agentMatrix", dist = "numeric"),
definition = function(world, turtles, dist, torus) {
radHeading <- rad(turtles@.Data[, "heading"])
xcor <- round(turtles@.Data[, "xcor"] + sin(radHeading) * dist, digits = 5)
ycor <- round(turtles@.Data[, "ycor"] + cos(radHeading) * dist, digits = 5)
pAhead <- patch(
world = world, x = xcor, y = ycor, duplicate = TRUE,
torus = torus, out = TRUE
)
return(pAhead)
}
)
################################################################################
#' `Patches` here
#'
#' Report the coordinates of the `patches` under the `turtles`
#' locations.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#' `pycor` representing the coordinates of the `patches` at the `turtles`
#' location. The order of the `patches` follows the order of the `turtles`.
#'
#' @details If a `turtle` is located outside of the `world`'s extent,
#' `NA` are returned
#' for the `patch` coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-here>
#'
#' @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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' patchHere(world = w1, turtles = t1)
#'
#' @export
#' @rdname patchHere
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchHere",
function(world, turtles) {
standardGeneric("patchHere")
}
)
#' @export
#' @rdname patchHere
setMethod(
"patchHere",
signature = c("worldNLR", "agentMatrix"),
definition = function(world, turtles) {
pTurtles <- patch(
world = world, x = turtles@.Data[, 1], y = turtles@.Data[, 2],
duplicate = TRUE, out = TRUE
)
return(pTurtles)
}
)
################################################################################
#' `Patches` on the left
#'
#' Report the coordinates of the `patches` at the given distances of the `turtles`
#' and given `angle` left of their `headings`.
#'
#' @inheritParams fargs
#'
#' @inheritParams patchAhead
#'
#' @param angle Numeric. Vector of angles in degrees by which the `turtle`'s
#' `headings` should rotate to locate the patches. Must be of length 1 or of
#' length `turtles`.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the coordinates of the `patches` at `dist`
#' distances of the `turtles` and `angle` to the left of their `headings`.
#' The order of the `patches` follows the order of the `turtles`.
#'
#' @details If a given `dist` value is negative, then the `turtle` would look backward.
#' If a given `angle` value is negative, then the `turtle` would look to the right.
#'
#' If `torus = FALSE` and the `patch` at distance `dist` of a `turtle`
#' and `angle` degrees to the left of its `heading` 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.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-lr-and-ahead>
#'
#' @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)
#' t1 <- createTurtles(n = 1, coords = cbind(xcor = 2, ycor = 2), heading = 90)
#' patchLeft(world = w1, turtles = t1, dist = 2, angle = 90)
#'
#' @export
#' @rdname patchLeft
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchLeft",
function(world, turtles, dist, angle, torus = FALSE) {
standardGeneric("patchLeft")
}
)
#' @export
#' @rdname patchLeft
setMethod(
"patchLeft",
signature = c(
world = "worldNLR", turtles = "agentMatrix", dist = "numeric",
angle = "numeric"
),
definition = function(world, turtles, dist, angle, torus) {
tLeft <- left(turtles = turtles, angle = angle)
tFd <- fd(world = world, turtles = tLeft, dist = dist, torus = torus)
pLeftFd <- patchHere(world = world, turtles = tFd)
return(pLeftFd)
}
)
################################################################################
#' `Patches` on the right
#'
#' Report the coordinates of the `patches` at the given distances of the `turtles`
#' and given `angle` right of their `headings`.
#'
#' @inheritParams fargs
#'
#' @inheritParams patchLeft
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the coordinates of the `patches` at `dist`
#' distances of the `turtles` and `angle` to the right of their `headings`.
#' The order of the `patches` follows the order of the `turtles`.
#'
#' @details If a given `dist` value is negative, then the `turtle` would look backward.
#' If a given `angle` value is negative, then the `turtle` would
#' look to the left.
#'
#' If `torus = FALSE` and the `patch` at distance `dist` of a `turtle`
#' and `angle` degrees to the right of its `heading` 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.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#patch-lr-and-ahead>
#'
#' @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)
#' t1 <- createTurtles(n = 1, coords = cbind(xcor = 2, ycor = 2), heading = 90)
#' patchRight(world = w1, turtles = t1, dist = 2, angle = 90)
#'
#' @export
#' @rdname patchRight
#'
#' @author Sarah Bauduin
#'
setGeneric(
"patchRight",
function(world, turtles, dist, angle, torus = FALSE) {
standardGeneric("patchRight")
}
)
#' @export
#' @rdname patchRight
setMethod(
"patchRight",
signature = c(
world = "worldNLR", turtles = "agentMatrix", dist = "numeric",
angle = "numeric"
),
definition = function(world, turtles, dist, angle, torus) {
patchLeft(
world = world, turtles = turtles, dist = dist, angle = -angle,
torus = torus
)
}
)
################################################################################
#' Set `turtles`' locations
#'
#' Set the `turtles` `xcor` and `ycor` coordinates.
#'
#' @inheritParams fargs
#'
#' @param xcor Numeric. Vector of `x` coordinates. Must be of length 1 or
#' of length `turtles`.
#'
#' @param ycor Numeric. Vector of `y` coordinates. Must be of length 1 or
#' of length `turtles`.
#'
#' @return `AgentMatrix` representing the `turtles` with updated coordinates
#' and updated data for their previous coordinates `prevX` and `prevY`.
#'
#' @details `world` must be provided only if `torus = TRUE`.
#'
#' If the given coordinates `[xcor, ycor]`
#' are located outside of the `world`'s extent and `torus = TRUE`,
#' then the coordinates assigned to the `turtle`
#' are the ones from a wrapped `word`; if `torus = FALSE`, the `turtle`
#' is located outside of the `world`'s extent with the given coordinates.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 5, coords = randomXYcor(w1, n = 5))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t1 <- setXY(turtles = t1, xcor = 1:5, ycor = 1:5)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname setXY
#'
#' @author Sarah Bauduin
#'
setGeneric(
"setXY",
function(turtles, xcor, ycor, world, torus = FALSE) {
standardGeneric("setXY")
}
)
#' @export
#' @rdname setXY
setMethod(
"setXY",
signature = c("agentMatrix", "numeric", "numeric", "missing", "ANY"),
definition = function(turtles, xcor, ycor, torus) {
turtles@.Data[, "prevX"] <- turtles@.Data[, "xcor"]
turtles@.Data[, "prevY"] <- turtles@.Data[, "ycor"]
if (length(xcor) == 1 & NROW(turtles) != 1) {
xcor <- as.numeric(rep(xcor, NROW(turtles)))
}
if (length(ycor) == 1 & NROW(turtles) != 1) {
ycor <- as.numeric(rep(ycor, NROW(turtles)))
}
turtles@.Data[, "xcor"] <- xcor
turtles@.Data[, "ycor"] <- ycor
return(turtles)
}
)
#' @export
#' @rdname setXY
setMethod(
"setXY",
signature = c("agentMatrix", "numeric", "numeric", "worldNLR", "logical"),
definition = function(turtles, xcor, ycor, world, torus) {
wrapCoords <- wrap(cbind(x = xcor, y = ycor), world@extent)
setXY(
turtles = turtles, xcor = wrapCoords[, 1], ycor = wrapCoords[, 2],
torus = FALSE
)
}
)
################################################################################
#' Sprout new `turtles`
#'
#' Create `n` new `turtles` on specific `patches`.
#'
#' @param n Integer. Vector of length 1 or of length the number of `patches`.
#' Number of new `turtles`
#' to create on each `patch`.
#'
#' @param heading Numeric. Vector of values between 0 and 360.
#' Must be of length 1 or of length the number of `patches`.
#' If missing, a random `heading` is assigned to each sprouted `turtle`.
#'
#' @param breed Character. Vector of `breed` names.
#' Must be of length 1 or of length the number of `patches`.
#' If missing, `breed` = `turtle` for all the sprouted `turtles`.
#'
#' @param color Character. Vector of `color` names.
#' Must be of length 1, of length the number of `patches` or
#' of length `sum(n)`.
#' If missing, `colors` are assigned using the function `rainbow(n)`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` including the new
#' sprouted `turtles`.
#'
#' @details `nrow(patches)` must be equal to 1 or to `n`.
#'
#' If `turtles` is provided, the new `turtles` are added to
#' the `turtles` when returned. The `who` numbers of the sprouted `turtles`
#' therefore follow the ones from the `turtles`.
#' All new sprouted `turtles` are placed at the end of the `agentMatrix` object.
#' If no `turtles`
#' is provided, a new `agentMatrix` is created and the `who` numbers
#' start at 0.
#'
#' If `turtles` is provided and had additional variables created
#' with `turtlesOwn()`, `NA` is given for these variables
#' for the new sprouted `turtles`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#sprout>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' t1 <- sprout(patches = cbind(pxcor = 2, pycor = 2), n = 3)
#' t2 <- sprout(patches = cbind(pxcor = 3, pycor = 3), n = 3, turtles = t1)
#'
#' @export
#' @rdname sprout
#'
#' @author Sarah Bauduin
#'
setGeneric(
"sprout",
function(n, patches, breed, heading, color, turtles) {
standardGeneric("sprout")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname sprout
setMethod(
"sprout",
signature = c(n = "numeric", patches = "matrix"),
definition = function(n, patches, breed, heading, color, turtles) {
li <- lapply(names(match.call()[-1]), function(x) eval(parse(text = x)))
names(li) <- names(match.call())[-1]
if (length(n) == 1) {
if (nrow(li$patches) == 1 & n != 1) {
li$patches <- cbind(
as.numeric(rep(li$patches[, 1], n)),
as.numeric(rep(li$patches[, 2], n))
)
}
colnames(li$patches) <- c("xcor", "ycor")
if (missing(breed)) {
li$breed <- rep("turtle", n)
}
if (length(li$breed) == 1) {
li$breed <- rep(li$breed, n)
}
if (missing(heading)) li$heading <- runif(n = n, min = 0, max = 360)
if (length(li$heading) == 1) {
li$heading <- rep(li$heading, n)
}
if (missing(color)) li$color <- rainbow(n)
newTurtles <- createTurtles(
n = n, coords = li$patches, heading = li$heading,
breed = li$breed, color = li$color
)
} else {
# if length(n) != 0
li$patches <- cbind(
as.numeric(rep(li$patches[, 1], n)),
as.numeric(rep(li$patches[, 2], n))
)
colnames(li$patches) <- c("xcor", "ycor")
if (missing(breed)) li$breed <- rep("turtle", sum(n))
if (length(li$breed) == 1) {
li$breed <- rep(li$breed, sum(n))
} else if (length(li$breed) != sum(n)) {
li$breed <- rep(li$breed, n)
}
if (missing(heading)) li$heading <- runif(n = sum(n), min = 0, max = 360)
if (length(li$heading) == 1) {
li$heading <- rep(li$heading, sum(n))
} else if (length(li$heading) != sum(n)) {
li$heading <- rep(li$heading, n)
}
if (missing(color)) li$color <- rainbow(sum(n))
if (length(li$color) == 1) {
li$color <- rep(li$color, sum(n))
} else if (length(li$color) != sum(n)) {
li$color <- rep(li$color, n)
}
newTurtles <- createTurtles(
n = sum(n), coords = li$patches, heading = li$heading,
breed = li$breed, color = li$color
)
}
if (missing(turtles)) {
return(newTurtles)
} else {
turtles <- hatch(
turtles = turtles, who = max(turtles@.Data[, "who"]),
n = NLcount(newTurtles)
)
# Replace the locations and headings of newTurtles inside turtles
ids <- (nrow(turtles@.Data) - NLcount(newTurtles) + 1):nrow(turtles@.Data)
turtles@.Data[ids, c(1, 2, 4)] <- newTurtles@.Data[, c(1, 2, 4)]
# Replace the breed and color of the newTurtles inside turtles
ids <- (nrow(turtles@.Data) - NLcount(newTurtles) + 1):nrow(turtles@.Data)
whoNewTurtles <- turtles@.Data[ids, 3]
turtles <- NLset(
turtles = turtles, agents = turtle(turtles, who = whoNewTurtles),
var = "breed", val = of(agents = newTurtles, var = "breed")
)
turtles <- NLset(
turtles = turtles, agents = turtle(turtles, who = whoNewTurtles),
var = "color", val = of(agents = newTurtles, var = "color")
)
# Replace any other additional variables
if (ncol(turtles@.Data) > 8) {
valToReplace <- matrix(NA, ncol = (ncol(turtles@.Data) - 8), nrow = NLcount(newTurtles))
colnames(valToReplace) <- colnames(turtles@.Data)[9:ncol(turtles@.Data)]
turtles <- NLset(
turtles = turtles, agents = turtle(turtles, who = whoNewTurtles),
var = colnames(turtles@.Data)[9:ncol(turtles@.Data)],
val = valToReplace
)
}
return(turtles)
}
}
)
################################################################################
#' Inspect `turtles`
#'
#' Display all variables values for the selected individuals among the `turtles`.
#'
#' @inheritParams fargs
#'
#' @return `Dataframe` (`nrow` = `length(who)`) of the variables of the selected
#' individuals among the `turtles`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#inspect>
#'
#' @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)
#' t1 <- createOTurtles(world = w1, n = 10)
#' inspect(turtles = t1, who = c(2, 3))
#'
#' @export
#' @rdname inspect
#'
#' @author Sarah Bauduin
#'
setGeneric(
"inspect",
function(turtles, who) {
standardGeneric("inspect")
}
)
#' @export
#' @rdname inspect
setMethod(
"inspect",
signature = c("agentMatrix", "numeric"),
definition = function(turtles, who) {
tData <- as.data.frame(turtles@.Data[turtles@.Data[, "who"] %in% who, , drop = FALSE],
stringsAsFactors = FALSE
)
tData[, names(turtles@levels)] <- do.call(cbind, lapply(seq_along(turtles@levels), function(x) {
unlist(rename(tData[, names(turtles@levels)[x]],
from = unique(tData[, names(turtles@levels)[x]]),
to = turtles@levels[names(turtles@levels)[x]][[1]][
unique(tData[, names(turtles@levels)[x]])
]
))
}))
# tData[, names(turtles@levels)] <- do.call(cbind, lapply(1:length(turtles@levels), function(x){
# unlist(mapvalues(tData[, names(turtles@levels)[x]],
# from = unique(tData[, names(turtles@levels)[x]]),
# to = turtles@levels[names(turtles@levels)[x]][[1]][
# unique(tData[, names(turtles@levels)[x]])]))}))
#
# if (!identical(unname(as.matrix(tData[, names(turtles@levels)])), a))
# stop("mapvalues replacement was wrong")
return(tData)
}
)
################################################################################
#' Move to
#'
#' Move the `turtles` to the `agents`' locations.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the `turtles` with updated coordinates
#' and updated data for their previous coordinates `prevX` and `prevY`.
#'
#' @details The number of `agents` must be equal to 1 or to
#' length `turtles`.
#'
#' The `turtle`'s `headings` are not affected with this function.
#'
#' If a `turtle` is moving to a `patch` location, it will be located at
#' the `patch` center.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#move-to>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 5, coords = randomXYcor(w1, n = 5))
#' plot(w1)
#' points(t1, col = "black", pch = 16)
#'
#' t1 <- moveTo(turtles = t1, agents = turtle(t1, who = 0))
#' points(t1, col = "red", pch = 16)
#'
#' t1 <- moveTo(turtles = t1, agents = patch(w1, 9, 9))
#' points(t1, col = "blue", pch = 16)
#'
#' @export
#' @rdname moveTo
#'
#' @author Sarah Bauduin
#'
setGeneric(
"moveTo",
function(turtles, agents) {
standardGeneric("moveTo")
}
)
#' @export
#' @rdname moveTo
setMethod(
"moveTo",
signature = c("agentMatrix", "matrix"),
definition = function(turtles, agents) {
if (!inherits(agents, "agentMatrix")) {
setXY(
turtles = turtles, xcor = as.numeric(agents[, 1]),
ycor = as.numeric(agents[, 2]), torus = FALSE
)
} else {
setXY(
turtles = turtles, xcor = agents@.Data[, "xcor"],
ycor = agents@.Data[, "ycor"], torus = FALSE
)
}
}
)
################################################################################
#' Random `turtles` coordinates
#'
#' Report `n` random `xcor` and `ycor` coordinates within the `world`'s extent.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2, `nrow` = `n`) with the first column `xcor` and the second
#' column `ycor`.
#'
#' @examples
#' w1 <- createWorld(
#' minPxcor = 0, maxPxcor = 4, minPycor = 0, maxPycor = 4,
#' data = runif(25)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(world = w1, n = 10))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' @export
#' @rdname randomXYcor
#'
#' @author Sarah Bauduin
#'
setGeneric(
"randomXYcor",
function(world, n) {
standardGeneric("randomXYcor")
}
)
#' @export
#' @rdname randomXYcor
setMethod(
"randomXYcor",
signature = c("worldNLR", "numeric"),
definition = function(world, n) {
xycor <- cbind(
xcor = randomXcor(world = world, n = n),
ycor = randomYcor(world = world, n = n)
)
return(xycor)
}
)
################################################################################
#' Do the `turtle` exist?
#'
#' Report `TRUE` if a `turtle` exists inside the `turtles`, report
#' `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @return Logical. Vector of `TRUE` or `FALSE` if the `who` numbers
#' with any of the `breed`, if provided, exist or not
#' inside the `turtles`.
#'
#' @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)
#' t1 <- createTurtles(
#' n = 10, coords = randomXYcor(w1, n = 10),
#' breed = c(rep("sheep", 5), rep("wolf", 5))
#' )
#' tExist(turtles = t1, who = 3, breed = "sheep")
#' tExist(turtles = t1, who = 9, breed = "sheep")
#' tExist(turtles = t1, who = 9, breed = c("sheep", "wolf"))
#' tExist(turtles = t1, who = c(3, 9))
#'
#' @export
#' @rdname tExist
#'
#' @author Sarah Bauduin
#'
setGeneric(
"tExist",
function(turtles, who, breed) {
standardGeneric("tExist")
}
)
#' @export
#' @rdname tExist
setMethod(
"tExist",
signature = c("agentMatrix", "numeric", "missing"),
definition = function(turtles, who) {
tExist <- who %in% turtles@.Data[, "who"]
return(tExist)
}
)
#' @export
#' @rdname tExist
setMethod(
"tExist",
signature = c("agentMatrix", "numeric", "character"),
definition = function(turtles, who, breed) {
breedFactor <- match(breed, turtles@levels$breed)
tExist <- who %in% turtles@.Data[turtles@.Data[, "breed"] %in% breedFactor, "who"]
return(tExist)
}
)
################################################################################
#' Select `turtles`
#'
#' Report the individuals among `turtles` based on their `who` numbers
#' and `breed`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` of the selected `turtles` sorted in the order of
#' the `who` numbers requested. If `breed` was provided, the
#' `turtles` selected are of one of the `breed`.
#'
#' @details If no `turtle` matches the given `who` numbers, with potentially
#' one of the given
#' `breed`, inside `turtles`, then an empty `agentMatrix` is returned.
#'
#' If there are duplicates `who` numbers among the `turtles`, the first
#' matching `turtle` with the requested `who` number is returned.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtle>
#'
#' @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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' t2 <- turtle(t1, who = 2)
#'
#' @export
#' @rdname turtle
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtle",
function(turtles, who, breed) {
standardGeneric("turtle")
}
)
#' @export
#' @importFrom stats na.omit
#' @rdname turtle
setMethod(
"turtle",
signature = c("agentMatrix", "numeric", "missing"),
definition = function(turtles, who) {
turtles[na.omit(match(who, turtles@.Data[, "who"])), , drop = FALSE]
}
)
#' @export
#' @rdname turtle
setMethod(
"turtle",
signature = c("agentMatrix", "numeric", "character"),
definition = function(turtles, who, breed) {
breedFactor <- which(turtles@levels$breed %in% breed)
if (length(breedFactor) == 0) {
noTurtles()
} else {
tBreed <- turtles[which(turtles@.Data[, "breed"] %in% breedFactor), , drop = FALSE]
turtle(tBreed, who)
}
}
)
################################################################################
#' `Turtles` on
#'
#' Report the individuals among `turtles` that are on the same `patches` as
#' the `agents`.
#'
#' @inheritParams fargs
#'
#' @param simplify Logical. If `simplify = TRUE`, all `turtles` on the same
#' `patches` as any `agents` are returned; if `simplify = FALSE`,
#' the `turtles` are evaluated for each `agents`'s `patches`
#' individually.
#'
#' @return `AgentMatrix` representing any individuals from `turtles` of
#' any of the given `breed`, if specified,
#' located on the same `patches` as any of the `agents`, if `simplify = TRUE`, or
#'
#' Matrix (`ncol` = 2) with the first column `whoTurtles` and the second column
#' `id` showing which `turtles` are on the same
#' `patches` as which `agents` represented by `id`, if `simplify = FALSE`.
#' `id` represents and follows the order of the `agents`. `id` does not represent
#' the `who` numbers
#' of the `agents` if `agents` are `turtles`.
#'
#' @details The `agents` must be located inside the
#' `world`'s extent.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-on>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 500, coords = randomXYcor(w1, n = 500))
#' plot(w1)
#' points(t1, col = of(agents = t1, var = "color"), pch = 16)
#'
#' t2 <- turtlesOn(world = w1, turtles = t1, agents = patch(w1, 2, 2))
#'
#' @export
#' @rdname turtlesOn
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtlesOn",
function(world, turtles, agents, breed, simplify = TRUE) {
standardGeneric("turtlesOn")
}
)
#' @export
#' @importFrom stats na.omit
#' @rdname turtlesOn
setMethod(
"turtlesOn",
signature = c(
world = "worldNLR", turtles = "agentMatrix",
agents = "matrix", breed = "missing"
),
definition = function(world, turtles, agents, simplify) {
if (inherits(agents, "agentMatrix")) {
agents <- patchHere(world = world, turtles = agents)
}
pTurtles <- round(turtles@.Data[, c("xcor", "ycor", "who"), drop = FALSE])
colnames(pTurtles)[1:2] <- c("pxcor", "pycor") # awkward column name change
if (simplify == TRUE) {
# Instead of merge, which is slow, make an empty matrix (of NAs)
# and use the agents coordinates directly
a <- matrix(ncol = ncol(world), nrow = nrow(world))
# pxcor and pycor do not correspond to [x;y] in a matrix
x <- attr(world, "maxPycor") - agents[, 2] + 1
y <- agents[, 1] - attr(world, "minPxcor") + 1
a[cbind(x, y)] <- 1
px <- attr(world, "maxPycor") - pTurtles[, 2] + 1
py <- pTurtles[, 1] - attr(world, "minPxcor") + 1
pOn <- na.omit(a[cbind(px, py)] * pTurtles)
if (nrow(pOn) == 0) {
return(noTurtles())
} else {
return(turtle(turtles = turtles, who = pOn[, 3]))
}
} else {
if (any(is.na(agents))) {
agents <- na.omit(agents)
} # There shouldn't be any NAs passed in here, probably
agents <- cbind(agents, id = seq_len(dim(agents)[1]))
# pxcor and pycor do not correspond to [x;y] in a matrix
x <- attr(world, "maxPycor") - agents[, 2] + 1
y <- agents[, 1] - attr(world, "minPxcor") + 1
a <- matrix(ncol = ncol(world), nrow = nrow(world))
b <- a
a[cbind(x, y)] <- 1
b[cbind(x, y)] <- agents[, 3]
px <- attr(world, "maxPycor") - pTurtles[, 2] + 1
py <- pTurtles[, 1] - attr(world, "minPxcor") + 1
pOn <- na.omit(a[cbind(px, py)] * pTurtles)
dims <- c(nrow(pOn), ncol(pOn))
colNames <- colnames(pOn)
length(pOn) <- length(pOn) + dims[1]
dim(pOn) <- dims + c(0, 1)
colnames(pOn) <- c(colNames, "id")
pOn[, "id"] <- na.omit(b[cbind(px, py)])
pOn <- pOn[order(pOn[, "id"]), , drop = FALSE]
turtlesID <- pOn[, c("who", "id"), drop = FALSE]
colnames(turtlesID)[1] <- "whoTurtles"
return(turtlesID)
}
}
)
#' @export
#' @rdname turtlesOn
setMethod(
"turtlesOn",
signature = c(
world = "worldNLR", turtles = "agentMatrix",
agents = "matrix", breed = "character"
),
definition = function(world, turtles, agents, breed, simplify) {
breedFactor <- which(turtles@levels$breed %in% breed)
if (length(breedFactor) == 0) {
tBreed <- noTurtles()
} else {
tBreed <- turtles[which(turtles@.Data[, "breed"] %in% breedFactor), drop = FALSE]
}
turtlesOn(world = world, turtles = tBreed, agents = agents, simplify = simplify)
}
)
################################################################################
#' No `turtles`
#'
#' Report an empty `turtle` `agentset`.
#'
#' @return `AgentMatrix` with the `turtle` variables defined as when using
#' `createTurtles()` but with 0 `turtle`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#no-turtles>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' t1 <- noTurtles()
#' NLcount(t1)
#'
#' @export
#' @rdname noTurtles
#'
#' @author Sarah Bauduin
#'
noTurtles <- function() {
t0 <- createTurtles(n = 1, coords = cbind(xcor = 0, ycor = 0))
empty <- t0[which(t0@.Data[, "who"] == 1), , drop = FALSE]
empty@levels$breed <- character(0)
empty@levels$color <- character(0)
return(empty)
}
################################################################################
#' `Turtles` at
#'
#' Report the individuals among `turtles` that are located on the `patches` at
#' `(dx, dy)` distances of the `agents`.
#'
#' @inheritParams fargs
#'
#' @return `AgentMatrix` representing the individuals among `turtles`
#' of any of the given `breed`, if specified,
#' which are located on the `patches` at `(dx, dy)` distances of the
#' `agents`.
#'
#' @details If the `patch` at distance `(dx, dy)`
#' of an `agent` is outside of the `world`'s extent and `torus = FALSE`,
#' no `turtle` is returned;
#' if `torus = TRUE`, the `turtle` located on the `patch` whose coordinates
#' are defined from the wrapped `world` is returned.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-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)
#' t1 <- createTurtles(
#' n = 10, coords = cbind(xcor = 0:9, ycor = 0:9),
#' breed = c(rep("sheep", 5), rep("wolf", 5))
#' )
#' t2 <- turtlesAt(
#' world = w1, turtles = t1, agents = turtle(t1, who = 0),
#' dx = 1, dy = 1
#' )
#' t3 <- turtlesAt(
#' world = w1, turtles = t1,
#' agents = patch(w1, c(3, 4, 5), c(3, 4, 5)), dx = 1, dy = 1,
#' breed = "sheep"
#' )
#'
#' @export
#' @rdname turtlesAt
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtlesAt",
function(world, turtles, agents, dx, dy, breed, torus = FALSE) {
standardGeneric("turtlesAt")
}
)
#' @export
#' @rdname turtlesAt
setMethod(
"turtlesAt",
signature = c(
"worldNLR", "agentMatrix", "matrix", "numeric", "numeric",
"missing", "ANY"
),
definition = function(world, turtles, agents, dx, dy, torus) {
pAt <- patchAt(world = world, agents = agents, dx = dx, dy = dy)
turtlesOn(world = world, turtles = turtles, agents = pAt)
}
)
#' @export
#' @rdname turtlesAt
setMethod(
"turtlesAt",
signature = c(
"worldNLR", "agentMatrix", "matrix", "numeric", "numeric",
"character", "ANY"
),
definition = function(world, turtles, agents, dx, dy, breed, torus) {
pAt <- patchAt(world = world, agents = agents, dx = dx, dy = dy)
turtlesOn(world = world, turtles = turtles, agents = pAt, breed = breed)
}
)
################################################################################
#' Create a `turtle` `agentset`
#'
#' Report a `turtle` `agentset` containing all unique `turtles` provided in the inputs.
#'
#' @param ... `AgentMatrix` objects representing the moving `agents`.
#'
#' @return `AgentMatrix` object containing all the unique `turtles`.
#'
#' @details Duplicated `turtles` are identified based only on their `who` numbers.
#' The `turtle` chosen for a who number is the first one given in the inputs.
#' To keep all `turtles` from the inputs, use `NLset()` to
#' reassign `who` numbers in some of the inputs, prior using
#' `turtleSet()`, to avoid `turtles` with duplicated `who` numbers.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtle-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)
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10), breed = "sheep")
#' t2 <- createTurtles(n = 2, coords = randomXYcor(w1, n = 2), breed = "wolf")
#' t2 <- NLset(turtles = t2, agents = t2, var = "who", val = c(10, 11))
#' t3 <- createTurtles(n = 1, coords = randomXYcor(w1, n = 1), breed = "sheperd")
#' t3 <- NLset(turtles = t3, agents = t3, var = "who", val = 12)
#' t4 <- turtleSet(t1, t2, t3)
#'
#' @export
#' @rdname turtleSet
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtleSet",
function(...) {
standardGeneric("turtleSet")
}
)
#' @export
#' @rdname turtleSet
setMethod(
"turtleSet",
signature = "agentMatrix",
definition = function(...) {
dots <- list(...)
nTurtles <- lapply(dots, function(x) NROW(x))
if (sum(unlist(nTurtles)) == 0) {
return(noTurtles())
} else {
if (any(nTurtles == 0)) {
dots <- dots[which(nTurtles != 0)] # remove the empty agentMatrix
if (length(dots) == 1) {
# if there is only one list element left
return(dots[[1]])
}
}
# if (do.call(all.equal, lapply(dots, colnames))) {
allTurtles <- do.call(rbind, lapply(dots, function(x) x))
# } else {
# allTurtles <- as.data.frame(rbindlist(lapply(dots, function(x) {
# inspect(x, who = of(agents = x, var = "who"))}), fill = TRUE))
# }
if (anyDuplicated(allTurtles$who) != 0) {
warning("Duplicated turtles based on who numbers are present among the inputs.")
allTurtles <- allTurtles[match(unique(allTurtles$who), allTurtles$who), ]
}
if (!is(allTurtles, "agentMatrix")) {
allTurtles <- as(allTurtles, "agentMatrix")
}
return(allTurtles)
}
}
)
################################################################################
#' New `turtles` variable
#'
#' Create a new variable for the `turtles`.
#'
#' @inheritParams fargs
#'
#' @param tVar Character. the name of the `turtles` variable to create.
#'
#' @param tVal Vector representing the values of `tVar`.
#' Must be of length 1 or of length `turtles`.
#' If missing, `NA` is given.
#'
#' @return `AgentMatrix` representing the `turtles` with the new
#' variable `tVar` added.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-own>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' t1 <- createTurtles(n = 5, coords = cbind(xcor = 0, ycor = 0))
#' t1 <- turtlesOwn(turtles = t1, tVar = "sex", tVal = c("F", "F", "F", "M", "M"))
#'
#' @export
#' @rdname turtlesOwn
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtlesOwn",
function(turtles, tVar, tVal) {
standardGeneric("turtlesOwn")
}
)
#' @export
#' @rdname turtlesOwn
setMethod(
"turtlesOwn",
signature = c("agentMatrix", "character", "missing"),
definition = function(turtles, tVar) {
turtles@.Data <- cbind(turtles@.Data, newCol = NA)
colnames(turtles@.Data)[ncol(turtles@.Data)] <- tVar
return(turtles)
}
)
#' @export
#' @rdname turtlesOwn
setMethod(
"turtlesOwn",
signature = c("agentMatrix", "character", "ANY"),
definition = function(turtles, tVar, tVal) {
if (inherits(tVal, "numeric") | inherits(tVal, "integer")) {
turtles@.Data <- cbind(turtles@.Data, newCol = tVal)
colnames(turtles@.Data)[ncol(turtles@.Data)] <- tVar
} else {
turtles@.Data <- cbind(turtles@.Data, newCol = as.factor(tVal))
colnames(turtles@.Data)[ncol(turtles@.Data)] <- tVar
nameLevels <- names(turtles@levels)
listLevels <- c(turtles@levels, list(levels(as.factor(tVal))))
names(listLevels) <- c(nameLevels, tVar)
turtles@levels <- listLevels
}
return(turtles)
}
)
################################################################################
#' Subtract `headings`
#'
#' Compute the difference between `headings`.
#'
#' @param angle1 `AgentMatrix` object representing the moving `agents`, or
#'
#' Numeric. Vector of angles.
#'
#' @param angle2 `AgentMatrix` object representing the moving `agents`, or
#'
#' Numeric. Vector of angles.
#'
#' @param range360 Logical. If `range360 = TRUE`, returned values are
#' between 0 and 360 degrees;
#' if `range360 = FALSE`, returned values are between
#' -180 and 180 degrees.
#' Default is `range360 = FALSE`.
#'
#' @return Numeric. Vector of the smallest angles in degrees
#' by which `angle1` could be rotated to produce `angle2`
#' (i.e., the target heading).
#'
#' @details This function does the opposite as the one in NetLogo where
#' `angle1` is the target heading.
#'
#' `angle1` and `angle2` must be of the same length or if different,
#' one of them must be of length 1.
#'
#' Positive values mean clockwise rotations, negative value mean
#' counterclockwise rotations.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#subtract-headings>
#'
#' @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)
#' t1 <- createOTurtles(n = 10, world = w1)
#' subHeadings(angle1 = t1, angle2 = 0)
#'
#' @export
#' @rdname subHeadings
#'
#' @author Sarah Bauduin
#'
setGeneric(
"subHeadings",
function(angle1, angle2, range360 = FALSE) {
standardGeneric("subHeadings")
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "numeric", angle2 = "numeric"),
definition = function(angle1, angle2, range360) {
len2 <- length(angle2)
len1 <- length(angle1)
if (len2 != len1) {
if (len2 == 1) {
angle2 <- rep(angle2, len1)
} else if (len1 == 1) {
angle1 <- rep(angle1, len2)
} else {
stop("angle1 and angle2 must be of the same length or one must be of length 1")
}
}
rad2 <- rad(angle2)
rad1 <- rad(angle1)
rads <- rad2 - rad1
angles <- deg(atan2(sin(rads), cos(rads)))
if (range360 == TRUE) {
anglesNeg <- angles < 0
angles[anglesNeg] <- angles[anglesNeg] + 360
}
return(angles)
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "agentMatrix", angle2 = "numeric"),
definition = function(angle1, angle2, range360) {
subHeadings(
angle1 = angle1@.Data[, "heading"], angle2 = angle2,
range360 = range360
)
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "numeric", angle2 = "agentMatrix"),
definition = function(angle1, angle2, range360) {
subHeadings(
angle1 = angle1, angle2 = angle2@.Data[, "heading"],
range360 = range360
)
}
)
#' @export
#' @rdname subHeadings
setMethod(
"subHeadings",
signature = c(angle1 = "agentMatrix", angle2 = "agentMatrix"),
definition = function(angle1, angle2, range360) {
subHeadings(
angle1 = angle1@.Data[, "heading"], angle2 = angle2@.Data[, "heading"],
range360 = range360
)
}
)
################################################################################
#' Others
#'
#' Report an `agentset` of the `agents` except specific ones.
#'
#' @inheritParams fargs
#'
#' @param except Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the `patches` coordinates, or
#'
#' `AgentMatrix` object representing the moving `agents`.
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second
#' column `pycor` representing the `patches` in `agents` without
#' the ones in `except`, or
#'
#' `AgentMatrix` representing the `turtles` in `agents` without
#' the ones in `except`.
#'
#' @details Both `agents` and `except` must be of the same class (e.g., both
#' `patches` or both `turtles`).
#'
#' Warning: this function removes `turtles` only based on similar `who` numbers
#' and `breed` names.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#other>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' # Patches
#' w1 <- createWorld(minPxcor = 0, maxPxcor = 9, minPycor = 0, maxPycor = 9)
#' p1 <- other(agents = patches(w1), except = patch(w1, 0, 0))
#' NLcount(p1) # 99 patches
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = cbind(xcor = 0, ycor = 0))
#' t2 <- other(agents = t1, except = turtle(t1, who = 0))
#' NLcount(t2) # 9 turtles
#'
#' @export
#' @rdname other
#'
#' @author Sarah Bauduin
#'
setGeneric(
"other",
function(agents, except) {
standardGeneric("other")
}
)
#' @export
#' @rdname other
setMethod(
"other",
signature = c("matrix", "matrix"),
definition = function(agents, except) {
if (inherits(agents, "agentMatrix") & inherits(except, "agentMatrix")) {
matchWho <- match(except@.Data[, "who"], agents@.Data[, "who"])
matchWho <- matchWho[!is.na(matchWho)]
matchBreed <- which(agents@.Data[matchWho, "breed"] ==
except@.Data[except@.Data[, "who"] ==
agents@.Data[matchWho, "who"], "breed"])
if (length(matchBreed) != 0) {
agents <- agents[-matchWho[matchBreed], , drop = FALSE]
}
return(agents)
} else {
pCoords <- agents[!duplicated(rbind(except, agents))[-1:-nrow(except)], , drop = FALSE]
return(pCoords)
}
}
)
################################################################################
#' Layout `turtles` on a circle
#'
#' Relocate the `turtles` on a circle centered on the `world`.
#'
#' @inheritParams fargs
#'
#' @param radius Numeric. Radius of the circle.
#'
#' @return `AgentMatrix` representing the `turtles` with updated
#' coordinates and updated data for their `heading` values and
#' previous coordinates `prevX`
#' and `prevY`.
#'
#' @details The `turtles` point outwards.
#'
#' If the
#' `radius` value leads `turtles` outside of the `world`'s extent
#' and `torus = TRUE`, they are
#' relocated on the other sides of the `world`, inside its extent; if
#' `torus = FALSE`, the `turtles` are located past
#' the `world`'s extent.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#layout-circle>
#'
#' @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,
#' data = runif(100)
#' )
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' plot(w1)
#' points(t1, col = "black", pch = 16)
#'
#' t1 <- layoutCircle(world = w1, turtles = t1, radius = 3)
#' points(t1, col = "red", pch = 16)
#'
#' @export
#' @rdname layoutCircle
#'
#' @author Sarah Bauduin
#'
setGeneric(
"layoutCircle",
function(world, turtles, radius, torus = FALSE) {
standardGeneric("layoutCircle")
}
)
#' @export
#' @rdname layoutCircle
setMethod(
"layoutCircle",
signature = c(world = "worldNLR", turtles = "agentMatrix", radius = "numeric"),
definition = function(world, turtles, radius, torus) {
tSurrogates <- createOTurtles(n = NLcount(turtles), world = world)
turtles@.Data[, c("xcor", "ycor")] <- tSurrogates@.Data[, c("xcor", "ycor")]
turtles@.Data[, "heading"] <- tSurrogates@.Data[, "heading"]
fd(world = world, turtles = turtles, dist = radius, torus = torus, out = TRUE)
}
)
################################################################################
#' Values of an `agents` variable
#'
#' Report the `agents` values for the requested variable.
#'
#' @inheritParams fargs
#'
#' @param var Character. Vector of the names of the selected `agents` variables.
#' If `agents` are `patches` and the `world` is a
#' `worldMatrix` object, `var` must not be provided. If
#' `agents` are `patches` and the `world` is a
#' `worldArray` object, `var` is the name of the layers to
#' use to define the `patches`
#' values. If `agents` are `turtles`, `var` is some of
#' the `turtles`' variable and can be any of the variables created
#' when `turtles` were created,
#' as well as any variable created with `turtlesOwn()`.
#'
#' @return Vector of values for the `agents` if one variable is
#' requested. The class depends
#' of the variable class. The order of the vector follows the order
#' of the `agents`, or
#'
#' Matrix or `Dataframe` (`ncol` = `length(var)`, `nrow` = `NLcount(agents)`)
#' if more than one variable is requested. The row order
#' follows the order of the `agents`.
#'
#' @details `world` must be provided only if `agents` are `patches`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#of>
#'
#' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
#' Center for Connected Learning and Computer-Based Modeling,
#' Northwestern University. Evanston, IL.
#'
#' @examples
#' # Patches
#' w1 <- createWorld(
#' minPxcor = 0, maxPxcor = 4, minPycor = 0, maxPycor = 4,
#' data = 1:25
#' )
#' of(world = w1, agents = patch(w1, c(0, 0), c(4, 0)))
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' of(agents = t1, var = "heading")
#'
#' @export
#' @rdname of
#'
#' @author Sarah Bauduin
#'
setGeneric(
"of",
function(world, agents, var) {
standardGeneric("of")
}
)
#' @export
#' @rdname of
setMethod(
"of",
signature = c("missing", "agentMatrix", "character"),
definition = function(agents, var) {
if (any(names(agents@levels) %in% var)) {
wh <- var %in% names(agents@levels)
# if (any(wh)) {
newNames <- var[wh]
df <- do.call(data.frame, args = append(
list(stringsAsFactors = FALSE),
lapply(which(wh), function(w) {
agents@levels[[var[w]]][agents@.Data[, var[w]]]
})
))
if (!all(wh)) {
df <- as.data.frame(cbind(agents@.Data[, var[!wh], drop = FALSE], df))
newNames <- c(var[!wh], newNames)
}
colnames(df) <- newNames
return(df[, match(newNames, var)])
} else {
if (length(var) == 1) {
return(agents@.Data[, var])
} else {
return(agents@.Data[, var, drop = FALSE])
}
}
}
)
#' @export
#' @rdname of
setMethod(
"of",
signature = c("worldMatrix", "matrix", "missing"),
definition = function(world, agents) {
if (identical(patches(world), agents)) {
return(as.numeric(t(world@.Data))) # values must be returned by row
} else {
return(world[agents[, 1], agents[, 2]])
}
}
)
#' @export
#' @rdname of
setMethod(
"of",
signature = c("worldArray", "matrix", "character"),
definition = function(world, agents, var) {
if (identical(patches(world), agents)) {
allValues <- world[]
return(allValues[, var])
} else {
cellNum <- cellFromPxcorPycor(world = world, pxcor = agents[, 1], pycor = agents[, 2])
allValues <- world[]
if (length(var) == 1) {
return(allValues[cellNum, var])
} else {
return(allValues[cellNum, var, drop = FALSE])
}
}
}
)
################################################################################
#' From `SpatialPointsDataFrame` to `agentMatrix`
#'
#' Convert a `SpatialPointsDataFrame` object into an `agentMatrix` object.
#'
#' @param spdf `SpatialPointsDataFrame` object representing moving `agents`.
#'
#' @return `AgentMatrix` object representing the moving `agents` (coordinates and data)
#' as contained in `spdf`.
#'
#' @details If the `spdf` does not contain the variables created with
#' `createTurtles()`, these variables will be created with the
#' default values as in `createTurtles()`.
#'
#' @examples
#' if (requireNamespace("sp", quietly = TRUE)) {
#' sp1 <- sp::SpatialPointsDataFrame(
#' coords = cbind(x = c(1, 2, 3), y = c(1, 2, 3)),
#' data = cbind.data.frame(
#' age = c(0, 0, 3),
#' sex = c("F", "F", "M")
#' )
#' )
#' t1 <- spdf2turtles(spdf = sp1)
#' }
#'
#' @export
#' @rdname spdf2turtles
#'
#' @author Sarah Bauduin
#'
setGeneric(
"spdf2turtles",
function(spdf) {
standardGeneric("spdf2turtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname spdf2turtles
setMethod(
"spdf2turtles",
signature = c("ANY"),
definition = function(spdf) {
if (!is(spdf, "SpatialPointsDataFrame")) {
stop("spdf is not a SpatialPointsDataFrame")
}
spdfData <- spdf@data
n <- length(spdf)
if (!is.na(match("who", names(spdfData)))) {
who <- spdfData$who
} else {
who <- seq(from = 0, to = n - 1, by = 1)
}
if (!is.na(match("heading", names(spdfData)))) {
heading <- spdfData$heading
} else {
heading <- runif(n = n, min = 0, max = 360)
}
if (!is.na(match("prevX", names(spdfData)))) {
prevX <- spdfData$prevX
} else {
prevX <- rep(NA, n)
}
if (!is.na(match("prevY", names(spdfData)))) {
prevY <- spdfData$prevY
} else {
prevY <- rep(NA, n)
}
if (!is.na(match("breed", names(spdfData)))) {
breed <- spdfData$breed
} else {
breed <- rep("turtle", n)
}
if (!is.na(match("color", names(spdfData)))) {
color <- spdfData$color
} else {
color <- rainbow(n)
}
turtles <- new("agentMatrix",
coords = cbind(xcor = spdf@coords[, 1], ycor = spdf@coords[, 2]),
who = who,
heading = heading,
prevX = prevX,
prevY = prevY,
breed = breed,
color = color
)
for (i in which(!names(spdfData) %in% c(
"who", "heading", "prevX", "prevY",
"breed", "color", "stringsAsFactors"
))) {
turtles <- turtlesOwn(turtles = turtles, tVar = names(spdfData)[i], tVal = spdfData[, i])
}
return(turtles)
}
)
################################################################################
#' From `sf` to `agentMatrix`
#'
#' Convert a `sf` object into an `agentMatrix` object.
#'
#' @param turtles_sf `sf` object of `POINT geometry` representing moving `agents`.
#'
#' @return `AgentMatrix` object representing the moving `agents` (coordinates and data)
#' as contained in `turtles_sf`.
#'
#' @details If the `turtles_sf` does not contain the variables created with
#' `createTurtles()`, these variables will be created with the
#' default values as in `createTurtles()`.
#'
#' @examples
#' if (requireNamespace("sf", quietly = TRUE)) {
#' turtles_sf1 <- sf::st_as_sf(
#' cbind.data.frame(
#' x = c(1, 2, 3), y = c(1, 2, 3),
#' age = c(0, 0, 3), sex = c("F", "F", "M")
#' ),
#' coords = c("x", "y")
#' )
#' t1 <- sf2turtles(turtles_sf = turtles_sf1)
#' }
#'
#' @export
#' @rdname sf2turtles
#'
#' @author Sarah Bauduin
#'
setGeneric(
"sf2turtles",
function(turtles_sf) {
standardGeneric("sf2turtles")
}
)
#' @export
#' @importFrom grDevices rainbow
#' @importFrom stats runif
#' @rdname sf2turtles
setMethod(
"sf2turtles",
signature = c("ANY"),
definition = function(turtles_sf) {
if (!is(turtles_sf, "sf")) {
stop("To use sf2turtles, sf must be installed: install.packages('sf')")
}
sfData <- sf::st_drop_geometry(turtles_sf)
n <- nrow(turtles_sf)
if (!is.na(match("who", names(sfData)))) {
who <- sfData$who
} else {
who <- seq(from = 0, to = n - 1, by = 1)
}
if (!is.na(match("heading", names(sfData)))) {
heading <- sfData$heading
} else {
heading <- runif(n = n, min = 0, max = 360)
}
if (!is.na(match("prevX", names(sfData)))) {
prevX <- sfData$prevX
} else {
prevX <- rep(NA, n)
}
if (!is.na(match("prevY", names(sfData)))) {
prevY <- sfData$prevY
} else {
prevY <- rep(NA, n)
}
if (!is.na(match("breed", names(sfData)))) {
breed <- sfData$breed
} else {
breed <- rep("turtle", n)
}
if (!is.na(match("color", names(sfData)))) {
color <- sfData$color
} else {
color <- rainbow(n)
}
turtles <- new("agentMatrix",
coords = cbind(
xcor = sf::st_coordinates(turtles_sf)[, 1],
ycor = sf::st_coordinates(turtles_sf)[, 2]
),
who = who,
heading = heading,
prevX = prevX,
prevY = prevY,
breed = breed,
color = color
)
for (i in which(!names(sfData) %in% c(
"who", "heading", "prevX", "prevY",
"breed", "color", "stringsAsFactors"
))) {
turtles <- turtlesOwn(turtles = turtles, tVar = names(sfData)[i], tVal = sfData[, i])
}
return(turtles)
}
)
################################################################################
#' From `agentMatrix` to `SpatialPointsDataFrame`
#'
#' Convert an `agentMatrix` object into a `SpatialPointsDataFrame` object.
#'
#' @inheritParams fargs
#'
#' @return `SpatialPointsDataFrame` object representing the moving `agents`
#' (coordinates and data)
#' as contained in `turtles`.
#'
#' @examples
#' t1 <- createTurtles(n = 10, coords = cbind(xcor = 1:10, ycor = 1:10))
#' if (requireNamespace("sp", quietly = TRUE)) {
#' sp1 <- turtles2spdf(turtles = t1)
#' }
#'
#' @export
#' @rdname turtles2spdf
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtles2spdf",
function(turtles) {
standardGeneric("turtles2spdf")
}
)
#' @export
#' @rdname turtles2spdf
setMethod(
"turtles2spdf",
signature = c("agentMatrix"),
definition = function(turtles) {
if (!requireNamespace("sp", quietly = TRUE)) {
stop("Please install.packages('sp') to use sp objects")
}
spdf <- sp::SpatialPointsDataFrame(
coords = turtles@.Data[, c("xcor", "ycor"), drop = FALSE],
data = inspect(turtles, who = turtles@.Data[, "who"])
[3:ncol(turtles@.Data)]
)
return(spdf)
}
)
################################################################################
#' From `agentMatrix` to `sf`
#'
#' Convert an `agentMatrix` object into an `sf` object.
#'
#' @inheritParams fargs
#'
#' @return `sf` object of `POINT geometry` representing the moving `agents`
#' (coordinates and data)
#' as contained in `turtles`.
#'
#' @examples
#' t1 <- createTurtles(n = 10, coords = cbind(xcor = 1:10, ycor = 1:10))
#' if (requireNamespace("sf", quietly = TRUE)) {
#' sf_t1 <- turtles2sf(turtles = t1)
#' }
#'
#' @export
#' @rdname turtles2sf
#'
#' @author Sarah Bauduin
#'
setGeneric(
"turtles2sf",
function(turtles) {
standardGeneric("turtles2sf")
}
)
#' @export
#' @rdname turtles2sf
setMethod(
"turtles2sf",
signature = c("ANY"),
definition = function(turtles) {
if (!requireNamespace("sf", quietly = TRUE)) {
stop("To use turtles2sf, sf must be installed: install.packages('sf')")
}
turtles_sf <- sf::st_as_sf(inspect(turtles, who = turtles@.Data[, "who"]),
coords = c("xcor", "ycor")
)
return(turtles_sf)
}
)
extents <- function(ext) {
xmn <- terra::xmin(ext)
xmx <- terra::xmax(ext)
ymn <- terra::ymin(ext)
ymx <- terra::ymax(ext)
list(xmin = xmn, xmax = xmx, ymin = ymn, ymax = ymx)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.