h3jsr: Access Uber's H3 Library

context('Core H3 API')

test_that('is_valid returns correctly', {
  val1 <- is_valid(h3_address = '8abe8d12acaffff')
  val2 <- is_valid(h3_address = c('whereami', '8abe8d12acaffff'))
  val3 <- is_valid(h3_address = c('whereami', '8abe8d12acaffff'),
                   simple = FALSE)
  expect_equal(val1, TRUE)
  expect_equal(val2, c(FALSE, TRUE))
  expect_is(val3, 'data.frame')
  expect_is(val3$h3_address, 'character')
  expect_equal(val3$h3_valid, c(FALSE, TRUE))
})

test_that('is_pentagon returns correctly', {
  expect_error(is_pentagon(h3_address = 'whereami'))
  val1 <- is_pentagon(h3_address = '8abe8d12acaffff')
  val2 <- is_pentagon(h3_address = '8abe8d12acaffff', simple = FALSE)
  expect_equal(val1, FALSE)
  expect_is(val2, 'data.frame')
  expect_is(val2$h3_address, 'character')
  expect_equal(val2$h3_pentagon, FALSE)
  # note to self find the addy of a pentagon
})

# is_rc3
test_that('is_rc3 returns correctly', {
  expect_error(is_rc3(h3_address = 'whereami'))
  val1 <- is_rc3(h3_address = '8abe8d12acaffff')
  val2 <- is_rc3(h3_address = '8abe8d12acaffff', simple = FALSE)
  expect_equal(val1, FALSE)
  expect_is(val2, 'data.frame')
  expect_is(val2$h3_address, 'character')
  expect_equal(val2$h3_rc3, FALSE)
})

test_that('get_base_cell returns correctly', {
  expect_error(get_base_cell(h3_address = 'whereami'))
  val1 <- get_base_cell(h3_address = '8abe8d12acaffff')
  val2 <- get_base_cell(h3_address = '8abe8d12acaffff', simple = FALSE)
  expect_equal(val1, 95L)
  expect_is(val2, 'data.frame')
  expect_is(val2$h3_address, 'character')
  expect_equal(val2$h3_base_cell, 95L)
})

test_that('get_faces returns correctly', {
  expect_error(get_faces(h3_address = 'whereami'))
  val1 <- get_faces(h3_address = '8abe8d12acaffff')
  val2 <- get_faces(h3_address = '8abe8d12acaffff', simple = FALSE)
  expect_equal(val1, 15L)
  expect_is(val2, 'data.frame')
  expect_is(val2$h3_faces, 'list')
  expect_equal(val2$h3_faces[[1]], 15L)
})

test_that('get_pentagons returns correctly', {
  expect_error(get_pentagons(res = Inf))
  val1 <- get_pentagons(res = 8)
  val2 <- get_pentagons(res = c(8, 9), simple = FALSE)
  expect_is(val1, 'list')
  expect_is(val2, 'data.frame')
  expect_length(val1, 1L)
  expect_length(val1[[1]], 12L)
  expect_true("8808000001fffff" %in% val1[[1]])
  expect_is(val2$h3_pentagons, 'list')
  expect_length(val2$h3_pentagons, 2L)
  expect_length(val2$h3_pentagons[[1]], 12L)
})

test_that('get_res returns correctly', {
  expect_error(get_res(h3_address = 'whereami'))
  val1 <- get_res(h3_address = '8abe8d12acaffff')
  val2 <- get_res(h3_address = '8abe8d12acaffff', simple = FALSE)
  expect_equal(val1, 10L)
  expect_is(val2, 'data.frame')
  expect_is(val2$h3_address, 'character')
  expect_equal(val2$h3_res, 10L)
})

