Dynamically display images from upload in Shiny UI - r

This is pretty much the same question as presented here:
dynamically add plots to web page using shiny
But instead of producing a variable number of plots (which I've successfully done), I am trying to upload a selection of images into the application and display them on the user interface. Using the same approach as described in the question above, I've produced my application with the code below. But only the first image is rendering in the UI.
What obvious thing have I missed today?
R 3.2.2 (Windows 7)
shiny 0.12.2
server.R
library(shiny)
shinyServer(function(input, output) {
output$files <- renderTable(input$files)
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$images <- renderUI({
image_output_list <-
lapply(seq_along(nrow(files())),
function(i)
{
imagename = paste0("image", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
observe({
for (i in seq_along(nrow(files())))
{
local({
my_i <- i
imagename = paste0("image", my_i)
output[[imagename]] <-
renderImage({
list(src = files()$datapath[my_i],
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput(inputId = 'files',
label = 'Select an Image',
multiple = TRUE,
accept=c('image/png', 'image/jpeg'))
),
mainPanel(
tableOutput('files'),
uiOutput('images')
)
)
))

Your so close! Try this:
library(shiny)
server <- shinyServer(function(input, output) {
output$files <- renderTable(input$files)
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$images <- renderUI({
if(is.null(input$files)) return(NULL)
image_output_list <-
lapply(1:nrow(files()),
function(i)
{
imagename = paste0("image", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
observe({
if(is.null(input$files)) return(NULL)
for (i in 1:nrow(files()))
{
print(i)
local({
my_i <- i
imagename = paste0("image", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(src = files()$datapath[my_i],
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
})
ui <- shinyUI(fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput(inputId = 'files',
label = 'Select an Image',
multiple = TRUE,
accept=c('image/png', 'image/jpeg'))
),
mainPanel(
tableOutput('files'),
uiOutput('images')
)
)
))
shinyApp(ui=ui,server=server)
I changed seq_along to just 1:nrow(files()) but seq_len(nrow(files())) or seq_along(t(files())) would work to.

Related

Multiple UI Output Based on File Upload Using Shiny Modules

Dataset Viewer
Hello, I am attempting to create a shiny application that allows to user to view their uploaded datasets individually.
When there is no file uploaded a message appears asking the user to upload their file...once a csv file is uploaded, the message disappears and shows the users uploaded datasets.
What I've tried
I've tried: using conditionalPanels in app.R & upload.R, creating a separate R file exclusively for each ui condition. I believe my issue is that output$table (function that renders mainpanel ui) is not being triggered after the file uploads.
My issue
Once the user uploads a csv file(any readable csv file), the pre-existing message is not being replaced by the uploaded datasets.
upload.R
data = list()
numDatasets = 0
uploadSideUI <- function(id) {
ns <- NS(id)
tagList(
h2("Dataset Viewer"),
fileInput(ns("file"),label = "Upload File", multiple = FALSE, accept = ".csv")
)
}
uploadMainUI <- function(id) {
ns <- NS(id)
uiOutput(ns("table"))
}
uploadServer <- function(id) {
moduleServer(id, function(input,output,session){
observeEvent(eventExpr = input$file,
handlerExpr = {
df <- read.csv(file = input$file$datapath,header = FALSE)
data <<- c(data,list(df))
numDatasets <<- numDatasets + 1
})
output$table <- renderUI({
if(numDatasets ==0){
h2("please upload file")
}else{
req(input$file)
print(numDatasets)
lapply(1:numDatasets,function(i) {
dataframe = data[[i]]
tagList(
h2(paste("dataset",i)),
hr(),
datatable(dataframe,rownames = FALSE, option = list(scrollY="300px",searching=FALSE)),
br()
)
})
}
})
})
}
app.R
#app.R
library(DT)
library(shiny)
source("testModule.R")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uploadSideUI("uploadPage")
),mainPanel(
uploadMainUI("uploadPage")
)
)
)
server <- function(input, output, session) {
uploadServer("uploadPage")
}
shinyApp(ui = ui, server = server)
I am new to the modulization process in shiny, so if you have any other suggestions please point them out! Thanks in advance!
Try this
uploadServer <- function(id) {
moduleServer(id, function(input,output,session){
rv <- reactiveValues(numDatasets = 0)
observeEvent(eventExpr = input$file,
handlerExpr = {
df <- read.csv(file = input$file$datapath,header = FALSE)
data <<- c(data,list(df))
rv$numDatasets <<- rv$numDatasets + 1
})
output$table <- renderUI({
if(rv$numDatasets == 0){
h2("please upload file")
}else{
req(input$file)
print(rv$numDatasets)
lapply(1:rv$numDatasets,function(i) {
dataframe = data[[i]]
tagList(
h2(paste("dataset",i)),
hr(),
datatable(dataframe,rownames = FALSE, option = list(scrollY="300px",searching=FALSE)),
br()
)
})
}
})
})
}

About shiny branch processing using outputUI

We are currently developing Shiny APP.
When Option A or Option B is selected from pickerinput
If you select Option A, an open file dialog opens. Then select the text file. When I select a text file, I want the title of the text file to be displayed.
When I select OptionB, I want to display nothing and do nothing.
I wrote a sample codee.
library(shiny)
library(shinyWidgets)
library(shinyFiles)
ui <- fluidPage(
pickerInput(
inputId = "Pi1",
label = "SELECT!!",
choices = list(c("OptionA"),
c("OptionB")),
options = list(`actions-box` = TRUE,size = 7),
multiple = FALSE,
),
uiOutput("button"),
uiOutput("Message")
)
server <- function(input, output, session) {
OutputUi_func(input,output)
observeEvent(input$file, {
volumes <- c("Documents"=Sys.getenv("HOME"))
shinyFileChoose(input,'file', session=session,roots=volumes, filetypes=c('', 'txt'))
if(length(input$file) <= 1) return({})
fname <- unlist(input$file)
fname <- c(fname[2][1])
ftitle <- "FileName:"
fname <- paste0(ftitle,fname)
output$filename <- renderText({
paste0(fname)
})
})
}
OutputUi_func <- function(input,output){
output$button <- renderUI({
req(input$Pi1)
if(input$Pi1 %in% c("OptionA")){
shinyFilesButton('file', 'Read File', 'select file', FALSE)
}else return(NULL)})
output$Message <- renderText({
req(input$Pi1)
if(input$Pi1 %in% c("OptionA")){
textOutput("filename")
}else return(NULL)})
}
shinyApp(ui, server)
The code has a problem.
・When I execute the code, I get an error about "cat".
・ Even if you select a text file,The file title is not displayed.
What should I do to avoid the above two errors?
Try :
library(shiny)
library(shinyWidgets)
library(shinyFiles)
ui <- fluidPage(
pickerInput(
inputId = "Pi1",
label = "SELECT!!",
choices = list(c("OptionA"),
c("OptionB")),
options = list(`actions-box` = TRUE,size = 7),
multiple = FALSE,
),
uiOutput("button"),
uiOutput("Message")
)
server <- function(input, output, session) {
OutputUi_func(input,output)
observeEvent(input$file, {
if(input$Pi1 %in% "OptionB") return(NULL)
volumes <- c("Documents"=Sys.getenv("HOME"))
shinyFileChoose(input,'file', session=session,roots=volumes, filetypes=c('', 'txt'))
if(length(input$file) <= 1) return(NULL)
output$Message <- renderText({
if(length(input$file) <= 1 || input$Pi1 %in% "OptionB") return(NULL)
sprintf("FileName:%s", unlist(input$file$files)[[3]])
})
})
}
OutputUi_func <- function(input,output){
output$button <- renderUI({
if(input$Pi1 %in% "OptionA")
shinyFilesButton('file', 'Read File', 'select file', FALSE)
else return(NULL)
})
}
shinyApp(ui, server)

Render images for interactive display from folder loaded with shinyDirChoose

The code below works if the user chooses several images. How can I implement this with shinyDirChoose, so that the user only chooses the folder where the images are located.
Problem: I don't know how to get the local datapath which is stored in the files() object. This path is needed for rendering the images.
Couldn't find any good answers in the web so far.
library(shiny)
ui <- shinyUI(fluidPage(
tags$script('
$(document).on("keydown", function (e) {
Shiny.onInputChange("rightCursor", [e.which,e.timeStamp]);
});
'),
sidebarLayout(
sidebarPanel(
fileInput(inputId = 'files',
label = 'Select an image or several images',
multiple = TRUE,
accept=c('image/png', 'image/jpeg'))
),
mainPanel(
uiOutput('images'),
tableOutput('files')
)
)
))
server <- shinyServer(function(input, output) {
rv <- reactiveValues(page = 1)
output$files <- renderTable(input$files)
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$images <- renderUI({
if(is.null(input$files)) return(NULL)
imagename = paste0("image", rv$page)
image_output <- imageOutput(imagename)
})
observe({
if(is.null(input$files)) return(NULL)
for (i in 1:nrow(files()))
{
print(i)
local({
my_i <- i
imagename = paste0("image", my_i)
output[[imagename]] <-
renderImage({
list(src = files()$datapath[my_i], width = 400, height = 400,
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
navPage <- function(direction) {
rv$page <- rv$page + direction
}
observeEvent(input$rightCursor,{
navPage(1)
print(rv$page)
})
})
shinyApp(ui=ui,server=server)
The user only chooses the folder where the images are located, instead of one or several files.
Here is a way.
library(shiny)
library(shinyFiles)
ui <- fluidPage(
tags$head(
tags$script('
$(document).on("keydown", function (e) {
Shiny.onInputChange("rightCursor", [e.which,e.timeStamp]);
});
')
),
mainPanel(
shinyDirButton("dir", "Input directory", "Upload"),
verbatimTextOutput("dir", placeholder = TRUE),
uiOutput('images')
))
server <- function(input, output) {
shinyDirChoose(
input, "dir", roots = c(home = "~"), filetypes = c("png", "jpg")
)
folder <- reactiveVal()
output$dir <- renderText({
folder()
})
observeEvent(input$dir, {
if (!"path" %in% names(input$dir)) return()
home <- normalizePath("~")
folder(
file.path(
home,
paste(unlist(input$dir$path[-1]), collapse = .Platform$file.sep)
)
)
})
files <- eventReactive(folder(), {
list.files(folder(), full.names = TRUE)
})
page <- reactiveVal(1)
output$images <- renderUI({
req(files())
imagename = paste0("image", page())
imageOutput(imagename)
})
observeEvent(files(), {
for (i in 1:length(files()))
{
print(i)
local({
my_i <- i
imagename = paste0("image", my_i)
output[[imagename]] <-
renderImage({
list(src = files()[my_i], width = 400, height = 400,
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
observeEvent(input$rightCursor,{
page(page()+1)
})
}
# Run the application
shinyApp(ui = ui, server = server)

How to insert multiple images into shiny after click of a button?

I created a shiny app which has two buttons as you can see in the following screenshot. I want to display 8 images which I have in this folder in the shiny app after I click the "Show Images" button. I tried using renderImages but couldn't get it to work.
Here is the code I have so far:
ui.R
fluidPage(
# Application title
titlePanel("For Fun!!"),
hr(),
sidebarLayout(
# Sidebar with a slider and selection inputs
sidebarPanel(
actionButton("update", "Print Text"),
hr(),
actionButton("test", "Show Images")
),
mainPanel(
verbatimTextOutput("plot"),
uiOutput("images")
)
)
)
server.r
server <- function(input, output) {
randomVals <- eventReactive(input$update, {
myString="Hello!"
myString
})
output$plot <- renderPrint({
myString=randomVals()
print(myString)
})
}
This is what I'm looking for as an output:
Thanks for your time
Try it like this.
library(shiny)
server <- shinyServer(function(input, output) {
output$files <- renderTable(input$files)
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$images <- renderUI({
if(is.null(input$files)) return(NULL)
image_output_list <-
lapply(1:nrow(files()),
function(i)
{
imagename = paste0("image", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
observe({
if(is.null(input$files)) return(NULL)
for (i in 1:nrow(files()))
{
print(i)
local({
my_i <- i
imagename = paste0("image", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(src = files()$datapath[my_i],
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
})
ui <- shinyUI(fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput(inputId = 'files',
label = 'Select an Image',
multiple = TRUE,
accept=c('image/png', 'image/jpeg'))
),
mainPanel(
tableOutput('files'),
uiOutput('images')
)
)
))
shinyApp(ui=ui,server=server)

Outputting Shiny (non-ggplot) plot to PDF

Is there a method to output (UI end) Shiny plots to PDF for the app user to download? I've tried various methods similar to those involving ggplot, but it seems downloadHandler can't operate in this way. For example the following just produces broken PDF's that don't open.
library(shiny)
runApp(list(
ui = fluidPage(downloadButton('foo')),
server = function(input, output) {
plotInput = reactive({
plot(1:10)
})
output$foo = downloadHandler(
filename = 'test.pdf',
content = function(file) {
plotInput()
dev.copy2pdf(file = file, width=12, height=8, out.type="pdf")
})
}
))
Very grateful for assistance.
Solved. The plot should be saved locally with pdf(), not the screen device (as with dev.copy2pdf). Here's a working example: shiny::runGist('d8d4a14542c0b9d32786'). For a nice basic model try:
server.R
library(shiny)
shinyServer(
function(input, output) {
plotInput <- reactive({
if(input$returnpdf){
pdf("plot.pdf", width=as.numeric(input$w), height=as.numeric(input$h))
plot(rnorm(sample(100:1000,1)))
dev.off()
}
plot(rnorm(sample(100:1000,1)))
})
output$myplot <- renderPlot({ plotInput() })
output$pdflink <- downloadHandler(
filename <- "myplot.pdf",
content <- function(file) {
file.copy("plot.pdf", file)
}
)
}
)
ui.R
require(shiny)
pageWithSidebar(
headerPanel("Output to PDF"),
sidebarPanel(
checkboxInput('returnpdf', 'output pdf?', FALSE),
conditionalPanel(
condition = "input.returnpdf == true",
strong("PDF size (inches):"),
sliderInput(inputId="w", label = "width:", min=3, max=20, value=8, width=100, ticks=F),
sliderInput(inputId="h", label = "height:", min=3, max=20, value=6, width=100, ticks=F),
br(),
downloadLink('pdflink')
)
),
mainPanel({ mainPanel(plotOutput("myplot")) })
)
(Hello), just use pdf :
library(shiny)
runApp(list(
ui = fluidPage(downloadButton('foo')),
server = function(input, output) {
plotInput = reactive({
plot(1:10)
})
output$foo = downloadHandler(
filename = 'test.pdf',
content = function(file) {
pdf(file = file, width=12, height=8)
plotInput()
dev.off()
})
}
))
EDIT : I don't know... It's weird. A workaround is to use dev.copy2pdf like you did in the first place but in the reactive function instead downloadHandler :
## server.R
library(shiny)
shinyServer(
function(input, output) {
plotInput <- reactive({plot(rnorm(1000))
dev.copy2pdf(file = "plot.pdf")
})
output$myplot <- renderPlot({ plotInput() })
output$foo <- downloadHandler(
filename <- "plot.pdf",
content <- function(file) {
file.copy("plot.pdf", file)
})
}
)

Resources