[Bug]: qenv prints plots to the device when running shiny app

[gogonzo]

What happened?

In qenv we execute print(plot) to capture possible errors or warning during print of the plot. In the same time this plot is sent to the shiny::plotOutput (through teal.widgets::plot_with_settings). Issue is following - plot is printed in the reactive and the same reactive is used in plot_with_settings_srv, in verbatim_popup_srv (SRC and warnings) and sometimes in table_with_settings. This results in a situation that during interactive session plot output is rendered in shiny and additionally printed to the device - this is annoying as it's printed to IDE. I'm not also sure if:

1. R uses the same file (annoying)
2. or create a file twice (serious issue)

Please analyse example below and observe when output is printed to IDE. Currently, we experience additional print in following modules:

• ✔️ "plot+observe" caused by observe - expected
• ❌ "pws+warn" caused by disable in verbatim_popup_srv (not expected)
• ❌ "pws+tws" caused by table_with_settings (not expected)
• ❌ "tmg-scatterplot" caused by verbatim_popup_srv and renderDataTable (not expected)

Run the example and see

library(shiny)
library(ggplot2)
library(magrittr)
library(rtables)
pkgload::load_all("teal.widgets")
pkgload::load_all("teal.modules.general")
pkgload::load_all("teal.code")
library(teal)
library(scda)
ADSL <- synthetic_cdisc_data("latest")$adsl

ui_plot_noqenv <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    div(
      plotOutput(ns("plot_normal")),
      DT::dataTableOutput(ns("tab2"))
    )
  )
}
server_plot_noqenv <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('basic')
        plot(1:10)
        print(p)
      }))
    })

    output$plot_normal <- renderPlot(q2())
    output$tab2 <- DT::renderDataTable({
      q2()
      head(iris)
    })
  })
}

ui_plot <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(9, plotOutput(ns("plot_normal"))),
      column(3, verbatim_popup_ui(ns("pop2"), "SRC"))
    )
  )
}
server_plot <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('plot')
        plot(1:10)
        print(p)
      }))
    })

    output$plot_normal <- renderPlot(q2()[["p"]])
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}

ui_plot_and_table <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(9, plotOutput(ns("plot_normal"))),
      column(3, verbatim_popup_ui(ns("pop2"), "SRC"))
    ),
    DT::dataTableOutput(ns("table"))
  )
}
server_plot_and_table <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('plot+table')
        plot(1:10)
        print(p)
      }))
    })

    output$plot_normal <- renderPlot(q2()[["p"]])
    output$table <- DT::renderDataTable(q2()[["iris"]])
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}

ui_plot_and_observe <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(9, plotOutput(ns("plot_normal"))),
      column(3, verbatim_popup_ui(ns("pop2"), "SRC"))
    )
  )
}
server_plot_and_observe <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('plot+observe')
        plot(1:10)
        print(p)
      }))
    })

    output$plot_normal <- renderPlot(q2()[["p"]])
    observe(q2())
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}

ui_plot_uirender <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    uiOutput(ns("ui"))
  )
}
server_plot_uirender <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    output$ui <- renderUI({
        fluidRow(
        column(9, plotOutput(session$ns("plot_normal"))),
        column(3, verbatim_popup_ui(session$ns("pop2"), "SRC"))
      )
    })
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('plot+uirender')
        plot(1:10)
        print(p)
      }))
    })

    output$plot_normal <- renderPlot(q2()[["p"]])
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}

ui_pws <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(9, teal.widgets::plot_with_settings_ui(id = ns("p2"))),
      column(3, verbatim_popup_ui(ns("pop2"), "SRC"))
    )
  )
}
server_pws <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('pws')
        plot(1:10)
        print(p)
      }))
    })

    teal.widgets::plot_with_settings_srv(id = "p2", plot_r = reactive(q2()[["p"]]))
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}

