Shiny: Plot Results in Popup Window

Shiny: plot results in popup window

Look into shinyBS package which offers modal popups. Example below shows the plot upon button click.

EDIT - Added a download button to the Modal

rm(list = ls())
library(shiny)
library(shinyBS)

shinyApp(
  ui =
    fluidPage(
      sidebarLayout(
        sidebarPanel(numericInput("n", "n", 50),actionButton("go", "Go")),
        mainPanel(
          bsModal("modalExample", "Your plot", "go", size = "large",plotOutput("plot"),downloadButton('downloadPlot', 'Download'))
        )
      )
    ),
  server =
    function(input, output, session) {

      randomVals <- eventReactive(input$go, {
        runif(input$n)
      })

      plotInput <- function(){hist(randomVals())}

      output$plot <- renderPlot({
        hist(randomVals())
      })

      output$downloadPlot <- downloadHandler(
        filename = "Shinyplot.png",
        content = function(file) {
          png(file)
          plotInput()
          dev.off()
        }) 

    }
)

R Shiny: How to open a popup window and show a graph that depends on row click event of DT datatable

We can use modalDialog function from shiny to show the plot in a pop-up and
input$tableID_rows_selected to filter the data:

df_subset <- reactiveVal(NULL)

  observeEvent(input$table_rows_selected, {
    v1_value <- df[input$table_rows_selected, "v1"]
    df_subset(filter(df, v1 == v1_value))
    showModal(modalDialog(plotlyOutput("plot"), size = "m"))
  })

App:

library(shiny)
library(DT)
library(plotly)
library(dplyr)
library(shinyWidgets)
library(shinydashboard)

id <- c(1:100)
v1 <- rep(LETTERS[1:10], times = 10)
v2 <- sample.int(100, 100)
v3 <- sample.int(200, 100)
v4 <- sample.int(300, 100)
v5 <- rep(c(2000:2019), times = 5)
df <- data.frame(id, v1, v2, v3, v4, v5)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("first", tabName = "first")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "first",
        box(
          width = 12, solidHeader = TRUE,
          DT::dataTableOutput("table"),
          # plotlyOutput("plot")
        )
      )
    )
  )
)

server <- function(input, output) {
  df_subset <- reactiveVal(NULL)

  output$table <- DT::renderDataTable({
    DT::datatable(df,
      options = list(
        pageLength = 10, paging = TRUE, searching = TRUE
      ),
      rownames = FALSE, selection = "single",
    )
  })

  observeEvent(input$table_rows_selected, {
    v1_value <- df[input$table_rows_selected, "v1"]
    df_subset(filter(df, v1 == v1_value))
    showModal(modalDialog(plotlyOutput("plot"), size = "m"))
  })

  click_subset <- df %>% filter(v1 == "B")

  # Plot in popup window
  output$plot <- renderPlotly({
    req(df_subset)
    plot_ly(df_subset(), type = "bar") %>%
      add_trace(
        x = ~v5, y = ~v3
      )
  })
}

shinyApp(ui, server)

How to create Popup window of DataTable/plot in ShinyDashboard?

As shown in the answer you need to wrap each item you want to popout in a div() and give an id. Then use that id to popout and display what you wish. Try this

library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(shinyBS)
library(DT)
#library(visdat) 
ui<-dashboardPage(
  dashboardHeader(title="Missing",titleWidth = 230),
  dashboardSidebar(
    fileInput("file1", "Upload CSV File below",
              accept = c(
                "text/csv",
                "text/comma-separated-values,text/plain",
                ".csv")
    )),
  dashboardBody(
    fluidRow(
      div(id="popme1", box(plotOutput("Plot1"),collapsible = TRUE,title="Columns with null",solidHeader = TRUE,status = "primary")),
      bsModal("modalExample1", "Plot1", "popme1", size = "large", plotOutput("Plot11")),
      div(id="popme2", box(plotOutput("Plot2"),collapsible=TRUE,title="Data Types of columns",solidHeader = TRUE,status = "primary")),
      bsModal("modalExample2", "Plot2", "popme2", size = "large", plotOutput("Plot22")),
      div(id="popme3", fluidRow(column(width=8,box(DTOutput("Missing_datatable"), width = NULL,collapsible = TRUE)) )),
      bsModal("modalExample3", "Data Table", "popme3", size = "large", DTOutput("Missing_datatable2"))
    )
  )
)

server<- function(input, output,session) {
  
  output$Plot1 <- renderPlot({
    plot(cars)
  })
  output$Plot11 <- renderPlot({
    plot(cars)
  })
  output$Plot22 <- renderPlot({ plot(pressure)})
  
  output$Plot2 <- renderPlot({ plot(pressure) })
  
  output$Missing_datatable <- renderDT({iris[1:7,]})
  output$Missing_datatable2 <- renderDT({iris[1:7,]})
}
  
# Run the application 
shinyApp(ui = ui, server = server)

Popup frameless window in R Shiny

I don't have a mobile to try, but the link given in your code says that the popups are not blocked if they are ran from the onclick attribute, so I would try:

