example_src_generated.R

library(testthat)
library(wk)

src <- yaml::read_yaml("example/example_src.yaml")

# Check wk roundtrip to make sure we have valid WKT and that we have the WKT
# that is generated by most tools
for (item in src) {
  is_null <- vapply(item, is.null, logical(1))
  item[is_null] <- NA_character_
  item <- as.character(item)
  roundtrip <- wk_handle(wk::wkt(item), wkt_writer()) |> unclass()
  expect_equal(roundtrip, item)
}

# Generate the portion Z, M, and ZM versions of the WKT
make_z <- function(item) {
  is_null <- vapply(item, is.null, logical(1))
  item[is_null] <- NA_character_
  item <- wkt(item) |> wk_set_z(1)
  coords <- wk_coords(item)
  coords$z <- coords$x + coords$y
  wk_coords(item) <- coords
  item_lst <- item |> as.character() |> as.list()
  item_lst[vapply(item_lst, identical, logical(1), NA_character_)] <- list(NULL)
  item_lst
}

make_m <- function(item) {
  is_null <- vapply(item, is.null, logical(1))
  item[is_null] <- NA_character_
  item <- wkt(item) |> wk_set_m(1)
  coords <- wk_coords(item)
  coords$m <- coords$x * coords$y
  wk_coords(item) <- coords
  item_lst <- item |> as.character() |> as.list()
  item_lst[vapply(item_lst, identical, logical(1), NA_character_)] <- list(NULL)
  item_lst
}

make_zm <- function(item) {
  is_null <- vapply(item, is.null, logical(1))
  item[is_null] <- NA_character_
  item <- wkt(item) |> wk_set_z(1) |> wk_set_m(1)
  coords <- wk_coords(item)
  coords$z <- coords$x + coords$y
  coords$m <- coords$x * coords$y
  wk_coords(item) <- coords
  item_lst <- item |> as.character() |> as.list()
  item_lst[vapply(item_lst, identical, logical(1), NA_character_)] <- list(NULL)
  item_lst
}

src_z <- lapply(src, make_z)
names(src_z) <- paste0(names(src_z), "-z")
src_m <- lapply(src, make_m)
names(src_m) <- paste0(names(src_m), "-m")
src_zm <- lapply(src, make_zm)
names(src_zm) <- paste0(names(src_zm), "-zm")

out <- file("example/example_src_generated.yaml", "w")
writeLines("# generated by example_src_generated.R", out)
yaml::write_yaml(src_z, out)
yaml::write_yaml(src_m, out)
yaml::write_yaml(src_zm, out)
close(out)