simMove: Simulates position of birds by individual, season, year, and...

In SMBC-NZP/MigConnectivity: Estimate Migratory Connectivity for Migratory Animals

Simulates position of birds by individual, season, year, and month.

Description

Incorporates migratory connectivity, movement within season, and dispersal between seasons. Does not incorporate births or deaths.

Usage

simMove(
  breedingAbund,
  breedingDist,
  winteringDist,
  psi,
  nYears = 10,
  nMonths = 3,
  winMoveRate = 0,
  sumMoveRate = 0,
  winDispRate = 0,
  sumDispRate = 0,
  natalDispRate = 0,
  breedDispRate = 0,
  verbose = 0
)

Arguments

breedingAbund	Vector with number of birds to simulate starting at each breeding site.
breedingDist	Distances between the breeding sites. Symmetric matrix.
winteringDist	Distances between the wintering sites. Symmetric matrix.
psi	Transition probabilities between B origin and W target sites. A matrix with B rows and W columns where rows sum to 1.
nYears	Number of years to simulate movement.
nMonths	Number of months per breeding and wintering season.
winMoveRate	Within winter movement rate. Defaults to 0 (no movement).
sumMoveRate	Within summer movement rate. Defaults to 0 (no movement).
winDispRate	Between winter dispersal rate. Defaults to 0 (no dispersal).
sumDispRate	Between summer dispersal rate. Defaults to 0 (no dispersal). Setting this to a value above 0 is equivalent to setting both natal and breeding dispersal to that same value.
natalDispRate	Natal dispersal rate. Controls the movement of animals from their birthplace on their first return to the breeding grounds. Defaults to 0 (return to the birthplace for all).
breedDispRate	Breeding dispersal rate. Controls the movement of animals between breeding sites on spring migrations after the first. Defaults to 0 (return to the same breeding site each year).
verbose	If set to a value > 0, informs the user on the passage of years and seasons during the simulation. Defaults to 0 (no output during simulation).

Value

simMove returns a list with elements:

animalLoc

sum(breedingAbund) (number of animals) by 2 by nYears by nMonths array with the simulated locations of each animal in each month of each season (summer or winter) of each year. Values of cells are 1...B (first column) and 1...W (second column) where B is the number of breeding sites and W is the number of wintering sites.

breedDispMat

B by B matrix of probabilities of breeding dispersal between each pair of 1...B breeding sites. Direction is from row to column, so each row sums to 1.

natalDispMat

B by B matrix of probabilities of natal dispersal between each pair of 1...B breeding sites. Direction is from row to column, so each row sums to 1.

sumMoveMat

B by B matrix of probabilities of within season movement between each pair of 1...B breeding sites. Direction is from row to column, so each row sums to 1.

winDispMat

W by W matrix of probabilities of dispersal between each pair of 1...W nonbreeding sites. Direction is from row to column, so each row sums to 1.

winMoveMat

W by W matrix of probabilities of within season movement between each pair of 1...W nonbreeding sites. Direction is from row to column, so each row sums to 1.

References

Cohen, E. B., J. A. Hostetler, M. T. Hallworth, C. S. Rushing, T. S. Sillett, and P. P. Marra. 2018. Quantifying the strength of migratory connectivity. Methods in Ecology and Evolution 9: 513-524. \Sexpr[results=rd]{tools:::Rd_expr_doi("10.1111/2041-210X.12916")}

Examples

### Dispersal simulation ----
## Utility functions for use in simulations

# Simple approach to estimate psi matrix and MC from simulated (or real) data
# (doesn't include uncertainty).  Only uses one year for computation
calcPsiMC <- function(originDist, targetDist, originRelAbund, locations,
                      years = 1, months = 1, verbose=FALSE) {
  nOrigin <- nrow(originDist)
  nTarget <- nrow(targetDist)
  psiMat <- matrix(0, nOrigin, nTarget)
  nInd <- dim(locations)[1]
  nYears <- dim(locations)[3]
  nMonths <- dim(locations)[4]
  for (i in 1:nInd) {
    if (i %% 1000 == 0 && verbose) #
      cat("Individual", i, "of", nInd, "\n")
    originMat <- locations[i, 1, years, months]
    targetMat <- locations[i, 2, years, months]
    bIndices <- which(!is.na(originMat))
    wIndices <- which(!is.na(targetMat))
    if (length(bIndices) && length(wIndices))
      for (bi in bIndices)
        for (wi in wIndices)
          psiMat[originMat[bi], targetMat[wi]] <- psiMat[originMat[bi], targetMat[wi]] + 1
  }
  psiMat <- apply(psiMat, 2, "/", rowSums(psiMat))
  MC <- calcMC(originDist, targetDist, psi = psiMat,
               originRelAbund = originRelAbund, sampleSize = nInd)
  return(list(psi=psiMat, MC=MC))
}