library("shiny")
library("bslib")

provinces <- c("British Columbia", "Alberta", "Saskatchewan", "Manitoba", "Ontario", "Quebec", 
               "New Brunswick", "Nova Scotia", "PEI", "Newfoundland and Labrador")
select_input_width <- "220px"

ui <- bootstrapPage(
  theme = bs_theme(version = 5, 
                   "font-scale" = 1.0), 
  div(class = "container-fluid",
      selectInput(
        inputId = "province", 
        label = tags$span(
          tags$label(
            "Province ",
            style = "font-weight: bold; font-size: 1.2rem;"
          ), 
          tags$a(
            icon("info-circle"), 
            style = "cursor: pointer;",
            onclick = "open('https://google.com', 'test', 'scrollbars=no,resizable=no,status=no,location=no,toolbar=no,menubar=no,width=300,height=335,left=100,top=100');"
          )
        ),
        choices = provinces, 
        selected = "Ontario", 
        selectize = FALSE,
        width = select_input_width)
  )
)

server <- function(input, output, session) {}

shinyApp(ui, server)

Graph in popup on hover with R Shiny

I've used shinyjs to trigger an action based on hover but the lapsing time is something i couldn't crack yet.

library(shiny)
library(shinyjs)

shinyApp(

  ui = fluidPage(
    useShinyjs(),
    sidebarLayout(
      sidebarPanel(
        sliderInput("bins",
                    "Number of bins:",
                    min = 1,
                    max = 50,
                    value = 30),
        bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
                  "right", options = list(container = "body"))
      ),
      mainPanel(
        checkboxInput(inputId = "Check", "Graph here in popup when I hover here?"))
    )

  ),
  server =  function(input, output, session) {
    output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      x    <- faithful[, 2]
      bins <- seq(min(x), max(x), length.out = input$bins + 1)

      # draw the histogram with the specified number of bins
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
    observeEvent(input$Check, { 
      print("1")
      showModal(div(id="modalAutoSaveMenu", modalDialog(
        inputId = "distPlot",
        title = HTML('<span style="color:#339fff; font-size: 20px; font-weight:bold; font-family:sans-serif ">Current data column<span>
                     <button type = "button" class="close" data-dismiss="modal" ">
                     <span style="color:#339fff; ">x <span>
                     </button> '),
        br(),
        plotOutput("distPlot"),
        br(),
        easyClose = TRUE,
        footer = NULL )))
    })

    onevent('mouseover','Check',{

delay(1000, 
showModal(div(id="modalAutoSaveMenu", modalDialog(
          inputId = "distPlot",
          title = HTML('<span style="color:#339fff; font-size: 20px; font-weight:bold; font-family:sans-serif ">Current data column<span>
                       <button type = "button" class="close" data-dismiss="modal" ">
                       <span style="color:#339fff; ">x <span>
                       </button> '),
          br(),
          plotOutput("distPlot"),
          br(),
          easyClose = TRUE,
          footer = NULL )))) }, T)
      }
    )

R Shiny - Popup window when hovering over icon

The native HTML tooltips are not customizable. Bootstrap tooltips are.

library(shiny)
library(bslib)

css <- '
.tooltip {
  pointer-events: none;
}
.tooltip > .tooltip-inner {
  pointer-events: none;
  background-color: #73AD21;
  color: #FFFFFF;
  border: 1px solid green;
  padding: 10px;
  font-size: 25px;
  font-style: italic;
  text-align: justify;
  margin-left: 0;
  max-width: 1000px;
}
.tooltip > .arrow::before {
  border-right-color: #73AD21;
}
'

js <- "
$(function () {
  $('[data-toggle=tooltip]').tooltip()
})
"

shinyApp(
  server = function(input,output,session){},
  ui = fluidPage(
    theme = bs_theme(version = 4),
    tags$head(
      tags$style(HTML(css)),
      tags$script(HTML(js))
    ),
    br(),
    span(
      "Example",
      span(
        `data-toggle` = "tooltip", `data-placement` = "right",
        title = "A tooltip",
        icon("info-circle")
      )
    )
  )
)

Interactive plot with shiny modal dialog

Your first parameter doesn't need the 'body' name. You should be able to pass as many items as you need as unnamed parameters to modalDialog.

showModal(
    modalDialog(
        plotOutput(ns("plot")),
        otherOutput("output1"),
        otherOutput("output2"),
        footer = downloadButton(ns("downloadPlot")),
        easyClose = TRUE,
        size = "l"
    )
)

You can see here that the UI elements for the modal body can be passed in directly.

How to open on click popup window in shiny app

You can do this with conditionalPanel, where you set the condition to the number of clicks on your action button. Eg

conditionalPanel(
  condition = "input.Twitter_Sentiment_analysis % 2 == 1",
  absolutePanel(
    left = 10,
    top = 10,
    width = 800,
    plotOutput("Twitter_Sentiment_analysis_plot")
  )
)

An alternative would be to use shinyBS::bsModal which gives you a nice UI but requires another package.

---

Related Topics