Multiwindow App

calendar Aug 30, 2021 · 10 min read · R shiny javascript  ·
Share on: linkedin copy

This is an initial concept of a framework for multiwindow shiny apps. Shiny is a great R package for building an interactive, web-based, graphical UI using R. It does, however, suffer from some limitations. One of these is the fact that a Shiny app runs in a single browser window. To make a more complex interface we can extend the browser window to full screen and add tab panels or scrollbars. Another concept is to break parts of the app into separate apps, each with their own window, separate but linked through a single data source (a single source of truth).
In this prototype, one app pushes data to a json file and two others read the data from this file using a reactiveFileReader. The reactiveFileReader ensures that any changes made to the data updates the apps that are dependent upon it. One additional shiny app (launcher) is responsible for opening and closing all other apps.

Folder Structure

The folder structure is as follows, under the multiwindow project folder:

 1multiwindow
 2├── launcher  
 3│   ├── app.R
 4│   └── www  
 5│       └── script.js  
 6├── app_options  
 7│   └── app.R  
 8├── app_graphics  
 9│   └── app.R  
10└── app_details  
11   └── app.R

There are four apps along with a javascript file which handles opening windows:

  • launcher/app.R - an app that manages opening and closing the other shiny apps as well as defining the json file location.
  • launcher/www/script.js - a javascript file that opens shiny apps in minimal browser windows of specified size and location.
  • app_options/app.R - a simple app that allows the user to select a number of options and writes them to a json file.
  • app_graphics/app.R - a simple app that reads in the json file and plots a chart.
  • app_details/app.R - a simple app that reads in the json file and outputs the file contents.

Concept

launcher controls opening and closing of the other three apps (app_options, app_graphics and app_details). Communication is handled using a json file.

graph TB subgraph launcher app_options --> json_file; json_file --> app_graphics; json_file --> app_details; end

Code

launcher/app.R

  1## App lauuncher
  2## This app manages all others
  3
  4
  5library(shiny)
  6library(shinyWidgets)
  7
  8server <- function(input, output, session) {
  9  
 10  ## create a temp folder with access permissions
 11  jsonfile <- tempfile(fileext = ".json")
 12  
 13  ## replace this with the shiny server URL (subfolder = mutiwindow)
 14  url_base <- ###
 15  
 16  ## define app windows
 17  app_windows <- data.frame(
 18    name = c("app_options", "app_graphics", "app_details"),
 19    app = c("app_options", "app_graphics", "app_details"),
 20    height = c(0.25, 0.4, 0.25),
 21    width = c(0.095, 0.2, 0.095),
 22    left = c(0.02, 0.02, 0.125),
 23    top = c(0.02, 0.33, 0.02),
 24    closable = c(TRUE, TRUE, TRUE),
 25    stringsAsFactors = FALSE
 26  )
 27  app_windows$url <- paste0(url_base, app_windows$app, "/?file=", jsonfile)
 28  
 29  
 30  ## launch all apps
 31  for (i in 1:nrow(app_windows)) {
 32    session$sendCustomMessage("launch_app", app_windows[i, ])
 33  }
 34  
 35  observe({
 36    req(!is.null(input$txt_com_file))
 37    session$sendCustomMessage("disable", "txt_com_file")
 38  })
 39  
 40  output$ui_communications <- renderUI({
 41    column(10, offset = 1, textInput("txt_com_file", label = "Communications File", width = "100%", value = jsonfile))
 42  })
 43  
 44  
 45  # app_options ------------------------------------------------------------------
 46  
 47  ## options UI
 48  output$ui_app_options <- renderUI({
 49    fluidRow(
 50      column(1, offset = 1, style = "margin-top: 8px;", prettySwitch("swt_app_options", status = "success", label = NULL, inline = TRUE, bigger = TRUE, value = TRUE)),
 51      column(5, h4("shiny app: setting options")),
 52      column(2, offset = 1, actionBttn("but_close_all", label = "Close All", style = "simple", color = "danger", size = "sm"))
 53    )
 54  })
 55  
 56  ## switch enable
 57  observe({
 58    req(!is.null(input$swt_app_options))
 59    if (!app_windows[1, ]$closable) {
 60      session$sendCustomMessage("disable", "swt_app_options")
 61    }
 62  })
 63  
 64  ## close app_options
 65  observeEvent(input$swt_app_options, {
 66    if (input$swt_app_options == TRUE) {
 67      session$sendCustomMessage("launch_app", app_windows[1, ])
 68    } else {
 69      session$sendCustomMessage("close_app", app_windows[1, ])
 70    }
 71  })
 72
 73
 74  # app_graphics ------------------------------------------------------------------
 75  
 76  ## graphics UI
 77  output$ui_app_graphics <- renderUI({
 78    fluidRow(
 79      column(1, offset = 1, style = "margin-top: 8px;", prettySwitch("swt_app_graphics", status = "success", label = NULL, inline = TRUE, bigger = TRUE, value = TRUE)),
 80      column(5, h4("shiny app: plotting graphics"))
 81    )
 82  })
 83  
 84  ## switch enable
 85  observe({
 86    req(!is.null(input$swt_app_graphics))
 87    if (!app_windows[2, ]$closable) {
 88      session$sendCustomMessage("disable", "swt_app_graphics")
 89    }
 90  })
 91  
 92  ## close app_options
 93  observeEvent(input$swt_app_graphics, {
 94    if (input$swt_app_graphics == TRUE) {
 95      session$sendCustomMessage("launch_app", app_windows[2, ])
 96    } else {
 97      session$sendCustomMessage("close_app", app_windows[2, ])
 98    }
 99  })
100
101
102  # app_details ------------------------------------------------------------------
103  
104  ## details UI
105  output$ui_app_details <- renderUI({
106    fluidRow(
107      column(1, offset = 1, style = "margin-top: 8px;", prettySwitch("swt_app_details", status = "success", label = NULL, inline = TRUE, bigger = TRUE, value = TRUE)),
108      column(5, h4("shiny app: setting details"))
109    )
110  })
111  
112  ## switch enable
113  observe({
114    req(!is.null(input$swt_app_details))
115    if (!app_windows[3, ]$closable) {
116      session$sendCustomMessage("disable", "swt_app_details")
117    }
118  })
119  
120  ## close app_options
121  observeEvent(input$swt_app_details, {
122    if (input$swt_app_details == TRUE) {
123      session$sendCustomMessage("launch_app", app_windows[3, ])
124    } else {
125      session$sendCustomMessage("close_app", app_windows[3, ])
126    }
127  })
128  
129  ## close all apps
130  observeEvent(input$but_close_all, {
131    for (i in 1:nrow(app_windows)) {
132      session$sendCustomMessage("close_app", app_windows[i, ])
133    }
134  })
135
136}
137
138ui <- fluidPage(
139  tags$head(
140    tags$script(type = "text/javascript", src = "script.js")
141  ),
142  br(),
143  br(),
144  fluidRow(column(10, offset = 1, 
145                  panel(status = "primary", heading = "App Launcher",
146                        panel(status = "danger", heading = "Communications",
147                              uiOutput("ui_communications")
148                        ),
149                        br(),
150                        panel(status = "danger", heading = "App Windows",
151                              fluidRow(uiOutput("ui_app_options")),
152                              fluidRow(uiOutput("ui_app_graphics")),
153                              fluidRow(uiOutput("ui_app_details"))
154                        )
155                  )
156  ))
157)
158
159shinyApp(ui = ui, server = server)
160

