Shiny: plot results in popup window - r

I am trying to build a web app with shiny and I would like to display the resulting plot of a R function in a popup
window rather than in mainPanel.
For instance, for the below example (from http://shiny.rstudio.com/articles/action-buttons.html), clicking on "Go" button
would show the same plot but in a popup window.
I tried to add some javascript, but I have not succeeded yet... Can anyone help ?
Thank you in advance !
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
numericInput("n", "n", 50),
plotOutput("plot")
)
server <- function(input, output) {
randomVals <- eventReactive(input$go, {
runif(input$n)
})
output$plot <- renderPlot({
hist(randomVals())
})
}
shinyApp(ui, server)

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()
})
}
)

Using native Shiny functionality
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
numericInput("n", "n", 50)
)
server <- function(input, output) {
randomVals <- eventReactive(input$go, {
runif(input$n)
})
output$plot <- renderPlot({
hist(randomVals())
})
observeEvent(input$go, {
showModal(modalDialog(
plotOutput("plot"),
footer = NULL,
easyClose = TRUE
))
})
}
shinyApp(ui, server)

You could use a conditional panel to show/hide an absolute panel containing your plot, setting the condition to some js variable toggled by a function attached to your button .
e.g.
conditionalPanel("popupActive==1",
absolutePanel(id = "popup", class = "modal",
fixed = FALSE, draggable = TRUE,
top = 200, right = "auto", left = 400,
bottom = "auto",
width = 500, height = 500,
plotOutput(#output plot stuff#)
)
)
Then toggle the value of popupActive in js to show/hide
HTML('<head><script>popupActive = 0; function myFunction(){popupActive=!popupActive;} </script></head>'), HTML('<button id="go" type="button" class="btn btn-default action-button" onclick="myFunction()">Go</button>'),

Related

How to wrap up Image as a floating window in R shiny

I want to develop a feature that when opening the switch the image can show outside of the page and when closing the switch, the image is hidden. Here is my sample code for showing/hiding the image in the page but if we can make the image be a floating window and can be moved around the exiting app page?
library("shinydashboard")
library("shinyWidgets")
ui <- fluidPage(
h4("Embedded image"),
uiOutput("img"),
fluidRow(
tags$h4("Show and Hide Image"),
materialSwitch(
inputId = "get_image",
label = "Show Image",
value = FALSE,
status = "success"
),
),
)
server <- function(input, output, session) {
observeEvent(input$get_image, {
if(input$get_image == TRUE){
output$img <- renderUI({
tags$img(src = "https://www.r-project.org/logo/Rlogo.png")
})
}else{
output$img <- NULL
}
})
}
shinyApp(ui, server)
Something like this?
library(shiny)
library("shinydashboard")
library("shinyWidgets")
ui <- fluidPage(
h4("Embedded image"),
uiOutput("img"),
fluidRow(
tags$h4("Show and Hide Image"),
materialSwitch(
inputId = "get_image",
label = "Show Image",
value = FALSE,
status = "success"
),
),
)
server <- function(input, output, session) {
output$img <- renderUI({
if(input$get_image)
absolutePanel(
tags$img(src = "https://www.r-project.org/logo/Rlogo.png", width = "512"),
draggable = TRUE
)
})
}
shinyApp(ui, server)

How to display default plot in www/ before actionButton is clicked R shiny

Here is a sample code to generate a plot upon clicking the actionButton.
shinyApp(
shinyUI(fluidPage(
inputPanel(
numericInput("n", "n", 10),
actionButton("update", "Update")
),
plotOutput("plot")
)),
shinyServer(function(input, output) {
values <- reactiveValues()
values$data <- c()
obs <- observe({
input$update
isolate({ values$data <- c(values$data, runif(as.numeric(input$n), -10, 10)) })
}, suspended=TRUE)
obs2 <- observe({
if (input$update > 0) obs$resume()
})
output$plot <- renderPlot({
dat <- values$data
hist(dat)
})
})
)
I would like to display a default plot which is in www/test.png to appear when the application is launched. And then change the plot after clicking the actionButton as per the user input.
First, I create a simple plot, export it as an image (manually, not in code) and name it Rplot.png (save it where you want):
plot(mtcars$mpg)
Then, in the shiny app, we have to distinguish two situations :
when the app starts, no button is clicked yet, we render the image with renderImage
when we click on the button, we replace renderImage with renderPlot and render an interactive plot
This means that we must use uiOutput in ui part so that we can choose the output to be an image or a plot according to the situation.
Here's an example (I didn't adapt your code but it should not be too difficult):
library(shiny)
# determine your path to image here (you should use the package "here" to do so)
ui <- fluidPage(
selectInput("choice", "Choose", choices = names(mtcars)),
actionButton("run", "Run"),
uiOutput("some_ui")
)
server <- function(input, output, session) {
### "Static" part: no click on actionButton yet
output$some_ui <- renderUI({
imageOutput("image_plot")
})
output$image_plot <- renderImage({
list(src = "Rplot.png",
contentType = 'image/png')
}, deleteFile = FALSE) # Do not forget this option
### Click on actionButton
observeEvent(input$run, {
output$some_ui <- renderUI({
plotOutput("dynamic_plot")
})
output$dynamic_plot <- renderPlot({
plot(mtcars[[input$choice]])
})
})
}
shinyApp(ui, server)
The key is to use renderUI, so you can either show an image or a R plot. This should do what you desire:
shinyApp(
shinyUI(fluidPage(
inputPanel(
numericInput("n", "n", 10),
actionButton("update", "Update")
),
uiOutput("out")
)),
shinyServer(function(session, input, output) {
values <- reactiveValues()
# check if plot has been already rendered
check <- reactiveVal(FALSE)
values$data <- c()
observeEvent(input$update, {
# set check to TRUE
check(TRUE)
input$update
values$data <- c(values$data, runif(as.numeric(input$n), -10, 10))
dat <- values$data
output$plot <- renderPlot({
hist(dat)
})
})
# initial picture.
output$picture <- renderImage({
list(src = "temp.png")
}, deleteFile = FALSE)
output$out <- renderUI({
# in the beginning, check is FALSE and the picture is shown
if (!check()) {
imageOutput("picture")
} else {
# as soon as the button has been pressed the first time,
# the plot is shown
plotOutput("plot")
}
})
})
)
I know, that this has been solved a while, but I needed a solution, without uiOutput. Plus I find this much simpler.
library(shiny)
if (interactive()) {
shinyApp(
ui = fluidPage(
actionButton("btn", "Click me"),
br(),
plotOutput('some_plot', width = '100%')
),
server = function(input, output) {
output$some_plot <- renderPlot({
if (!input$btn) {
# default plot
plot(1, 1, col = 'red')
} else{
# updated plot
plot(1000, 1000, col = 'green')
}
})
}
)
}

