retrain defaults in verify_guides() and account for zcolor; fixes #1235

Author: cpsievert

R/utils.R

@@ -781,27 +781,39 @@ verify_guides <- function(p) {
   }
 
   isVisibleBar <- function(tr) {
-    is.colorbar(tr) && isTRUE(tr$showscale %||% TRUE)
+    is.colorbar(tr) && (tr$showscale %||% TRUE)
   }
   isBar <- vapply(p$x$data, isVisibleBar, logical(1))
   nGuides <- sum(isBar) + has_legend(p)
 
   if (nGuides > 1) {
 
     # place legend at bottom since its scrolly
-    p$x$layout$legend <- modify_list(
-      list(y = 1 - ((nGuides - 1) / nGuides), yanchor = "top"),
-      p$x$layout$legend
-    )
+    yanchor <- default("top")
+    y <- default(1 - ((nGuides - 1) / nGuides))
+    p$x$layout$legend$yanchor <- p$x$layout$legend$yanchor %|D|% yanchor
+    p$x$layout$legend$y <- p$x$layout$legend[["y"]] %|D|% y
 
+    # shrink/position colorbars
     idx <- which(isBar)
     for (i in seq_along(idx)) {
+      len     <- default(1 / nGuides)
+      lenmode <- default("fraction")
+      y       <- default(1 - ((i - 1) / nGuides))
+      
       j <- idx[[i]]
-      bar <- p$x$data[[j]]$marker$colorbar
-      p$x$data[[j]]$marker$colorbar$len <- bar$len %||% (1 / nGuides)
-      p$x$data[[j]]$marker$colorbar$lenmode <- bar$lenmode %||% "fraction"
-      p$x$data[[j]]$marker$colorbar$y <- bar$y %||% (1 - ((i - 1) / nGuides))
-      p$x$data[[j]]$marker$colorbar$yanchor <- bar$yanchor %||% "top"
+      tr <- p$x$data[[j]]
+      if (inherits(tr, "zcolor")) {
+        p$x$data[[j]]$colorbar$len <- tr$colorbar$len %|D|% len
+        p$x$data[[j]]$colorbar$lenmode <- tr$colorbar$lenmode %|D|% "fraction"
+        p$x$data[[j]]$colorbar$y <- tr$colorbar$y %|D|% y
+        p$x$data[[j]]$colorbar$yanchor <- tr$colorbar$yanchor %|D|% yanchor
+      } else {
+        p$x$data[[j]]$marker$colorbar$len <- tr$marker$colorbar$len %|D|% len
+        p$x$data[[j]]$marker$colorbar$lenmode <- tr$marker$colorbar$lenmode %|D|% "fraction"
+        p$x$data[[j]]$marker$colorbar$y <- tr$marker$colorbar$y %|D|% y
+        p$x$data[[j]]$marker$colorbar$yanchor <- tr$marker$colorbar$yanchor %|D|% yanchor
+      }
     }
 
   }

tests/testthat/test-plotly-colorbar.R

@@ -92,4 +92,51 @@ test_that("can control both fill and stroke colorbars", {
   expect_true(bar_stroke$y == 0.55)
   expect_true(bar_stroke$title == "stroke color")
 
+})
+
+test_that("positioning with multiple colorbars and legends", {
+  
+  s <- subplot(
+    plot_ly(z = ~volcano),
+    plot_ly(x = 1:10, y = 1:10, color = 1:10)
+  )
+  
+  b <- plotly_build(s)
+  d <- b$x$data
+  expect_length(d, 3)
+  
+  expect_true(d[[1]]$colorbar$len == 1/3)
+  expect_true(d[[1]]$colorbar$lenmode == "fraction")
+  expect_true(d[[1]]$colorbar$yanchor == "top")
+  expect_true(d[[1]]$colorbar$y == 1)
+  
+  expect_true(d[[3]]$marker$colorbar$len == 1/3)
+  expect_true(d[[3]]$marker$colorbar$lenmode == "fraction")
+  expect_true(d[[3]]$marker$colorbar$yanchor == "top")
+  expect_equal(as.numeric(d[[3]]$marker$colorbar$y), 2/3, tolerance = 0.01)
+  
+  expect_true(b$x$layout$legend$yanchor == "top")
+  expect_equal(as.numeric(b$x$layout$legend$y), 1/3, tolerance = 0.01)
+  
+  
+  s <- subplot(
+    plot_ly(z = ~volcano),
+    plot_ly(x = 1:10, y = 1:10, color = factor(1:10))
+  )
+  
+  b <- plotly_build(s)
+  d <- b$x$data
+  expect_length(d, 11)
+  
+  expect_true(d[[1]]$colorbar$len == 0.5)
+  expect_true(d[[1]]$colorbar$lenmode == "fraction")
+  expect_true(d[[1]]$colorbar$yanchor == "top")
+  expect_true(d[[1]]$colorbar$y == 1)
+  
+  expect_true(b$x$layout$legend$y == 0.5)
+  expect_true(b$x$layout$legend$yanchor == "top")
+  
+  
+  
+  
 })