launcher/www/script.js

 1var shiny_app_options = "";
 2var shiny_app_graphics = "";
 3var shiny_app_details = "";
 4
 5// launch a shiny app in a minimal window
 6// window opens with a specified size at a specified screen location (based on fraction of total screen width and height)
 7Shiny.addCustomMessageHandler('launch_app', function(x) {
 8  scr_height = window.screen.height;
 9  scr_width = window.screen.width;
10  window_height = scr_height * x.height;
11  window_width = scr_width * x.width;
12  window_left = scr_width * x.left;
13  window_top = scr_height * x.top;
14  window_options = "height=" + window_height + ", width=" + window_width + ", left=" + window_left + ", top=" + window_top;
15  
16  if (x.name == "app_options") {
17    shiny_app_options = window.open(x.url, x.name, window_options);
18  } else if (x.name == "app_graphics") {
19    shiny_app_graphics = window.open(x.url, x.name, window_options);
20  } else if (x.name == "app_details") {
21    shiny_app_details = window.open(x.url, x.name, window_options);
22  }
23});
24
25// close a shiny app
26Shiny.addCustomMessageHandler('close_app', function(x) {
27  console.log(x.name);
28  // can't pass window name as variable to close so have to hardcode :(
29  if (x.name == "app_options") {
30    console.log('close app_options');
31    shiny_app_options.close();
32  } else if (x.name == "app_graphics") {
33    console.log('close app_graphics');
34    shiny_app_graphics.close();
35  } else if (x.name == "app_details") {
36    console.log('close app_details');
37    shiny_app_details.close();
38  }
39});
40
41// disable a shiny input
42Shiny.addCustomMessageHandler('disable', function(id) {
43  var input_type = $("#" + id).prop("type");
44  if (input_type.startsWith("select")) {
45    $("#" + id)[0].selectize.disable();
46  } else {
47    $("#" + id).prop("disabled", true);
48  }
49});
50

