tests/testthat/test-data_construction.R

In spatialwidget: Formats Spatial Data for Use in Htmlwidgets

context("data_construction.hpp")

test_that("data is constructed", {

  n <- 5
  lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
  params <- list(stroke_colour = "col1", stroke_width = 3)
  param_names <- lst_params[[ "parameter" ]]
  df <- data.frame(col1 = 1:n)
  data_names <- names( df )
  data <- df
  data_rows <- nrow( df )
  lst_defaults <- list(stroke_opacity = rep(100, n))

  ## when entering the 'construct_data' function, all the colours and palettes will have been sorted out
  res <- spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows )

  expect_true( nrow(res) == 5)
  ## names will be the 'params' + defaults
  expect_true( all(names(res) %in% c("stroke_opacity", "stroke_colour", "stroke_width")  ) )
})

test_that("invalid columns and parameters handled", {

  n <- 5
  lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
  params <- list(stroke_colour = "col1", fill_colour = "col2", stroke_width = 3)
  param_names <- lst_params[[ "parameter" ]]
  df <- data.frame(col1 = 1:n)
  data_names <- names( df )
  data <- df
  data_rows <- nrow( df )
  lst_defaults <- list(stroke_opacity = rep(100, n))

  ## when entering the 'construct_data' function, all the colours and palettes will have been sorted out
  expect_error(
    spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows ),
    "spatialwidget - unsuitable data object"
  )

  ## param_names is created from params, so they should alwys be teh same length
  ## Rcpp::StringVector param_names = params.names();
  n <- 5
  lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
  params <- list(stroke_width = 3)
  param_names <- lst_params[[ "parameter" ]]
  df <- data.frame(col1 = 1:n)
  data_names <- names( df )
  data <- df
  data_rows <- nrow( df )
  lst_defaults <- list()

  expect_error(
    spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows ),
    "spatialwidget - unsuitable data object"
  )

  # res <- spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows )
  # expect_true(ncol(res) == 1)
  # expect_true(names(res) == "stroke_colour")

  # n <- 5
  # lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
  # params <- list(stroke_colour = "col2", stroke_width = 3)
  # param_names <- lst_params[[ "parameter" ]]
  # df <- data.frame(col1 = 1:n)
  # data_names <- names( df )
  # data <- df
  # data_rows <- nrow( df )
  # lst_defaults <- list(stroke_opacity = rep(100, n))
  #
  # ## when entering the 'construct_data' function, all the colours and palettes will have been sorted out
  # expect_error(
  #   spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows )
  #   , "unknown column - col2"
  # )

})

test_that("parameters not supplied by user are ignored", {

  n <- 5
  lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
  params <- list(stroke_width = 3)
  param_names <- lst_params[[ "parameter" ]]
  df <- data.frame(col1 = 1:n)
  data_names <- names( df )
  data <- df
  data_rows <- nrow( df )
  lst_defaults <- list(stroke_opacity = rep(100, n))

  expect_error(
    spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows ),
    "spatialwidget - unsuitable data object"
  )

  # res <- spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows )
  # expect_true(ncol(res) == 2)
  # expect_true( all( names(res) %in% c("stroke_opacity", "stroke_width")))

})

test_that("input data remains unchanged", {


  df <- data.frame(lon = c(1,2,-5,0.3), lat = 1:4)

  spatialwidget::widget_point(
    data = df
    , lon = "lon"
    , lat = "lat"
    , fill_colour = "lon"
  )

  expect_true( all( df$lon == c(1,2,-5,0.3) ) )


  df <- data.frame(lon = c(1,2,-5,0.3), lat = 1:4, col = c("a","b","d","z"))

  spatialwidget::widget_point(
    data = df
    , lon = "lon"
    , lat = "lat"
    , fill_colour = "col"
  )

  expect_true( all( df$col == c("a","b","d","z") ) )


  df <- data.frame(lon = c(1,2,-5,0.3), lat = 1:4, col = seq(as.Date("2018-01-01"), as.Date("2018-01-04"), length.out = 4))

  spatialwidget::widget_point(
    data = df
    , lon = "lon"
    , lat = "lat"
    , fill_colour = "col"
  )

  expect_true( all( df$col == seq(as.Date("2018-01-01"), as.Date("2018-01-04"), length.out = 4) ) )

  df <- data.frame(lon = c(1,2,-5,0.3), lat = 1:4, col = seq(as.POSIXct("2018-01-01"), as.POSIXct("2018-01-04"), length.out = 4))

  spatialwidget::widget_point(
    data = df
    , lon = "lon"
    , lat = "lat"
    , fill_colour = "col"
  )

  expect_true( all( df$col == seq(as.POSIXct("2018-01-01"), as.POSIXct("2018-01-04"), length.out = 4) ) )

})


# test_that("factors are converted to strings", {
#
#   n <- 5
#   lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
#   params <- list(stroke_colour = "col1", stroke_width = 3)
#   param_names <- lst_params[[ "parameter" ]]
#   df <- data.frame(col1 = letters[1:n])
#   data_names <- names( df )
#   data <- df
#   data_rows <- nrow( df )
#   lst_defaults <- list(stroke_opacity = rep(100, n))
#
#   ## when entering the 'construct_data' function, all the colours and palettes will have been sorted out
#   res <- spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows )
#
#   expect_true( nrow(res) == 5)
#   ## names will be the 'params' + defaults
#   expect_true( all(names(res) %in% c("stroke_opacity", "stroke_colour", "stroke_width")  ) )
# })