## Simulation
originNames <- c("A", "B", "C")
nBreeding <- length(originNames) # Number of sites reduced for example speed
targetNames <- as.character(1:4)
nWintering <- length(targetNames)

psi <- matrix(c(0.5, 0.25, 0.15, 0.1,
                0.15, 0.4, 0.25, 0.2,
                0.1, 0.15, 0.2, 0.55), nBreeding, nWintering,
              TRUE, list(originNames, targetNames))
psi
breedingPos <- matrix(c(seq(-99, -93, 3),
                        rep(40, nBreeding)), nBreeding, 2)
winteringPos <- matrix(c(seq(-88, -82, 2),
                         rep(0, nWintering)), nWintering, 2)
breedingPos
winteringPos

breedDist <- distFromPos(breedingPos, 'ellipsoid')
nonbreedDist <- distFromPos(winteringPos, 'ellipsoid')

# Breeding Abundance
breedingN <- rep(50, nBreeding) # Reduced from 5000 for example speed
breedingRelN <- breedingN/sum(breedingN)


# Baseline strength of migratory connectivity

  MC <- calcMC(breedDist, nonbreedDist, breedingRelN, psi, sum(breedingN))
  round(MC, 4)

# Other basic simulation parameters

## Dispersal simulations---
set.seed(1516)
nYears <- 4 # Reduced from 15 for example speed
nMonths <- 2 # Each season, reduced from 4 for example speed
Drates <- c(0.04, 0.16) # Rates of dispersal, fewer for example speed


  birdLocDisp <- vector('list', length(Drates))
  Disp.df  <- data.frame(Year=rep(1:nYears, length(Drates)),
                         Rate=rep(Drates, each = nYears), MC = NA)
  for(i in 1:length(Drates)){
    cat('Dispersal Rate', Drates[i], '\n')
    birdLocDisp[[i]] <- simMove(breedingN, breedDist, nonbreedDist, psi, nYears,
                                nMonths, sumDispRate = Drates[i])
    for(j in 1:nYears){
      cat('\tYear', j, '\n')
      temp.results <- calcPsiMC(breedDist, nonbreedDist, breedingRelN,
                                   birdLocDisp[[i]]$animalLoc, years = j)
      Disp.df$MC[j + (i - 1) * nYears] <- temp.results$MC
    }
  } # end i loop

  Disp.df$Year <- Disp.df$Year - 1 #just run once!
  data.frame(Disp.df, roundMC = round(Disp.df$MC, 2),
             nearZero = Disp.df$MC < 0.01)

  # Convert dispersal rates to probabilities of dispersing at least certain
  # distance
  threshold <- 1000
  probFarDisp <- matrix(NA, nBreeding, length(Drates),
                        dimnames = list(NULL, Drates))
  for (i in 1:length(Drates)) {
    for (k in 1:nBreeding) {
      probFarDisp[k, i] <- sum(
        birdLocDisp[[i]]$natalDispMat[k, which(breedDist[k, ]>= threshold)])
    }
  }
  summary(probFarDisp)

  #plot results
  with(subset(Disp.df, Rate == 0.04),
       plot(Year, MC, "l", col = "blue", ylim = c(0, 0.3), lwd = 2))
  lines(Disp.df$Year[Disp.df$Rate==0.16], Disp.df$MC[Disp.df$Rate==0.16],
        col = "darkblue", lwd = 2)
  legend("bottomleft", legend = Drates, col = c("blue", "darkblue"), lty = 1,
         lwd = 2)

SMBC-NZP/MigConnectivity documentation built on March 26, 2024, 4:22 p.m.