app_options/app.R

 1## app_options
 2## A simple app that offers a series of options
 3
 4library(shiny)
 5library(shinyWidgets)
 6library(jsonlite)
 7
 8server <- function(input, output, session) {
 9  
10  filename <- reactive({
11    query <- parseQueryString(session$clientData$url_search)
12    if (!is.null(query$file)) {
13      query$file
14    } else {
15      ""
16    }
17  })
18  
19  output$ui_axes <- renderUI({
20    req(input$sel_data)
21    ## select x and y parameters from numeric columns
22    df <- get(input$sel_data)
23    columns <- names(df)[sapply(df, class) == "numeric"]
24    tagList(
25      selectizeInput("sel_x", "X parameter", choices = columns),
26      selectizeInput("sel_y", "Y parameter", choices = columns)
27    )
28  })
29  
30  ## write file when updating parameter
31  observeEvent(input$sel_data, {
32    write_file()
33  })
34  
35  observeEvent(input$sel_x, {
36    write_file()
37  })
38  
39  observeEvent(input$sel_y, {
40    write_file()
41  })
42  
43  ## write a file
44  write_file <- function() {
45    if (filename() != "") {
46      output <- list(
47        data = input$sel_data,
48        x = input$sel_x,
49        y = input$sel_y
50      )
51      json_out <- toJSON(output, auto_unbox = TRUE, null = "null")
52      con <- file(filename(), open = "wt")
53      writeLines(json_out, con)
54      close(con)
55    }
56  }
57}
58
59ui <- fluidPage(
60  br(),
61  br(),
62  panel(heading = "Options", status = "primary",
63        selectizeInput("sel_data", "dataset", choices = c("iris", "mtcars")),
64        uiOutput("ui_axes")
65        )
66)
67
68shinyApp(ui, server)

app_graphics/app.R

 1## app_graphics
 2## A simple app that draws a ggplot
 3
 4library(shiny)
 5library(shinyWidgets)
 6library(ggplot2)
 7library(jsonlite)
 8
 9server <- function(input, output, session) {
10  
11  filename <- reactive({
12    query <- parseQueryString(session$clientData$url_search)
13    if (!is.null(query$file)) {
14      query$file
15    } else {
16      ""
17    }
18  })
19  
20  ## retrieve data from file
21  json_data <- reactiveFileReader(2000, session, filePath = filename, readFunc = function(filePath) {
22    tryCatch({
23      con <- file(filePath)
24      file_contents <- readLines(con)
25      close(con)
26      file_contents
27    },
28    error = function(e) NA
29    )
30  })
31  
32  output$plt <- renderPlot({
33    req(json_data())
34    
35    ## check all plotting parameters are present
36    params <- c("data", "x", "y")
37    data <- fromJSON(json_data())
38    if (all(sapply(params, function(x) !is.null(data[[x]])))) {
39      ggplot(get(data[["data"]]), aes(x = .data[[data[["x"]]]], y = .data[[data[["y"]]]])) +
40        geom_point() +
41        labs(title = paste0("Plot data = ", data[["data"]]),
42             x = data[["x"]], 
43             y = data[["y"]])
44    }
45
46  })
47  
48}
49
50ui <- fluidPage(
51  br(),
52  br(),
53  panel(heading = "Graphics", status = "primary",
54        plotOutput("plt")
55  )
56)
57
58shinyApp(ui, server)

app_details/app.R

 1## app_details
 2## A simple app that lists some details
 3
 4library(shiny)
 5library(shinyWidgets)
 6library(jsonlite)
 7
 8server <- function(input, output, session) {
 9  
10  filename <- reactive({
11    query <- parseQueryString(session$clientData$url_search)
12    if (!is.null(query$file)) {
13      query$file
14    } else {
15      ""
16    }
17  })
18  
19  ## retrieve data from file
20  json_data <- reactiveFileReader(2000, session, filePath = filename, readFunc = function(filePath) {
21    tryCatch({
22      con <- file(filePath)
23      file_contents <- readLines(con)
24      close(con)
25      file_contents
26    },
27    error = function(e) NA
28    )
29  })
30  
31  output$txt_details <- renderPrint({
32    prettify(json_data())
33  })
34  
35}
36
37ui <- fluidPage(
38  br(),
39  br(),
40  panel(heading = "Output", status = "primary",
41        verbatimTextOutput("txt_details")
42  )
43)
44
45shinyApp(ui, server)

Output

When running the launcher app the following window first opens:

This automatically triggers opening of the other three shiny apps (app_options, app_graphics and app_details). The windows for these apps are sized and located according to the app_windows data frame in launcher/app.R as follows:

 1  ## define app windows
 2  app_windows <- data.frame(
 3    name = c("app_options", "app_graphics", "app_details"),
 4    app = c("app_options", "app_graphics", "app_details"),
 5    height = c(0.25, 0.4, 0.25),
 6    width = c(0.095, 0.2, 0.095),
 7    left = c(0.02, 0.02, 0.125),
 8    top = c(0.02, 0.33, 0.02),
 9    closable = c(TRUE, TRUE, TRUE),
10    stringsAsFactors = FALSE
11  )
12  app_windows$url <- paste0(url_base, app_windows$app, "/?file=", jsonfile)

Here, the sizes and dimensions are based on screen fractions so app_options is 25% of the screen height and 9.5% of the screen width, and is placed 2% from the left of the screen and 2% from the top of the screen.

The resulting screen capture of app_options, app_graphics and app_details looks like this:

When an option in app_options is changed, the json file is update and the reactiveFileReader in app_graphics and app_details triggers an update. All three apps are independent but connected through the json file.

Here's a screenshot after updating: