knitr::opts_chunk$set(echo = TRUE) library(trajr)
# NOTE that I have to do some confusing chunk duplication so that I can use functions before printing their definitions
# Some colours DARKBLUE <- "#102050" MIDRED <- "#f82010" MIDBLUE <- "#2040b8" LIGHTBLUE <- "#60a0ff" # Return the coordinates of a point in a trajectory as vector. By default, it's the end point. trjPt <- function(trj, rowIdx = nrow(trj)) { as.numeric(trj[rowIdx, c(1, 2)]) } # Rotate pt around origin by angle rotatePt <- function(origin, pt, angle) { rm <- matrix(c(cos(angle), sin(angle), -sin(angle), cos(angle)), ncol = 2) npt <- as.numeric(t(pt) - origin) rm %*% npt + origin } # Generate a dataframe of points that lie along an arc arcPts <- function(radius = 1, startAngle = 0, endAngle = 2 * pi, cx = 0, cy = 0, numPts = 10) { angles <- seq(startAngle, endAngle, length.out = numPts) data.frame(x = cx + radius * cos(angles), y = cy + radius * sin(angles)) }
# Rotates trj around origin so that its starting point lies inside the boundary. # Uses a brute force algorithm to find the minimal rotation: simply tests lots # of potential rotations. # # @param origin The trajectory is rotated around this point. # @param trj The trajectory to be rotated. # @param boundary The region to stay inside. # @param inc Angular increment (in radians) of points to test. The first point # tested is inc, then -inc, then 2 * inc, 2 * -inc and so on. RotateToDeflect <- function(origin, trj, boundary, inc = pi / 90) { pt2 <- trjPt(trj, 1) # Starting point of trj # Find a rotation such that pt2 is inside the boundary angle <- findRotation(origin, pt2, inc) # Now rotate the whole trajectory around the origin point TrajRotate(trj, angle, origin = origin, relative = FALSE) } # This is the algorithm to find the minimal rotation angle. Simply generates # lots of angles, then tests them until a suitable angle is found findRotation <- function(pt1, pt2, inc) { for (alpha in seq(inc, pi, by = inc)) { # Rotate pt2 around pt1 by +- alpha npt2 <- rotatePt(pt1, pt2, alpha) # point.in.polygon returns 1 if the point is inside if (sp::point.in.polygon(npt2[1], npt2[2], boundary$x, boundary$y) == 1) return(alpha) npt2 <- rotatePt(pt1, pt2, -alpha) if (sp::point.in.polygon(npt2[1], npt2[2], boundary$x, boundary$y) == 1) return(-alpha) } stop("Cannot find suitable rotation") }
# Constrains a trajectory to the inside of a boundary, using a simple model of # behaviour which is: don't walk through walls. ConstrainTrajectory <- function(trj, boundary) { # Start adjusting the trajectory so it doesn't cross any walls. # Find the first crossing, and split into 2 parts l <- TrajSplitAtFirstCrossing(trj, boundary) # Now l is a list containing 2 trajectories (which we earlier referred to as t1 & t2). # Build up a list of rotated parts as we go parts <- list(l[[1]]) # When l has length 1, the remainder of the trajectory lies inside the boundary while (length(l) == 2) { # Rotate the section t2 about the last point in the previous section t2 <- RotateToDeflect(trjPt(l[[1]]), l[[2]], boundary) # Work out where the trajectory now crosses the boundary l <- TrajSplitAtFirstCrossing(t2, boundary) # Save the rotated section that's inside parts[[length(parts) + 1]] <- l[[1]] } # Put all the parts back together into a single trajectory TrajMerge(parts) }
trajr
provides some functionality to assist with simulating trajectories. Functions are provided to split and merge trajectories (TrajSplit
and TrajMerge
), to identify where a trajectory crosses an arbitrary polygon (TrajInPolygon
), and to split a trajectory where it first crosses a polygon (TrajSplitAtFirstCrossing
). trajr
does not attempt to model animal behaviours other than by generating random walks (i.e. the TrajGenerate
function). To use the TrajInPolygon
or TrajSplitAtFirstCrossing
functions, you must have the sp
package installed.
To demonstrate one way in which this functionality can be used, I will simulate a trajectory in a bounded space. Let's assume a very simple behaviour - that animals cannot walk through walls. Whenever a wall is encountered, the animal will turn by the smallest angle possible to allow it to continue walking. This behaviour is not part of the trajr
package, however the implementation is fully described in this vignette.
To implement the behaviour of not walking through walls, we must define the rules needed to create a constrained trajectory. Obviously, different behaviours would require different rules. The steps for our rules are:
o
, that lies outside the boundary. Let's name the last point inside the boundary i
(Fig 1B).o
: t1
ends at i
and lies wholly within the boundary; t2
starts at o
, so by definition, t2
starts outside the boundary (Fig 1C). The function TrajSplitAtFirstCrossing
performs steps 2 & 3.o
about i
such that o
lies within the boundary.t2
by $\alpha$ (Fig 1D).TrajMerge
performs this operation.par(mfrow = c(3, 2), mar = c(5, 4, 1, 2) + .1) boundary <- data.frame(x = c(-10, 10, 10, -10), y = c(-10, -10, 10, 10)) set.seed(1) trj <- TrajGenerate(n = 6, stepLength = 4, angularErrorSd = .4) xlim <- range(c(trj$x, boundary$x)) ylim <- range(c(trj$y, boundary$y)) # Step 1 plot(trj, xlim = xlim, ylim = ylim, col = DARKBLUE) polygon(boundary, border = "brown", lwd = 2) adj <- -.2 line <- -1 mtext("A", line = line, adj = adj) # Step 2 l <- TrajSplitAtFirstCrossing(trj, boundary) plot(trj, xlim = xlim, ylim = ylim, col = DARKBLUE) polygon(boundary, border = "brown", lwd = 2) pI <- trjPt(l[[1]]) pO <- trjPt(l[[2]], 1) points(pI[1], pI[2], pch = 4) text(pI[1], pI[2], "i", pos = 1, font = 4) points(pO[1], pO[2], pch = 4) text(pO[1], pO[2], "o", pos = 1, font = 4) mtext("B", line = line, adj = adj) # Step 3 plot(l[[1]], xlim = xlim, ylim = ylim, col = MIDRED, lwd = 2) lines(l[[2]], col = MIDBLUE) polygon(boundary, border = "brown", lwd = 2, lwd = 2) text(4, -.8, "t1", pos = 1, font = 4) text(18, -2.5, "t2", pos = 1, font = 4) mtext("C", line = line, adj = adj) # Step 4 angle <- findRotation(pI, pO, pi / 10) # Step 5 plot(l[[1]], xlim = xlim, ylim = ylim, col = MIDRED, lwd = 2) polygon(boundary, border = "brown", lwd = 2, lwd = 2) x <- sapply(seq(0, angle, length.out = 5), function(alpha) lines(TrajRotate(l[[2]], alpha, origin = pI, relative = FALSE), col = LIGHTBLUE, start.pt.cex = .6)) mtext("D", line = line, adj = adj) # Step 6 plot(l[[1]], xlim = range(boundary$x), ylim = range(boundary$y), col = MIDRED, lwd = 2) polygon(boundary, border = "brown", lwd = 2, lwd = 2) parts <- list(l[[1]]) while (length(l) == 2) { t2 <- RotateToDeflect(trjPt(l[[1]]), l[[2]], boundary) l <- TrajSplitAtFirstCrossing(t2, boundary) parts[[length(parts) + 1]] <- l[[1]] lines(l[[1]], start.pt.cex = 1.2) } mtext("E", line = line, adj = adj) # Step 7 plot(NULL, xlim = range(boundary$x), ylim = range(boundary$y), asp = 1) polygon(boundary, border = "brown", lwd = 2, lwd = 2) lines(TrajMerge(parts), col = DARKBLUE, lwd = 2) mtext("F", line = line, adj = adj)
To start, I will define some general purpose helper functions.
Here is a function to rotate a trajectory section so its starting point lies inside the boundary. This is the "decision-making" part of the modelled behaviour.
Now we will combine all of the work into a single function that adjusts a trajectory so it is constrained to the inside of a boundary.
Let's put it all together to simulate an animal walking in a circular arena.
# Circular arena boundary <- arcPts(100, 0, 2 * pi, numPts = 60) # Create a random trajectory set.seed(1) trj <- TrajGenerate(n = 5000, angularErrorSd = .14, spatialUnits = "mm") # Constrain it to the arena constrained <- ConstrainTrajectory(trj, boundary) plot(constrained, col = DARKBLUE) polygon(boundary, border = "brown", lwd = 2)
Creed & Miller (1990) used an hourglass shaped arena to test for active wall following, i.e. an animal deliberately stays next to the wall while walking. We can use the same shaped arena and a simulated trajectory to see whether random movement (i.e. not actively wall-following) can look like wall-following.
# Build an hourglass-shaped arena similar to Creed & Miller, (1990) hourglassArena <- function() { # Define lower-left quadrant shape c1 <- arcPts(30, pi, 1.5 * pi, -70, -30) c2 <- arcPts(30, 1.5 * pi, 1.9 * pi, -49, -30) c3 <- arcPts(20, .9 * pi, pi / 2, 0, -40) xs <- c(c1$x, c2$x, c3$x) ys <- c(c1$y, c2$y, c3$y) # Exploit the 2 axes of symmetry data.frame(x = c(xs, -rev(xs), -xs, rev(xs)), y = c(ys, rev(ys), -(ys), -rev(ys))) } boundary <- hourglassArena() # Create a random trajectory set.seed(2) trj <- TrajGenerate(n = 10000, stepLength = 2, angularErrorSd = .1, spatialUnits = "mm") # Constrain it to the arena constrained <- ConstrainTrajectory(trj, boundary) plot(constrained, col = DARKBLUE) polygon(boundary, border = "brown", lwd = 2)
If we plot a heatmap of the trajectory, we can visualise locations where the animal spends more time. Darker regions indicate areas visited more frequently, and lighter regions are less visited.
d <- MASS::kde2d(constrained$x, constrained$y, n = 300) par(mar = c(3, 2, 1, 1) + .1) image(d, asp = 1) polygon(boundary, border = "blue", lwd = 2)
Since the darker regions are generally adjacent to the walls, it appears that the trajectory is following the walls, even though we know there is no active wall-following behaviour. A close look at Figure 3. reveals that the trajectory generally leaves the wall at convex bends, suggesting (correctly) that there is no wall following behaviour occurring.
Creed, R. P., & Miller, J. R. (1990). Interpreting animal wall-following behavior. Experientia, 46(7), 758-761. \doi{10.1007/BF01939959}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.