tests/testthat/test_calcMC.R

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

library(MigConnectivity)
context('Calculate migratory connectivity strength')

test_that('psi examples generate right MC values', {
  psiMats <- list(matrix(0.25, 4, 4), #"Full Mix"
                matrix(c(rep(0.32, 12), rep(0.04, 4)), 4, 4), #"Avoid One Site"
                diag(nrow=4),  #"Full Connectivity"
                matrix(c(rep(c(0.5, 0), 2, each=2), rep(c(0, 0.5), 2, each=2)),
                       4, 4), #"Half Mix"
                matrix(c(0.55, 0.2, 0.15, 0.1, 0.1, 0.55, 0.2, 0.15, 0.15, 0.1,
                         0.55, 0.2, 0.2, 0.15, 0.1, 0.55), 4, 4, byrow=TRUE), #"Low"
                matrix(c(rep(c(0.75, 0.15, rep(0.05, 3)), 3), 0.75), 4, 4,
                       byrow=TRUE), #"Medium"
                matrix(c(rep(0.25, 12), rep(0, 3), 1), 4, 4, byrow=TRUE), #"Site Pref"
                matrix(c(0.01, 0.49, 0.49, 0.01, 0.49, 0.01, 0.01, 0.49, 0.49,
                         0.01, 0.01, 0.49, 0.01, 0.49, 0.49, 0.01), 4, 4,
                       byrow=TRUE)) #Negative
  psiMats[[6]][4, 1] <- 0.15
  nBreeding <- sapply(psiMats, nrow)
  nWintering <- sapply(psiMats, ncol)
  nScenarios <- length(psiMats)

  # Relative abundances
  breedingRelN <- breedingN <- vector("list", nScenarios)
  # Distances
  genericD <- matrix(c(0:3, 1, 0, 1, 2, 2, 1, 0, 1, 3:0), 4, 4)
  breedingD <- winteringD <- vector("list", nScenarios)
  for (i in 1:nScenarios) {
    breedingN[[i]] <- rep(10000, nBreeding[i])
    breedingRelN[[i]] <- breedingN[[i]] / sum(breedingN[[i]])
    breedingD[[i]] <- genericD[1:nBreeding[i], 1:nBreeding[i]]
    winteringD[[i]] <- genericD[1:nWintering[i], 1:nWintering[i]]
  }

  expect_equal(calcMC(originDist = breedingD[[1]], targetDist = winteringD[[1]],
                      originRelAbund = breedingRelN[[1]], psi = psiMats[[1]]),
               0)
  expect_equal(calcMC(originDist = breedingD[[2]], targetDist = winteringD[[2]],
                      originRelAbund = breedingRelN[[2]], psi = psiMats[[2]]),
               0)
  expect_equal(calcMC(originDist = breedingD[[3]], targetDist = winteringD[[3]],
                      originRelAbund = breedingRelN[[3]], psi = psiMats[[3]]),
               1)
  expect_equal(calcMC(originDist = breedingD[[4]], targetDist = winteringD[[4]],
                      originRelAbund = breedingRelN[[4]], psi = psiMats[[4]]),
               0.6)
  expect_equal(calcMC(originDist = breedingD[[5]], targetDist = winteringD[[5]],
                      originRelAbund = breedingRelN[[5]], psi = psiMats[[5]]),
               0.196)
  expect_equal(calcMC(originDist = breedingD[[6]], targetDist = winteringD[[6]],
                      originRelAbund = breedingRelN[[6]], psi = psiMats[[6]]),
               0.504)
  expect_equal(calcMC(originDist = breedingD[[7]], targetDist = winteringD[[7]],
                      originRelAbund = breedingRelN[[7]], psi = psiMats[[7]]),
               0.164144856)
  expect_equal(calcMC(originDist = breedingD[[8]], targetDist = winteringD[[8]],
                      originRelAbund = breedingRelN[[8]], psi = psiMats[[8]]),
               -6.656e-02)
  expect_equal(calcMC(originDist = breedingD[[1]], targetDist = winteringD[[1]],
                      originRelAbund = breedingRelN[[1]], psi = psiMats[[1]],
                      sampleSize = sum(breedingN[[1]])),
               -0.00004166944463)
})