R/agentset-functions.R

################################################################################
#' All agents?
#'
#' Report `TRUE` if all `agents` have their variable equal to a given value,
#' report `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @return Logical. `TRUE` if all the `agents` have their variable equal to
#'         `val`, `FALSE` otherwise.
#'
#' @details `world` must not be provided if `agents` are turtles.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#all>
#'
#' @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 = runif(25))
#' NLall(agents = patches(w1), world = w1, val = 5)
#' w2 <- w1
#' w2 <- NLset(world = w1, agents = patches(w1), val = 5)
#' NLall(agents = patches(w2), world = w2, val = 5)
#'
#' # Turtles
#' t1 <- createTurtles(n = 5, coords = cbind(xcor = 1, ycor = 1), heading = c(1, 2, 2, 1, 2))
#' NLall(agents = t1, var = "xcor", val = 1)
#' NLall(agents = t1, var = "heading", val = 2)
#'
#' @export
#' @rdname NLall
#' @aliases all
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "NLall",
  function(agents, world, var, val) {
    standardGeneric("NLall")
  }
)

#' @export
#' @rdname NLall
setMethod(
  "NLall",
  signature = c("matrix", "worldMatrix", "missing", "ANY"),
  definition = function(agents, world, val) {
    withVal <- NLwith(agents = agents, world = world, val = val)
    allTrue <- ifelse(nrow(agents) == nrow(withVal), TRUE, FALSE)
    return(allTrue)
  }
)

#' @export
#' @rdname NLall
setMethod(
  "NLall",
  signature = c("matrix", "worldArray", "character", "ANY"),
  definition = function(agents, world, var, val) {
    withVal <- NLwith(agents = agents, world = world, var = var, val = val)
    allTrue <- ifelse(nrow(agents) == nrow(withVal), TRUE, FALSE)
    return(allTrue)
  }
)

#' @export
#' @rdname NLall
setMethod(
  "NLall",
  signature = c("agentMatrix", "missing", "character", "ANY"),
  definition = function(agents, var, val) {
    withVal <- NLwith(agents = agents, var = var, val = val)
    allTrue <- ifelse(length(agents) == length(withVal), TRUE, FALSE)
    return(allTrue)
  }
)


################################################################################
#' Any agents?
#'
#' Report `TRUE` if `agents` is non empty, report `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @return Logical. `TRUE` if there is at least one patch or one turtle in the
#'         `agents`, `FALSE` otherwise.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#any>
#'
#' @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)
#' p1 <- noPatches()
#' p2 <- patch(w1, 0, 0)
#' NLany(p1)
#' NLany(p2)
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' t2 <- noTurtles()
#' NLany(t1)
#' NLany(t2)
#'
#' @export
#' @rdname NLany
#' @aliases any
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "NLany",
  function(agents) {
    standardGeneric("NLany")
  }
)

#' @export
#' @rdname NLany
setMethod(
  "NLany",
  signature = c("matrix"),
  definition = function(agents) {
    if (inherits(agents, "agentMatrix")) {
      anyAgents <- ifelse(NROW(agents) == 0, FALSE, TRUE)
    } else {
      anyAgents <- ifelse(NROW(agents) == 0, FALSE, TRUE)

      if (anyAgents == TRUE) {
        nonNAs <- apply(agents, 2, function(x) length(which(!is.na(x))))
        if (sum(nonNAs) == 0) {
          anyAgents <- FALSE
        }
      }
    }

    return(anyAgents)
  }
)


################################################################################
#' Count agents
#'
#' Report the number of patches or turtles inside `agents`.
#'
#' @inheritParams fargs
#'
#' @return Integer.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#count>
#'
#' @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)
#' p1 <- patches(w1)
#' NLcount(p1) # 25 patches
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' NLcount(t1) # 10 turtles
#'
#' @export
#' @rdname NLcount
#' @aliases count
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "NLcount",
  function(agents) {
    standardGeneric("NLcount")
  }
)

#' @export
#' @rdname NLcount
setMethod(
  "NLcount",
  signature = c("matrix"),
  definition = function(agents) {
    return(NROW(agents))
  }
)


################################################################################
#' Sort `agents`
#'
#' Return the `agents` sorted according to their value.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#'         `pycor` representing the coordinates of the `patches` sorted according to
#'         their values, if `agents`
#'         are `patches`, or
#'
#'         `AgentMatrix` representing the `turtles` sorted according
#'         to their `var` values, if `agents` are
#'         `turtles`.
#'
#' @details `world` must not be provided if `agents` are `turtles`.
#'
#'          The sorting of the `agents` is done in a increasing order.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#sort-on>
#'
#' @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 = sample(1:5, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- sortOn(agents = patches(w1), world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' sortHeadingT1 <- sortOn(agents = t1, var = "heading")
#'
#' # or
#' library(quickPlot)
#'
#' Plot(w1)
#' Plot(t1, addTo = "w1")
#'
#' @export
#' @rdname sortOn
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "sortOn",
  function(agents, world, var) {
    standardGeneric("sortOn")
  }
)

#' @export
#' @rdname sortOn
setMethod(
  "sortOn",
  signature = c("matrix", "worldMatrix", "missing"),
  definition = function(agents, world) {
    agentsVal <- world[agents[, 1], agents[, 2]]
    pCoords <- agents[order(agentsVal), ]
    return(pCoords)
  }
)

#' @export
#' @rdname sortOn
setMethod(
  "sortOn",
  signature = c("matrix", "worldArray", "character"),
  definition = function(agents, world, var) {
    agentsVal <- world[agents[, 1], agents[, 2]]
    pCoords <- agents[order(agentsVal[, var]), ]
    return(pCoords)
  }
)

#' @export
#' @rdname sortOn
setMethod(
  "sortOn",
  signature = c("agentMatrix", "missing", "character"),
  definition = function(agents, var) {
    if (NROW(agents) > 1) {
      agents@.Data <- agents@.Data[order(agents@.Data[, var]), ]
    }
    return(agents)
  }
)


################################################################################
#' `Agents` with
#'
#' Report the `patches` or the `turtles` among `agents` which have their variable
#' equals to specific values.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#'         `pycor` representing the coordinates of the `patches` among the `agents`
#'         which have their variable
#'         equals to any `val`, or
#'
#'         `AgentMatrix` representing the `turtles` among the `agents`
#'         which have their variable
#'         `var` equals to any `val`.
#'
#' @details `world` must not be provided if `agents` are `turtles`.
#'
#'          This is equivalent in R to subsetting.
#'
#'          `val` can include `NA`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#with>
#'
#' @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 = sample(1:5, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p2 <- NLwith(agents = patches(w1), world = w1, val = 2)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 5, coords = randomXYcor(w1, n = 5),
#'   breed = c("sheep", "sheep", "wolf", "sheep", "sheperd")
#' )
#' t2 <- NLwith(agents = t1, var = "breed", val = "sheep")
#' t3 <- NLwith(agents = t1, var = "breed", val = c("sheep", "wolf"))
#'
#' @export
#' @rdname NLwith
#' @aliases with
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "NLwith",
  function(agents, world, var, val) {
    standardGeneric("NLwith")
  }
)

#' @export
#' @rdname NLwith
setMethod(
  "NLwith",
  signature = c("matrix", "worldMatrix", "missing", "ANY"),
  definition = function(agents, world, val) {
    agentsValues <- world[agents[, 1], agents[, 2], drop = FALSE]
    pVal <- which(agentsValues %in% val)
    return(agents[pVal, , drop = FALSE])
  }
)

#' @export
#' @rdname NLwith
setMethod(
  "NLwith",
  signature = c("matrix", "worldArray", "character", "ANY"),
  definition = function(agents, world, var, val) {
    agentsCell <- cellFromPxcorPycor(world = world, pxcor = agents[, 1], pycor = agents[, 2])
    allVal <- as.numeric(t(world@.Data[, , var])) # t() to retrieve the values by rows
    agentsValues <- allVal[agentsCell]
    pVal <- which(agentsValues %in% val)
    return(agents[pVal, , drop = FALSE])
  }
)

