create patchwork design

DESCRIPTION

@@ -13,8 +13,10 @@ RoxygenNote: 7.3.1
 Imports: 
     htmltools,
     htmlwidgets,
+    rlang,
     shiny
 Suggests:
     bslib,
     data.table,
-    ggplot2
+    ggplot2,
+    patchwork

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(create_design)
 export(gridstack)
 export(gridstackOutput)
 export(gridstack_proxy)
@@ -22,6 +23,8 @@ importFrom(htmlwidgets,createWidget)
 importFrom(htmlwidgets,shinyRenderWidget)
 importFrom(htmlwidgets,shinyWidgetOutput)
 importFrom(htmlwidgets,sizingPolicy)
+importFrom(rlang,"%||%")
+importFrom(rlang,expr)
 importFrom(shiny,exprToFunction)
 importFrom(shiny,getDefaultReactiveDomain)
 importFrom(shiny,insertUI)

R/design.R

@@ -0,0 +1,27 @@
+
+#' Create a patchwork design
+#'
+#' @param grid_layout Layout of the GridStack retrieved via `input$<outputId>_layout`.
+#'
+#' @return An expression that can be evaluated to create a design usable in {patchwork}.
+#' @export
+#'
+#' @importFrom rlang expr %||%
+#'
+#' @example examples/patchwork-design.R
+create_design <- function(grid_layout) {
+  if (is.null(grid_layout$children))
+    stop("grid_layout must be the value stored in `input$<outputId>_layout`")
+  design <- lapply(
+    X = grid_layout$children,
+    FUN = function(x) {
+      t <- x$y + 1
+      l <- x$x + 1
+      b <- x$y + x$h %||% 1
+      r <- x$x + x$w %||% 1
+      expr(area(!!t, !!l, !!b, !!r))
+    }
+  )
+  expr(c(!!!design))
+}
+

R/gridstack.R

@@ -30,6 +30,7 @@
 #' @param bg Background color.
 #' @inheritParams htmlwidgets::createWidget
 #'
+#'
 #' @importFrom htmlwidgets createWidget sizingPolicy
 #' @importFrom htmltools renderTags
 #'
@@ -102,35 +103,30 @@ gridstack <- function(...,
   )
 }
 
-#' #' @importFrom htmltools tags
-#' gridstack_html <- function(id, style, class, ...) {
-#'   tags$div(
-#'     id = id,
-#'     class = class,
-#'     class = "grid-stack",
-#'     style = style,
-#'     ...
-#'   )
-#' }
 
-#' Shiny bindings for gridstack
+
+
+
+#' @title Shiny bindings for gridstack
 #'
+#' @description
 #' Output and render functions for using gridstack within Shiny
 #' applications and interactive Rmd documents.
 #'
-#' @param outputId output variable to read from
-#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
-#'   \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
-#'   string and have \code{'px'} appended.
-#' @param expr An expression that generates a gridstack
-#' @param env The environment in which to evaluate \code{expr}.
-#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
-#'   is useful if you want to save an expression in a variable.
+#' @inheritParams htmlwidgets::shinyWidgetOutput
+#' @inheritParams htmlwidgets::shinyRenderWidget
+#'
+#' @note
+#' The GridStack layout can be retrieved via the special shiny input `input$<outputId>_layout`.
 #'
 #' @name gridstack-shiny
 #' @importFrom htmlwidgets shinyWidgetOutput shinyRenderWidget
 #' @export
-gridstackOutput <- function(outputId, width = "100%", height = "400px"){
+#'
+#' @example examples/shiny.R
+#'
+#' @example examples/shiny-input.R
+gridstackOutput <- function(outputId, width = "100%", height = "400px") {
   htmlwidgets::shinyWidgetOutput(outputId, "gridstack", width, height, package = "gridstackr")
 }
 

R/zzz.R

@@ -0,0 +1,3 @@
+utils::globalVariables(c(
+  "area" # from patchwork
+))

examples/patchwork-design.R

@@ -0,0 +1,67 @@
+
+library(shiny)
+library(bslib)
+library(ggplot2)
+library(gridstackr)
+library(patchwork)
+
+ui <- page_fluid(
+  tags$h2("Create {patchwork} design"),
+  fluidRow(
+    column(
+      width = 6,
+      tags$b("Create your design:"),
+      gridstackOutput("grid")
+    ),
+    column(
+      width = 6,
+      tags$b("Result:"),
+      plotOutput("design")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  output$grid <- renderGridstack({
+    gridstack(
+      resize_handles = "se,e,s",
+      gs_item(
+        plotOutput("plot1", height = "100%")
+      ),
+      gs_item(
+        plotOutput("plot2", height = "100%")
+      ),
+      gs_item(
+        plotOutput("plot3", height = "100%")
+      ),
+      gs_item(
+        plotOutput("plot4", height = "100%")
+      )
+    )
+  })
+
+  output$plot1 <- renderPlot({
+    ggplot(mtcars) + geom_point(aes(mpg, disp))
+  })
+  outputOptions(output, "plot1", suspendWhenHidden = TRUE)
+  output$plot2 <- renderPlot({
+    ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))
+  })
+  output$plot3 <- renderPlot({
+    ggplot(mtcars) + geom_smooth(aes(disp, qsec))
+  })
+  output$plot4 <- renderPlot({
+    ggplot(mtcars) + geom_bar(aes(carb))
+  })
+
+  output$design <- renderPlot({
+    req(input$grid_layout)
+    mydesign <- create_design(input$grid_layout)
+    plot(eval(mydesign))
+  })
+
+}
+
+if (interactive())
+  shinyApp(ui, server)