tests/testthat/test-colspace.R

library(pavo)
context('colspace')

test_that('Receptor orders/names', {
  data(flowers)

  # dichromat
  di <- sensmodel(c(440, 330))
  names(di) <- c('wl', 'l', 's')
  di.vis <- vismodel(flowers, visual = di)
  di.space <- colspace(di.vis)
  expect_equal(di.vis, di.space[, 2:1], check.attributes = FALSE)

  # trichromat
  tri <- sensmodel(c(550, 440, 330))
  names(tri) <- c('wl', 'l', 'm' ,'s')
  tri.vis <- vismodel(flowers, visual = tri)
  tri.space <- colspace(tri.vis)
  expect_equal(tri.vis, tri.space[, 3:1], check.attributes = FALSE)

  # tetrachromat
  tetra <- sensmodel(c(660, 550, 440, 330))
  names(tetra) <- c('wl', 'l', 'm', 's', 'u')
  tetra.vis <- vismodel(flowers, visual = tetra)
  tetra.space <- colspace(tetra.vis)
  expect_equal(tetra.vis, tetra.space[, 4:1], check.attributes = FALSE)

})

test_that("Relative quantum catches", {
  data(flowers)

  # dichromat
  di <- sensmodel(c(440, 330))
  names(di) <- c('wl', 'l', 's')

  di_vis <- vismodel(flowers, visual = di)
  di_vis_norel <- vismodel(flowers, visual = di, relative = FALSE)
  di_vis_noreldf <- as.data.frame(di_vis_norel)

  expect_warning(colspace(di_vis_norel), "not relative")
  expect_warning(colspace(di_vis_noreldf), "not relative")

  expect_equal(suppressWarnings(colspace(di_vis)), 
               suppressWarnings(colspace(di_vis_norel)))

  # trichromat
  tri <- sensmodel(c(550, 440, 330))
  names(tri) <- c('wl', 'l', 'm' ,'s')

  tri_vis <- vismodel(flowers, visual = tri)
  tri_vis_norel <- vismodel(flowers, visual = tri, relative = FALSE)
  tri_vis_noreldf <- as.data.frame(tri_vis_norel)

  expect_warning(colspace(tri_vis_norel), "not relative")
  expect_warning(colspace(tri_vis_noreldf), "not relative")

  expect_equal(suppressWarnings(colspace(tri_vis)), 
               suppressWarnings(colspace(tri_vis_norel)))
})

Try the pavo package in your browser

Any scripts or data that you put into this service are public.

pavo documentation built on July 16, 2018, 9:03 a.m.