#' @export
#' @rdname NLwith
setMethod(
  "NLwith",
  signature = c("agentMatrix", "missing", "character", "ANY"),
  definition = function(agents, var, val) {
    # simpler for speed if only 1 val
    if (length(val) == 1) {
      if (is.na(val)) {
        toReturn <- agents[is.na(agents@.Data[, var, drop = FALSE]), ]
      } else {
        if (!is.numeric(val)) {
          toReturn <- (agents[agents@levels[[var]][agents@.Data[, var, drop = FALSE]] == val, ,
            drop = FALSE
          ])
        } else {
          toReturn <- agents[agents@.Data[, var] == val, , drop = FALSE]
        }
      }
    } else {
      if (!is.numeric(val)) {
        toReturn <- (agents[agents@levels[[var]][agents@.Data[, var, drop = FALSE]] %in% val, ,
          drop = FALSE
        ])
      } else {
        toReturn <- agents[agents@.Data[, var, drop = FALSE] %in% val, , drop = FALSE]
      }
    }
    return(toReturn[!is.na(toReturn@.Data[, "who"]), , drop = FALSE])
  }
)

################################################################################
#' `Agents` with maximum
#'
#' Report the `patches` or `turtles` among `agents` which have their variable
#' equals to the maximum value.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#'         `pycor` representing the coordinates of the patches among the `agents`
#'         which have their variable
#'         equal to the maximum value among the `agents`, or
#'
#'         `AgentMatrix` representing the `turtles` among the `agents`
#'         which have their variable
#'         `var` equal to the maximum value among the `agents`.
#'
#' @details `world` must not be provided if `agents` are turtles.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#with-max>
#'
#' @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 = sample(1:5, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- withMax(agents = patches(w1), world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 10, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:3, size = 10, replace = TRUE)
#' )
#' t2 <- withMax(agents = t1, var = "heading")
#'
#' @export
#' @rdname withMax
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "withMax",
  function(agents, world, var) {
    standardGeneric("withMax")
  }
)

#' @export
#' @rdname withMax
setMethod(
  "withMax",
  signature = c("matrix", "worldMatrix", "missing"),
  definition = function(agents, world) {
    val <- of(world = world, agents = agents)

    if (length(val[is.na(val)]) == length(val)) {
      stop("patches' values are all NAs")
    } else {
      maxVal <- max(val, na.rm = TRUE)
      posMax <- which(val %in% maxVal)
      return(agents[posMax, , drop = FALSE])
    }
  }
)

#' @export
#' @rdname withMax
setMethod(
  "withMax",
  signature = c("matrix", "worldArray", "character"),
  definition = function(agents, world, var) {
    val <- of(world = world, agents = agents, var = var)

    if (length(val[is.na(val)]) == length(val)) {
      stop("patches' values are all NAs")
    } else {
      maxVal <- max(val, na.rm = TRUE)
      posMax <- which(val %in% maxVal)
      return(agents[posMax, , drop = FALSE])
    }
  }
)

#' @export
#' @rdname withMax
setMethod(
  "withMax",
  signature = c("agentMatrix", "missing", "character"),
  definition = function(agents, var) {
    val <- of(agents = agents, var = var)

    if (length(val[is.na(val)]) == length(val)) {
      stop("patches' values are all NAs")
    } else {
      maxVal <- max(val, na.rm = TRUE)
      posMax <- val %in% maxVal
      return(agents[posMax, , drop = FALSE])
    }
  }
)


################################################################################
#' `Agents` with minimum
#'
#' Report the `patches` or `turtles` among `agents` which have their variable
#' equals to the minimum value.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2) with the first column `pxcor` and the second column
#'         `pycor` representing the coordinates of the `patches` among the `agents`
#'         which have their variable
#'         equal to the minimum value among the `agents`, or
#'
#'         `AgentMatrix` representing the `turtles` among the `agents`
#'         which have their variable
#'         `var` equal to the minimum value among the `agents`.
#'
#' @details `world` must not be provided if `agents` are turtles.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#with-min>
#'
#' @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 = sample(1:5, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- withMin(agents = patches(w1), world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 10, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:3, size = 10, replace = TRUE)
#' )
#' t2 <- withMin(agents = t1, var = "heading")
#'
#' @export
#' @rdname withMin
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "withMin",
  function(agents, world, var) {
    standardGeneric("withMin")
  }
)

#' @export
#' @rdname withMin
setMethod(
  "withMin",
  signature = c("matrix", "worldMatrix", "missing"),
  definition = function(agents, world) {
    val <- of(world = world, agents = agents)

    if (length(val[is.na(val)]) == length(val)) {
      stop("patches' values are all NAs")
    } else {
      minVal <- min(val, na.rm = TRUE)
      posMin <- which(val %in% minVal)
      return(agents[posMin, , drop = FALSE])
    }
  }
)

#' @export
#' @rdname withMin
setMethod(
  "withMin",
  signature = c("matrix", "worldArray", "character"),
  definition = function(agents, world, var) {
    val <- of(world = world, agents = agents, var = var)

    if (length(val[is.na(val)]) == length(val)) {
      stop("patches' values are all NAs")
    } else {
      minVal <- min(val, na.rm = TRUE)
      posMin <- which(val %in% minVal)
      return(agents[posMin, , drop = FALSE])
    }
  }
)

#' @export
#' @rdname withMin
setMethod(
  "withMin",
  signature = c("agentMatrix", "missing", "character"),
  definition = function(agents, var) {
    val <- of(agents = agents, var = var)

    if (length(val[is.na(val)]) == length(val)) {
      stop("patches' values are all NAs")
    } else {
      minVal <- min(val, na.rm = TRUE)
      posMin <- which(val %in% minVal)
      return(agents[posMin, , drop = FALSE])
    }
  }
)


################################################################################
#' One `agent` with maximum
#'
#' Report one `patch` or one `turtle` among `agents` which has its variable equals
#' to the maximum value.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2, `nrow` = 1) with the first column `pxcor` and
#'         the second column `pycor` representing the coordinates of the `patch`
#'         (or of one of the `patches`) among the `agents` which has its variable
#'         equals to the maximum value
#'         among the `agents`, or
#'
#'         `AgentMatrix` of length 1 representing the `turtle` (or one of
#'         the `turtles`) among the `agents` which has its variable `var`
#'         equals to the maximum value
#'         among the `agents`.
#'
#' @details `world` must not be provided if `agents` are turtles.
#'
#'          If there are several `patches` or `turtles` among `agents` with their
#'          variable equal to the maximum
#'          value, one is chosen randomly. To access to all `patches` or `turtles` among
#'          `agents` which have their variable equal
#'          to the maximum value, use `withMax()`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#max-one-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 = sample(1:5, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- maxOneOf(agents = patches(w1), world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 10, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:3, size = 10, replace = TRUE)
#' )
#' t2 <- maxOneOf(agents = t1, var = "heading")
#'
#' @export
#' @rdname maxOneOf
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "maxOneOf",
  function(agents, world, var) {
    standardGeneric("maxOneOf")
  }
)

#' @export
#' @rdname maxOneOf
setMethod(
  "maxOneOf",
  signature = c("matrix", "worldMatrix", "missing"),
  definition = function(agents, world) {
    maxAgents <- withMax(world = world, agents = agents)
    row <- resample(seq_len(NROW(maxAgents)), size = 1)
    return(maxAgents[row, , drop = FALSE])
  }
)

#' @export
#' @rdname maxOneOf
setMethod(
  "maxOneOf",
  signature = c("matrix", "worldArray", "character"),
  definition = function(agents, world, var) {
    maxAgents <- withMax(world = world, agents = agents, var = var)
    row <- resample(seq_len(NROW(maxAgents)), size = 1)
    return(maxAgents[row, , drop = FALSE])
  }
)

#' @export
#' @rdname maxOneOf
setMethod(
  "maxOneOf",
  signature = c("agentMatrix", "missing", "character"),
  definition = function(agents, var) {
    maxAgents <- withMax(agents = agents, var = var)
    row <- resample(1:NLcount(maxAgents), size = 1)
    return(maxAgents[row, , drop = FALSE])
  }
)