test_that('prep_for_pt2cell works consistently across methods', {
  # matrix method
  bth_mat <- matrix(c(153.023503, -27.468920), ncol = 2)
  bth_mat_m <- matrix(c(bth_mat, bth_mat, bth_mat),
                      ncol = 2, byrow = TRUE)
  val1 <- h3jsr:::prep_for_pt2cell(bth_mat)
  val2 <- h3jsr:::prep_for_pt2cell(bth_mat_m)
  expect_is(val1, 'matrix')
  expect_is(val2, 'matrix')
  expect_message(h3jsr:::prep_for_pt2cell(bth_mat))
  # df method
  bth_df <- as.data.frame(bth_mat)
  bth_df_m <-  as.data.frame(bth_mat_m)
  val3 <- h3jsr:::prep_for_pt2cell(bth_df)
  val4 <- h3jsr:::prep_for_pt2cell(bth_df_m)
  expect_equal(val1, val3)
  expect_equal(val2, val4)
  expect_message(h3jsr:::prep_for_pt2cell(bth_df))
  # sfg method
  bth_sfg <- sf::st_point(bth_mat)
  val5 <- h3jsr:::prep_for_pt2cell(bth_sfg)
  expect_equivalent(val1, val5) # dimnames, meh
  expect_message(h3jsr:::prep_for_pt2cell(bth_sfg))
  # sfc method
  bth_sfc   <- sf::st_sfc(bth_sfg, crs = 4326)
  bth_sfc_m <-
    sf::st_as_sfc(list(bth_sfg, bth_sfg, bth_sfg), crs = 4326)
  val6 <- h3jsr:::prep_for_pt2cell(bth_sfc)
  val7 <- h3jsr:::prep_for_pt2cell(bth_sfc_m)
  expect_equal(val5, val6)
  expect_equivalent(val2, val7) # dimnames
  bth_sfc2 <- sf::st_sfc(bth_sfg, crs = 4283)
  expect_message(h3jsr:::prep_for_pt2cell(bth_sfc2))
  # sf method
  bth_sf <- sf::st_sf('geometry' = bth_sfc)
  bth_sf_m <- sf::st_sf('geometry' = bth_sfc_m)
  val8 <- h3jsr:::prep_for_pt2cell(bth_sf)
  val9 <- h3jsr:::prep_for_pt2cell(bth_sf_m)
  expect_equal(val6, val8)
  expect_equal(val7, val9)
  bth_sf2 <- sf::st_sf('geometry' = bth_sfc2)
  expect_message(h3jsr:::prep_for_pt2cell(bth_sf2))
  # simple vector
  bth_vec <- c(153.023503, -27.468920)
  val10 <- h3jsr:::prep_for_pt2cell(bth_vec)
  expect_equal(val1, val10)
})

test_that('point_to_cell with various options', {
  bpts <- list(c(153.02350, -27.46892),
               c(153.02456, -27.47071),
               c(153.02245, -27.47078))
  bpts <- lapply(bpts, sf::st_point)
  bpts_sfc <- sf::st_sfc(bpts, crs = 4326)
  bpts_sf <- sf::st_sf('geometry' = bpts_sfc)
  # several points 1 res
  expect_error(point_to_cell(bpts_sfc, res = 25))
  val1 <- point_to_cell(bpts_sfc, res = 11)
  val2 <- point_to_cell(bpts_sfc, res = 11, simple = FALSE)
  expect_equal(val1[1], '8bbe8d12acadfff')
  expect_length(val1, 3)
  expect_is(val2, 'data.frame')
  expect_equal(nrow(val2), 3)
  # several points several res
  val3 <- point_to_cell(bpts_sfc, res = c(11,12))
  val4 <- point_to_cell(bpts_sfc, res = c(11,12), simple = FALSE)
  expect_identical(val3, val4)
  expect_identical(val2$h3_resolution_11, val3$h3_resolution_11,
                   val4$h3_resolution_11)
  # sf object with other attribs
  bpts_sf2 <- sf::st_sf('ID' = seq(length(bpts_sfc)),
                        'geometry' = bpts_sfc)
  val5 <-  point_to_cell(bpts_sf2, res = c(11,12), simple = FALSE)
  expect_is(val5, 'data.frame')
  expect_equal(nrow(val5), 3)
  expect_equal(names(val5), c('ID', 'h3_resolution_11', 'h3_resolution_12'))
  expect_equal(val5[[1]], c(1,2,3))
  # df with other attribs
  bpts_df2 <-
    as.data.frame(cbind(matrix(unlist(bpts_sfc),
                               ncol = 2, byrow = T), 'ID' = seq(3)))
  val6 <- point_to_cell(bpts_df2, res = c(11, 12), simple = FALSE)
  expect_equal(val5, val6)
})

test_that('cell_to_point returns an appropriate dataset', {
  expect_error(cell_to_point(h3_address = 'whereami'))
  val1 <- cell_to_point('8abe8d12acaffff')
  val2 <- cell_to_point('8abe8d12acaffff', simple = FALSE)
  expect_is(val1, 'sfc_POINT')
  expect_equal(val1, val2$geometry)
  # lock in in case underlying fn gets fixed
  expect_equal(val1[[1]][1], 153.0239032)
  expect_equal(val1[[1]][2], -27.46852938)
  expect_is(val2, 'sf')
  expect_equal(names(val2), c('h3_address', 'geometry'))
})

# cell_to_polygon
test_that('cell_to_polygon returns an appropriate dataset', {
  expect_error(cell_to_polygon(input = 'whereami'))
  val1 <- cell_to_polygon('8abe8d12acaffff')
  val2 <- cell_to_polygon('8abe8d12acaffff', simple = FALSE)
  # xy checks
  expect_equal(val1[[1]][[1]][1,1], 153.0245835)
  expect_equal(val1[[1]][[1]][1,2], -27.46896347)
  expect_is(val1, 'sfc_POLYGON')
  expect_is(val2, 'sf')
  expect_equal(as.character(sf::st_geometry_type(val2)), 'POLYGON')
  expect_identical(val1, val2$geometry)
  expect_equal(names(val2), c('h3_address', 'geometry'))
  expect_equal(sf::st_crs(val1)$epsg, 4326)
  # data frame inputs
  df <- data.frame('h3_resolution_7' = c('8abe8d12acaffff',
                                         '8abe8d12acaffff',
                                         '8abe8d12acaffff'),
                   'ID' = seq(3))
  val3 <- cell_to_polygon(df)
  expect_is(val3, 'sfc_POLYGON')
  expect_equal(as.character(sf::st_geometry_type(val3[[1]])), 'POLYGON')
  val4 <- cell_to_polygon(df, simple = FALSE)
  expect_is(val4, 'sf')
  expect_equal(val3, val4$geometry)
  expect_error(cell_to_polygon(df[ , c(2,1)], simple = FALSE))
})

