tests/testthat/test_gdm.R

In txm676/mmSAR2: Fit and Compare Species-Area Relationship Models Using Multimodel Inference

context("gdm")
library(sars)

test_that("gdm functions return correct results", {
  data(galap)
  galap$t <- c(4, 1, 13, 16, 15, 2, 6, 4, 5, 11, 3, 9, 8, 10, 12, 7)
  data(aegean)
  
  ###matches with sar_power_
  g2 <- sars::gdm(galap, model = "power_area", mod_sel = TRUE)
  pow <- g2[[3]]
  pow_sars <- sar_power(galap)
  
  expect_equal(as.vector(round(pow_sars$par[2], 2)), 
               as.vector(round(pow$m$getPars()[2], 2)))
  expect_equal(as.vector(round(pow_sars$par[1], 1)), 
               as.vector(round(exp(pow$m$getPars()[1]), 1)))
  expect_equal(pow_sars$AIC, AIC(pow))
  expect_error(sars::gdm(aegean), "Not enough columns/variables to fit GDM")
  expect_error(sars::gdm(galap, start_vals = c(5,4,3,6)), 
               "start_vals should be a dataframe with 1 row and four columns")
  expect_error(sars::gdm(galap, model = "betap"), "provided model name not available")
  expect_error(sars::gdm(galap, mod_sel = "d"), 
               "mod_sel argument should be TRUE or FALSE")
  #matches with BAT values
 # BTP <- BAT::gdm(galap$s, area = galap$a, time = galap$t)
 # expect_equal(as.vector(round(BTP[3,3], 2)),
 #             as.vector(round(g2[[1]]$m$getAllPars()[3], 2)))
 # expect_equal(as.vector(round(BTP[3,4], 2)),
 #             as.vector(round(g2[[1]]$m$getAllPars()[4], 2)))
 # expect_equal(as.vector(round(BTP[3,2], 2)),
 #              as.vector(round(g2[[1]]$m$getAllPars()[2], 2)))
 #  
  #power_area_time matches
 g2b <- sars::gdm(galap, model = "power_area_time", mod_sel = TRUE)
 pow <- g2b[[3]]
 pow_sars <- sar_power(galap)
 
 expect_equal(as.vector(round(pow_sars$par[2], 2)), 
              as.vector(round(pow$m$getPars()[2], 2)))
 expect_equal(as.vector(round(pow_sars$par[1], 1)), 
              as.vector(round(exp(pow$m$getPars()[1]), 1)))
 expect_equal(pow_sars$AIC, AIC(pow))
 #matches with BAT values
 # expect_equal(as.vector(round(BTP[4,3], 2)),
 #              as.vector(round(g2b[[1]]$m$getAllPars()[3], 2)))
 # expect_equal(as.vector(round(BTP[4,4], 2)),
 #              as.vector(round(g2b[[1]]$m$getAllPars()[4], 2)))
 # expect_equal(as.vector(round(BTP[4,2], 2)),
 #              as.vector(round(g2b[[1]]$m$getAllPars()[2], 2)))
 # expect_equal(round(as.vector(round(BTP[4,5], 2)), 2), #R2
 #              as.vector(round(sars:::R2_gdm(g2b[[1]]), 2)))
 
 ###matches with sar_loga
  g3 <- sars::gdm(galap, model = "loga", mod_sel = TRUE)
  loga <- g3[[3]]
  loga_sars <- sar_loga(galap)
  
  expect_equal(as.vector(round(loga_sars$par[2], 2)), 
               as.vector(round(loga$m$getPars()[2], 2)))
  expect_equal(as.vector(round(loga_sars$par[1], 1)), 
               as.vector(round(loga$m$getPars()[1], 1)))
  expect_equal(loga_sars$AIC, AIC(loga))
  #matches with BAT values
# expect_equal(as.vector(round(BTP[2,3], 2)),
#             as.vector(round(g3[[1]]$m$getAllPars()[3], 2)))
# expect_equal(as.vector(round(BTP[2,4], 2)),
#              as.vector(round(g3[[1]]$m$getAllPars()[4], 2)))
#  expect_equal(as.vector(round(BTP[2,2], 2)),
#               as.vector(round(g3[[1]]$m$getAllPars()[2], 2)))
#  expect_equal(round(as.vector(round(BTP[2,5], 2)), 2), #R2
#               as.vector(round(sars:::R2_gdm(g3[[1]]), 2)))
 
  ###matches with sar_linear
  g4 <- sars::gdm(galap, model = "linear", mod_sel = TRUE)
  linear <- g4[[3]]
  lin_sars <- sar_linear(galap)
  
  expect_equal(as.vector(round(lin_sars$par[2], 2)), 
               as.vector(round(linear$m$getPars()[2], 2)))
  expect_equal(as.vector(round(lin_sars$par[1], 1)), 
               as.vector(round(linear$m$getPars()[1], 1)))
  expect_equal(lin_sars$AIC, AIC(linear))
  #matches with BAT values
# expect_equal(as.vector(round(BTP[1,3], 2)),
#              as.vector(round(g4[[1]]$m$getAllPars()[3], 2)))
#  expect_equal(as.vector(round(BTP[1,4], 2)),
#               as.vector(round(g4[[1]]$m$getAllPars()[4], 2)))
#  expect_equal(as.vector(round(BTP[1,2], 2)),
#               as.vector(round(g4[[1]]$m$getAllPars()[2], 2)))
  
  ###all model comparison matches with individual model fits
  g5 <- sars::gdm(galap, model = "all", mod_sel = FALSE)
  expect_equal(AIC(g4[[1]]), AIC(g5[[2]]))
  expect_equal(AIC(g2[[1]]), AIC(g5[[3]]))
  expect_equal(AICcmodavg::AICc(g3[[1]]), AICcmodavg::AICc(g5[[1]]))
  expect_equal(AICcmodavg::AICc(g2b[[1]]), AICcmodavg::AICc(g5[[4]]))
  #matches with BAT values (Delta AIC of linear (and _area_time) vs. power)
 #  expect_equal(round(AIC(g5[[2]]) - AIC(g5[[3]]), 2), round(BTP[1,7], 2))
 # expect_equal(round(AICcmodavg::AICc(g5[[2]]) - AICcmodavg::AICc(g5[[3]]), 2),
 #             round(BTP[1,9], 2))
 # expect_equal(round(AIC(g5[[4]]) - AIC(g5[[3]]), 2), round(BTP[4,7], 2))
 # expect_equal(round(AICcmodavg::AICc(g5[[4]]) - AICcmodavg::AICc(g5[[3]]), 2),
 #              round(BTP[4,9], 2))

  g5b <- sars::gdm(galap, model = "all", mod_sel = TRUE)
  expect_equal(length(g5b), 4)
  expect_equal(length(g5b[[4]]), 4)
  expect_equal(length(g5b[[2]]), 4)
  
  ###linear power version
  g6 <- sars::gdm(galap, model = "ATT2", mod_sel = TRUE)
  linP <- g6[[3]]
  lin_sars <- sar_loga(galap)
  
  expect_equal(as.vector(round(linP$coefficients[2], 2)), 
               as.vector(round(lin_sars$par[2], 2)))
  expect_equal(as.vector(round(linP$coefficients[1], 2)), 
               as.vector(round(lin_sars$par[1], 2)))
  
  g6b <- sars::gdm(galap, model = "ATT2", mod_sel = FALSE)
  expect_equal(class(g6b), c("gdm", "lm"))
  
  expect_error(sars::gdm(galap, model = "lin_pow", mod_sel = FALSE))
  
  g7 <- sars::gdm(galap, model = "ATT2", mod_sel = FALSE)
  expect_equal(round(g7$coefficients, 2), round(g6[[1]]$coefficients, 2))
  expect_equal(as.vector(round(g7$coefficients, 2)),
               c(-104.00, 14.35, 49.97, -2.84))
  
})