################################################################################
#' One `agent` with minimum
#'
#' Report one `patch` or one `turtle` among `agents` which has its variable equals
#' to the minimum value.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2, `nrow` = 1) with the first column `pxcor` and
#'         the second column `pycor` representing the coordinates of the `patch`
#'         (or of one of the `patches`) among the `agents` which has its variable
#'         equals to the minimum value
#'         among the `agents`, or
#'
#'         `AgentMatrix` of length 1 representing the `turtle` (or one of
#'         the `turtles`) among the `agents` which has its variable `var`
#'         equals to the minimum value
#'         among the `agents`.
#'
#' @details `world` must not be provided if `agents` are turtles.
#'
#'          If there are several `patches` or `turtles` among `agents` with their
#'          variable equal to the minimum
#'          value, one is chosen randomly. To access to all `patches` or `turtles` among
#'          `agents` which have their variable equal
#'          to the minimum value, use `withMin()`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#min-one-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 = sample(1:5, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- minOneOf(agents = patches(w1), world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 10, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:3, size = 10, replace = TRUE)
#' )
#' t2 <- minOneOf(agents = t1, var = "heading")
#'
#' @export
#' @rdname minOneOf
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "minOneOf",
  function(agents, world, var) {
    standardGeneric("minOneOf")
  }
)

#' @export
#' @rdname minOneOf
setMethod(
  "minOneOf",
  signature = c("matrix", "worldMatrix", "missing"),
  definition = function(agents, world) {
    minAgents <- withMin(world = world, agents = agents)
    row <- resample(seq_len(NROW(minAgents)), size = 1)
    return(minAgents[row, , drop = FALSE])
  }
)

#' @export
#' @rdname minOneOf
setMethod(
  "minOneOf",
  signature = c("matrix", "worldArray", "character"),
  definition = function(agents, world, var) {
    minAgents <- withMin(world = world, agents = agents, var = var)
    row <- resample(seq_len(NROW(minAgents)), size = 1)
    return(minAgents[row, , drop = FALSE])
  }
)

#' @export
#' @rdname minOneOf
setMethod(
  "minOneOf",
  signature = c("agentMatrix", "missing", "character"),
  definition = function(agents, var) {
    minAgents <- withMin(agents = agents, var = var)
    row <- resample(1:NLcount(minAgents), size = 1)
    return(minAgents[row, , drop = FALSE])
  }
)


################################################################################
#' Type of object
#'
#' Report `TRUE` if the `agents` is of the `class` tested,
#' report `FALSE` otherwise.
#'
#' @inheritParams fargs
#'
#' @param class  Character. Can take one of the following options to define
#'               the `class`: `"agent"`, `"agentset"`,
#'               `"patch"`, `"patchset"`. `"turtle"` or `"turtleset"`.
#'
#' @return Logical. `TRUE` if `agents` is of the `class` tested.
#'
#' @details Careful! The `class` tested does not correspond to actual R classes.
#'
#'          `agents` is `"patch"` if it is a matrix (`ncol` = 2) with the
#'          first column `pxcor` and the second column `pycor` with only
#'          one row. `agents` is `"patcheset"` if the matrix has more than
#'          one row.
#'
#'          `agents` is `"turtle"` if it is an `agentMatrix`
#'          containing only one `turtle`.
#'          `agents` is `"turtleset"` if the
#'          `agentMatrix` contains more than one `turtle`.
#'
#'          `agents` is `"agent"` if it is either `"patch"` or
#'          `"turtle"`. `agents` is `"agentset"` if it is either
#'          `"patcheset"` or `"turtleset"`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#is-of-type>
#'
#' @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, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:3, size = 10, replace = TRUE)
#' )
#' isNLclass(agents = patches(w1), class = "patch")
#' isNLclass(agents = patches(w1), class = "patcheset")
#' isNLclass(agents = t1, class = "agentset")
#' isNLclass(agents = t1, class = "turtleset")
#'
#' @export
#' @rdname isNLclass
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "isNLclass",
  function(agents, class) {
    standardGeneric("isNLclass")
  }
)

#' @export
#' @rdname isNLclass
setMethod(
  "isNLclass",
  signature = c("matrix", "character"),
  definition = function(agents, class) {
    # turtles
    if (inherits(agents, "agentMatrix")) {
      if (class == "agent") {
        class <- "turtle"
      }
      if (class == "agentset") {
        class <- "turtleset"
      }

      if (all(colnames(agents@.Data)[1:8] == c(
        "xcor", "ycor", "who", "heading",
        "prevX", "prevY", "breed", "color"
      ) &
        NLcount(agents) != 0)) {
        if (NLcount(agents) == 1) {
          agentsClass <- "turtle"
        } else {
          agentsClass <- "turtleset"
        }
      } else {
        agentsClass <- "nothing"
      }

      matchClass <- ifelse(class == agentsClass, TRUE, FALSE)
      return(matchClass)
    } else {
      # If it is this signature, it is a matrix, therefore patch or patches
      if (class == "agent") {
        class <- "patch"
      }
      if (class == "agentset") {
        class <- "patchset"
      }

      if (all(colnames(agents) == c("pxcor", "pycor") & NROW(agents) != 0)) {
        if (NROW(agents) == 1) {
          agentsClass <- "patch"
        } else {
          agentsClass <- "patchset"
        }
      } else {
        agentsClass <- "nothing"
      }

      matchClass <- ifelse(class == agentsClass, TRUE, FALSE)
      return(matchClass)
    }
  }
)


################################################################################
#' N random `agents`
#'
#' Report `n` `patches` or `turtles` randomly selected among `agents`.
#'
#' @inheritParams oneOf
#'
#' @param n  Integer. Number of `patches` or `turtles` to select from `agents`.
#'
#' @return Matrix (`ncol` = 2, `nrow` = `n`) with the first column `pxcor`
#'         and the second  column `pycor` representing the coordinates of the
#'         selected patches from `agents`, or
#'
#'         Matrix (`ncol` = 2) with the first column `pxcor`
#'         and the second  column `pycor` representing the coordinates of the
#'         selected `patches` from `agents`, `n` per individual "id", or
#'
#'         `AgentMatrix` (`nrow` = `n`) representing the `turtles`
#'         selected from `agents`,
#'
#'         Integer. Vector of `who` numbers for the selected `turtles` from
#'         `agents`, `n` per individual "id".
#'
#' @details `n` must be less or equal the number of `patches`
#'          or `turtles` in `agents`.
#'
#'          If `agents` is a matrix with `ncol` = 3, the selection of `n`
#'          random `patches` is done per individual "id". The order of the `patches`
#'          coordinates returned follow the order of "id".
#'          If `agents` is a matrix (`ncol` = 2) with columns `whoTurtles` and
#'          `id`, the selection of `n` random `turtles` (defined by their `whoTurtles`)
#'          is done per individual "id". The order of the `who` numbers returned
#'          follow the order of "id".
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#n-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)
#' pSelect <- nOf(agents = patches(w1), n = 5)
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' tSelect <- nOf(agents = t1, n = 2)
#'
#' @export
#' @rdname nOf
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "nOf",
  function(agents, n) {
    standardGeneric("nOf")
  }
)

#' @export
#' @rdname nOf
setMethod(
  "nOf",
  signature = c("matrix", "numeric"),
  definition = function(agents, n) {
    if (inherits(agents, "agentMatrix")) {
      row <- resample(seq_len(NROW(agents)), size = n, replace = FALSE)
      row <- row[order(row)]
      turtles <- agents[row, , drop = FALSE]
      return(turtles)
    } else {
      if (ncol(agents) == 2 && colnames(agents)[1] == "pxcor") {
        # patches
        row <- resample(seq_len(NROW(agents)), size = n, replace = FALSE)
        row <- row[order(row)]
        patches <- agents[row, , drop = FALSE]
        return(patches)
      } else {
        # patches
        if (min(table(agents[, "id"])) < n) {
          stop("n is larger than the number of agents per id")
        } else {
          if (ncol(agents) == 3) {
            # patches with id
            row <- tapply(
              X = seq_len(NROW(agents)), INDEX = as.factor(agents[, "id"]),
              FUN = function(x) resample(x, size = n, replace = FALSE)
            )
            patches <- agents[unlist(row), c("pxcor", "pycor")]
            return(patches)
          } else {
            # whoNUmbers of turtles with id
            row <- tapply(
              X = seq_len(NROW(agents)), INDEX = as.factor(agents[, "id"]),
              FUN = function(x) resample(x, size = n, replace = FALSE)
            )
            turtles <- agents[unlist(row), "whoTurtles"]
            return(turtles)
          }
        }
      }
    }
  }
)