test_that('get_res0 returns correctly', {
  res0 <- get_res0()
  expect_is(res0, 'character')
  expect_equal(length(res0), 122)
  expect_equal(res0[1], '8001fffffffffff')
})

# cell_to_splitlong
test_that('cell_to_splitlong returns correctly', {
  val1 <- cell_to_splitlong('8abe8d12acaffff')
  val2 <- cell_to_splitlong('8abe8d12acaffff', simple = FALSE)
  val3 <- cell_to_splitlong(c('86be8d12fffffff', '86be8d107ffffff', '86be8d127ffffff'))
  val4 <- cell_to_splitlong(c('86be8d12fffffff', '86be8d107ffffff', '86be8d127ffffff'), simple = FALSE)
  expect_is(val1, 'list')
  expect_is(val2, 'data.frame')
  expect_is(val3, 'list')
  expect_is(val4, 'data.frame')
  expect_length(val1, 1)
  expect_length(val1[[1]], 2)
  expect_equal(val1[[1]][1], 717946879)
  expect_equal(val1[[1]][2], 145483985)
  expect_equal(nrow(val2), 1)
  expect_equal(val1[[1]][1], val2$split_lower)
  expect_length(val3, 3)
  expect_length(val3[[2]], 2)
  expect_equal(val3[[1]][1], 805306367)
  expect_equal(val3[[3]][1], 671088639)
  expect_equal(nrow(val4), 3)
  expect_equal(val3[[1]][1], val4$split_lower[1])
  expect_equal(val3[[3]][1], val4$split_lower[3])
})

# splitlong_to_cell
test_that('splitlong_to_cell returns correctly', {
  val1 <- cell_to_splitlong('8abe8d12acaffff')
  val2 <- splitlong_to_cell(val1[[1]][1], val1[[1]][2])
  expect_error(splitlong_to_cell('8abe8d12acaffff'))
  expect_equal(val2, '8abe8d12acaffff')
})

# degs to rads
test_that('degs_to_rads returns correctly and consistently', {
  val1 <- degs_to_rads(120)
  val2 <- degs_to_rads(120, 'h3')
  expect_equal(val1, val2)
  expect_equal(val1, 2.094395102393195262636)
  expect_error(degs_to_rads(120, 'C++'))
})

test_that('rads_to_degs returns correctly and consistently', {
  val1 <- rads_to_degs(2.09)
  val2 <- rads_to_degs(2.09, 'h3')
  expect_equal(val1, val2)
  expect_equal(val1, 119.7481791823420564924)
  expect_error(rads_to_degs(2.09, 'C++'))
})

test_that('cell_to_childpos returns correctly', {
  val1 <- cell_to_childpos('872830b82ffffff', c(3,4,5,6))
  val2 <- cell_to_childpos('872830b82ffffff', c(3,4,5,6), simple = FALSE)
  expect_equal(val1, val2$child_pos)
  expect_equal(val1, c(2011, 296, 2, 2))
  expect_error(cell_to_childpos('872830b82ffffff', 8))
  expect_error(cell_to_childpos('lol', 8))
  expect_error(cell_to_childpos('872830b82ffffff', 25))
})

test_that('childpos_to_cell returns correctly', {
  val1 <- childpos_to_cell(0, '872830b82ffffff', 9)
  val2 <- childpos_to_cell(0, '872830b82ffffff', 9, simple = FALSE)
  expect_equal(val1, val2$child_cell)
  expect_equal(val1, '892830b8203ffff')
  expect_error(childpos_to_cell(0, '872830b82ffffff', 6))
  expect_error(childpos_to_cell(0, 'lol', 9))
  expect_error(childpos_to_cell(0, '872830b82ffffff', 25))
})

test_that('cell_to_children_size returns correctly', {
  val1 <- cell_to_children_size('872830b82ffffff', c(8,9,10,11))
  val2 <- cell_to_children_size('872830b82ffffff', c(8,9,10,11), simple = FALSE)
  expect_equal(val1, val2$child_size)
  expect_equal(val1, c(7, 49, 343, 2401))
  expect_error(cell_to_children_size('872830b82ffffff', 6))
  expect_error(cell_to_children_size('lol', 9))
  expect_error(cell_to_children_size('872830b82ffffff', 25))
})