implementing geom_label_aligned

.gitignore

@@ -10,5 +10,5 @@
 *ANIMINT_TEST_FOO
 *pids.txt
 *~
-.vscode/settings.jsonnode_modules/
-node_modules/
+.vscode/settings.json
+/node_modules

DESCRIPTION

@@ -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'

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)

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

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"

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

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