################################################################################
#' One random `agent`
#'
#' Report one `patch` or `turtle` randomly selected among `agents`.
#'
#' @param agents Matrix (`ncol` = 2) with the first column `pxcor` and the second
#'               column `pycor` representing the `patches` coordinates, or
#'
#'               Matrix (`ncol` = 3) with the first column "`pxcor` and the second
#'               column `pycor` representing the `patches` coordinates and the
#'               third column `id`, or
#'
#'               `AgentMatrix` object representing the moving `agents`, or
#'
#'               Matrix (`ncol` = 2) with the first column `whoTurtles` and the
#'               second column `id`.
#'
#' @return Matrix (`ncol` = 2, `nrow` = 1) with the first column `pxcor`
#'         and the second  column `pycor` representing the coordinates of the
#'         selected `patch` from `agents`, or
#'
#'         Matrix (`ncol` = 2) with the first column `pxcor`
#'         and the second  column `pycor` representing the coordinates of the
#'         selected `patches` from `agents`, one per individual `id`, or
#'
#'         `AgentMatrix` object representing the `turtle`
#'         selected from `agents`, or
#'
#'         Integer. Vector of `who` numbers for the selected `turtles` from
#'         `agents`, one per individual `id`.
#'
#' @details If `agents` is a matrix with `ncol` = 3, the selection of one
#'          random `patch` is done per individual `id`. The order of the `patches`
#'          coordinates returned follow the order of `id`.
#'          If `agents` is a matrix (`ncol` = 2) with columns `whoTurtles` and
#'          `id`, the selection of one random `turtle` (defined by their `whoTurtles`)
#'          is done per individual `id`. The order of the `who` numbers returned
#'          follow the order of `id`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#one-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)
#' pSelect <- oneOf(agents = patches(w1))
#'
#' # Turtles
#' t1 <- createTurtles(n = 10, coords = randomXYcor(w1, n = 10))
#' tSelect <- oneOf(agents = t1)
#'
#' @export
#' @rdname oneOf
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "oneOf",
  function(agents) {
    standardGeneric("oneOf")
  }
)

#' @export
#' @rdname oneOf
setMethod(
  "oneOf",
  signature = c("matrix"),
  definition = function(agents) {
    nOf(agents = agents, n = 1)
    # if (inherits(agents, "agentMatrix")) {
    #   nOf(agents = agents, n = 1)
    # } else {
    #   nO
    #   if (ncol(agents) == 2 & colnames(agents)[1] == "pxcor") {
    #     # patches
    #     nOf(agents = agents, n = 1)
    #   } else if (ncol(agents) == 3) {
    #     # patches with id
    #     out <- nOf(agents = agents, n = 1)
    #     # out <- mApply(X = agents[, c("pxcor", "pycor")], INDEX = as.factor(agents[, "id"]),
    #     #        FUN = oneOf, keepmatrix = TRUE)
    #     return(out)
    #
    #   } else {
    #     # whoNUmbers of turtles with id
    #     whoTurtles <- tapply(X = agents[, "whoTurtles"], INDEX = as.factor(agents[, "id"]),
    #                          FUN = function(x) resample(x, size = 1) )
    #     return(as.numeric(whoTurtles))
    #   }
    # }
  }
)

################################################################################
#' `N` `agents` with maximum
#'
#' Report the `n` `patches` or `turtles` among `agents` which have their variable
#' among the maximum values.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2, `nrow` = `n`) with the first column `pxcor` and
#'         the second column `pycor` representing the coordinates of the `n`
#'         `patches` among the `agents` which have their variable values among
#'         the maximum values among the
#'         `agents`, or
#'
#'         `AgentMatrix` of length `n` representing the `turtles` among the
#'         `agents` which
#'         have their `var` values among the maximum values among the `agents`.
#'
#' @details `world` must not be provided if `agents` are `turtles`.
#'
#'          If there is a tie that would make the number of returned `patches` or `turtles` larger
#'          than `n`, it is broken randomly.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#max-n-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 = sample(1:10, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- maxNof(agents = patches(w1), n = 6, world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 10, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:5, size = 10, replace = TRUE)
#' )
#' t2 <- maxNof(agents = t1, n = 5, var = "heading")
#'
#' @export
#' @rdname maxNof
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "maxNof",
  function(agents, n, world, var) {
    standardGeneric("maxNof")
  }
)

#' @export
#' @rdname maxNof
setMethod(
  "maxNof",
  signature = c("matrix", "numeric", "worldMatrix", "missing"),
  definition = function(agents, n, world) {
    if (n == 1) {
      maxOneOf(agents = agents, world = world)
    } else if (n == 0) {
      noPatches()
    } else if (n == NROW(agents)) {
      return(agents)
    } else {
      val <- of(world = world, agents = agents)
      agentsVal <- cbind(val, agents)
      agentsVal <- agentsVal[order(-agentsVal[, "val"]), ] # decreasing order

      minVal <- min(agentsVal[1:n, "val"], na.rm = TRUE)
      maxAgents <- agentsVal[agentsVal[, "val"] >= minVal, , drop = FALSE]

      # To break ties randomly
      if (NROW(maxAgents) != n) {
        nToRemove <- NROW(maxAgents) - n # how many ties to remove
        toKeep <- sample(seq_len(NROW(maxAgents[maxAgents[, "val"] == minVal, ])),
          size = NROW(maxAgents[maxAgents[, "val"] == minVal, ]) - nToRemove
        )
        maxAgents <- rbind(
          maxAgents[maxAgents[, "val"] > minVal, ],
          maxAgents[maxAgents[, "val"] == minVal, ][toKeep, ]
        )
      }

      return(maxAgents[, c("pxcor", "pycor"), drop = FALSE])
    }
  }
)

#' @export
#' @rdname maxNof
setMethod(
  "maxNof",
  signature = c("matrix", "numeric", "worldArray", "character"),
  definition = function(agents, n, world, var) {
    if (n == 1) {
      maxOneOf(agents = agents, world = world, var = var)
    } else if (n == 0) {
      noPatches()
    } else if (n == NROW(agents)) {
      return(agents)
    } else {
      val <- of(world = world, agents = agents, var = var)
      agentsVal <- cbind(val, agents)
      agentsVal <- agentsVal[order(-agentsVal[, "val"]), , drop = FALSE] # decreasing order

      minVal <- min(agentsVal[1:n, "val"], na.rm = TRUE)
      maxAgents <- agentsVal[agentsVal[, "val"] >= minVal, , drop = FALSE]

      # To break ties randomly
      if (NROW(maxAgents) != n) {
        nToRemove <- NROW(maxAgents) - n # how many ties to remove
        toKeep <- sample(seq_len(NROW(maxAgents[maxAgents[, "val"] == minVal, ])),
          size = NROW(maxAgents[maxAgents[, "val"] == minVal, ]) - nToRemove
        )
        maxAgents <- rbind(
          maxAgents[maxAgents[, "val"] > minVal, ],
          maxAgents[maxAgents[, "val"] == minVal, ][toKeep, ]
        )
      }

      return(maxAgents[, c("pxcor", "pycor"), drop = FALSE])
    }
  }
)

#' @export
#' @rdname maxNof
setMethod(
  "maxNof",
  signature = c("agentMatrix", "numeric", "missing", "character"),
  definition = function(agents, n, var) {
    if (n == 1) {
      maxOneOf(agents = agents, var = var)
    } else if (n == 0) {
      noTurtles()
    } else if (n == NLcount(agents)) {
      return(agents)
    } else {
      tData <- inspect(agents, who = agents@.Data[, "who"])
      rownames(tData) <- seq_len(NROW(tData))
      tData <- tData[order(-tData[, var]), , drop = FALSE] # decreasing order

      minVal <- min(tData[1:n, var], na.rm = TRUE)
      maxAgents <- tData[tData[, var] >= minVal, , drop = FALSE]

      # To break ties randomly
      if (NROW(maxAgents) != n) {
        nToRemove <- NROW(maxAgents) - n # how many ties to remove
        toKeep <- sample(seq_len(NROW(maxAgents[maxAgents[, var] == minVal, ])),
          size = NROW(maxAgents[maxAgents[, var] == minVal, ]) - nToRemove
        )
        maxAgents <- rbind(
          maxAgents[maxAgents[, var] > minVal, , drop = FALSE],
          maxAgents[maxAgents[, var] == minVal, , drop = FALSE][toKeep, ,
            drop = FALSE
          ]
        )
      }

      tSelect <- as.numeric(rownames(maxAgents))
      tSelect <- sort(tSelect)
      maxTurtles <- agents[tSelect, , drop = FALSE]
      return(maxTurtles)
    }
  }
)