ui_pws_and_warn <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(9, teal.widgets::plot_with_settings_ui(id = ns("p2"))),
      column(3, verbatim_popup_ui(ns("pop2"), "SRC")),
      column(3, verbatim_popup_ui(ns("pop2w"), "Warn"))
    )
  )
}
server_pws_and_warn <- function(id) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('pws+warn')
        plot(1:10)
        print(p)
      }))
    })

    teal.widgets::plot_with_settings_srv(id = "p2", plot_r = reactive(q2()[["p"]]))
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
    verbatim_popup_srv("pop2w", reactive(get_warnings(q2())), "Warn", disabled = reactive(is.null(get_warnings(q2()))))
  })
}

ui_pws_tws <- function(id) {
  ns <- NS(id)
  fluidPage(
    shinyjs::useShinyjs(),
    fluidRow(
      column(9, teal.widgets::plot_with_settings_ui(id = ns("p2"))),
      column(3, verbatim_popup_ui(ns("pop2"), "SRC"))
    ),
    teal.widgets::table_with_settings_ui(id = ns("t2"))
  )
}
server_pws_tws <- function(id) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('pws+tws')
        plot(1:10)
        print(p)
      }))
    })
    table_r <- reactive({
      q2()
      l <- basic_table() %>%
        split_cols_by("ARM") %>%
        analyze(c("SEX", "AGE"))
      build_table(l, DM)
    })

    teal.widgets::plot_with_settings_srv(id = "p2", plot_r = reactive(q2()[["p"]]))
    teal.widgets::table_with_settings_srv(id = "t2", table_r = reactive(table_r()))
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}
server_pws_tws_fix <- function(id) {
  moduleServer(id, function(input, output, session) {
    q2 <- reactive({
      new_qenv() |>
      eval_code(quote({
        iris[1:10, "Sepal.Width"] <- NA
        p <- ggplot(data = iris) + geom_point(aes(x = Sepal.Width, y = Petal.Width)) + ggtitle('pws+tws')
        plot(1:10)
        print(p)
      }))
    })
    table_r <- reactive({
      pdf(NULL)
      q2()
      dev.off()
      l <- basic_table() %>%
        split_cols_by("ARM") %>%
        analyze(c("SEX", "AGE"))
      build_table(l, DM)
    })

    teal.widgets::plot_with_settings_srv(id = "p2", plot_r = reactive(q2()[["p"]]))
    teal.widgets::table_with_settings_srv(id = "t2", table_r = reactive(table_r()))
    verbatim_popup_srv("pop2", reactive(paste(get_code(q2()), collapse = "\n")), "SRC")
  })
}

app <- teal::init(
  data = list(iris = iris, ADSL = ADSL),
  modules = list(
    module("basic", ui = ui_plot_noqenv, server = server_plot_noqenv),
    module("plot", ui = ui_plot, server = server_plot),
    module("plot+table", ui = ui_plot_and_table, server = server_plot_and_table), #
    module("plot+observe", ui = ui_plot_and_observe, server = server_plot_and_observe), # extra print by observe
    module("generic+renderUI", ui = ui_plot_uirender, server = server_plot_uirender),
    module("pws+warn", ui = ui_pws_and_warn, server = server_pws_and_warn), # extra print by verbatim_poppup
    module("pws", ui = ui_pws, server = server_pws),
    module("pws+tws", ui = ui_pws_tws, server = server_pws_tws), # extra print by tws
    module("pws+tws+fix", ui = ui_pws_tws, server = server_pws_tws_fix),
    tm_g_scatterplot( # extra print by multiple things
      label = "Scatterplot Choices",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(ADSL, c("AGE", "BMRKR1", "BMRKR2")),
          selected = "AGE",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(ADSL, c("AGE", "BMRKR1", "BMRKR2")),
          selected = "BMRKR1",
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  )
)

runApp(app)

[gogonzo]

Maybe some sort of dev.off in verbatim_popup would make a trick.

[donyunardi]

Acceptance Criteria

• Not to have plot to show in the IDE (in the Plot tab)
• This is not a problem in the server once deployed, but only happens locally within IDE.
• Might be link with plot_with_settings_srv