diff --git a/.gitignore b/.gitignore index 3f678b1ea..80b74d00b 100644 --- a/.gitignore +++ b/.gitignore @@ -10,5 +10,5 @@ *ANIMINT_TEST_FOO *pids.txt *~ -.vscode/settings.jsonnode_modules/ -node_modules/ +.vscode/settings.json +/node_modules \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index d0e78b6dc..594187796 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: animint2 Title: Animated Interactive Grammar of Graphics -Version: 2025.7.10 +Version: 2025.7.21 URL: https://animint.github.io/animint2/ BugReports: https://github.com/animint/animint2/issues Authors@R: c( @@ -180,6 +180,7 @@ Collate: 'geom-histogram.r' 'geom-hline.r' 'geom-jitter.r' + 'geom-label-aligned.R' 'geom-label.R' 'geom-linerange.r' 'geom-point.r' diff --git a/NAMESPACE b/NAMESPACE index 2eea75acb..72f51e800 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -147,6 +147,7 @@ export(GeomFreqpoly) export(GeomHex) export(GeomHline) export(GeomLabel) +export(GeomLabelAligned) export(GeomLine) export(GeomLinerange) export(GeomLogticks) @@ -290,6 +291,7 @@ export(geom_histogram) export(geom_hline) export(geom_jitter) export(geom_label) +export(geom_label_aligned) export(geom_line) export(geom_linerange) export(geom_map) diff --git a/NEWS.md b/NEWS.md index 72442db39..91bc8d94e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# Changes in version 2025.7.21 (PR#203) + +- Added `geom_label_aligned`, a new geom that plots text labels with non-overlapping positioning along a specified alignment axis ("horizontal" or "vertical"). It uses quadratic programming to optimize label placement and includes options for spacing (min_distance), alignment, rounded background rectangles (label_r), disabling the background rectangle (background_rect = FALSE), etc. + # Changes in version 2025.7.10 (PR#208) - Added Codecov integration for both R and JavaScript tests; coverage reports now available at https://app.codecov.io/github/animint/animint2 diff --git a/R/geom-label-aligned.R b/R/geom-label-aligned.R new file mode 100644 index 000000000..7b755f9b5 --- /dev/null +++ b/R/geom-label-aligned.R @@ -0,0 +1,155 @@ +#' Non-overlapping label boxes +#' +#' This geom creates boxes with labels that are aligned either vertically or horizontally, +#' using quadratic programming to optimize their positions and avoid overlaps. The QP solver +#' is applied after all showSelected filtering occurs, and operates as follows: +#' +#' For vertical alignment (default): +#' - QP optimizes Y positions while keeping X positions fixed +#' - Constraints ensure boxes don't overlap vertically +#' - Boxes are aligned along the vertical axis at their original X positions +#' +#' For horizontal alignment: +#' - QP optimizes X positions while keeping Y positions fixed +#' - Constraints ensure boxes don't overlap horizontally +#' - Boxes are aligned along the horizontal axis at their original Y positions +#' +#' The QP solver minimizes the total squared distance from original positions while +#' enforcing minimum spacing constraints between boxes. +#' +#' @inheritParams layer +#' @inheritParams geom_point +#' @param label_r Radius of rounded corners. Defaults to 0.15 lines. +#' @param alignment One of "vertical" (QP on Y axis) or "horizontal" (QP on X axis) +#' @param min_distance Minimum distance between boxes in pixels. +#' @param background_rect Disables text background rect if set to FALSE. +#' @export +#' @examples +#' library(nlme) +#' data(BodyWeight, package = "nlme") +#' # Extracting the last point of each rat's trajectory +#' library(data.table) +#' label_data <- data.table(BodyWeight)[Time == max(Time)] +#' library(animint2) +#' viz <- animint( +#' bodyPlot = ggplot() + +#' theme_bw() + +#' theme_animint(width=800)+ +#' geom_line(aes( +#' x = Time, y = weight, group = Rat), +#' clickSelects="Rat", +#' size=3, +#' data = BodyWeight) + +#' geom_line(aes( +#' x = Time, y = weight, group = Rat, colour = Rat), +#' clickSelects="Rat", +#' data = BodyWeight) + +#' geom_label_aligned(aes( +#' x = Time, y = weight, label = Rat, fill = Rat), +#' clickSelects="Rat", +#' hjust = 0, +#' data = label_data) + +#' facet_grid(~Diet) + +#' ggtitle("Rat body weight over time by diet") + +#' xlab("Time (days)") + +#' ylab("Body Weight (grams)") +#' ) +#' viz +geom_label_aligned <- function +(mapping = NULL, data = NULL, + stat = "identity", position = "identity", + ..., + label_r = 0.15, + alignment = "vertical", + min_distance = 0.1, + background_rect = TRUE, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE) { + layer( + data = data, + mapping = mapping, + stat = stat, + geom = GeomLabelAligned, + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list( + label_r = label_r, + alignment = alignment, + min_distance = min_distance, + background_rect = background_rect, + na.rm = na.rm, + ... + ) + ) +} + +#' @rdname animint2-gganimintproto +#' @format NULL +#' @usage NULL +#' @export +GeomLabelAligned <- gganimintproto( + "GeomLabelAligned", + Geom, + required_aes = c("x", "y", "label"), + default_aes = aes( + colour = "black", fill = "white", size = 12, + angle = 0, hjust = 0.5, vjust = 0.5, alpha = 1, + family = "", fontface = 1, lineheight = 1.2 + ), + draw_panel = function + (self, data, panel_scales, coord, + label_r = 0.15, + alignment = "vertical", + min_distance = 0.1, + background_rect = TRUE, + na.rm = FALSE) { + if (empty(data)) return(zeroGrob()) + coords <- coord$transform(data, panel_scales) + coords$label_r <- label_r + coords$alignment <- alignment + coords$min_distance <- min_distance + coords$background_rect <- background_rect + rect_grobs <- lapply(1:nrow(coords), function(i) { + grid::roundrectGrob( + x = unit(coords$x[i], "native"), + y = unit(coords$y[i], "native"), + width = unit(0.1, "npc"), + height = unit(0.1, "npc"), + just = "center", + r = unit(coords$label_r[i], "native"), + gp = grid::gpar( + col = coords$colour[i], + fill = scales::alpha(coords$fill[i], coords$alpha[i]) + ) + ) + }) + text_grobs <- lapply(1:nrow(coords), function(i) { + grid::textGrob( + coords$label[i], + x = unit(coords$x[i], "native"), + y = unit(coords$y[i], "native"), + just = "center", + gp = grid::gpar( + col = coords$colour[i], + fontsize = coords$size[i], + fontfamily = coords$family[i], + fontface = coords$fontface[i], + lineheight = coords$lineheight[i] + ) + ) + }) + grobs <- mapply( + function(r, t) grid::gTree(children = grid::gList(r, t)), + rect_grobs, text_grobs) + class(grobs) <- "gList" + ggname("geom_label_aligned", grid::grobTree(children = grobs)) + }, + pre_process = function(g, g.data, ...) { + # This ensures our geom is identified as "label_aligned" in JS + g$geom <- "label_aligned" + return(list(g = g, g.data = g.data)) + }, + draw_key = draw_key_label +) diff --git a/build.sh b/build.sh index 22110e938..f9a72ef09 100644 --- a/build.sh +++ b/build.sh @@ -32,17 +32,23 @@ PKG_TGZ=$(R CMD build animint2-release|grep building|sed "s/.*\(animint2.*.tar.g echo built $PKG_TGZ so now we INSTALL R CMD INSTALL $PKG_TGZ echo "Running R CMD check --as-cran $PKG_TGZ" -check_output=$(R CMD check --as-cran $PKG_TGZ 2>&1) -check_status=$? -echo "$check_output" -# Check for WARNINGs or NOTEs in the output -if echo "$check_output" | grep -q -E "WARNING|NOTE"; then - echo "CRAN check generated WARNINGs or NOTEs:" +# temporary log file +LOG_FILE=$(mktemp) +trap 'rm -f "$LOG_FILE"' EXIT +# Run check and capture output +R CMD check --as-cran $PKG_TGZ 2>&1 | tee "$LOG_FILE" +CHECK_STATUS=${PIPESTATUS[0]} +# Check for WARNINGs or NOTEs +if grep -q -E "WARNING|NOTE" "$LOG_FILE"; then + echo "::error:: CRAN check generated WARNINGs or NOTEs:" + grep -E "WARNING|NOTE" "$LOG_FILE" exit 1 fi # Exit with original status if no WARNINGs/NOTEs but check failed -if [ $check_status -ne 0 ]; then - echo "R CMD check failed with status $check_status" - exit $check_status +if [ $CHECK_STATUS -ne 0 ]; then + echo "::error:: R CMD check failed with status $CHECK_STATUS" + echo "Full output:" + cat "$LOG_FILE" + exit $CHECK_STATUS fi echo "CRAN check completed successfully" \ No newline at end of file diff --git a/data/parallelPeaks.RData b/data/parallelPeaks.RData new file mode 100644 index 000000000..3f31c5687 Binary files /dev/null and b/data/parallelPeaks.RData differ diff --git a/inst/examples/WorldBank-facets-map.R b/inst/examples/WorldBank-facets-map.R index e802e978e..c0991321b 100644 --- a/inst/examples/WorldBank-facets-map.R +++ b/inst/examples/WorldBank-facets-map.R @@ -90,7 +90,7 @@ wb.facets <- animint( size=4, alpha=1, alpha_off=0.1)+ - geom_text(aes( + geom_label_aligned(aes( year, life.expectancy, colour=region, label=country), showSelected="country", clickSelects="country", @@ -118,11 +118,12 @@ wb.facets <- animint( alpha_off=0.3, chunk_vars=character(), data=SCATTER(not.na))+ - geom_text(aes( + geom_label_aligned(aes( fertility.rate, life.expectancy, label=country, key=country), #also use key here! showSelected=c("country", "year", "region"), clickSelects="country", + alpha=0.7, help="Names of selected countries", chunk_vars=character(), data=SCATTER(not.na))+ diff --git a/inst/examples/geom_label_aligned_examples.R b/inst/examples/geom_label_aligned_examples.R new file mode 100644 index 000000000..57d6325c5 --- /dev/null +++ b/inst/examples/geom_label_aligned_examples.R @@ -0,0 +1,137 @@ +library(animint2) +set.seed(42) +# Create synthetic labels +label_names <- paste("Label", 1:5) +n_timepoints <- 10 + +line_data <- do.call(rbind, lapply(label_names, function(label) { + data.frame( + Time = 1:n_timepoints, + Value = cumsum(rnorm(n_timepoints, mean = 0.5, sd = 2)) + runif(1, 20, 30), + Label = label + ) +})) + +# Manually override the final y-values of some labels to create overlaps +line_data$Value[line_data$Label == "Label 1" & line_data$Time == n_timepoints] <- 40 +line_data$Value[line_data$Label == "Label 2" & line_data$Time == n_timepoints] <- 40 +line_data$Value[line_data$Label == "Label 3" & line_data$Time == n_timepoints] <- 40 + +# Create label data for the aligned labels at final time point +label_data <- line_data[line_data$Time == n_timepoints, ] +label_data$label <- label_data$Label + +p <- ggplot() + + geom_line( + data = line_data, + aes(x = Time, y = Value, color = Label, group = Label), + size = 1.2 + ) + + geom_label_aligned( + data = label_data, + aes(x = Time, y = Value, label = label, fill = Label), + alignment = "vertical" + ) + + ggtitle("Synthetic Trends with Smart Aligned Labels") + + xlab("Time") + + ylab("Value") + +viz <- list(syntheticTrend = p) +animint2dir(viz, "smart_aligned_labels") + +# Plot 2 : Collisions with axes and other boxes at the same time +library(nlme) +library(dplyr) +data(BodyWeight, package = "nlme") +# Extracting the last point of each rat's trajectory +label_data <- BodyWeight %>% + group_by(Rat) %>% + filter(Time == max(Time)) %>% + ungroup() %>% + mutate(label = as.character(Rat)) + +viz2 <- list( + bodyPlot = ggplot() + + geom_line(aes(x = Time, y = weight, group = Rat, colour = Rat), + data = BodyWeight) + + geom_label_aligned(aes(x = Time, y = weight, label = label, fill = Rat), + data = label_data) + + facet_wrap(~Diet, nrow = 1) + + ggtitle("Rat body weight over time by diet") + + xlab("Time (days)") + + ylab("Body Weight (grams)") +) + +# Render to directory +animint2dir(viz2, "bodyweight-label-aligned") + +# Example 3: World Bank Data with Interactive Aligned Labels +library(data.table) +data(WorldBank, package = "animint2") + +WorldBank <- as.data.table(WorldBank) +# subset of countries +tracked_countries <- c( + "United States", "Vietnam", "India", "China", "Brazil", + "Nigeria", "Mali", "South Africa", "Canada") + +# Filter WorldBank data +wb <- WorldBank[ + country %in% tracked_countries & + !is.na(life.expectancy) & !is.na(fertility.rate), + .(country, year = as.integer(year), life.expectancy, fertility.rate)] +# Label data for the time series +label_data_line <- wb[, .SD[year == max(year)], by = country] +# Text data for year display +year_text_data <- data.table(year = unique(wb$year)) +wb.viz <- list( + lifeExpectancyPlot = ggplot() + + geom_line( + data = wb, + aes(x = year, y = life.expectancy, group = country, color = country, key=country), + size = 1.2, + clickSelects = "country", + showSelected = "country" + ) + + geom_label_aligned( + data = label_data_line, + aes( + x = year, y = life.expectancy, label = country, + fill = country, key = country), + alignment = "vertical", + hjust = 1, + min_distance = 3, + size=10, + color = "white", + showSelected = "country", + clickSelects = "country" + ) + + ggtitle("Life Expectancy Over Time") + + xlab("Year") + + ylab("Life Expectancy (years)"), + worldbankAnim = ggplot() + + geom_point( + data = wb, + aes(x = fertility.rate, y = life.expectancy, color = country, key = country), + size = 8, + showSelected = "year", + clickSelects = "country" + ) + + geom_label_aligned( + data = wb, + aes(x = fertility.rate, y = life.expectancy, label = country, fill = country, key = country), + size=5, + alignment = "vertical", color = "#ffffd1", label_r = 9, + showSelected = "year", + clickSelects = "country" + ) + + make_text(year_text_data, x = 4, y = 82, label = "year") + + ggtitle("Life Expectancy vs Fertility Rate") + + xlab("Fertility Rate") + + ylab("Life Expectancy"), + time = list(variable = "year", ms = 3000), + duration = list(year = 2000, country=2000), + first = list(year = min(wb$year)), + selector.types = list(country = "multiple") +) +animint2dir(wb.viz, "worldbank-label-aligned") diff --git a/inst/examples/parallelPeaks_geom_label_aligned.R b/inst/examples/parallelPeaks_geom_label_aligned.R new file mode 100644 index 000000000..ad762a193 --- /dev/null +++ b/inst/examples/parallelPeaks_geom_label_aligned.R @@ -0,0 +1,44 @@ +data(parallelPeaks,package="animint2") +library(animint2) +library(data.table) +max.proc <- max(parallelPeaks$process_i) +ggplot()+ + theme_bw()+ + geom_segment(aes( + start.seconds, process_i, + color=design, + xend=end.seconds, yend=process_i), + data=parallelPeaks)+ + geom_point(aes( + start.seconds, process_i, color=design), + shape=1, + data=parallelPeaks)+ + facet_grid(Fun + design ~ ., scales="free", labeller=label_both)+ + scale_y_continuous(breaks=seq(1, max.proc))+ + scale_x_continuous("Time from start of computation (seconds)") + +gg_wrap <- ggplot()+ + theme_bw()+ + geom_segment(aes( + start.seconds, process_i, + xend=end.seconds, yend=process_i), + data=parallelPeaks)+ + geom_point(aes( + start.seconds, process_i), + shape=1, + data=parallelPeaks)+ + geom_blank(aes( + start.seconds, process_i-1), + shape=1, + data=parallelPeaks)+ + geom_label_aligned(aes( + start.seconds, process_i-0.5, label=peaks), + alignment = "horizontal", + data=parallelPeaks)+ + facet_wrap( ~ design + Fun, labeller=label_both, ncol=1)+ + scale_y_continuous( + breaks=c(1,5,8,14))+ + scale_x_continuous("Time from start of computation (seconds)") +animint(gg_wrap+theme_animint(width=1500, height=2000)) + +animint(gg_wrap+theme_animint(width=1500, height=1000)) diff --git a/inst/htmljs/animint.js b/inst/htmljs/animint.js index d5fb2a4ca..5472ca8d0 100644 --- a/inst/htmljs/animint.js +++ b/inst/htmljs/animint.js @@ -122,7 +122,7 @@ var animint = function (to_select, json_file) { // and then measure the element // Inspired from http://jsfiddle.net/uzddx/2/ var measureText = function(pText, pFontSize, pAngle, pStyle) { - if (!pText || pText.length === 0) return {height: 0, width: 0}; + if (pText === undefined || pText === null || pText.length === 0) return {height: 0, width: 0}; if (pAngle === null || isNaN(pAngle)) pAngle = 0; var container = element.append('svg'); @@ -1076,6 +1076,15 @@ var animint = function (to_select, json_file) { }); }; + var fontsize = 12; + var get_fontsize; + if (aes.hasOwnProperty("size")){ + get_fontsize = get_attr("size") + }else if(g_info.params.hasOwnProperty("size")){ + get_fontsize = function(d) { return g_info.params.size; }; + }else{ + get_fontsize = function(d) { return fontsize; }; + } var size = 2; var get_size; if(aes.hasOwnProperty("size")){ @@ -1140,15 +1149,36 @@ var animint = function (to_select, json_file) { }; } var get_colour_off_default = get_colour; - - var fill = "black", fill_off = "black"; + if (g_info.geom == "label_aligned") { + var fill = "white", fill_off = "white"; + }else{ + var fill = "black", fill_off = "black"; + } var get_fill = function (d) { return fill; }; var get_fill_off = function (d) { return fill_off; }; - + + var get_hjust; + var default_hjust = 0.5; // default center + if(aes.hasOwnProperty("hjust")){ + get_hjust = get_attr("hjust"); + }else if(g_info.params.hasOwnProperty("hjust")){ + get_hjust = function(d){ return g_info.params.hjust; }; + }else{ + get_hjust = function(d){ return default_hjust; }; + } + var get_vjust; + var default_vjust = 0.5; // default center + if(aes.hasOwnProperty("vjust")){ + get_vjust = get_attr("vjust"); + }else if(g_info.params.hasOwnProperty("vjust")){ + get_vjust = function(d){ return g_info.params.vjust; }; + }else{ + get_vjust = function(d){ return default_vjust; }; + } var angle = 0; var get_angle; if(aes.hasOwnProperty("angle")){ @@ -1429,6 +1459,118 @@ var animint = function (to_select, json_file) { }; eAppend = "circle"; } + // function to calculate the size of boxes in geom_label_aligned according to the inside text + var calcLabelBox = function(d) { + var textStyle = [ + "font-family:" + (d.family || "sans-serif"), + "font-weight:" + (d.fontface == 2 ? "bold" : "normal"), + "font-style:" + (d.fontface == 3 ? "italic" : "normal") + ].join(";"); + // Use d.size for font size (always current value) + var fontsize = d.size; + var textSize = measureText(d.label, fontsize, d.angle, textStyle); + d.boxWidth = textSize.width; + d.boxHeight = textSize.height; + d.scaledX = scales.x(d.x); + d.scaledY = scales.y(d.y); + } + if (g_info.geom == "label_aligned") { + // Get parameters + var alignment = g_info.params.alignment || "vertical"; + var min_distance = g_info.params.min_distance || 0.1; + var background_rect = g_info.params.background_rect !== false; // Default true + // Set d.size and d.originalFontsize for each datum + data.forEach(function(d) { + if (typeof d.originalFontsize === "undefined") { + d.size = get_fontsize(d); + d.originalFontsize = d.size; + } + // Always reset to original before shrinking + d.size = d.originalFontsize; + calcLabelBox(d); + }); + var plot_limits; + if (alignment === "vertical") { + var yRange = scales.y.range(); + plot_limits = [Math.min.apply(null, yRange), Math.max.apply(null, yRange)]; + } else { + var xRange = scales.x.range(); + plot_limits = [Math.min.apply(null, xRange), Math.max.apply(null, xRange)]; + } + // using quadprog.js for optimizing positions of colliding boxes + optimizeAlignedLabels(data, alignment, min_distance, plot_limits, function(d){return d.size;}, calcLabelBox); + + eAppend = "g"; + eActions = function(groups) { + // Handle transitions seperately due to unique structure of geom_label_aligned + var transitionDuration = 0; + if (Selectors.hasOwnProperty(selector_name)) { + transitionDuration = +Selectors[selector_name].duration || 0; + } + groups.each(function(d) { + var group = d3.select(this); + // Select existing elements (if any) + var rect = group.select("rect"); + var text = group.select("text"); + var rectIsNew = false, textIsNew = false; + // If elements don't exist, create them + if (rect.empty()) {rect = group.append("rect"); rectIsNew = true;} + if (text.empty()) {text = group.append("text"); textIsNew = true;} + // Apply transitions to both elements + if (!rectIsNew && transitionDuration > 0) { + rect = rect.transition().duration(transitionDuration); + } + if (!textIsNew && transitionDuration > 0) { + text = text.transition().duration(transitionDuration); + } + if (background_rect) { + rect + .attr("x", function(d) { + if (alignment == "vertical") { + return d.scaledX - d.boxWidth * get_hjust(d); + } else { + return d.optimizedPos - d.boxWidth / 2; + } + }) + .attr("y", function(d) { + if (alignment == "vertical") { + return d.optimizedPos - d.boxHeight / 2; + } else { + return d.scaledY - d.boxHeight * get_vjust(d); + } + }) + .attr("width", function(d) { return d.boxWidth; }) + .attr("height", function(d) { return d.boxHeight; }) + .style("opacity", get_alpha) + .style("stroke", get_colour) + .style("fill", get_fill) + .attr("rx", g_info.params.label_r || 0) + .attr("ry", g_info.params.label_r || 0); + } + text + .attr("x", function(d) { + if (alignment == "vertical") { + return d.scaledX - d.boxWidth * get_hjust(d) + d.boxWidth / 2; + } else { + return d.optimizedPos; + } + }) + .attr("y", function(d) { + if (alignment == "vertical") { + return d.optimizedPos; + } else { + return d.scaledY - d.boxHeight * get_vjust(d) + d.boxHeight / 2 ; + } + }) + .attr("dominant-baseline", "middle") + .attr("font-size", function(d) { return d.size + "px"; }) + .style("text-anchor", "middle") + .style("fill", get_colour) + .text(function(d) { return d.label; }); + }); + }; + } + var rect_geoms = ["tallrect","widerect","rect"]; if(rect_geoms.includes(g_info.geom)){ eAppend = "rect"; @@ -1517,6 +1659,7 @@ var animint = function (to_select, json_file) { size = g_info.params.size; } var styleActions = function(e){ + if (g_info.geom == "label_aligned") return; // Do NOT call styleActions(e) for geom_label_aligned g_info.style_list.forEach(function(s){ e.style(s, function(d) { var style_on_fun = style_on_funs[s]; @@ -1540,15 +1683,18 @@ var animint = function (to_select, json_file) { var select_style_default = ["opacity","stroke","fill"]; g_info.select_style = select_style_default.filter( X => g_info.style_list.includes(X)); + var styles_to_apply = (g_info.geom === "label_aligned") ? ["opacity"] : g_info.select_style; + // (Only apply opacity to geom_label_aligned + // due to its structure difference -- to avoid double styling in both and inside ) var over_fun = function(e){ - g_info.select_style.forEach(function(s){ + styles_to_apply.forEach(function(s){ e.style(s, function (d) { return style_on_funs[s](d); }); }); }; var out_fun = function(e){ - g_info.select_style.forEach(function(s){ + styles_to_apply.forEach(function(s){ e.style(s, function (d) { var select_on = style_on_funs[s](d); var select_off = style_off_funs[s](d); diff --git a/inst/htmljs/index.html b/inst/htmljs/index.html index 7c7cd9f2a..2062330a3 100644 --- a/inst/htmljs/index.html +++ b/inst/htmljs/index.html @@ -5,6 +5,7 @@ Interactive animation + diff --git a/inst/htmljs/vendor/quadprog.js b/inst/htmljs/vendor/quadprog.js new file mode 100644 index 000000000..cdab9c6f7 --- /dev/null +++ b/inst/htmljs/vendor/quadprog.js @@ -0,0 +1,737 @@ +/** + * JavaScript port of the R `quadprog` package for solving quadratic programming problems. + * Source: https://github.com/albertosantini/quadprog + * + * The following five functions (`dpofa`, `dposl`, `dmach`, `daxpy`, `ddot`) are adapted from the + * above JS implementation repository. These are used to support `optimizeAlignedBoxes()`, a custom function + * for resolving label box collisions using QP. + */ + +function dpofa(a, lda, n) { + let info, jm1, t, s; + + for (let j = 1; j <= n; j += 1) { + info = j; + s = 0; + jm1 = j - 1; + if (jm1 < 1) { + s = a[j][j] - s; + } else { + for (let k = 1; k <= jm1; k += 1) { + + // t = a[k][j] - ddot(k - 1, a[1][k], 1, a[1][j], 1); + t = a[k][j]; + for (let i = 1; i < k; i += 1) { + t -= a[i][j] * a[i][k]; + } + t /= a[k][k]; + a[k][j] = t; + s += t * t; + } + s = a[j][j] - s; + } + + if (s <= 0) { + break; + } + + a[j][j] = Math.sqrt(s); + info = 0; + } + + return info; +} + + +function dpori(a, lda, n) { + let kp1, t; + + for (let k = 1; k <= n; k += 1) { + a[k][k] = 1 / a[k][k]; + t = -a[k][k]; + + // dscal(k - 1, t, a[1][k], 1); + for (let i = 1; i < k; i += 1) { + a[i][k] *= t; + } + + kp1 = k + 1; + if (n < kp1) { + break; + } + for (let j = kp1; j <= n; j += 1) { + t = a[k][j]; + a[k][j] = 0; + + // daxpy(k, t, a[1][k], 1, a[1][j], 1); + for (let i = 1; i <= k; i += 1) { + a[i][j] += t * a[i][k]; + } + } + } +} + + +function dposl(a, lda, n, b) { + let k, t; + + for (k = 1; k <= n; k += 1) { + + // t = ddot(k - 1, a[1][k], 1, b[1], 1); + t = 0; + for (let i = 1; i < k; i += 1) { + t += a[i][k] * b[i]; + } + + b[k] = (b[k] - t) / a[k][k]; + } + + for (let kb = 1; kb <= n; kb += 1) { + k = n + 1 - kb; + b[k] /= a[k][k]; + t = -b[k]; + + // daxpy(k - 1, t, a[1][k], 1, b[1], 1); + for (let i = 1; i < k; i += 1) { + b[i] += t * a[i][k]; + } + } +} + +"use strict"; + +let epsilon = 1.0e-60; +let tmpa; +let tmpb; +let vsmall = 1.0e-60; + +do { + epsilon += epsilon; + tmpa = 1 + 0.1 * epsilon; + tmpb = 1 + 0.2 * epsilon; +} while (tmpa <= 1 || tmpb <= 1); + + +function qpgen2(dmat, dvec, fddmat, n, sol, lagr, crval, amat, bvec, fdamat, q, meq, iact, nnact, iter, work, ierr) { + let l1, it1, nvl, nact, temp, sum, t1, tt, gc, gs, nu, t1inf, t2min, go; + + const r = Math.min(n, q); + + let l = 2 * n + (r * (r + 5)) / 2 + 2 * q + 1; + + for (let i = 1; i <= n; i += 1) { + work[i] = dvec[i]; + } + for (let i = n + 1; i <= l; i += 1) { + work[i] = 0; + } + for (let i = 1; i <= q; i += 1) { + iact[i] = 0; + lagr[i] = 0; + } + + if (ierr[1] === 0) { + const info = dpofa(dmat, fddmat, n); + + if (info !== 0) { + ierr = 2; // eslint-disable-line + return; + } + dposl(dmat, fddmat, n, dvec); + dpori(dmat, fddmat, n); + } else { + for (let j = 1; j <= n; j += 1) { + sol[j] = 0; + for (let i = 1; i <= j; i += 1) { + sol[j] += dmat[i][j] * dvec[i]; + } + } + for (let j = 1; j <= n; j += 1) { + dvec[j] = 0; + for (let i = j; i <= n; i += 1) { + dvec[j] += dmat[j][i] * sol[i]; + } + } + } + + crval[1] = 0; + for (let j = 1; j <= n; j += 1) { + sol[j] = dvec[j]; + crval[1] += work[j] * sol[j]; + work[j] = 0; + for (let i = j + 1; i <= n; i += 1) { + dmat[i][j] = 0; + } + } + crval[1] = -crval[1] / 2; + ierr[1] = 0; + + const iwzv = n; + const iwrv = iwzv + n; + const iwuv = iwrv + r; + const iwrm = iwuv + r + 1; + const iwsv = iwrm + (r * (r + 1)) / 2; + const iwnbv = iwsv + q; + + for (let i = 1; i <= q; i += 1) { + sum = 0; + for (let j = 1; j <= n; j += 1) { + sum += amat[j][i] * amat[j][i]; + } + work[iwnbv + i] = Math.sqrt(sum); + } + + nact = nnact; + + iter[1] = 0; + iter[2] = 0; + + function fnGoto50() { + iter[1] += 1; + + l = iwsv; + for (let i = 1; i <= q; i += 1) { + l += 1; + sum = -bvec[i]; + for (let j = 1; j <= n; j += 1) { + sum += amat[j][i] * sol[j]; + } + if (Math.abs(sum) < vsmall) { + sum = 0; + } + if (i > meq) { + work[l] = sum; + } else { + work[l] = -Math.abs(sum); + if (sum > 0) { + for (let j = 1; j <= n; j += 1) { + amat[j][i] = -amat[j][i]; + } + bvec[i] = -bvec[i]; + } + } + } + + for (let i = 1; i <= nact; i += 1) { + work[iwsv + iact[i]] = 0; + } + + nvl = 0; + temp = 0; + for (let i = 1; i <= q; i += 1) { + if (work[iwsv + i] < temp * work[iwnbv + i]) { + nvl = i; + temp = work[iwsv + i] / work[iwnbv + i]; + } + } + if (nvl === 0) { + for (let i = 1; i <= nact; i += 1) { + lagr[iact[i]] = work[iwuv + i]; + } + return 999; + } + + return 0; + } + + function fnGoto55() { + for (let i = 1; i <= n; i += 1) { + sum = 0; + for (let j = 1; j <= n; j += 1) { + sum += dmat[j][i] * amat[j][nvl]; + } + work[i] = sum; + } + + l1 = iwzv; + for (let i = 1; i <= n; i += 1) { + work[l1 + i] = 0; + } + for (let j = nact + 1; j <= n; j += 1) { + for (let i = 1; i <= n; i += 1) { + work[l1 + i] = work[l1 + i] + dmat[i][j] * work[j]; + } + } + + t1inf = true; + for (let i = nact; i >= 1; i -= 1) { + sum = work[i]; + l = iwrm + (i * (i + 3)) / 2; + l1 = l - i; + for (let j = i + 1; j <= nact; j += 1) { + sum -= work[l] * work[iwrv + j]; + l += j; + } + sum /= work[l1]; + work[iwrv + i] = sum; + if (iact[i] <= meq) { + continue; + } + if (sum <= 0) { + continue; + } + t1inf = false; + it1 = i; + } + + if (!t1inf) { + t1 = work[iwuv + it1] / work[iwrv + it1]; + for (let i = 1; i <= nact; i += 1) { + if (iact[i] <= meq) { + continue; + } + if (work[iwrv + i] <= 0) { + continue; + } + temp = work[iwuv + i] / work[iwrv + i]; + if (temp < t1) { + t1 = temp; + it1 = i; + } + } + } + + sum = 0; + for (let i = iwzv + 1; i <= iwzv + n; i += 1) { + sum += work[i] * work[i]; + } + if (Math.abs(sum) <= vsmall) { + if (t1inf) { + ierr[1] = 1; + + return 999; // GOTO 999 + } + for (let i = 1; i <= nact; i += 1) { + work[iwuv + i] = work[iwuv + i] - t1 * work[iwrv + i]; + } + work[iwuv + nact + 1] = work[iwuv + nact + 1] + t1; + + return 700; // GOTO 700 + } + sum = 0; + for (let i = 1; i <= n; i += 1) { + sum += work[iwzv + i] * amat[i][nvl]; + } + tt = -work[iwsv + nvl] / sum; + t2min = true; + if (!t1inf) { + if (t1 < tt) { + tt = t1; + t2min = false; + } + } + + for (let i = 1; i <= n; i += 1) { + sol[i] += tt * work[iwzv + i]; + if (Math.abs(sol[i]) < vsmall) { + sol[i] = 0; + } + } + + crval[1] += tt * sum * (tt / 2 + work[iwuv + nact + 1]); + for (let i = 1; i <= nact; i += 1) { + work[iwuv + i] = work[iwuv + i] - tt * work[iwrv + i]; + } + work[iwuv + nact + 1] = work[iwuv + nact + 1] + tt; + + if (t2min) { + nact += 1; + iact[nact] = nvl; + + l = iwrm + ((nact - 1) * nact) / 2 + 1; + for (let i = 1; i <= nact - 1; i += 1) { + work[l] = work[i]; + l += 1; + } + + if (nact === n) { + work[l] = work[n]; + } else { + for (let i = n; i >= nact + 1; i -= 1) { + if (work[i] === 0) { + continue; + } + gc = Math.max(Math.abs(work[i - 1]), Math.abs(work[i])); + gs = Math.min(Math.abs(work[i - 1]), Math.abs(work[i])); + if (work[i - 1] >= 0) { + temp = Math.abs(gc * Math.sqrt(1 + gs * gs / + (gc * gc))); + } else { + temp = -Math.abs(gc * Math.sqrt(1 + gs * gs / + (gc * gc))); + } + gc = work[i - 1] / temp; + gs = work[i] / temp; + + if (gc === 1) { + continue; + } + if (gc === 0) { + work[i - 1] = gs * temp; + for (let j = 1; j <= n; j += 1) { + temp = dmat[j][i - 1]; + dmat[j][i - 1] = dmat[j][i]; + dmat[j][i] = temp; + } + } else { + work[i - 1] = temp; + nu = gs / (1 + gc); + for (let j = 1; j <= n; j += 1) { + temp = gc * dmat[j][i - 1] + gs * dmat[j][i]; + dmat[j][i] = nu * (dmat[j][i - 1] + temp) - + dmat[j][i]; + dmat[j][i - 1] = temp; + + } + } + } + work[l] = work[nact]; + } + } else { + sum = -bvec[nvl]; + for (let j = 1; j <= n; j += 1) { + sum += sol[j] * amat[j][nvl]; + } + if (nvl > meq) { + work[iwsv + nvl] = sum; + } else { + work[iwsv + nvl] = -Math.abs(sum); + if (sum > 0) { + for (let j = 1; j <= n; j += 1) { + amat[j][nvl] = -amat[j][nvl]; + } + bvec[nvl] = -bvec[nvl]; + } + } + + return 700; // GOTO 700 + } + + return 0; + } + + function fnGoto797() { + l = iwrm + (it1 * (it1 + 1)) / 2 + 1; + l1 = l + it1; + if (work[l1] === 0) { + return 798; // GOTO 798 + } + gc = Math.max(Math.abs(work[l1 - 1]), Math.abs(work[l1])); + gs = Math.min(Math.abs(work[l1 - 1]), Math.abs(work[l1])); + if (work[l1 - 1] >= 0) { + temp = Math.abs(gc * Math.sqrt(1 + (gs / gc) * (gs / gc))); + } else { + temp = -Math.abs(gc * Math.sqrt(1 + (gs / gc) * (gs / gc))); + } + gc = work[l1 - 1] / temp; + gs = work[l1] / temp; + + if (gc === 1) { + return 798; // GOTO 798 + } + if (gc === 0) { + for (let i = it1 + 1; i <= nact; i += 1) { + temp = work[l1 - 1]; + work[l1 - 1] = work[l1]; + work[l1] = temp; + l1 += i; + } + for (let i = 1; i <= n; i += 1) { + temp = dmat[i][it1]; + dmat[i][it1] = dmat[i][it1 + 1]; + dmat[i][it1 + 1] = temp; + } + } else { + nu = gs / (1 + gc); + for (let i = it1 + 1; i <= nact; i += 1) { + temp = gc * work[l1 - 1] + gs * work[l1]; + work[l1] = nu * (work[l1 - 1] + temp) - work[l1]; + work[l1 - 1] = temp; + l1 += i; + } + for (let i = 1; i <= n; i += 1) { + temp = gc * dmat[i][it1] + gs * dmat[i][it1 + 1]; + dmat[i][it1 + 1] = nu * (dmat[i][it1] + temp) - + dmat[i][it1 + 1]; + dmat[i][it1] = temp; + } + } + + return 0; + } + + function fnGoto798() { + l1 = l - it1; + for (let i = 1; i <= it1; i += 1) { + work[l1] = work[l]; + l += 1; + l1 += 1; + } + + work[iwuv + it1] = work[iwuv + it1 + 1]; + iact[it1] = iact[it1 + 1]; + it1 += 1; + if (it1 < nact) { + return 797; // GOTO 797 + } + + return 0; + } + + function fnGoto799() { + work[iwuv + nact] = work[iwuv + nact + 1]; + work[iwuv + nact + 1] = 0; + iact[nact] = 0; + nact -= 1; + iter[2] += 1; + + return 0; + } + + while (true) { + go = fnGoto50(); + if (go === 999) { + return; + } + while (true) { + go = fnGoto55(); + if (go === 0) { + break; + } + if (go === 999) { + return; + } + if (go === 700) { + if (it1 === nact) { + fnGoto799(); + } else { + while (true) { + fnGoto797(); + go = fnGoto798(); + if (go !== 797) { + break; + } + } + fnGoto799(); + } + } + } + } + +} + +function solveQP(Dmat, dvec, Amat, bvec = [], meq = 0, factorized = [0, 0]) { + const crval = []; + const iact = []; + const sol = []; + const lagr = []; + const work = []; + const iter = []; + + let message = ""; + + // In Fortran the array index starts from 1 + const n = Dmat.length - 1; + const q = Amat[1].length - 1; + + if (!bvec) { + for (let i = 1; i <= q; i += 1) { + bvec[i] = 0; + } + } + + if (n !== Dmat[1].length - 1) { + message = "Dmat is not symmetric!"; + } + if (n !== dvec.length - 1) { + message = "Dmat and dvec are incompatible!"; + } + if (n !== Amat.length - 1) { + message = "Amat and dvec are incompatible!"; + } + if (q !== bvec.length - 1) { + message = "Amat and bvec are incompatible!"; + } + if ((meq > q) || (meq < 0)) { + message = "Value of meq is invalid!"; + } + + if (message !== "") { + return { + message + }; + } + + for (let i = 1; i <= q; i += 1) { + iact[i] = 0; + lagr[i] = 0; + } + + const nact = 0; + const r = Math.min(n, q); + + for (let i = 1; i <= n; i += 1) { + sol[i] = 0; + } + crval[1] = 0; + for (let i = 1; i <= (2 * n + (r * (r + 5)) / 2 + 2 * q + 1); i += 1) { + work[i] = 0; + } + for (let i = 1; i <= 2; i += 1) { + iter[i] = 0; + } + + qpgen2(Dmat, dvec, n, n, sol, lagr, crval, Amat, bvec, n, q, meq, iact, nact, iter, work, factorized); + + if (factorized[1] === 1) { + message = "constraints are inconsistent, no solution!"; + } + if (factorized[1] === 2) { + message = "matrix D in quadratic function is not positive definite!"; + } + + return { + solution: sol, + Lagrangian: lagr, + value: crval, + unconstrained_solution: dvec, // eslint-disable-line camelcase + iterations: iter, + iact, + message + }; +} + +// --------------------------------------------------------------------------------------------------- +// Label positioning functions inspired by the R `directlabels` package: https://github.com/tdhock/directlabels +// +// `optimizeAlignedBoxes` uses a QP solver to reposition only the overlapping label boxes, +// finding the nearest possible positions to their original locations, subject to the constraint +// that the boxes do not overlap. +function optimizeAlignedLabels(data, alignment, min_distance, plot_limits = null, get_fontsize, calcLabelBox) { + const n = data.length; + if (n === 0) return; + + // Prepare variables + const getSize = d => alignment === "vertical" ? d.boxHeight : d.boxWidth; + const setFontSize = (d, newFontSize) => { + d.size = newFontSize; + calcLabelBox(d); + }; + const getPos = d => alignment === "vertical" ? d.scaledY : d.scaledX; + const getFixedPos = d => alignment === "vertical" ? d.scaledX : d.scaledY; + const setOptimized = (d, pos) => { d.optimizedPos = pos; }; + + // Sort by fixed position first, then by optimization axis + data.sort((a, b) => { + const fixedDiff = getFixedPos(a) - getFixedPos(b); + return fixedDiff !== 0 ? fixedDiff : getPos(a) - getPos(b); + }); + + // Calculate all boxes at original font size FIRST + data.forEach(d => { + if (!d.originalFontsize) d.originalFontsize = get_fontsize(d); + d.size = d.originalFontsize; + calcLabelBox(d); + }); + // grouping logic + const groups = []; + let currentGroup = []; + let currentFixedPos = null; + + data.forEach(d => { + const fixedPos = getFixedPos(d); + if (currentGroup.length === 0 || Math.abs(fixedPos - currentFixedPos) < 0.1) { + currentGroup.push(d); + currentFixedPos = fixedPos; + } else { + groups.push(currentGroup); + currentGroup = [d]; + currentFixedPos = fixedPos; + } + }); + if (currentGroup.length > 0) groups.push(currentGroup); + + // For each group, run QP with plot limits and shrink if needed + groups.forEach(group => { + // Sort by optimization axis within group + group.sort((a, b) => getPos(a) - getPos(b)); + let n = group.length; + // Always start from original font size for each label + group.forEach(d => { + d.size = d.originalFontsize || get_fontsize(d); + calcLabelBox(d); + }); + // Compute total space needed + let totalSize = group.reduce((sum, d) => sum + getSize(d), 0); + let available = plot_limits ? Math.abs(plot_limits[1] - plot_limits[0]) : Infinity; + // If not enough space, shrink label sizes until they fit + let shrinkFactor = 1; + if (totalSize + min_distance * (n - 1) > available) { + shrinkFactor = (available - min_distance * (n - 1)) / totalSize * 0.98; // a bit smaller for safety + group.forEach(d => { + let newFont = (d.originalFontsize || get_fontsize(d)) * shrinkFactor; + setFontSize(d, newFont); + }); + } + // QP optimization for this group + const Dmat = [null]; + const dvec = [null]; + for (let i = 0; i < n; i++) { + Dmat[i + 1] = Array(n + 1).fill(0); + Dmat[i + 1][i + 1] = 1; + dvec[i + 1] = getPos(group[i]); + } + // Constraints - all adjacent pairs in group + let Amat = [null]; // Amat[1..n][1..m] + let bvec = [null]; + let m = 0; + // Non-overlap constraints: x[i+1] - x[i] >= min_gap + for (let i = 0; i < n - 1; i++) { + m++; + Amat[m] = Array(n + 1).fill(0); + Amat[m][i + 1] = -1; + Amat[m][i + 2] = 1; + const minGap = (getSize(group[i]) + getSize(group[i + 1])) / 2 + min_distance; + bvec[m] = minGap; + } + // Plot limits constraints + if (plot_limits) { + const [minBound, maxBound] = plot_limits; + // Lower bound: pos[i] - size[i]/2 >= minBound + for (let i = 0; i < n; i++) { + m++; + Amat[m] = Array(n + 1).fill(0); + Amat[m][i + 1] = 1; + bvec[m] = minBound + getSize(group[i]) / 2; + } + // Upper bound: pos[i] + size[i]/2 <= maxBound => -pos[i] >= -maxBound + size[i]/2 + for (let i = 0; i < n; i++) { + m++; + Amat[m] = Array(n + 1).fill(0); + Amat[m][i + 1] = -1; + bvec[m] = -maxBound + getSize(group[i]) / 2; + } + } + // Transpose Amat to match solveQP's expected input: Amat[n+1][m+1] + let AmatT = [null]; + for (let i = 1; i <= n; i++) { + AmatT[i] = [null]; + for (let j = 1; j <= m; j++) { + AmatT[i][j] = Amat[j][i] || 0; + } + } + // Call QP solver + const result = solveQP(Dmat, dvec, AmatT, bvec, 0); + // Assign optimized positions + if (result.solution) { + for (let i = 0; i < n; i++) { + setOptimized(group[i], result.solution[i + 1]); + } + } else { + // fallback: assign original positions + for (let i = 0; i < n; i++) { + setOptimized(group[i], getPos(group[i])); + } + } + }); +} \ No newline at end of file diff --git a/man/animint2-gganimintproto.Rd b/man/animint2-gganimintproto.Rd index ef505aa03..98118db09 100644 --- a/man/animint2-gganimintproto.Rd +++ b/man/animint2-gganimintproto.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaa-.r, R/geom-.r, R/annotation-custom.r, -% R/annotation-logticks.r, R/geom-polygon.r, R/geom-map.r, -% R/annotation-map.r, R/coord-.r, R/coord-cartesian-.r, R/coord-fixed.r, -% R/coord-flip.r, R/coord-map.r, R/coord-polar.r, R/coord-quickmap.R, -% R/coord-transform.r, R/stat-.r, R/geom-abline.r, R/geom-rect.r, -% R/geom-bar.r, R/geom-bin2d.r, R/geom-blank.r, R/geom-path.r, -% R/geom-contour.r, R/geom-crossbar.r, R/geom-segment.r, R/geom-curve.r, -% R/geom-ribbon.r, R/geom-density.r, R/geom-density2d.r, R/geom-dotplot.r, -% R/geom-errorbar.r, R/geom-errorbarh.r, R/geom-freqpoly.r, R/geom-hex.r, -% R/geom-hline.r, R/geom-label.R, R/geom-linerange.r, R/geom-point.r, -% R/geom-pointrange.r, R/geom-rug.r, R/geom-smooth.r, R/geom-spoke.r, -% R/geom-text.r, R/geom-tile.r, R/geom-violin.r, R/geom-vline.r, -% R/position-.r, R/position-dodge.r, R/position-fill.r, R/position-identity.r, +% R/annotation-logticks.r, R/geom-polygon.r, R/geom-map.r, R/annotation-map.r, +% R/coord-.r, R/coord-cartesian-.r, R/coord-fixed.r, R/coord-flip.r, +% R/coord-map.r, R/coord-polar.r, R/coord-quickmap.R, R/coord-transform.r, +% R/stat-.r, R/geom-abline.r, R/geom-rect.r, R/geom-bar.r, R/geom-bin2d.r, +% R/geom-blank.r, R/geom-path.r, R/geom-contour.r, R/geom-crossbar.r, +% R/geom-segment.r, R/geom-curve.r, R/geom-ribbon.r, R/geom-density.r, +% R/geom-density2d.r, R/geom-dotplot.r, R/geom-errorbar.r, R/geom-errorbarh.r, +% R/geom-freqpoly.r, R/geom-hex.r, R/geom-hline.r, R/geom-label-aligned.R, +% R/geom-label.R, R/geom-linerange.r, R/geom-point.r, R/geom-pointrange.r, +% R/geom-rug.r, R/geom-smooth.r, R/geom-spoke.r, R/geom-text.r, +% R/geom-tile.r, R/geom-violin.r, R/geom-vline.r, R/position-.r, +% R/position-dodge.r, R/position-fill.r, R/position-identity.r, % R/position-jitter.r, R/position-jitterdodge.R, R/position-nudge.R, % R/position-stack.r, R/scale-.r, R/scale-continuous.r, R/scale-date.r, % R/scale-discrete-.r, R/scale-identity.r, R/scales-.r, R/stat-bin.r, @@ -61,6 +61,7 @@ \alias{GeomFreqpoly} \alias{GeomHex} \alias{GeomHline} +\alias{GeomLabelAligned} \alias{GeomLabel} \alias{GeomLinerange} \alias{GeomPoint} diff --git a/man/geom_label_aligned.Rd b/man/geom_label_aligned.Rd new file mode 100644 index 000000000..fe9d1c8f0 --- /dev/null +++ b/man/geom_label_aligned.Rd @@ -0,0 +1,123 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geom-label-aligned.R +\name{geom_label_aligned} +\alias{geom_label_aligned} +\title{Non-overlapping label boxes} +\usage{ +geom_label_aligned( + mapping = NULL, + data = NULL, + stat = "identity", + position = "identity", + ..., + label_r = 0.15, + alignment = "vertical", + min_distance = 0.1, + background_rect = TRUE, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE +) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or +\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the +default), it is combined with the default mapping at the top level of the +plot. You must supply \code{mapping} if there is no plot mapping.} + +\item{data}{The data to be displayed in this layer. There are three + options: + + If \code{NULL}, the default, the data is inherited from the plot + data as specified in the call to \code{\link{ggplot}}. + + A \code{data.frame}, or other object, will override the plot + data. All objects will be fortified to produce a data frame. See + \code{\link{fortify}} for which variables will be created. + + A \code{function} will be called with a single argument, + the plot data. The return value must be a \code{data.frame.}, and + will be used as the layer data.} + +\item{stat}{The statistical transformation to use on the data for this +layer, as a string.} + +\item{position}{Position adjustment, either as a string, or the result of +a call to a position adjustment function.} + +\item{...}{other arguments passed on to \code{\link{layer}}. These are +often aesthetics, used to set an aesthetic to a fixed value, like +\code{color = "red"} or \code{size = 3}. They may also be parameters +to the paired geom/stat.} + +\item{label_r}{Radius of rounded corners. Defaults to 0.15 lines.} + +\item{alignment}{One of "vertical" (QP on Y axis) or "horizontal" (QP on X axis)} + +\item{min_distance}{Minimum distance between boxes in pixels.} + +\item{background_rect}{Disables text background rect if set to FALSE.} + +\item{na.rm}{If \code{FALSE} (the default), removes missing values with +a warning. If \code{TRUE} silently removes missing values.} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes.} + +\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +rather than combining with them. This is most useful for helper functions +that define both data and aesthetics and shouldn't inherit behaviour from +the default plot specification, e.g. \code{\link{borders}}.} +} +\description{ +This geom creates boxes with labels that are aligned either vertically or horizontally, +using quadratic programming to optimize their positions and avoid overlaps. The QP solver +is applied after all showSelected filtering occurs, and operates as follows: +} +\details{ +For vertical alignment (default): +- QP optimizes Y positions while keeping X positions fixed +- Constraints ensure boxes don't overlap vertically +- Boxes are aligned along the vertical axis at their original X positions + +For horizontal alignment: +- QP optimizes X positions while keeping Y positions fixed +- Constraints ensure boxes don't overlap horizontally +- Boxes are aligned along the horizontal axis at their original Y positions + +The QP solver minimizes the total squared distance from original positions while +enforcing minimum spacing constraints between boxes. +} +\examples{ +library(nlme) +data(BodyWeight, package = "nlme") +# Extracting the last point of each rat's trajectory +library(data.table) +label_data <- data.table(BodyWeight)[Time == max(Time)] +library(animint2) +viz <- animint( + bodyPlot = ggplot() + + theme_bw() + + theme_animint(width=800)+ + geom_line(aes( + x = Time, y = weight, group = Rat), + clickSelects="Rat", + size=3, + data = BodyWeight) + + geom_line(aes( + x = Time, y = weight, group = Rat, colour = Rat), + clickSelects="Rat", + data = BodyWeight) + + geom_label_aligned(aes( + x = Time, y = weight, label = Rat, fill = Rat), + clickSelects="Rat", + hjust = 0, + data = label_data) + + facet_grid(~Diet) + + ggtitle("Rat body weight over time by diet") + + xlab("Time (days)") + + ylab("Body Weight (grams)") +) +viz +} diff --git a/tests/testthat/helper-functions.R b/tests/testthat/helper-functions.R index faac04203..a8c6b8b9a 100644 --- a/tests/testthat/helper-functions.R +++ b/tests/testthat/helper-functions.R @@ -443,3 +443,34 @@ driverjs_get <- function(html=getHTML()){ } out.list } + +check_aligned_box_collisions <- function(html_doc, xpath) { + box_groups <- getNodeSet(html_doc, xpath) + box_info <- lapply(box_groups, function(group) { + rect <- getNodeSet(group, './/rect')[[1]] + attrs <- xmlAttrs(rect) + list( + x = as.numeric(attrs["x"]), + y = as.numeric(attrs["y"]), + width = as.numeric(attrs["width"]), + height = as.numeric(attrs["height"]) + ) + }) + has_overlap <- FALSE + first_overlap_msg <- NULL + for (i in 1:(length(box_info) - 1)) { + for (j in (i + 1):length(box_info)) { + box1 <- box_info[[i]] + box2 <- box_info[[j]] + x_overlap <- box1$x < (box2$x + box2$width) && (box1$x + box1$width) > box2$x + y_overlap <- box1$y < (box2$y + box2$height) && (box1$y + box1$height) > box2$y + if (x_overlap && y_overlap) { + has_overlap <- TRUE + first_overlap_msg <- paste("Overlap detected between boxes", i, "and", j) + break + } + } + if (has_overlap) break + } + expect_false(has_overlap, info = first_overlap_msg) +} \ No newline at end of file diff --git a/tests/testthat/test-renderer1-geom-label-aligned.R b/tests/testthat/test-renderer1-geom-label-aligned.R new file mode 100644 index 000000000..347b45c3e --- /dev/null +++ b/tests/testthat/test-renderer1-geom-label-aligned.R @@ -0,0 +1,385 @@ +acontext("geom-label-aligned") + +library(animint2) +library(data.table) +data(WorldBank, package = "animint2") +WorldBank_dt <- as.data.table(WorldBank) +# subset of countries +tracked_countries <- c( + "United States", "Vietnam", "India", "China", "Brazil", + "Nigeria", "Mali", "South Africa", "Canada") +# Filter WorldBank data +wb <- WorldBank_dt[ + country %in% tracked_countries & + !is.na(life.expectancy) & !is.na(fertility.rate), + .(country, year = as.integer(year), life.expectancy, fertility.rate)] +# Label data for the time series +label_data_line <- wb[, .SD[year == max(year)], by = country] +# Text data for year display +year_text_data <- data.table(year = unique(wb$year)) +wb.viz <- list( + lifeExpectancyPlot = ggplot() + + geom_line(aes( + x = year, y = life.expectancy, group = country, + color = country, key=country), + size = 1.2, + data = wb, + clickSelects = "country", + showSelected = "country" + ) + + geom_label_aligned(aes( + x = year, y = life.expectancy, label = country, + fill = country, key = country), + data = label_data_line, + alignment = "vertical", + hjust = 1, + min_distance = 3, + size=10, + color = "white", + showSelected = "country", + clickSelects = "country" + ) + + ggtitle("Life Expectancy Over Time") + + xlab("Year") + + ylab("Life Expectancy (years)"), + worldbankAnim = ggplot() + + geom_point(aes( + x = fertility.rate, y = life.expectancy, color = country, key = country), + data = wb, + size = 8, + showSelected = "year", + clickSelects = "country" + ) + + geom_label_aligned(aes( + x = fertility.rate, y = life.expectancy, + label = country, fill = country, key = country), + data = wb, + size=5, + alignment = "vertical", color = "#ffffd1", label_r = 5, + showSelected = "year", + clickSelects = "country" + ) + + make_text(year_text_data, x = 4, y = 82, label = "year") + + ggtitle("Life Expectancy vs Fertility Rate") + + xlab("Fertility Rate") + + ylab("Life Expectancy"), + time = list(variable = "year", ms = 3000), + duration = list(year = 2000, country=2000), + first = list(year = min(wb$year)), + selector.types = list(country = "multiple") +) +info <- animint2HTML(wb.viz) + +# Basic rendering tests +test_that("correct number of label_aligned geoms are created", { + box_groups <- getNodeSet(info$html, '//g[@class="geom4_labelaligned_worldbankAnim"]//g[@class="geom"]') + expect_equal(length(box_groups), length(tracked_countries)) +}) + +test_that("each geom has both rect and text elements", { + box_groups <- getNodeSet(info$html, '//g[@class="geom4_labelaligned_worldbankAnim"]//g[@class="geom"]') + for (group in box_groups) { + rect <- getNodeSet(group, './/rect') + expect_equal(length(rect), 1) + text <- getNodeSet(group, './/text') + expect_equal(length(text), 1) + } +}) + +test_that("label text content is correct", { + box_groups <- getNodeSet(info$html, '//g[@class="geom4_labelaligned_worldbankAnim"]//g[@class="geom"]') + actual_texts <- sapply(box_groups, getTextValue) + expect_true(all(actual_texts %in% tracked_countries)) +}) + +test_that("label size is correct", { + ts_size <- getPropertyValue(info$html, '//g[@class="geom2_labelaligned_lifeExpectancyPlot"]//text', "font-size") + expect_equal(ts_size, rep("10px", nrow(label_data_line))) + scatter_size <- getPropertyValue(info$html, '//g[@class="geom4_labelaligned_worldbankAnim"]//text', "font-size") + expect_equal(scatter_size, rep("5px", nrow(label_data_line))) +}) + +# Collision avoidance tests +test_that("label boxes in timeSeries plot do not overlap initially", { + check_aligned_box_collisions( + info$html, + '//g[@class="geom2_labelaligned_lifeExpectancyPlot"]//g[@class="geom"]' + ) +}) + +getLabelY <- function(country){ + box.groups <- getNodeSet(getHTML(), '//g[@class="geom4_labelaligned_worldbankAnim"]//g[@class="PANEL1"]//g[@class="geom"]') + for (group in box.groups) { + text.node <- getNodeSet(group, './/text')[[1]] + if (xmlValue(text.node) == country) { + return(as.numeric(xmlAttrs(text.node)[["y"]])) + } + } +} + +test_that("geom_label_aligned shows smooth transition of y-position", { + clickID("plot_show_hide_animation_controls") + Sys.sleep(1) + clickID("play_pause") + Sys.sleep(1) + before.y <- getLabelY("China") + clickID("play_pause") + Sys.sleep(3) + during.y <- getLabelY("China") + Sys.sleep(2) + after.y <- getLabelY("China") + expect_true(during.y != after.y, info = "During position should differ from after (smooth transition)") +}) + +# Interaction tests +test_that("Aligned labels in timeSeries respond to deselecting and reselecting without disappearing or duplicating", { + extract_labels_ts <- function(html_doc) { + text_nodes <- getNodeSet(html_doc, '//g[@class="geom2_labelaligned_lifeExpectancyPlot"]//g[@class="geom"]/text') + sapply(text_nodes, xmlValue) + } + + # Deselect Brazil + clickID("plot_lifeExpectancyPlot_country_variable_Brazil") + Sys.sleep(0.5) + info$html_ts_1 <- getHTML() + labels1 <- extract_labels_ts(info$html_ts_1) + expect_false("Brazil" %in% labels1) + expect_true("India" %in% labels1) + + # Deselect India + clickID("plot_lifeExpectancyPlot_country_variable_India") + Sys.sleep(0.5) + info$html_ts_2 <- getHTML() + labels2 <- extract_labels_ts(info$html_ts_2) + expect_false("Brazil" %in% labels2) + expect_false("India" %in% labels2) + + # Reselect Brazil + clickID("plot_lifeExpectancyPlot_country_variable_Brazil") + Sys.sleep(0.5) + info$html_ts_3 <- getHTML() + labels3 <- extract_labels_ts(info$html_ts_3) + expect_true("Brazil" %in% labels3) + expect_false("India" %in% labels3) + + # Ensure no duplicate labels + expect_equal(length(labels3), length(unique(labels3)), info = "No duplicate labels should exist in timeSeries labels") +}) +test_that("Aligned labels in timeSeries do not collide after selection/deselection", { + # interactions already occurred from previous test + info$html_ts_latest <- getHTML() + check_aligned_box_collisions( + info$html_ts_latest, + '//g[@class="geom2_labelaligned_lifeExpectancyPlot"]//g[@class="geom"]' + ) +}) + +test_that("label_r sets correct rx and ry values", { + rx <- getPropertyValue(info$html, '//g[@class="geom4_labelaligned_worldbankAnim"]//rect', "rx") + ry <- getPropertyValue(info$html, '//g[@class="geom4_labelaligned_worldbankAnim"]//rect', "ry") + expect_true(all(as.numeric(rx) == 5)) + expect_true(all(as.numeric(ry) == 5)) +}) + +test_that("labels have at least 3px vertical spacing", { + y <- as.numeric(getPropertyValue(info$html, '//g[@class="geom2_labelaligned_lifeExpectancyPlot"]//rect', "y")) + h <- as.numeric(getPropertyValue(info$html, '//g[@class="geom2_labelaligned_lifeExpectancyPlot"]//rect', "height")) + positions <- lapply(seq_along(y), function(i) { + list(top = y[i], bottom = y[i] + h[i]) + }) + positions <- positions[order(sapply(positions, `[[`, "top"))] + # Calculate vertical gaps: distance from bottom[i] to top[i+1] + gaps <- mapply(function(a, b) b$top - a$bottom, + positions[-length(positions)], positions[-1]) + expect_true(all(gaps >= 3), info = paste("Min gap found:", min(gaps))) +}) + +# Testing tsv file contents , alignment positions and shrinking mechanism for labels +library(data.table) +data(Orange) +set.seed(42) +Orange <- as.data.table(Orange) +Orange_list <- lapply(1:6, function(i) { + group_name <- if(i %% 3 == 1) "Fast" else if(i %% 3 == 2) "Medium" else "Slow" + age_scalar <- if(group_name == "Fast") 1.2 else if(group_name == "Medium") 1.0 else 0.8 + Orange_copy <- copy(Orange) + Orange_copy[, `:=`( + Tree = as.numeric(Tree) + (i-1)*100, + TreeFactor = as.factor(Tree), + growth_group = group_name, + circumference = circumference * (1 + (i %% 3)/5) * runif(.N, 0.95, 1.05), + age = age * age_scalar + )] + Orange_copy +}) +Orange <- rbindlist(Orange_list) +label_data <- Orange[, .SD[age == max(age)], by = Tree][ + , label := sprintf("Tree %d (%s)", Tree, growth_group)][ + , TreeFactor := as.factor(Tree)] +viz <- list( + orangeGrowth = ggplot() + + geom_line( + data = Orange, + aes(x = circumference, y = age, group = Tree, color = growth_group, id = paste0(growth_group, Tree)), + size = 1.5, + clickSelects = "Tree", + showSelected = "growth_group", + alpha = 0.7, alpha_off = 0.1 + ) + + geom_label_aligned( + data = label_data, + aes(x = circumference, y = age, label = label, fill = growth_group, id = paste0(growth_group, Tree)), + alignment = "horizontal", + color = "white", + showSelected = "Tree", + clickSelects = "Tree" + ) + + scale_color_manual( + values = c(Fast = "#E41A1C", Medium = "#377EB8", Slow = "#4DAF4A"), + name = "Growth Rate" + ) + + scale_fill_manual( + values = c(Fast = "#E41A1C", Medium = "#377EB8", Slow = "#4DAF4A"), + name = "Growth Rate" + ) + + ggtitle("Orange Tree Growth Patterns with Natural Overlap") + + xlab("Circumference (mm)") + + ylab("Age (days)") + + theme_bw(), + first = list(growth_group = c("Fast","Medium","Slow"), + Tree = c(101, 102, 103, 104, 201, 202, 203, 204, 301, 302)), + selector.types = list(Tree = "multiple"), + title = "Orange Tree Growth Analysis" +) +info <- animint2HTML(viz) + +# Path to the chunk1 TSV file +chunk1.tsv <- file.path("animint-htmltest", "geom2_labelaligned_orangeGrowth_chunk1.tsv") + +test_that("chunk1.tsv exists", { + expect_true(file.exists(chunk1.tsv)) +}) + +chunk1 <- read.table(chunk1.tsv, sep = "\t", header = TRUE, + comment.char = "", quote = "") + +test_that("chunk1 contains expected columns", { + expected.cols <- c("fill", "x", "y", "label","id", "showSelected1", "showSelected2", "clickSelects", "group") + expect_identical(sort(names(chunk1)), sort(expected.cols)) +}) + +test_that("chunk1 data matches label_data for initially selected growth groups", { + selected_labels <- label_data[growth_group %in% c("Fast", "Medium", "Slow")] + expect_equal(nrow(chunk1), nrow(selected_labels)) + expect_setequal(chunk1$label, selected_labels$label) + expect_true(all(complete.cases(chunk1))) +}) + +test_that("initial label boxes do not overlap", { + check_aligned_box_collisions( + info$html, + '//g[contains(@class, "geom2_labelaligned_orangeGrowth")]//g[@class="geom"]' + ) +}) + +test_that("initial labels are within plot boundaries", { + plot_xlim <- info$plots$orangeGrowth$layout$panel_ranges[[1]]$x.range + plot_ylim <- info$plots$orangeGrowth$layout$panel_ranges[[1]]$y.range + + expect_true(all(chunk1$x >= plot_xlim[1] & chunk1$x <= plot_xlim[2])) + expect_true(all(chunk1$y >= plot_ylim[1] & chunk1$y <= plot_ylim[2])) +}) + +# Simulate clicking on multiple Medium group tree lines that are close together in space. +# These are expected to be positioned at the top of the plot where horizontal alignment +# can lead to overlaps, and label shrinking should occur to accommodate them. +clickID("Medium401") +clickID("Medium402") +clickID("Medium405") +clickID("Medium105") + +Sys.sleep(1) + +# ───────────────────────────────────────────────────────────────────────────── +# Test: Confirm all labels are within plot boundaries after new selections. +# This validates that when there is not enough room for all of the boxes, +# the Optimisation function shrinks the font size until all labels fit in the available space +test_that("All labels after Medium selections are within plot boundaries", { + plot_xlim <- info$plots$orangeGrowth$layout$panel_ranges[[1]]$x.range + plot_ylim <- info$plots$orangeGrowth$layout$panel_ranges[[1]]$y.range + x_vals <- as.numeric(getPropertyValue(info$html, '//g[contains(@class, "geom2_labelaligned_orangeGrowth")]//text', "x")) + y_vals <- as.numeric(getPropertyValue(info$html, '//g[contains(@class, "geom2_labelaligned_orangeGrowth")]//text', "y")) + expect_true(all(x_vals >= plot_xlim[1] & x_vals <= plot_xlim[2])) + expect_true(all(y_vals >= plot_ylim[1] & y_vals <= plot_ylim[2])) +}) + +# ───────────────────────────────────────────────────────────────────────────── +# Test: Ensure that no label boxes are overlapping after the new selections and label shrinking. +# This checks that the QP solver successfully avoids overlaps even after label shrinking and crowding. +test_that("No label overlaps occur after selecting Medium trees", { + check_aligned_box_collisions( + info$html, + '//g[contains(@class, "geom2_labelaligned_orangeGrowth")]//g[@class="geom"]' + ) +}) + +# ───────────────────────────────────────────────────────────────────────────── +# Test: Verify that the font size of Medium group labels (labels close to each other in this case) has decreased +# after adding more crowded labels, indicating the shrinking mechanism is working correctly. +test_that("Font size shrinks for Medium labels after crowding (vs. initial)", { + # XPath to target the elements inside + medium_label_text_xpath <- '//g[@class="geom2_labelaligned_orangeGrowth"]//g[starts-with(@id, "Medium")]//text' + initial_font_sizes <- getPropertyValue(info$html, medium_label_text_xpath, "font-size") + initial_font_sizes_num <- as.numeric(gsub("px", "", initial_font_sizes)) + expect_true(length(initial_font_sizes_num) > 0, + info = "No Medium group labels found in initial plot") + updated_html <- getHTML() + updated_font_sizes <- getPropertyValue(updated_html, medium_label_text_xpath, "font-size") + updated_font_sizes_num <- as.numeric(gsub("px", "", updated_font_sizes)) + expect_true(all(updated_font_sizes_num < initial_font_sizes_num), + info = paste("Font sizes did not decrease as expected:", + "Initial sizes:", paste(initial_font_sizes_num, collapse=", "), + "Updated sizes:", paste(updated_font_sizes_num, collapse=", "))) +}) +# ───────────────────────────────────────────────────────────────────────────── +test_data <- data.frame( + x = c(1, 2, 3), + y = c(1, 1, 1), + label = c("Bottom", "Middle", "Top"), + vjust = c(0, 0.5, 1) +) +viz <- list( + zeroLabelTest = ggplot() + + geom_label_aligned( + data = data.frame(x = 1, y = 1, label = 0), + aes(x, y, label = label) + ), + vjustTest = ggplot() + + geom_point(aes(x, y), data = test_data) + + geom_label_aligned( + aes(x, y, label = label, vjust = vjust), + data = test_data, + alignment = "horizontal" + ) + + ggtitle("Test of vjust values (0=bottom, 0.5=middle, 1=top)") +) +info <- animint2HTML(viz) + +# Test 1: Non-zero rect size for label=0 +test_that("label = 0 shows non-zero rect size", { + rect.nodes <- getNodeSet(info$html, '//g[@class="geom1_labelaligned_zeroLabelTest"]//rect') + expect_equal(length(rect.nodes), 1) + width <- as.numeric(getPropertyValue(info$html, '//g[@class="geom1_labelaligned_zeroLabelTest"]//rect', "width")) + height <- as.numeric(getPropertyValue(info$html, '//g[@class="geom1_labelaligned_zeroLabelTest"]//rect', "height")) + expect_gt(width, 0) + expect_gt(height, 0) +}) + +# Test 2: vjust positioning +test_that("vjust positions labels correctly for horizontal alignment", { + text_ys <- as.numeric(getPropertyValue(info$html, '//g[@class="geom3_labelaligned_vjustTest"]//text', "y")) + point_ys <- as.numeric(getPropertyValue(info$html, '//g[@class="geom2_point_vjustTest"]//circle', "cy")) + expect_gt(text_ys[1], point_ys[1]) + expect_equal(text_ys[2], point_ys[2]) + expect_lt(text_ys[3], point_ys[3]) +}) \ No newline at end of file