tests/testthat/test-lsw.R

In spatial-ews/spatialwarnings: Spatial Early Warning Signals of Ecosystem Degradation

# 
# Test the implementation of the LSW distribution
# 


test_that("LSW distribution works", { 
  
  cLSW <- function(r, mu) {
    x <- seq(0, 1.5, 0.01) * mu
    PDF <- dLSW(x, mu)
    CDF <- cumsum(PDF) / sum(PDF)
    y <- approx(x, CDF, r)[["y"]]
    
    return(y)
  }

  rs <- seq(0, 20, l = 512)
  mus <- seq(1, 10, l = 5)
  
  # Multiple values for mu is not supported
  expect_error({ 
    dLSW(rs, mus)
  })
  
  for ( mu in mus ) { 
    
    # Make sure log of dLSW is correct 
    logds <- log(dLSW(rs, mu))
    dslog <- dLSW(rs, mu, log = TRUE)
    
    # Compare only values where the log(p) is finite
    expect_true({ 
      all( na.omit(abs(logds[is.finite(logds)] - dslog[is.finite(logds)]))  < 1e-10 )
    })
    
    # Make sure pLSW works
    ps <- pLSW(rs, mu)
    psinv <- pLSW(rs, mu, lower.tail = FALSE)
    expect_true({ 
      all( abs(ps - ( 1 - psinv )) < 1e-10)
    })
    
    # 
    pslog <- pLSW(rs, mu, log.p = TRUE)
    diffs <- suppressWarnings({ 
      ifelse(!(ps > 0), 0, log(ps) - pslog)
    })
    expect_true({ 
      all( abs(diffs) < 1e-10)
    })
    
    # Compare with original functions. There is actually a pretty large difference, 
    # as the original one was quite approximate. We remove NAs that are returned 
    # by cLSW, and only compare values that can be compared.
    orig_ps <- cLSW(rs, mu)
    expect_true({ 
      all( na.omit(abs(ps - orig_ps)) < 0.1 )
    })
    
  }
  
})

test_that("LSW fitting recovers correct values", { 
  
  fits <- vapply(dda, function(m) { 
    LSW_fit(patchsizes(m))[["mu"]]
  }, numeric(1))
  
  # As tau increases, we expect mu to increase. This is a very light test that 
  # will only catch gross errors, but we are not able to produce random samples 
  # from LSW distrib, so we cannot do an in-depth test of the fitting. 
  cor <- cor.test(dda.pars[ ,"tau"], log(fits))[["estimate"]]
  expect_true({ 
    cor > 0
  })
  
})

test_that("LSW indicators produce consistent values", { 
  
  
  m <- list(diag(100)*rnorm(10), 
            diag(100)*rnorm(10))
  
  # Does not work with logical matrices
  expect_error({ 
    lsw_sews(m)
  })
  
  
  m <- dda[1:2]
  
  lapply(c(TRUE, FALSE), function(wrap) { 
    ic <- as.data.frame(lsw_sews(m, wrap = wrap))
    
    # Check that results are consistent with individual functions
    ic_ref <- unlist(lapply(m, function(mc) { 
      c(mean(mc), raw_patch_radii_skewness(mc, wrap = wrap), raw_lsw_aicw(mc, wrap = wrap)) 
    }))
    
    expect_true(
      all(abs(ic_ref - ic[ ,"value"]) < 1e-8)
    )
  })
  
})