################################################################################
#' `N` `agents` with minimum
#'
#' Report the `n` `patches` or `turtles` among `agents` which have their variable
#' among the minimum values.
#'
#' @inheritParams fargs
#'
#' @return Matrix (`ncol` = 2, `nrow` = `n`) with the first column `pxcor` and
#'         the second column `pycor` representing the coordinates of the `n`
#'         `patches` among the `agents` which have their variable values among
#'         the minimum values among the
#'         `agents`, or
#'
#'         `AgentMatrix` of length `n` representing the `turtles` among the
#'         `agents` which
#'         have their `var` values among the minimum values among the `agents`.
#'
#' @details `world` must not be provided if `agents` are `turtles`.
#'
#'          If there is a tie that would make the number of returned `patches` or `turtles` larger
#'          than `n`, it is broken randomly.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#min-n-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 = sample(1:10, size = 25, replace = TRUE)
#' )
#' plot(w1)
#' p1 <- minNof(agents = patches(w1), n = 6, world = w1)
#'
#' # Turtles
#' t1 <- createTurtles(
#'   n = 10, coords = randomXYcor(w1, n = 10),
#'   heading = sample(1:5, size = 10, replace = TRUE)
#' )
#' t2 <- minNof(agents = t1, n = 5, var = "heading")
#'
#' @export
#' @rdname minNof
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "minNof",
  function(agents, n, world, var) {
    standardGeneric("minNof")
  }
)

#' @export
#' @rdname minNof
setMethod(
  "minNof",
  signature = c("matrix", "numeric", "worldMatrix", "missing"),
  definition = function(agents, n, world) {
    if (n == 1) {
      minOneOf(agents = agents, world = world)
    } else if (n == 0) {
      noPatches()
    } else if (n == NROW(agents)) {
      return(agents)
    } else {
      val <- of(world = world, agents = agents)
      agentsVal <- cbind(val, agents)
      agentsVal <- agentsVal[order(agentsVal[, "val", drop = FALSE]), , drop = FALSE] # incr. order

      maxVal <- max(agentsVal[1:n, "val", drop = FALSE], na.rm = TRUE)
      minAgents <- agentsVal[agentsVal[, "val"] <= maxVal, , drop = FALSE]

      # To break ties randomly
      if (NROW(minAgents) != n) {
        nToRemove <- NROW(minAgents) - n # how many ties to remove
        toKeep <- sample(
          seq_len(NROW(minAgents[minAgents[, "val", drop = FALSE] == maxVal, ,
            drop = FALSE
          ])),
          size = NROW(minAgents[minAgents[, "val", drop = FALSE] == maxVal, ,
            drop = FALSE
          ]) - nToRemove
        )
        minAgents <- rbind(
          minAgents[minAgents[, "val", drop = FALSE] < maxVal, , drop = FALSE],
          minAgents[minAgents[, "val", drop = FALSE] == maxVal, , drop = FALSE][
            toKeep, ,
            drop = FALSE
          ]
        )
      }

      return(minAgents[, c("pxcor", "pycor"), drop = FALSE])
    }
  }
)

#' @export
#' @rdname minNof
setMethod(
  "minNof",
  signature = c("matrix", "numeric", "worldArray", "character"),
  definition = function(agents, n, world, var) {
    if (n == 1) {
      minOneOf(agents = agents, world = world, var = var)
    } else if (n == 0) {
      noPatches()
    } else if (n == NROW(agents)) {
      return(agents)
    } else {
      val <- of(world = world, agents = agents, var = var)
      agentsVal <- cbind(val, agents)
      agentsVal <- agentsVal[order(agentsVal[, "val", drop = FALSE]), , drop = FALSE] # incr. order

      maxVal <- max(agentsVal[1:n, "val", drop = FALSE], na.rm = TRUE)
      minAgents <- agentsVal[agentsVal[, "val", drop = FALSE] <= maxVal, , drop = FALSE]

      # To break ties randomly
      if (NROW(minAgents) != n) {
        nToRemove <- NROW(minAgents) - n # how many ties to remove
        toKeep <- sample(
          seq_len(NROW(minAgents[minAgents[, "val", drop = FALSE] == maxVal, ,
            drop = FALSE
          ])),
          size = NROW(minAgents[minAgents[, "val"] == maxVal, , drop = FALSE]) -
            nToRemove
        )
        minAgents <- rbind(
          minAgents[minAgents[, "val", drop = FALSE] < maxVal, , drop = FALSE],
          minAgents[minAgents[, "val", drop = FALSE] == maxVal, , drop = FALSE][
            toKeep, ,
            drop = FALSE
          ]
        )
      }

      return(minAgents[, c("pxcor", "pycor"), drop = FALSE])
    }
  }
)

#' @export
#' @rdname minNof
setMethod(
  "minNof",
  signature = c("agentMatrix", "numeric", "missing", "character"),
  definition = function(agents, n, var) {
    if (n == 1) {
      minOneOf(agents = agents, var = var)
    } else if (n == 0) {
      noTurtles()
    } else if (n == NLcount(agents)) {
      return(agents)
    } else {
      tData <- inspect(agents, who = agents@.Data[, "who"])
      rownames(tData) <- seq_len(NROW(tData))
      tData <- tData[order(tData[, var]), , drop = FALSE] # increasing order

      maxVal <- max(tData[1:n, var], na.rm = TRUE)
      minAgents <- tData[tData[, var] <= maxVal, , drop = FALSE]

      # To break ties randomly
      if (NROW(minAgents) != n) {
        nToRemove <- NROW(minAgents) - n # how many ties to remove
        toKeep <- sample(seq_len(NROW(minAgents[minAgents[, var] == maxVal, ])),
          size = NROW(minAgents[minAgents[, var] == maxVal, ]) - nToRemove
        )
        minAgents <- rbind(
          minAgents[minAgents[, var] < maxVal, , drop = FALSE],
          minAgents[minAgents[, var] == maxVal, , drop = FALSE][toKeep, ,
            drop = FALSE
          ]
        )
      }

      tSelect <- as.numeric(rownames(minAgents))
      tSelect <- sort(tSelect)
      minTurtles <- agents[tSelect, , drop = FALSE]
      return(minTurtles)
    }
  }
)


################################################################################
#' `Agents` in radius
#'
#' Report the `patches` or `turtles` among `agents2` within given distances of
#' each of the `agents`. Currently, this function multiplies `radius` by
#' 1.0000001 so that the response of `inRadius` is inclusive.
#'
#' @inheritParams fargs
#'
#' @param radius  Numeric. Vector of distances from `agents` to locate
#'                `agents2`. Must be of length 1 or of length `agents`.
#'
#' @param agents2 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` = 3) with the first column `pxcor`
#'         and the second column `pycor` representing the coordinates of the
#'         `patches` among `agents2` within `radius` distances for each `agents`
#'         which are represented by the `id` column, if
#'         `agents2` are `patches`, or
#'
#'         Matrix (`ncol` = 2) with the first column `who`
#'         representing the `who` numbers of the
#'         `turtles` among `agents2` within `radius` distances for each `agents`
#'         which are represented by the `id` column, if
#'         `agents2` are `turtles`.
#'
#' @details Distances from/to `patches` are calculated from/to their center.
#'
#'          If `torus = FALSE`, `world` does not need to be provided.
#'
#'          If `torus = TRUE`, the `radius` distances are calculated
#'          around the sides of the `world` to select `agents2`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#in-radius>
#'
#' @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, coords = randomXYcor(w1, n = 10))
#'
#' if (requireNamespace("sf", quietly = TRUE)) {
#'   p1 <- inRadius(agents = patch(w1, 0, 0), radius = 2, agents2 = patches(w1))
#'   t2 <- inRadius(agents = patch(w1, 0, 0), radius = 2, agents2 = t1)
#'   p2 <- inRadius(agents = t1, radius = 2, agents2 = patches(w1))
#'   t3 <- inRadius(agents = turtle(t1, who = 0), radius = 2, agents2 = t1)
#' }
#'
#' @export
#' @rdname inRadius
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "inRadius",
  function(agents, radius, agents2, world, torus = FALSE) {
    standardGeneric("inRadius")
  }
)

