tests/testthat/test-sfnetworks.R

In tinyVAST: Multivariate Spatio-Temporal Models using Structural Equations

test_that("Basic sfnetworks works", {
  library(sf)
  library(sfnetworks)
  set.seed(101)

  stream <- st_read( file.path(system.file("stream_network",package="tinyVAST"),
                    "East_Fork_Lewis_basin.shp"), quiet=TRUE )

  suppressWarnings({stream = as_sfnetwork(stream)})

  # Rescale
  graph = sfnetwork_mesh( stream )
  graph$table$dist = graph$table$dist / 1000  # Convert distance scale
  graph$Dist_ss = graph$Dist_ss / 1000

  # Parameters
  alpha = 2
  kappa = 0.05

  # simulate
  omega_s = simulate_sfnetwork( n=1, sfnetwork_mesh=graph, theta=kappa)[,1]

  # sample locations along network
  extrap = st_union( st_line_sample( activate(stream,"edges"), density=1/10000))
  extrap = st_cast( extrap, "POINT" )

  # Project to sampled locations
  A_is = sfnetwork_evaluator( stream = graph$stream,
                                 loc = st_coordinates(extrap) )
  omega_i = (A_is %*% omega_s)[,1]

  # Simulate sampling
  #Count = rpois( n=graph$n, lambda=exp(alpha + omega) )
  Count_i = rnorm( n=length(omega_i), mean=alpha + omega_i, sd=0.5 )

  # Format into long-form data frame expected by tinyVAST
  Data = data.frame( Count = Count_i,
                     st_coordinates(extrap),
                     var = "species",  # Univariate model so only one value
                     time = "2020",    # no time-dynamics, so only one value
                     dist = "obs" )    # only one type of sampling in data

  # fit model
  out = tinyVAST( data = Data,
             formula = Count ~ 1,
             spatial_domain = graph,
             space_column = c("X","Y"),
             variable_column = "var",
             time_column = "time",
             distribution_column = "dist",
             space_term = "" )
  #expect_equal( out$opt$obj, 119.3909, tolerance=0.01 )
  expect_equal( out$opt$obj, 119.4153, tolerance=0.01 )   # AFTER FIXING BUG in v1.1.0

  #
  integrate_output( out,
                    newdata = Data,
                    bias.correct = TRUE )
  integrate_output( out,
                    newdata = Data,
                    bias.correct = FALSE,
                    apply.epsilon = TRUE,
                    intern = TRUE )

  # Check OU precision
  theta = exp(out$internal$parlist$log_kappa)
  edges = activate(stream,"edges")
  Dist_ss = igraph::distances( edges, weights = sf::st_length(edges)  / 1000 )
  V_ss = 1 / (2*theta) * exp( -theta * Dist_ss )
  Q_ss = Matrix::Matrix(zapsmall(solve(V_ss)))
  # Compare
  Q2_ss = out$rep$Q_ss * exp(out$rep$log_tau)^2
  diff_z = (Q_ss - Q2_ss)@x
  expect_equal( diff_z, rep(0,length(diff_z)), tolerance = 0.001 )
})