diff --git a/R/c4a_gui.R b/R/c4a_gui.R index 33d5651..238b929 100644 --- a/R/c4a_gui.R +++ b/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) diff --git a/R/c4a_palettes.R b/R/c4a_palettes.R index 77169a9..d73a84b 100644 --- a/R/c4a_palettes.R +++ b/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)) { diff --git a/R/c4a_table.R b/R/c4a_table.R index 2e78184..64bce10 100644 --- a/R/c4a_table.R +++ b/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. diff --git a/R/check_pals.R b/R/check_pals.R index 50a3817..a1954c2 100644 --- a/R/check_pals.R +++ b/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({ diff --git a/R/sysdata.rda b/R/sysdata.rda index c0aaa5e..810c763 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/build/build_data.R b/build/build_data.R index 161b0ae..8813962 100644 --- a/build/build_data.R +++ b/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 ) + })) diff --git a/build/build_palettes.R b/build/build_palettes.R index cf13b82..f79fbae 100644 --- a/build/build_palettes.R +++ b/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] diff --git a/build/description.csv b/build/description.csv index 103cd90..50aae01 100644 --- a/build/description.csv +++ b/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" diff --git a/man/c4a_gui.Rd b/man/c4a_gui.Rd index de9cfc8..2190a99 100644 --- a/man/c4a_gui.Rd +++ b/man/c4a_gui.Rd @@ -11,7 +11,7 @@ c4a_table( type = c("cat", "seq", "div", "cyc", "bivs", "bivc", "bivd", "bivg"), n = NULL, m = NULL, - n.only = FALSE, + filters = character(0), cvd.sim = c("none", "deutan", "protan", "tritan"), sort = "name", text.format = "hex", @@ -32,7 +32,7 @@ c4a_table( \item{series}{Series of palettes to show. See \code{\link{c4a_series}} for options. By default, \code{"all"}, which means all series. For \code{c4a_gui} it only determines which series are shown initially.} -\item{n.only}{should only palettes be contained that have exactly \code{n.only} colors (\code{FALSE} by default)} +\item{filters}{filters to be applied. A character vector with a subset from:\code{"nmax"} (only palettes where \code{n = nmax}, which is only applicable for categorical palettes), \code{"cbf"} (colorblind-friendly), \code{"fair"} (fairness),\code{"naming"} (nameability), \code{"crW"} (sufficient contrast ratio with white), and \code{"crB"} (sufficient contrast ratio with black). By default an empty vector, so no filters are applied.} \item{cvd.sim}{color vision deficiency simulation: one of \code{"none"}, \code{"deutan"}, \code{"protan"}, \code{"tritan"}} diff --git a/sandbox/hcl_pie.R b/sandbox/hcl_pie.R index 9b3eeb1..30e3842 100644 --- a/sandbox/hcl_pie.R +++ b/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, ]