add_polygon (and similar) crash using Rstudio when fill_colour is not blank on Windows about mapdeck HOT 46 OPEN

remotes::install_github("dcooley/geometries")
remotes::install_github("dcooley/sfheaders")
remotes::install_github("SymbolixAU/geojsonsf")
remotes::install_github("SymbolixAU/colourvalues")
remotes::install_github("SymbolixAU/spatialwidget")
remotes::install_github("SymbolixAU/mapdeck")

# remotes::install_github("dcooley/geometries")

library(Rcpp)

cppFunction(
  includes = '
    #include "geometries/geometries.hpp"
  ',
  code = '
    SEXP a_point( SEXP x ) {
      return geometries::matrix::to_geometry_matrix( x );
    }
  '
  , depends = "geometries"
)

a_point(1:3)

sfheaders:::rcpp_sfg_point(1:2, NULL, "XY")

js <- spatialwidget::widget_point( data = spatialwidget::widget_capitals, fill_colour = "country", legend = TRUE)

substr( js$data, 1, 200 )

l <- widget_polygon( widget_melbourne[1:2, ], fill_colour = "AREASQKM16", legend = F)
substr( l$data, 1, 200 )

remotes::install_github("dcooley/geometries")
remotes::install_github("dcooley/sfheaders")
remotes::install_github("SymbolixAU/spatialwidget")

js <- spatialwidget::widget_point( data = spatialwidget::widget_capitals, fill_colour = "country", legend = TRUE)

  n <- 5
  params <- list(fill_colour = "col1")
  df <- data.frame(col1 = 1:n)
  lst_params <- spatialwidget:::rcpp_construct_params(df, params)
  data <- df
  total_colours <- nrow( df )
  repeats <- 1L
  lst_defaults <- list(fill_colour = rep(1,5))

  colour_name <- "fill_colour"
  opacity_name <- "fill_colour"
  lst_legend <- list("stroke_colour" = TRUE)
  include_legend <- FALSE

  colour_format = "hex"

  res <- spatialwidget:::rcpp_resolve_colour(
    lst_params,
    params,
    data,
    lst_defaults,
    colour_name,
    opacity_name,
    lst_legend,
    include_legend,
    repeats,
    total_colours,
    colour_format
  )

df <- spatialwidget::widget_capitals
l <- list(fill_colour = "country")
res <- spatialwidget:::rcpp_construct_params(df, l)

## restart your R session
install.packages(c("geometries","sfheaders","colourvalues"))
install.packages("mapdeck")

  df <- spatialwidget::widget_capitals
  l <- list(fill_colour = "country", stroke_colour = "capital", legend = T)
  data_rows <- nrow( df )
  lst_defaults <- list(
    fill_colour = rep(1.0, data_rows)
    , stroke_colour = rep(1.0, data_rows)
  )

  layer_legend <- c("fill_colour","stroke_colour")
  parameter_exclusions <- c("legend","legend_options","palette","na_colour")

  res <- spatialwidget:::rcpp_params_to_data(
    df, l, lst_defaults, layer_legend, data_rows, parameter_exclusions,
    factors_as_string = TRUE
  )

  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))

  spatialwidget:::rcpp_construct_data( param_names, params, data_names, lst_defaults, data, data_rows )

# stroke_opacity stroke_colour stroke_width
# 1            100             1            3
# 2            100             2            3
# 3            100             3            3
# 4            100             4            3
# 5            100             5            3

df <- spatialwidget::widget_capitals
  l <- list(fill_colour = "country", stroke_colour = "capital", legend = T)
  p <- spatialwidget:::rcpp_construct_params( data = df, params = l)
  pn <- names( l )
  ll <- c("fill_colour","stroke_colour")

  spatialwidget:::rcpp_construct_legend_list(
    lst_params = p
    , params = l
    , param_names = pn
    , legend_types = ll
    )

# $fill_colour
# [1] TRUE
# 
# $stroke_colour
# [1] TRUE

  lst <- list(let = letters, vals = 1:5)
  new_lst <- spatialwidget:::rcpp_remove_list_elements(lst, "vals")

pp <- spatialwidget::widget_melbourne

mapdeck() %>%
  add_polygon(
    data = pp, 
    fill_colour = "SA2_NAME",
    fill_opacity = 1.0
  )

mapdeck() %>%
  add_polygon(
    data = pp, 
    #fill_colour = "SA2_NAME",
    fill_opacity = 0.2
  )

library(testthat)
library(spatialwidget)

n <- 5
  params <- list(fill_colour = "col1")
  df <- data.frame(col1 = 1:n)
  lst_params <- spatialwidget:::rcpp_construct_params(df, params)
  data <- df
  total_colours <- nrow( df )
  repeats <- 1L
  lst_defaults <- list(fill_colour = rep(1,5))

  colour_name <- "fill_colour"
  opacity_name <- "fill_colour"
  lst_legend <- list("stroke_colour" = TRUE)
  include_legend <- FALSE

  colour_format = "hex"

  res <- spatialwidget:::rcpp_resolve_colour(
    lst_params,
    params,
    data,
    lst_defaults,
    colour_name,
    opacity_name,
    lst_legend,
    include_legend,
    repeats,
    total_colours,
    colour_format
  )

expect_equal(
    res$defaults$fill_colour, colourvalues::colour_values(1:5, alpha = 1:5)
  )

n <- 5
  params <- list(fill_colour = "col1")
  df <- data.frame(col1 = 1:n)
  lst_params <- spatialwidget:::rcpp_construct_params(df, params)
  data <- df
  total_colours <- nrow( df )
  repeats <- 1L
  lst_defaults <- list(fill_colour = rep(1,5))

  colour_name <- "fill_colour"
  opacity_name <- "not_a_column_will_use_default"
  lst_legend <- list("stroke_colour" = TRUE)
  include_legend <- FALSE

  colour_format = "hex"

  res <- spatialwidget:::rcpp_resolve_colour(
    lst_params,
    params,
    data,
    lst_defaults,
    colour_name,
    opacity_name,
    lst_legend,
    include_legend,
    repeats,
    total_colours,
    colour_format
  )

expect_equal(
    res$defaults$fill_colour, colourvalues::colour_values(1:5)
  )

n <- 5
  params <- list(fill_colour = "col1")
  df <- data.frame(col1 = 1:n)
  lst_params <- spatialwidget:::rcpp_construct_params(df, params)
  data <- df
  total_colours <- nrow( df )
  repeats <- 1L
  lst_defaults <- list(fill_colour = rep(1,5))

  colour_name <- "fill_colour"
  opacity_name <- "fill_colour"
  lst_legend <- list("stroke_colour" = TRUE)
  include_legend <- FALSE

  colour_format = "rgb"

  res <- spatialwidget:::rcpp_resolve_colour(
    lst_params,
    params,
    data,
    lst_defaults,
    colour_name,
    opacity_name,
    lst_legend,
    include_legend,
    repeats,
    total_colours,
    colour_format
  )

expect_equal(
    res$defaults$fill_colour, colourvalues::colour_values_rgb(1:5, alpha = 1:5)
  )

 lst_params <- list(parameter = c("stroke_colour", "palette", "stroke_width"), parameter_type = c(), data_column_index = c() )
  params <- list(stroke_colour = "col1", palette = "mypalette", stroke_width = 3)
  expect_equal( spatialwidget:::rcpp_resolve_palette( lst_params, params ), "mypalette" )

  lst_params <- list(parameter = c("stroke_colour", "stroke_width"), parameter_type = c(), data_column_index = c() )
  params <- list(stroke_colour = "col1", stroke_width = 3)
  spatialwidget:::rcpp_resolve_palette( lst_params, params )
  expect_equal( spatialwidget:::rcpp_resolve_palette( lst_params, params ), "viridis" )


  res <- spatialwidget:::rcpp_colour_str_with_palette("viridis", letters, 255.0, "#808080FF", TRUE, "fill_colour" )
  col <- colourvalues::color_values(letters, summary = T)

  expect_equal( res$colours, col$colours )
  expect_equal( res$summary_colours, col$summary_colours )
  expect_equal( res$summary_values, col$summary_values )

  res <- spatialwidget:::rcpp_colour_num_with_palette("viridis", 1:26, 255.0, "#808080FF", TRUE, "fill_colour" )
  col <- colourvalues::color_values(1:26, n_summaries = 5, format = T)

  expect_equal( res$colours, col$colours )
  expect_equal( res$summary_colours, col$summary_colours )
  expect_equal( res$summary_values, col$summary_values )

  res <- spatialwidget:::rcpp_colour_num_with_palette("viridis", 1:26, 255.0, "#808080FF", TRUE, "fill_colour", 5)
  col <- colourvalues::color_values(1:26, n_summaries = 5, format = T, digits = 5)

  expect_equal( res$colours, col$colours )
  expect_equal( res$summary_colours, col$summary_colours )
  expect_equal( res$summary_values, col$summary_values )

library(Rcpp)

cppFunction(
  
  depends = c( "spatialwidget")
  , includes = c('#include "spatialwidget/utils/colour/colour.hpp"')
  , code = 'void testCString() {
  
    Rcpp::StringVector colour_vec = {"#FFFFFF"};
    Rcpp::String first_colour = colour_vec[0];
    if ( spatialwidget::utils::colour::is_hex( first_colour.get_cstring() ) ) {
      Rcpp::Rcout << "true" << std::endl;
    } else {
      Rcpp::Rcout << "false" << std::endl;
    }  
  }'
)

testCString()
# true