How to return back to the first plot in R-Shiny?

I am working on an R-Shiny Application. I have used the following code(demo code) to interact with the plot.
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
observe({
output$graph <- renderPlot({
plot(1, 1)
})
})
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
x <- sample(20:30,1,F)
isolate({
output$graph <- renderPlot({
draw.single.venn(x)
})
})
})
})
shinyApp(ui=ui,server=server)
It can change the plot on a mouse click. I want to get back to the very first plot using a reset button. Kindly help.
I added a reset button to your sidebar. Hope that's helpful. This link provides more info on how to do this type of functionality.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
actionButton("Reset", label="Reset Graph")
),
mainPanel(
plotOutput("graph", width = "100%", click = "plot_click"),
verbatimTextOutput("click_info")
)
)
)
)
server <- shinyServer(function(input, output, session) {
observeEvent(input$Reset,{ output$graph <- renderPlot({ plot(1, 1) }) }, ignoreNULL = F)
# interaction click in graph
observe({
if(is.null(input$plot_click$x)) return(NULL)
x <- sample(20:30,1,F)
isolate({
output$graph <- renderPlot({
draw.single.venn(x)
})
})
})
})
shinyApp(ui=ui,server=server)

Shiny, obtaining details from the plots

I have developed an application, where I am generating plots. I am able to render the plots and download it without any problem.
I would like to get the details of the points in the graph, when i move my cursor to the points. With search, I am not sure, if I can obtain this in Shiny.
Any help would be great.
Below is the code, i have used.
UI Code:
tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
SERVER CODE
server <- function(input,output){
output$claim_overview <- renderValueBox({
valueBox(
paste("91")," Overview",icon=icon("hourglass"),
color="green"
)
})
data<- reactiveValues()
observeEvent(input$result1,{
data$plot <- ggplot(data=timedata, aes(x=dat1, y=yes, group=3))+
geom_point(shape=1)+
coord_cartesian(xlim=c(dat1_xlowlim,dat1_xhighlim))+
labs(title="Prediction Probability",x="Reg.Date",y="True probability")
})
output$plot3 <- renderPlot({ data$plot })
output$downloadPlot <- downloadHandler(
filename = function()
{paste("input$plot3",'.png',sep='')
},
content = function(file){
ggsave(file,plot = data$plot)
}
)
}
You can use either brush option or hover option to get any info from the plot.
Mouse hover example:
df<- table(rpois(100, 5))
ui <- fluidPage(
mainPanel(
plotOutput(outputId = "scatterplot", hover = "plot_hover"),
verbatimTextOutput(outputId = "dftable"),
br()
)
)
server <- function(input, output) {
output$scatterplot <- renderPlot({
plot(df, type = "h", col = "red", lwd = 10)
})
output$dftable <- renderPrint({
paste(input$plot_hover)
})
}
shinyApp(ui = ui, server = server)

shinyBS not compatible with new shiny 1.0.5

I am developing shiny app and I would like to use shinyBS. But the shinyBS is not compatible with new shiny v1.0.5, entire screen gray, including modal.
I would like to plot on bsModal window.
Is there a alternative way for shinyBS?
Any idea ?
Many thanks.
Here is the code:
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()
})
}
)

Resources