improved div pal interwing distance

R/c4a_gui.R

@@ -52,7 +52,7 @@ c4a_gui = function(type = "cat", n = NA, series = "all") {
 	ani_off = shiny::icon("circle-xmark", "fa-2x fa-solid", verify_fa = FALSE)
 	ani_on = shiny::icon("circle-info", "fa-2x fa-light", verify_fa = FALSE)
 
-	if (!check_installed_packages(c("shiny", "shinyjs", "kableExtra", "colorblindcheck"))) return(invisible(NULL))
+	if (!check_installed_packages(c("shiny", "shinyjs", "kableExtra", "colorblindcheck", "plotly"))) return(invisible(NULL))
 
 
 	shiny::addResourcePath(prefix = "imgResources", directoryPath = system.file("img", package = "cols4all"))
@@ -302,25 +302,20 @@ c4a_gui = function(type = "cat", n = NA, series = "all") {
 							shiny::fluidRow(
 								shiny::column(width = 12,
 											  shiny::selectizeInput("CLPal", "Palette", choices = init_pal_list))),
+							shiny::fluidRow(
+								shiny::column(width = 4,
+											  infoBoxUI(title = "HCL space"),
+											  shiny::sliderInput("rangeH", min = 0, max = 360, value = c(0, 360), step = 10, label = "Hue"),
+											  shiny::sliderInput("rangeC", min = 0, max = 180, value = c(0, 180), step = 10, label = "Chroma"),
+											  shiny::sliderInput("rangeL", min = 0, max = 100, value = c(0, 100), step = 10, label = "Luminance"),
+											  shiny::checkboxInput("hclspacepal", "Palette colors", FALSE)),
+								shiny::column(width = 8,
+											  plotly::plotlyOutput("hclspace", height = "600px"))
+											  ),
 							shiny::fluidRow(
 								shiny::column(width = 6,
 											  infoBoxUI("infoHUE", "Hue necklace"),
-											  plotOverlay("anaHUE", width = "400px", height = "400px", "aniHUE")),
-								shiny::column(width = 3,
-											  infoBoxUI(title = "HCL space"),
-											  shiny::img(src = "imgResources/hcl_spacex1.png", srcset = "imgResources/hcl_spacex1.png 1x, imgResources/hcl_spacex2.png 2x"),
-											  shiny::markdown("
-															**Dimensions**
-
-															Hue - in degrees (0 to 360)
-
-															Luminance - 0 (black) to 100 (white)
-
-															Chroma - 0 (grayscale) to max, which depends on H and L (see right-hand side)
-															")),
-								shiny::column(width = 3,
-											  infoBoxUI(title = "Maximum Chroma"),
-											  shiny::img(src = "imgResources/max_chromax1.png", srcset = "imgResources/max_chromax2.png 1x, imgResources/max_chromax2.png 2x"))),
+											  plotOverlay("anaHUE", width = "400px", height = "400px", "aniHUE"))),
 							shiny::fluidRow(
 								shiny::column(width = 6,
 											  infoBoxUI("infoCL", "Chroma-Luminance"),
@@ -645,7 +640,7 @@ c4a_gui = function(type = "cat", n = NA, series = "all") {
 
 		output$nbivUI = shiny::renderUI({
 			type = get_type12()
-			shiny::sliderInput("nbiv", "Number of columns", min = 3, max = ifelse(type == "bivc", 10, 7), value = 3, ticks = FALSE)
+			shiny::sliderInput("nbiv", "Number of columns", min = 2, max = ifelse(type == "bivc", 10, 7), value = 3, ticks = FALSE)
 		})
 
 		output$filtersUI = shiny::renderUI({
@@ -1146,6 +1141,22 @@ c4a_gui = function(type = "cat", n = NA, series = "all") {
 		## HCL analysis tab
 		#############################
 
+		output$hclspace = plotly::renderPlotly({
+
+			Hr = input$rangeH
+			Cr = input$rangeC
+			Lr = input$rangeL
+
+
+			pal = if (input$hclspacepal) {
+				tab_vals$pal
+			} else NULL
+			c4a_plot_hcl_space(Hmin = Hr[1], Hmax = Hr[2],
+							   Cmin = Cr[1], Cmax = Cr[2],
+							   Lmin = Lr[1], Lmax = Lr[2],
+							   colors = pal)
+		})
+
 
 		output$anaHUE = shiny::renderPlot({
 			if (!length(tab_vals$pal)) return(NULL)

R/c4a_palettes.R

@@ -12,7 +12,7 @@
 #' @rdname c4a_palettes
 #' @name c4a_palettes
 #' @export
-c4a_palettes = function(type = c("all", "cat", "seq", "div", "cyc"), series = NULL, full.names = TRUE) {
+c4a_palettes = function(type = c("all", "cat", "seq", "div", "cyc", "bivs", "bivc", "bivd", "bivg"), series = NULL, full.names = TRUE) {
 	type = match.arg(type)
 	z = .C4A$z
 	if (is.null(z)) {

R/c4a_table.R

@@ -146,7 +146,8 @@ prep_table = function(type = c("cat", "seq", "div", "cyc", "bivs", "bivc", "bivd
 	zn$nlines = ((zn$n * m -1) %/% columns) + 1
 
 	if (substr(type, 1, 3) == "biv") {
-		zn$palette = lapply(zn$palette, function(p) as.vector(t(p[nrow(p):1L,])))
+		#zn$palette = lapply(zn$palette, function(p) as.vector(t(p[nrow(p):1L,])))
+		zn$palette = lapply(zn$palette, function(p) as.vector(t(p)))
 	}
 	list(zn = zn, n = n, m = m, columns = columns, type = type, qn = qn, ql = ql)
 }
@@ -440,7 +441,6 @@ plot_table = function(p, text.format, text.col, include.na, cvd.sim, verbose) {
 #'
 #' @param type type of palette. Run \code{\link{c4a_types}} to see the implemented types and their description. For `c4a_gui` it only determines which type is shown initially.
 #' @param n,m `n` is the number of displayed colors. For bivariate palettes `"biv"`, `n` and `m` are the number of columns and rows respectively. If omitted: for `"cat"` the full palette is displayed, for `"seq"` and `"div"`, 9 colors, and for `"bivs"`/`"bivc"`/`"bivd"`/`"bivg"` 4 columns and rows. For `c4a_gui` it only determines which number of colors initially.
-#' @param n.only should only palettes be contained that have exactly `n.only` colors (`FALSE` by default)
 #' @param filters filters to be applied. A character vector with a subset from:`"nmax"` (only palettes where `n = nmax`, which is only applicable for categorical palettes),  `"cbf"` (colorblind-friendly), `"fair"` (fairness),`"naming"` (nameability),  `"crW"` (sufficient contrast ratio with white), and `"crB"` (sufficient contrast ratio with black). By default an empty vector, so no filters are applied.
 #' @param cvd.sim color vision deficiency simulation: one of `"none"`, `"deutan"`, `"protan"`, `"tritan"`
 #' @param sort column name to sort the data. The available column names depend on the arguments `type` and `show.scores`. They are listed in the warning message. Use a `"-"` prefix to reverse the order.

R/check_pals.R

@@ -11,16 +11,35 @@ check_div_pal = function(p) {
 	nh = floor(n/2)
 
 	# needed for inter_wing_dist
-	p2 = c(rampPal(p[1:nh], 9), rampPal(p[(nh+1+(!is_even)):n], 9))
-	n2 = 18
-	nh2 = n2 / 2
+
+	# 1 2 3 4 5 6 7
+	# create two wings of n2/2
+	n2 = 50
+	p2 = c(rampPal(p[1:(nh+1) ], n2/2), rampPal(p[(nh+(!is_even)):n], n2/2))
+
+	# left wing: 1...nh1_scaled, right wing nh2_scaled ... n2
+	nh1 = (n - is_even) / 2
+	nh2 = nh1 + 1 + is_even
+
+
+	nh1b = floor(nh1)
+	nh2b = ceiling(nh2)
+
+	scale = function(id) ((id - 1) / (n - 1)) * (n2 - 1) + 1
+
+	nh1_scaled = floor(scale(nh1))
+	nh2_scaled = ceiling(scale(nh2))
+
+	nh1b_scaled = floor(scale(nh1b))
+	nh2b_scaled = ceiling(scale(nh2b))
 
 	cvds = c("deutan", "protan", "tritan")
 
 	scores = t(sapply(cvds, function(cvd) {
 		inter_wing_dist = local({
 			dm = get_dist_matrix(p2, cvd = cvd)
-			min(dm[1:nh2, (nh2+1):n2])
+			min(dm[1:nh1b_scaled, nh2_scaled:n2])
+			min(dm[1:nh1_scaled, nh2b_scaled:n2])
 		})
 
 		min_step_size = local({

build/build_data.R

@@ -124,6 +124,53 @@ rdata = c(rdata, local({
 
 	list(lines.x = x,
 		 lines.s = s)
+}), local({
+	require(colorspace)
+	require(volcano3D) # for polar grid
+
+	add_coords2= function(df, width = 180) {
+		df = within(df, {
+			x = sin(H / 180 * pi) * (C / 180) * width
+			y = cos(H / 180 * pi) * (C / 180) * width
+		})
+	}
+
+	hdf_all = expand.grid(H = seq(0, 360, by = 1),
+						  L = seq(0, 100, by = 0.5),
+						  Crel = seq(0, 1, by = 0.05))
+	hdf_all$Cmax = colorspace::max_chroma(h = hdf_all$H, l = hdf_all$L)
+	hdf_all$C = hdf_all$Crel * hdf_all$Cmax
+	hdf_all$hex = hcl(hdf_all$H, hdf_all$C, hdf_all$L)
+
+	hdf_all = hdf_all[!duplicated(hdf_all$hex), ]
+
+	hdf_all$prob = ifelse(hdf_all$C == hdf_all$Cmax, 0.8, 0.01)
+
+
+	rgb_extremes = c("#FF0000", "#00FF00", "#0000FF")
+	hcl_extremes = as.data.frame((hex2RGB(rgb_extremes) |> as("polarLUV"))@coords)[,3:1]
+	hcl_extremes2 = data.frame(H = hcl_extremes$H,
+							   L = hcl_extremes$L,
+							   Crel = 1,
+							   Cmax = hcl_extremes$C,
+							   C = hcl_extremes$C,
+							   hex = rgb_extremes,
+							   prob = 1e15)
+	hdf_all = rbind(hcl_extremes2, hdf_all)
+
+
+	hdf_all = add_coords2(hdf_all)
+	hdf_all$text = paste0(hdf_all$hex, "\n", "H ", round(hdf_all$H), ", C ", round(hdf_all$C), ", L ", round(hdf_all$L))
+
+
+	hdf = hdf_all[sample(nrow(hdf_all),10000, prob = hdf_all$prob),]
+	hdf_pg = polar_grid(r_axis_ticks = c(0, 45, 90, 135, 180),#seq(0, 180, by = 45),
+						z_axis_ticks = seq(0, 100, by = 20))
+
+
+	list(hdf = hdf,
+		 hdf_pg = hdf_pg )
+
 }))
 
 

build/build_palettes.R

@@ -689,8 +689,8 @@ local({
 	divc = list(winter_biv = tab_cat$Winter)
 	c4a_load(c4a_data(divc, types = "bivc", series = "tableau", biv.method = "bycol5"))
 
-	divc2 = list('20_div' = tab_cat$'20',
-				classic20_div = tab_cat$'Classic 20')
+	divc2 = list('20_biv' = tab_cat$'20',
+				classic20_biv = tab_cat$'Classic 20')
 	c4a_load(c4a_data(divc2, types = "bivc", series = "tableau", biv.method = "bycol10"))
 
 })
@@ -773,8 +773,8 @@ local({
 ########################################################################################
 #c4a_palettes_remove(series = "c4a")
 local({
-	bu2 = c4a("hcl.blues3", n = 5, range = c(0.3, 0.8))
-	yl_rd = c4a("hcl.red_yellow", n = 5, range = c(0.3, 0.8))
+	bu2 = c4a("-hcl.blues3", n = 5, range = c(0.3, 0.8))
+	yl_rd = c4a("-hcl.red_yellow", n = 5, range = c(0.3, 0.8))
 	pg = hcl.colors(11, "Purple-Green")
 	bu = hcl.colors(9, "Blues 3")[7:3]
 	gn = hcl.colors(9, "Greens 3")[7:3]

build/description.csv

@@ -9,7 +9,7 @@
 "parks","Palettes inspired by National Parks"
 "poly","Qualitative palettes with many colors"
 "seaborn","Palettes from the Python library Seaborn"
-"scico","Scientific colour map palettes by Fabio Crameri"
+"scico","Scientific colour maps by Fabio Crameri"
 "stevens","Bivariate palettes by Joshua Stevens"
 "tableau","Palettes designed by Tableau"
 "tol","Palettes designed by Paul Tol"

sandbox/hcl_pie.R

@@ -23,6 +23,14 @@ add_coords = function(df, height = .6, amp_s = 0.48, amp_c = 0.30) {
 	})
 }
 
+add_coords2= function(df, width = 180) {
+	df = within(df, {
+		x = sin(H / 180 * pi) * (C / 180) * width
+		y = cos(H / 180 * pi) * (C / 180) * width
+	})
+}
+
+
 df = add_coords(df)
 
 df$col = hcl(df$H, df$C, df$L)
@@ -66,3 +74,19 @@ for (scale in 1:2) {
 	grid.lines(a$x[8:nrow(a)], a$y[8:nrow(a)], arrow = arrow(length = unit(6 * lwd, "point")), gp = gpar(lwd = lwd*scale))
 	dev.off()
 }
+
+
+
+
+### HCL rock
+
+library(plotly)
+# volcano is a numeric matrix that ships with R
+fig <- plot_ly(z = ~volcano)
+fig <- fig %>% add_surface()
+
+fig
+
+
+
+#hdf = hdf[hdf$C <= 50 & hdf$L <= 80 & hdf$L >= 20, ]