tests/testthat/test-api.R

In colourvalues: Assigns Colours to Values

context("api")

test_that("hex api covered",{

  str_pal <- "viridis"
  mat_pal <- colourvalues::get_palette("viridis")
  int_mat_pal <- matrix( as.integer( mat_pal ), ncol = 4, byrow = TRUE )
  nv_mat_pal <- matrix( as.numeric( as.integer( mat_pal ) ), ncol = 4, byrow = T )
  unk_pal <- list()

  iv <- 1L:5L
  nv <- c(1.1,2.2,3.3,4.4,5.5)
  sv <- letters[1:5]
  lst <- list(1:5)
  lst_nv <- list(nv)
  fv <- as.factor( iv )
  lv <- c(FALSE, TRUE)

  alpha = 1L

  ## Teting numeric and int palettes reutrn same results
  res1 <- colourvalues:::rcpp_colour_values_hex(
    x = iv, palette = int_mat_pal, alpha = 255.0
  )
  res2 <- colourvalues:::rcpp_colour_values_hex(
    x = iv, palette = nv_mat_pal, alpha = 255.0
  )
  expect_equal( res1, res2 )

  expect_error(
    colourvalues:::rcpp_colour_values_hex(
      x = iv, palette = unk_pal, alpha = 255.0
    )
    , "colourvalues - Unknown palette type"
  )

  res_lst <- colourvalues:::rcpp_colour_values_hex(
    x = lst, palette = mat_pal, alpha = 255.0
  )

  res_iv <- colourvalues:::rcpp_colour_values_hex(
    x = iv, palette = mat_pal, alpha = 255.0
  )

  res_lv <- colourvalues:::rcpp_colour_values_hex(
    x = lv, palette = mat_pal, alpha = 255.0
  )

  expect_equal( res_lst[[1]], res_iv )
  expect_equal( res_lv, colourvalues::colour_values(1:2) )


  ## lists get summaries
  res_lst1 <- colourvalues:::rcpp_colour_values_hex(
    x = lst, palette = mat_pal, alpha = 255.0, n_summaries = 5, format = FALSE
  )

  res_lst2 <- colourvalues:::rcpp_colour_values_hex(
    x = list(letters[1:5]), palette = mat_pal, alpha = 255.0, n_summaries = 3, format = FALSE
  )

  res_lst3 <- colourvalues:::rcpp_colour_values_hex(
    x = list(letters[1:5]), palette = mat_pal, alpha = 255.0, n_summaries = 0, format = FALSE
  )

  expect_equal( res_lst1$summary_colours, res_lst2$summary_colours )
  expect_equal( res_lst1$colours, res_lst2$colours )
  expect_equal( res_lst1$colours, res_lst )
  expect_null( res_lst3$summary_values )

  res <- colourvalues:::rcpp_colour_values_hex(
    x = lst_nv, palette = mat_pal, alpha = 255.0, summary = TRUE, format = FALSE
  )

  res2 <- colourvalues:::rcpp_colour_values_hex(
    x = lst_nv, palette = str_pal, alpha = 255.0, n_summaries = 5, format = FALSE
  )

  expect_equal( res, res2 )

  expect_equal(
    res$colours[[1]]
    , colour_values(nv, n_summaries = 5, format = FALSE)$colours
  )

  expect_equal(
    res$summary_values
    , colour_values(nv, n_summaries = 5, format = FALSE)$summary_values
  )

  expect_equal(
    res$summary_colours
    , colour_values(nv, n_summaries = 5, format = FALSE)$summary_colours
  )
})

test_that("interleaved api covered",{

  str_pal <- "viridis"
  mat_pal <- colourvalues::get_palette("viridis")
  int_mat_pal <- matrix( as.integer( mat_pal ), ncol = 4, byrow = TRUE )
  nv_mat_pal <- matrix( as.numeric( as.integer( mat_pal ) ), ncol = 4, byrow = T )
  unk_pal <- list()

  iv <- 1L:5L
  nv <- c(1.1,2.2,3.3,4.4,5.5)
  sv <- letters[1:5]
  lst <- list(1:5)
  lst_nv <- list(nv)
  lst_iv <- list(1L:5L)
  lst_str <- list(letters[1:5])
  fv <- as.factor( iv )
  lv <- c(FALSE, TRUE)

  alpha = 1L

  res1 <- colourvalues:::rcpp_colour_values_rgb_interleaved(
    x = lst_nv
    , palette = nv_mat_pal
    , alpha = alpha
    , repeats = 1
    , total_colours = 5
    , summary = TRUE
  )

  res2 <- colourvalues:::rcpp_colour_values_rgb_interleaved(
    x = lst_str
    , palette = nv_mat_pal
    , alpha = alpha
    , repeats = 1
    , total_colours = 5
    , n_summaries = 5
  )

  expect_equal( res1$colours, res2$colours )
  expect_equal( res1$summary_colours, res2$summary_colours )


  res1 <- colourvalues:::rcpp_colour_values_rgb_interleaved(
    x = lst_nv
    , palette = str_pal
    , alpha = alpha
    , repeats = 1
    , total_colours = 5
    , summary = TRUE
  )

  res2 <- colourvalues:::rcpp_colour_values_rgb_interleaved(
    x = lst_str
    , palette = str_pal
    , alpha = alpha
    , repeats = 1
    , total_colours = 5
    , n_summaries = 5
  )

  res3 <- colourvalues:::rcpp_colour_values_rgb_interleaved(
    x = lst_iv
    , palette = str_pal
    , alpha = alpha
    , repeats = 1
    , total_colours = 5
    , n_summaries = 5
  )

  expect_equal( res1$colours, res2$colours )
  expect_equal( res1$summary_colours, res2$summary_colours )

  expect_equal( res1$colours, res3$colours )
  expect_equal( res1$summary_colours, res3$summary_colours )

})