#' @export
#' @rdname inRadius
setMethod(
  "inRadius",
  signature = c(agents = "matrix", radius = "numeric", agents2 = "matrix"),
  definition = function(agents, radius, agents2, world, torus) {
    if (inherits(agents, "agentMatrix") & inherits(agents2, "agentMatrix")) {
      # Transform agent into a matrix
      agents <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
      inRadius(agents = agents, radius = radius, agents2 = agents2, world = world, torus = torus)
    } else if (inherits(agents, "agentMatrix") & !inherits(agents2, "agentMatrix")) {
      # Transform agent into a matrix
      agents <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
      inRadius(agents = agents, radius = radius, agents2 = agents2, world = world, torus = torus)
    } else if (!inherits(agents, "agentMatrix") & inherits(agents2, "agentMatrix")) {
      # Transform the agents into sf to use st_buffer
      if (!requireNamespace("sf")) {
        stop(
          "to use inRadius on matrix objects (but not agentMatrix), ",
          "please install.packages('sf')"
        )
      }
      agents_sf <- sf::st_as_sf(as.data.frame(agents), coords = c(1, 2))
      # Create buffers around the locations of agents
      aBuffer <- sf::st_buffer(agents_sf, dist = radius)

      if (torus == TRUE) {
        if (missing(world)) {
          stop("A world must be provided as torus = TRUE")
        }

        agents2c <- agents2@.Data[, c("xcor", "ycor"), drop = FALSE]
        exts <- extents(world@extent)

        agents2c1 <- cbind(
          agents2c[, 1] - (exts$xmax - exts$xmin),
          agents2c[, 2] + (exts$ymax - exts$ymin)
        )
        agents2c2 <- cbind(agents2c[, 1], agents2c[, 2] + (exts$ymax - exts$ymin))
        agents2c3 <- cbind(
          agents2c[, 1] + (exts$xmax - exts$xmin),
          agents2c[, 2] + (exts$ymax - exts$ymin)
        )
        agents2c4 <- cbind(agents2c[, 1] - (exts$xmax - exts$xmin), agents2c[, 2])
        agents2c5 <- cbind(agents2c[, 1] + (exts$xmax - exts$xmin), agents2c[, 2])
        agents2c6 <- cbind(
          agents2c[, 1] - (exts$xmax - exts$xmin),
          agents2c[, 2] - (exts$ymax - exts$ymin)
        )
        agents2c7 <- cbind(agents2c[, 1], agents2c[, 2] - (exts$ymax - exts$ymin))
        agents2c8 <- cbind(
          agents2c[, 1] + (exts$xmax - exts$xmin),
          agents2c[, 2] - (exts$ymax - exts$ymin)
        )
        agents2cAll <- rbind(
          agents2c, agents2c1, agents2c2, agents2c3, agents2c4,
          agents2c5, agents2c6, agents2c7, agents2c8
        )

        # Extract the locations of agents2 under the buffers
        pOverL <- sf::st_intersects(
          aBuffer,
          sf::st_as_sf(as.data.frame(agents2cAll), coords = c(1, 2)),
          sparse = TRUE
        )
        pOver <- unlist(pOverL)
        lengthID <- unlist(lapply(pOverL, length))
        colnames(agents2cAll) <- c("x", "y")
        agentsWrap <- wrap(agents2cAll[pOver, , drop = FALSE], world@extent)
        agentsXY <- unique(cbind(agentsWrap, id = rep(seq_along(lengthID), lengthID)))

        tOn <- merge(agentsXY, agents2@.Data[, c("xcor", "ycor", "who"), drop = FALSE],
          by.x = c("x", "y"), by.y = c("xcor", "ycor")
        )
        return(tOn[order(tOn[, "id"]), c("who", "id")])
      } else {
        pOverL <- sf::st_intersects(
          aBuffer,
          sf::st_as_sf(inspect(agents2, who = agents2@.Data[, "who"]), coords = c("xcor", "ycor")),
          sparse = TRUE
        )
        pOver <- unlist(pOverL)
        lengthID <- unlist(lapply(pOverL, length))
        agentsXY <- unique(cbind(agents2@.Data[pOver, c("xcor", "ycor"), drop = FALSE],
          id = rep(seq_along(lengthID), lengthID)
        ))

        tOn <- merge(agentsXY, agents2@.Data[, c("xcor", "ycor", "who"), drop = FALSE])
        return(tOn[order(tOn[, "id"]), c("who", "id")])
      }
    } else {
      if (!requireNamespace("sf")) {
        stop(
          "to use inRadius on matrix objects (but not agentMatrix), ",
          "please install.packages('sf')"
        )
      }
      agents_sf <- sf::st_as_sf(as.data.frame(agents), coords = c(1, 2))
      # Create buffers around the locations of agents
      aBuffer <- sf::st_buffer(agents_sf, dist = radius * 1.0000001) ## (see #28)

      if (torus == TRUE) {
        if (missing(world)) {
          stop("A world must be provided as torus = TRUE")
        }

        worldWrap <- createWorld(
          minPxcor = minPxcor(world) - radius,
          maxPxcor = maxPxcor(world) + radius,
          minPycor = minPycor(world) - radius,
          maxPycor = maxPycor(world) + radius
        )
        pAllWrap <- patches(worldWrap)

        # Extract the locations of agents2 under the buffers
        sf1 <- sf::st_as_sf(as.data.frame(pAllWrap), coords = c(1, 2))

        pOverL <- sf::st_intersects(aBuffer, sf1, sparse = TRUE)
        pOver <- unlist(pOverL)
        lengthID <- unlist(lapply(pOverL, length))
        colnames(pAllWrap) <- c("x", "y")
        agentsWrap <- wrap(pAllWrap[pOver, , drop = FALSE], world@extent)
        agentsXY <- unique(cbind(agentsWrap, id = rep(seq_along(lengthID), lengthID)))
        colnames(agentsXY)[1:2] <- c("pxcor", "pycor")
        return(agentsXY)
      } else {
        sf1 <- sf::st_as_sf(as.data.frame(agents2), coords = c(1, 2))

        pOverL <- sf::st_intersects(aBuffer, sf1, sparse = TRUE)
        pOver <- unlist(pOverL)
        lengthID <- unlist(lapply(pOverL, length))
        agentsXY <- cbind(agents2[pOver, , drop = FALSE],
          id = rep(seq_along(lengthID), lengthID)
        )

        return(agentsXY)
      }
    }
  }
)

