theme_animint(rowspan, colspan, last_in_row)

R/z_animint.R

@@ -200,7 +200,7 @@ parsePlot <- function(meta, plot, plot.name){
   options_list <- getWidthAndHeight(plot$theme)
   options_list <- setUpdateAxes(plot$theme, options_list)
   plot.info$options <- options_list
-
+  plot.info$attributes <- theme_attribute(plot$theme)  
   list(
     plot.info=plot.info,
     ggplot=plot,

R/z_animintHelpers.R

@@ -131,20 +131,28 @@ getUniqueAxisLabels <- function(plot.meta){
   return(plot.meta)
 }
 
-
-getWidthAndHeight <- function(theme){
+getThemeOptions <- function(theme, keys, default_values) {
   options_list <- list()
-  for(wh in c("width", "height")){
-    awh <- paste0("animint.", wh)
-    options_list[[wh]] <- if(awh %in% names(theme)){
-      theme[[awh]]
-    }else{
-      400
+  for (i in seq_along(keys)) {
+    key <- keys[i]
+    attr_name <- paste0("animint.", key)
+    options_list[[key]] <- if (attr_name %in% names(theme)) {
+      theme[[attr_name]]
+    } else {
+      default_values[[i]]
     }
   }
   options_list
 }
 
+getWidthAndHeight <- function(theme) {
+  getThemeOptions(theme, c("width", "height"), list(400, 400))
+}
+
+theme_attribute <- function(theme) {
+  getThemeOptions(theme, c("rowspan", "colspan", "last_in_row"), list(1, 1, FALSE))
+}
+
 
 setUpdateAxes <- function(theme, options_list){
   update_axes <- "animint.update_axes"

inst/htmljs/animint.js

@@ -7,7 +7,9 @@
 var animint = function (to_select, json_file) {
   var steps = [];
   var default_axis_px = 16;
-
+  var element = d3.select(to_select);
+  this.element = element;
+  var viz_id = element.attr("id");
    function wait_until_then(timeout, condFun, readyFun) {
     var args=arguments
     function checkFun() {
@@ -243,15 +245,22 @@ var animint = function (to_select, json_file) {
     // Save this geom and load it!
     update_geom(g_name, null);
   };
+
+  var current_tr = plot_td.append("tr");
   var add_plot = function (p_name, p_info) {
-    // Each plot may have one or more legends. To make space for the
-    // legends, we put each plot in a table with one row and two
-    // columns: tdLeft and tdRight.
-    var plot_table = plot_td.append("table").style("display", "inline-block");
+    if(!current_tr) {
+    current_tr = plot_td.append("tr");
+  }
+  var td = current_tr.append("td");
+  var attributes = p_info.attributes || {};
+  td.attr("rowspan", attributes.rowspan || 1)
+    .attr("colspan", attributes.colspan || 1);
+    // Inner table for plot and legend
+    var plot_table = td.append("table").style("display", "inline-block");
     var plot_tr = plot_table.append("tr");
     var tdLeft = plot_tr.append("td");
-    var tdRight = plot_tr.append("td").attr("class", p_name+"_legend");
-    if(viz_id === null){
+    var tdRight = plot_tr.append("td").attr("class", p_name + "_legend");
+    if (viz_id === null) {
       p_info.plot_id = p_name;
     }else{
       p_info.plot_id = viz_id + "_" + p_name;
@@ -767,6 +776,10 @@ var animint = function (to_select, json_file) {
       ;
     }
     Plots[p_name].scales = scales;
+// Create new row if max columns reached or last_in_row specified
+ if(attributes.last_in_row) {
+    current_tr = plot_td.append("tr");
+  }
   }; //end of add_plot()
 
   function update_legend_opacity(v_name){
@@ -2273,6 +2286,9 @@ var animint = function (to_select, json_file) {
 	.attr("href", response.source)
 	.text("source");
     }
+    var widget_tr = plot_widget_table.append("tr");
+    var widget_td = widget_tr.append("td")
+    .attr("colspan", 2)  
     widget_td
       .append('button')
       .attr('class', 'animint_start_tour')

tests/testthat/test-renderer3-sixplot.R

@@ -0,0 +1,48 @@
+test_that("HTML layout includes rowspan and colspan attributes", {
+
+  base_data <- data.frame(x = 1:3, y = c(2, 4, 6))
+
+  plot_list <- list(
+    LargeLeftPanel = ggplot(base_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("Left Side Large") +
+      theme_animint(rowspan = 2, colspan = 1),
+    TopRight = ggplot(base_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("Top Right") +
+      theme_animint(last_in_row = TRUE),  
+    BottomRight = ggplot(base_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("Bottom Right") +
+      theme_animint(last_in_row = TRUE),  
+    FooterLeft = ggplot(base_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("Footer Left"),
+    FooterMiddle = ggplot(base_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("Footer Middle"),
+    FooterRight = ggplot(base_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("Footer Right") +
+      theme_animint( last_in_row = TRUE) +
+      theme_animint(colspan = 2)
+)
+
+  info <- animint2HTML(plot_list)
+  html <- info$html
+
+  all_plot_tables <- getNodeSet(html, "//table[@style='display: inline-block;']")
+  expect_equal(length(all_plot_tables), 6)
+
+  td_with_rowspan <- getNodeSet(html, "//td[@rowspan]")
+  rowspan_values <- sapply(td_with_rowspan, xmlGetAttr, "rowspan")
+  expect_true(any(rowspan_values == "2"), info = "Expect one or more cells with rowspan=2")
+
+  td_with_colspan <- getNodeSet(html, "//td[@colspan]")
+  colspan_values <- sapply(td_with_colspan, xmlGetAttr, "colspan")
+  expect_true(any(colspan_values == "2"), info = "Expect one or more cells with colspan=2")
+
+  html_lines <- XML::saveXML(html)
+  expect_true(any(grepl("Left Side Large", html_lines)))
+  expect_true(any(grepl("Footer Right", html_lines)))
+})

tests/testthat/test-renderer3-threeplot.R

@@ -0,0 +1,33 @@
+test_that("Simple rowspan layout works", {
+  plot_data <- data.frame(x = 1:3, y = c(2, 4, 6))
+
+  plot_collection <- list(
+    LeftPlot = ggplot(plot_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("left_plot") +
+      theme_animint(rowspan = 2),
+    TopRightPlot = ggplot(plot_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("top_right_plot") +
+      theme_animint(last_in_row = TRUE),
+    BottomRightPlot = ggplot(plot_data, aes(x, y)) +
+      geom_point() +
+      ggtitle("bottom_right_plot")
+  )
+
+  html <- animint2HTML(plot_collection)$html
+
+  # 3 plot tables should be rendered
+  tables <- getNodeSet(html, "//table[@style='display: inline-block;']")
+  expect_equal(length(tables), 3)
+
+  # Check that at least one cell has rowspan=2
+  rowspan_cells <- getNodeSet(html, "//td[@rowspan='2']")
+  expect_true(length(rowspan_cells) >= 1)
+
+  # Check that plot titles appear in HTML
+  html_text <- saveXML(html)
+  expect_true(grepl("left_plot", html_text))
+  expect_true(grepl("top_right_plot", html_text))
+  expect_true(grepl("bottom_right_plot", html_text))
+})