Merge remote-tracking branch 'refs/remotes/origin/master'

Conflicts:
	tests/testthat/test-agentMatrix.R

.travis.yml

@@ -12,6 +12,9 @@ addons:
     - tcl8.5-dev
     - tk8.5-dev
 
+r_binary_packages:
+  - matrixStats
+
 r_github_packages:
   - jimhester/covr
 

R/agentset-functions.R

@@ -1856,6 +1856,15 @@ setMethod(
 
         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
+          turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)[order(turtlesVarUnique)]] # levels in the order of the unique old levels numbers
+          turtles@levels[[var]] <- turtlesLevelsVarUpdated
+          turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique, to = rank(turtlesVarUnique)) # replace the levels number starting to 1 and increasing by 1
+          turtles@.Data[,var] <- turtlesVarUpdated
+
           if (identical(agents, turtles)) {
             turtles[,var] <- as.character(val)
 
@@ -1887,6 +1896,16 @@ setMethod(
 
         if (length(var_levels) != 0) {
           if (length(var_levels) == 1) {
+
+            # Update the levels as some may have disapeared
+            turtlesLevelsVar <- turtles@levels[[var[var_levels]]] # old levels
+            turtlesVar <- turtles@.Data[,var[var_levels]] # old levels number
+            turtlesVarUnique <- unique(turtlesVar) # unique old levels numbers
+            turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)[order(turtlesVarUnique)]] # levels in the order of the unique old levels numbers
+            turtles@levels[[var[var_levels]]] <- turtlesLevelsVarUpdated
+            turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique, to = rank(turtlesVarUnique)) # replace the levels number starting to 1 and increasing by 1
+            turtles@.Data[,var[var_levels]] <- turtlesVarUpdated
+
             if (identical(agents, turtles)) {
               turtles[,var[var_levels]] <- as.character(val[,var_levels])
 
@@ -1895,17 +1914,38 @@ setMethod(
               iAgents <- match(agents@.Data[,"who"], turtles@.Data[,"who"])
               turtles[iAgents,var[var_levels]] <- as.character(val[,var_levels])
             }
+
           } else {
 
             if (identical(agents, turtles)) {
 
               for(i in var_levels) {
+
+                # 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
+                turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)[order(turtlesVarUnique)]] # levels in the order of the unique old levels numbers
+                turtles@levels[[var[i]]] <- turtlesLevelsVarUpdated
+                turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique, to = rank(turtlesVarUnique)) # replace the levels number starting to 1 and increasing by 1
+                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 var_levels) {
+
+                # 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
+                turtlesLevelsVarUpdated <- turtlesLevelsVar[unique(turtlesVar)[order(turtlesVarUnique)]] # levels in the order of the unique old levels numbers
+                turtles@levels[[var[i]]] <- turtlesLevelsVarUpdated
+                turtlesVarUpdated <- mapvalues(x = turtlesVar, from = turtlesVarUnique, to = rank(turtlesVarUnique)) # replace the levels number starting to 1 and increasing by 1
+                turtles@.Data[,var[i]] <- turtlesVarUpdated
+
                 turtles[iAgents,var[i]] <- as.character(val[,i])
               }
             }

R/turtle-functions.R

@@ -1835,6 +1835,10 @@ setMethod(
 #'          is provided, a new agentMatrix is created and the who numbers
 #'          start at 0.
 #'
+#'          If \code{turtles} is provided and had additional variables created
+#'          with \code{turtlesOwn()}, \code{NA} is given for these variables
+#'          for the new sprouted turtles.
+#'
 #' @seealso \url{https://ccl.northwestern.edu/netlogo/docs/dictionary.html#sprout}
 #'
 #' @references Wilensky, U. 1999. NetLogo. http://ccl.northwestern.edu/netlogo/.
@@ -1927,15 +1931,32 @@ setMethod(
     if (missing(turtles)) {
       return(newTurtles)
     } else {
-      newTurtles@.Data[,"who"] <- (max(turtles@.Data[,"who"]) + 1):(NLcount(newTurtles) +
-                                                                      max(turtles@.Data[,"who"]))
-      # unique who number
-      newTurtlesBreed <- of(agents = newTurtles, var = "breed")
-      newTurtlesColor <- of(agents = newTurtles, var = "color")
 
-      turtles@.Data <- rbind(turtles@.Data, newTurtles@.Data)
-      turtles <- NLset(turtles = turtles, agents = newTurtles, var = "breed", val = newTurtlesBreed)
-      turtles <- NLset(turtles = turtles, agents = newTurtles, var = "color", val = newTurtlesColor)
+      turtles <- hatch(turtles = turtles, who = max(turtles@.Data[,"who"]), n = NLcount(newTurtles))
+      # Replace the locations and headings of newTurtles inside turtles
+      turtles@.Data[(nrow(turtles@.Data) - NLcount(newTurtles) + 1):nrow(turtles@.Data), c(1,2,4)] <- newTurtles@.Data[,c(1,2,4)]
+      # Replace the breed and color of the newTurtles inside turtles
+      whoNewTurtles <- turtles@.Data[(nrow(turtles@.Data) - NLcount(newTurtles) + 1):nrow(turtles@.Data), 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)
+      }
+
+      # newTurtles@.Data[,"who"] <- (max(turtles@.Data[,"who"]) + 1):(NLcount(newTurtles) +
+      #                                                                 max(turtles@.Data[,"who"]))
+      # # unique who number
+      # newTurtlesBreed <- of(agents = newTurtles, var = "breed")
+      # newTurtlesColor <- of(agents = newTurtles, var = "color")
+      #
+      # turtles@.Data <- rbind(turtles@.Data, newTurtles@.Data)
+      # turtles <- NLset(turtles = turtles, agents = newTurtles, var = "breed", val = newTurtlesBreed)
+      # turtles <- NLset(turtles = turtles, agents = newTurtles, var = "color", val = newTurtlesColor)
 
       return(turtles)
     }
@@ -2995,7 +3016,7 @@ setMethod(
                                                 lapply(which(wh), function(w)
             agents@levels[[var[w]]][agents@.Data[,var[w]]])))
         if (!all(wh))  {
-          df <- data.frame(agents@.Data[,var[!wh]], df)
+          df <- data.frame(agents@.Data[,var[!wh], drop = FALSE], df)
           newNames <- c(var[!wh],newNames)
         }
         colnames(df) <- newNames