################################################################################
#' `Agents` in cone
#'
#' Report the `agents` within the "cone of vision" in front of each one of the
#' `turtles`.
#'
#' @inheritParams fargs
#'
#' @param radius  Numeric. Vector of distances from `turtles` to locate
#'                `agents`. Must be of length 1 or of length `turtles`.
#'
#' @param angle   Numeric. Vector of angles to define the size of the cone of vision
#'                for the `turtles`. The cone of vision is defined between the
#'                direction of their `headings` minus `angle / 2`
#'                to the direction of their `headings` plus `angle / 2`. Must be of
#'                length 1 or
#'                of length `turtles`.
#'
#' @return Matrix (`ncol` = 3) with the first column `pxcor`
#'         and the second column `pycor` representing the coordinates of the
#'         `patches` among `agents2` within the cone of vision of each of the
#'         `turtles`
#'         which are represented by the `id` column, if
#'         `agents` are `patches`, or
#'
#'         Matrix (`ncol` = 2) with the first column `who`
#'         representing the `who` numbers of the
#'         `turtles` among `agents2` within the cone of vision of each of  the
#'         `turtles`
#'         which are represented by the `id` column, if
#'         `agents` are `turtles`.
#'
#' @details `agents` are reported if there are within `radius`
#'          distance of the `turtle` and their direction from the `turtle` is within
#'          `[-angle, + angle]` of the `turtle`'s heading.
#'
#'          Distances to `patches` are calculated to their center.
#'
#'          If `torus = FALSE`, `world` does not need to be provided.
#'
#'          If `torus = TRUE`, the `radius` distances are calculated
#'          around the sides of the `world` to select `agents`.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#in-cone>
#'
#' @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, coords = randomXYcor(w1, n = 10))
#'
#' if (requireNamespace("sf", quietly = TRUE)) {
#'   p1 <- inCone(turtles = t1, radius = 2, agents = patches(w1), angle = 90)
#'   t2 <- inCone(turtles = turtle(t1, who = 0), radius = 2, angle = 90, agents = t1)
#' }
#'
#' @export
#' @rdname inCone
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "inCone",
  function(turtles, radius, angle, agents, world, torus = FALSE) {
    standardGeneric("inCone")
  }
)

#' @export
#' @rdname inCone
setMethod(
  "inCone",
  signature = c(turtles = "agentMatrix", radius = "numeric", angle = "numeric", agents = "matrix"),
  definition = function(turtles, radius, angle, agents, world, torus) {
    if (inherits(agents, "agentMatrix")) {
      agentsCoords <- agents@.Data[, c("xcor", "ycor"), drop = FALSE]
      colnames(agentsCoords) <- c("pxcor", "pycor")
      patchInCone <- inCone(
        turtles = turtles, radius = radius, angle = angle,
        agents = agentsCoords, world = world, torus = torus
      )
      colnames(patchInCone)[1:2] <- c("xcor", "ycor")
      agentsInCone <- merge(patchInCone, agents@.Data[, c("xcor", "ycor", "who"), drop = FALSE])
      return(agentsInCone[order(agentsInCone[, "id"]), c("who", "id")])
    } else {
      # Find the patches within distances
      agentsInRadius <- inRadius(
        agents = turtles, radius = radius, agents2 = agents,
        world = world, torus = torus
      )
      if (NROW(agentsInRadius) == 0) {
        # No patches are within radius distances for any turtles
        return(agentsInRadius)
      } else {
        turtlesWith <- turtles[unique(agentsInRadius[, "id", drop = FALSE]), , drop = FALSE]

        # Direction from the turtle to each of their patches within radius distance
        tDir <- lapply(unique(agentsInRadius[, "id", drop = FALSE]), function(x) {
          towards(
            world = world, agents = turtles[x, , drop = FALSE],
            agents2 = agentsInRadius[agentsInRadius[, "id"] == x,
              c("pxcor", "pycor"),
              drop = FALSE
            ],
            torus = torus
          )
        })
        # Define the rotation angle between the turtle heading and the direction to each patches
        tCone <- lapply(seq_along(tDir), function(x) {
          subHeadings(angle1 = tDir[[x]], angle2 = turtles[x, , drop = FALSE], range360 = FALSE)
        })

        angle <- angle / 2
        if (length(angle) == 1) {
          angle <- rep(angle, NROW(turtles))
        }
        # Remove the angle for the turtles which do not have patches within radius distance
        angle <- angle[unique(agentsInRadius[, "id"])]

        # Is the rotation to face the patches smaller than the maximum rotation allowed
        pWithin <- lapply(seq_along(unique(agentsInRadius[, "id"])), function(x) {
          posPatch <- which(abs(tCone[[x]]) < angle[x])
          unique(agentsInRadius[agentsInRadius[, "id"] == unique(agentsInRadius[, "id"])[x],
            c("pxcor", "pycor"),
            drop = FALSE
          ][posPatch, , drop = FALSE])
        })

        nAgents <- unlist(lapply(pWithin, NROW))
        agentsInCone <- cbind(do.call(rbind, pWithin),
          id = rep(unique(agentsInRadius[, "id", drop = FALSE]), nAgents)
        )

        return(agentsInCone)
      }
    }
  }
)

################################################################################
#' Set an `agents` variable
#'
#' Assign values to the `agents` for the selected variables.
#'
#' @inheritParams of
#'
#' @inheritParams fargs
#'
#' @param val Numeric or character. Vector of length 1 or length `NLcount(agents)`
#'            if `length(var) == 1`, or
#'
#'            Matrix or `Dataframe` (`ncol` = `length(var)`, `nrow` = `NLcount(agents)`).
#'            Columns must be in the same order as `var`.
#'
#' @return `WorldMatrix` or `worldArray` object with the values `val` assigned to the `patches`
#'         variables `var`
#'         for the `agents`, or
#'
#'         `AgentMatrix` representing the `turtles` with
#'         the values `val` assigned to the variables `var` for the `agents`.
#'
#' @details If `agents` are `patches`, `world` must be provided and `turtles`
#'          must not be provided. If `agents` are `turtles`, `turtles` must be
#'          provided and `world` must not be provided.
#'
#' @seealso <https://ccl.northwestern.edu/netlogo/docs/dictionary.html#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 = 4, minPycor = 0, maxPycor = 4)
#' w1 <- NLset(world = w1, agents = patches(w1), val = 1)
#' # Set the patch[0,4] to 0
#' w1 <- NLset(world = w1, agents = patch(w1, 0, 4), val = 0)
#' of(world = w1, agents = patches(w1))
#'
#' t1 <- createTurtles(n = 3, world = w1, heading = 0)
#' # Set the heading of turtle 0 to 180
#' t2 <- NLset(turtles = t1, agents = turtle(t1, who = 0), var = "heading", val = 180)
#' of(agents = t2, var = "heading") # c(180, 0, 0)
#'
#' @export
#' @rdname NLset
#' @aliases set
#'
#' @author Sarah Bauduin
#'
setGeneric(
  "NLset",
  function(world, turtles, agents, var, val) {
    standardGeneric("NLset")
  }
)

#' @export
#' @rdname NLset
setMethod(
  "NLset",
  signature = c(
    world = "missing", turtles = "agentMatrix", agents = "agentMatrix",
    var = "character", val = "ANY"
  ),
  definition = function(turtles, agents, var, val) {
    if (NROW(agents) != 0) {
      if (length(var) == 1) {
        if (!is.na(match(var, names(turtles@levels)))) {
          # Update the levels as some may have disapeared
          turtlesLevelsVar <- turtles@levels[[var]] # old levels
          turtlesVar <- turtles@.Data[, var] # old levels number
          turtlesVarUnique <- unique(turtlesVar) # unique old levels numbers
          # levels in the order of the unique old levels numbers
          turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)[order(turtlesVarUnique)]]
          turtles@levels[[var]] <- turtlesLevelsVarUpdated

          # replace the levels number starting to 1 and increasing by 1
          # turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique,
          #                                to = rank(turtlesVarUnique))
          turtlesVarUpdated <- rename(
            x = turtlesVar, from = turtlesVarUnique,
            to = rank(turtlesVarUnique)
          )
          # if (!identical(turtlesVarUpdated, a)) stop("mapvalues and rename different in NLset")

          turtles@.Data[, var] <- turtlesVarUpdated

          if (identical(agents, turtles)) {
            turtles[, var] <- as.character(val)
          } else {
            iAgents <- match(agents@.Data[, "who"], turtles@.Data[, "who"])
            turtles[iAgents, var] <- as.character(val)
          }
        } else {
          if (identical(agents, turtles)) {
            turtles@.Data[, var] <- as.numeric(val)
          } else {
            iAgents <- match(agents@.Data[, "who"], turtles@.Data[, "who"])
            turtles@.Data[iAgents, var] <- as.numeric(val)
          }
        }
      } else {
        varLevels <- which(var %in% names(turtles@levels))
        if (length(varLevels) != 0) {
          varNum <- (seq_along(var))[!(seq_along(var)) %in% varLevels]
        } else {
          varNum <- seq_along(var)
        }

        if (length(varLevels) != 0) {
          if (length(varLevels) == 1) {
            # Update the levels as some may have disapeared
            turtlesLevelsVar <- turtles@levels[[var[varLevels]]] # old levels
            turtlesVar <- turtles@.Data[, var[varLevels]] # old levels number
            turtlesVarUnique <- unique(turtlesVar) # unique old levels numbers
            # levels in the order of the unique old levels numbers
            turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)
            [order(turtlesVarUnique)]]
            turtles@levels[[var[varLevels]]] <- turtlesLevelsVarUpdated
            # replace the levels number starting to 1 and increasing by 1
            # turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique,
            #                                to = rank(turtlesVarUnique))
            turtlesVarUpdated <- rename(
              x = turtlesVar, from = turtlesVarUnique,
              to = rank(turtlesVarUnique)
            )
            # if (!identical(turtlesVarUpdated, a))
            #   stop("mapvalues and rename different in NLset 2")

            turtles@.Data[, var[varLevels]] <- turtlesVarUpdated

            if (identical(agents, turtles)) {
              turtles[, var[varLevels]] <- as.character(val[, varLevels])
            } else {
              iAgents <- match(agents@.Data[, "who"], turtles@.Data[, "who"])
              turtles[iAgents, var[varLevels]] <- as.character(val[, varLevels])
            }
          } else {
            if (identical(agents, turtles)) {
              for (i in varLevels) {
                # Update the levels as some may have disapeared
                turtlesLevelsVar <- turtles@levels[[var[i]]] # old levels
                turtlesVar <- turtles@.Data[, var[i]] # old levels number
                turtlesVarUnique <- unique(turtlesVar) # unique old levels numbers
                # levels in the order of the unique old levels numbers
                turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)
                [order(turtlesVarUnique)]]
                turtles@levels[[var[i]]] <- turtlesLevelsVarUpdated

                # replace the levels number starting to 1 and increasing by 1
                turtlesVarUpdated <- rename(
                  x = turtlesVar, from = turtlesVarUnique,
                  to = rank(turtlesVarUnique)
                )

                turtles@.Data[, var[i]] <- turtlesVarUpdated

                turtles[, var[i]] <- as.character(val[, var[i]])
              }
            } else {
              iAgents <- match(agents@.Data[, "who"], turtles@.Data[, "who"])
              for (i in varLevels) {
                # Update the levels as some may have disapeared
                turtlesLevelsVar <- turtles@levels[[var[i]]] # old levels
                turtlesVar <- turtles@.Data[, var[i]] # old levels number
                turtlesVarUnique <- unique(turtlesVar) # unique old levels numbers
                # levels in the order of the unique old levels numbers
                turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)
                [order(turtlesVarUnique)]]
                turtles@levels[[var[i]]] <- turtlesLevelsVarUpdated
                # replace the levels number starting to 1 and increasing by 1
                # turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique,
                #                                to = rank(turtlesVarUnique))
                turtlesVarUpdated <- rename(
                  x = turtlesVar, from = turtlesVarUnique,
                  to = rank(turtlesVarUnique)
                )
                # if (!identical(turtlesVarUpdated, a))
                #   stop("mapvalues and rename different in NLset")

                turtles@.Data[, var[i]] <- turtlesVarUpdated

                turtles[iAgents, var[i]] <- as.character(val[, i])
              }
            }
          }
        }

        if (length(varNum) != 0) {
          if (length(varNum) == 1) {
            if (identical(agents@.Data[, "who"], turtles@.Data[, "who"])) {
              turtles@.Data[, var[varNum]] <- as.numeric(val[, varNum])
            } else {
              iAgents <- match(agents@.Data[, "who"], turtles@.Data[, "who"])
              turtles@.Data[iAgents, var[varNum]] <- as.numeric(val[, varNum])
            }
          } else {
            if (identical(agents, turtles)) {
              if (inherits(val[, varNum], "data.frame")) {
                turtles@.Data[, var[varNum]] <- as.matrix(val[, varNum])
              } else if (inherits(val[, varNum, drop = FALSE], "matrix")) {
                turtles@.Data[, var[varNum]] <- matrix(as.numeric(val[, varNum]),
                  ncol = length(varNum)
                )
              }
            } else {
              iAgents <- match(agents@.Data[, "who"], turtles@.Data[, "who"])

              if (inherits(val[, varNum], "data.frame")) {
                turtles@.Data[iAgents, var[varNum]] <- as.matrix(val[, varNum])
              } else if (inherits(val[, varNum, drop = FALSE], "matrix")) {
                turtles@.Data[iAgents, var[varNum]] <- matrix(as.numeric(val[, varNum]),
                  ncol = length(varNum)
                )
              }
            }
          }
        }
      }

      if (any(var == "who")) {
        # if the who numbers have been modified, check for duplicates
        if (anyDuplicated(turtles@.Data[, "who"]) != 0) {
          warning(paste(
            "Duplicated who numbers among the resulting turtles.",
            "Please, reassign who numbers to keep them unique inside the agentset."
          ))
        }
      }
    }

    return(turtles)
  }
)


#' @export
#' @rdname NLset
setMethod(
  "NLset",
  signature = c(
    world = "worldMatrix", turtles = "missing", agents = "matrix",
    var = "missing", val = "ANY"
  ),
  definition = function(world, agents, val) {
    if (NROW(agents) != 0) {
      if (length(val) == 1 & NROW(agents) != 1) {
        val <- rep(val, NROW(agents))
      }

      if (identical(patches(world), agents)) {
        world@.Data[] <- matrix(val, ncol = dim(world)[2], byrow = TRUE)
      } else {
        agents[is.na(agents[, 1]), 2] <- NA
        agents[is.na(agents[, 2]), 1] <- NA

        val <- val[!is.na(agents[, 1])]
        i <- agents[!is.na(agents[, 1]), 1]
        j <- agents[!is.na(agents[, 1]), 2]

        world[i, j] <- val
      }
    }

    return(world)
  }
)

#' @export
#' @rdname NLset
setMethod(
  "NLset",
  signature = c(
    world = "worldArray", turtles = "missing", agents = "matrix",
    var = "character", val = "ANY"
  ),
  definition = function(world, agents, var, val) {
    if (NROW(agents) != 0) {
      if (length(var) == 1) {
        if (length(val) == 1 & NROW(agents) != 1) {
          val <- rep(val, NROW(agents))
        }

        if (identical(patches(world), agents)) {
          world@.Data[, , var] <- matrix(val, ncol = dim(world)[2], byrow = TRUE)
        } else {
          agents[is.na(agents[, 1]), 2] <- NA
          agents[is.na(agents[, 2]), 1] <- NA

          val <- val[!is.na(agents[, 1])]
          pxcor <- agents[!is.na(agents[, 1]), 1]
          pycor <- agents[!is.na(agents[, 1]), 2]

          matj <- pxcor - world@minPxcor + 1
          mati <- world@maxPycor - pycor + 1

          vark <- match(var, dimnames(world@.Data)[[3]])
          world@.Data[cbind(mati, matj, vark)] <- val
        }
      } else {
        if (identical(patches(world), agents)) {
          for (i in seq_along(var)) {
            vali <- val[, var[i]]

            if (length(vali) == 1) {
              vali <- rep(vali, NROW(agents))
            }
            world@.Data[, , var[i]] <- matrix(vali, ncol = dim(world)[2], byrow = TRUE)
          }
        } else {
          matj <- agents[, 1] - world@minPxcor + 1
          mati <- world@maxPycor - agents[, 2] + 1

          mati[is.na(matj)] <- NA
          matj[is.na(mati)] <- NA

          if (nrow(val) == 1 & length(matj) != 1) {
            val <- val[rep(1, length(matj)), ]
          }

          if (is.matrix(val)) {
            val <- val[!is.na(matj), , drop = FALSE]
          } else {
            val <- val[!is.na(matj), ]
          }

          matj <- matj[!is.na(matj)]
          mati <- mati[!is.na(mati)]

          for (i in seq_along(var)) {
            vark <- match(var[i], dimnames(world@.Data)[[3]])
            world@.Data[cbind(mati, matj, vark)] <- val[, var[i]]
          }
        }
      }
    }

    return(world)
  }
)
PredictiveEcology/NetLogoR documentation built on Jan. 31, 2024, 9:31 p.m.