Shiny: Render dynamic number of images from destination - r

I need to render dynamic number of images from destination. But as the result through the loop I render several times only the last image from destination. But all images must be different.
My solution is inspired by these answers from stackoverflow
Shiny: Dynamic Number of Output Elements/Plots
dynamically add plots to web page using shiny
library(shiny)
# get all files from destination
images <- list.files("charts")
image_names <- str_replace_all(images, ".png", "")
server <- shinyServer(function(input, output) {
output$images <- renderUI({
image_output_list <-
lapply(1:length(image_names),
function(i)
{
imagename = paste0(image_names[i], "_image")
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
observe({
# if(is.null(input$files)) return(NULL)
for (i in 1:length(image_names))
{
print(i)
local({
imagename <- paste0(image_names[i], "_image")
print(imagename)
output[[imagename]] <-
renderImage({
list(src = normalizePath(paste0('charts/', image_names[i], '.png')))
}, deleteFile = FALSE)
})
}
})
})
ui <- shinyUI(fluidPage(
titlePanel("Sidebar"),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('images')
)
)
))
shinyApp(ui=ui,server=server)

Could you try this:
observe({
for (i in 1:length(image_names))
{
local({
ii <- i
imagename <- paste0(image_names[ii], "_image")
print(imagename)
output[[imagename]] <-
renderImage({
list(src = normalizePath(paste0('charts/', image_names[ii], '.png')))
}, deleteFile = FALSE)
})
}
})

Related

How to have sequential Modal dialogs in Shiny

I need a shiny app to do the following:
The user clicks a button
N pop-ups appear to the user asking for input
Then the user downloads the information displayed in the app with a download button
I've been able to achieve points 1 & 2, however I haven't been able to get to 3 because of the fact that the user inputs are reactive values. Here is a sample of code that almost works:
library(shiny)
library(shinyalert)
test <- c("C", "D", "F")
NUM_MODALS <- length(test)
ui <- fluidPage(
shinyalert::useShinyalert(),
actionButton("show", "Show modal dialog"),
lapply(seq(NUM_MODALS), function(id) {
div(id, ":", textOutput(paste0("modal", id), inline = TRUE))
}),
downloadButton("downloadData", "Download")
)
server <- function(input, output) {
observeEvent(input$show, {
for(id in 1:NUM_MODALS){
shinyalert::shinyalert(
type = "input",
text = paste("¿Cuál es la industria de la siguiente empresa?:", test[id]),
inputPlaceholder = "Cuidado con mayúsculas/minúsculas",
inputId = paste0("modal", id)
)
}
})
lapply(seq(NUM_MODALS), function(id) {
output[[paste0("modal", id)]] <- renderText({paste(test[id],input[[paste0("modal", id)]])})
})
export <- reactive(c(input$modal1, input$modal2, input$modal3))
export2 <- isolate(export)
print(export2)
#browser()
output$downloadData <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.csv', sep='')
},
content = function(filesillo) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
path <- paste("prueba.txt", sep = "")
fs <- c(fs, path)
write.csv(export2, filesillo)
}
)
}
shinyApp(ui = ui, server = server)
Instead of the inputs being assigned as a reactive, you can assign to reactiveValues in an observe.
export <- reactiveValues(
dat = NULL
)
observe({
export$dat <- dplyr::bind_rows(
modal1 = input$modal1,
modal2 = input$modal2,
modal3 = input$modal3
)
})
# export <- reactive(c(input$modal1, input$modal2, input$modal3))
# export2 <- isolate(export)
# print(export2)
#browser()
Then in your downloadHandler
#write.csv(export2, filesillo)
write.csv(export$dat, filesillo)
This will output a csv with modal inputs as columns

r shiny - Plotting multiple images using the imageOutput() and renderImage()

I am trying to plot several images saved in the www sub-directory folder of my shiny app folder. The image file names are in a data frame column; let’s say “img_path”.
I am using the imageOutput() function in the UI and renderImage() in the server interface.
Since I want to plot all the images in the www subfolder and that are referenced in the data frame, I am using a for loop.
Unfortunately, instead of rendering all the images, it always displays the last image. I guess this is happening because images are being overlayed on top of each other.
Let say that I have: my data
df_img <- data.frame(id = c(1:5), img_path = c("h1000.png", "h2000.png", "h3000.png", "h4000.png", "h000.png"))
which is stored in the data subfolder; the 5 images in the www subfolder are named as in the df_img[["img_path"]].
My basic shiny app code is:
library(shiny)
library(shinydashboard)
Define UI
ui <- fluidPage(
# Application title
titlePanel("Test app"),
# to render images in the www folder
box(imageOutput("houz"), width = 3)
)
Define server logic
server <- function(input, output) {
df_img <- read.csv("data/df_img.csv", header = T)
for (i in 1:nrow(df_img)) {
output$houz <- renderImage({
list(
src = file.path('www', df_img$img_path[i]),
contentType = "image/jpeg",
width = "100%", height = "45%"
)
}, deleteFile = FALSE)
}
}
# Run the application
shinyApp(ui = ui, server = server)
what_i_expect and what_i_get
Consider using Shiny modules. A working example is below, which assumes you have images with a "jpeg" extension in a "www" subdirectory of the working directory. I use purrr for functional programming - you could use lapply() or a for loop if you prefer.
Chapter 19 of Mastering Shiny is a good introduction to Shiny modules.
library(shiny)
library(purrr)
ui_module <- function(id) {
imageOutput(NS(id, "img"))
}
server_module <- function(id,
img_path) {
moduleServer(
id,
function(input, output, session) {
output$img <- renderImage({
list(src = img_path,
contentType = "image/jpeg",
width = "100%",
height = "45%")
},
deleteFile = FALSE)
})
}
images <- list.files(path = "www",
pattern = "jpeg",
full.names = TRUE)
ids <- tools::file_path_sans_ext(
basename(images)
)
ui <- fluidPage(
map(ids, ui_module)
)
server <- function(input, output, session) {
map2(.x = ids,
.y = images,
.f = server_module)
}
shinyApp(ui, server)
You can use renderUI to display the list of images you wish to display. Try this
df_img <- data.frame(id = c(1:5), img_path = c("h1000.png", "h2000.png", "h3000.png", "h4000.png", "h000.png"))
ui <- fluidPage(
# Application title
titlePanel("Test app"),
# to render images in the www folder
box(uiOutput("houz"), width = 3)
)
server <- function(input, output) {
#df_img <- read.csv("data/df_img.csv", header = T)
n <- nrow(df_img)
observe({
for (i in 1:n)
{
print(i)
local({
my_i <- i
imagename = paste0("img", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(src = file.path('www', df_img$img_path[my_i]),
width = "100%", height = "55%",
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
output$houz <- renderUI({
image_output_list <-
lapply(1:n,
function(i)
{
imagename = paste0("img", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
}
# Run the application
shinyApp(ui = ui, server = server)

R Shiny: interactive renderTable for dynamic number for fileInputs

I am trying to create a Shiny app that uploads a dynamic number of CSV files and display them through renderTable. I used the answer from this link for the dynamic fileInput. I added an eventReactive to read the CSV files and a renderUI for the dynamic number of tableOutputs. I don't get any errors when I run the code, so I don't know where the reactivity breaks.
Server:
shinyServer(function(input, output, session) {
output$fileInputs=renderUI({
n<-input$nfiles
html_ui = " "
for (i in 1:n){
html_ui <- paste0(html_ui, fileInput(inputId= paste0("fileupload",i), label=paste0("fileupload",i),accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")) )
}
HTML(html_ui)
})
Reading <-eventReactive(input$Read, {
lst<-list()
n<-input$nfiles
for (i in 1:n){
file<-paste0("fileupload",i)
inFile<-input$file
if (is.null(inFile))
return(NULL)
lst[[i]] <- read.csv(inFile$datapath)
}
lst
})
output$fileoutputs <- renderUI({
n<-input$nfiles
for (i in 1:n){
output[[paste0("table",i)]] <- renderTable( Reading()$lst[[i]] )
tableOutput(paste0("table",i))
}
})
})
UI:
shinyUI(pageWithSidebar(
headerPanel('Variable files'),
sidebarPanel(
numericInput("nfiles", "number of files", value = 2, min = 1, step = 1),
uiOutput("fileInputs"),
actionButton("Read", "read")
),
mainPanel(
uiOutput("fileoutputs")
)
))

Clean datatable when new data are loaded

I'd like to load a table from a file, make some computations (ie. sum elements of two columns) when I click a button and show the results into a datatable. Easy. However, every time I load a new file, I'd like to clean the previous results and not show them, otherwise, it is confusing whether they are the results of the new or the old ones.
Here's what I tried. but I didn't succeeed on it...
example table: tab.csv
x;A;B
x1;1;0
x2;2;1
x3;1;1
x4;5;2
x5;3;3
code: ui.R
shinyUI(pageWithSidebar(
headerPanel(""),
sidebarPanel(),
mainPanel(fluidRow(
fileInput("table", "Choose CSV File"),
actionButton("BUTCS", "Compute sum"),
dataTableOutput("tablesum")
))
))
server.R
shinyServer(function(input, output) {
user <- new.env()
user$table <- NULL
user$tablesum <- NULL
observe({
if(is.null(input$table)){return()}
tablefilecsv <- input$table
user$table <- read.csv2(tablefilecsv$name, header = TRUE)
})
observeEvent(input$table, {
if(is.null(input$table)){return()}
user$tablesum <- NULL
})
output$tablesum <- renderDataTable(
{
if(is.null(input$BUTCS)){return()}
d <- user$table
user$tablesum <- data.frame(x=d$x, sum=(d$A+d$B))
}, options = list(paging = FALSE,searching = FALSE))
})
Try, i think it is what you want
shinyServer(function(input, output) {
user <- reactiveValues(table= NULL, tablesum= NULL)
observeEvent(input$table, {
if(is.null(input$table)){
return()
}else{
tablefilecsv <- input$table
user$table <- read.csv2(tablefilecsv$datapath ,header = TRUE)
output$tablesum <- renderDataTable(NULL)
}
})
observeEvent(input$BUTCS,{
output$tablesum <- renderDataTable({
d <- user$table
user$tablesum <- data.frame(x=d$x, sum=(d$A+d$B))
}, options = list(paging = FALSE,searching = FALSE))
})
})
Option using reactive functional ( added by #Stefano)
shinyServer(function(input, output) {
data <- reactive({
tablefilecsv <- input$table
table <- read.csv2(tablefilecsv$name, header=TRUE)
})
observeEvent(input$table,{
output$tablesum <- renderDataTable(NULL)
})
observeEvent(input$BUTCS,{
output$tablesum <- renderDataTable({
d <- data()
tablesum <- cbind.data.frame(x=d$x, sum=(d$A+d$B))
}, options = list(paging=FALSE, searching=FALSE))
})
})

Downloading png from Shiny (R)

I am pretty new to Shiny (and R) and struggling with exporting the plot I make in Shiny to a png-file.
I looked at these two threads but could not figure it out:
Save plots made in a shiny app
Shiny downloadHandler doesn't save PNG files
I manage to create the download button in the ui and the server seems to be doing everything I want it to do, too. When I hit the download button in the preview window, a pop up window asks me to specify the file location and name but no file is saved. When I do the same in a browser window, a png file is created but it is empty.
Any insight is much appreciated!
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a scatterplot"),
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose CSV file',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
uiOutput("varselect1"),
uiOutput("varselect2"),
downloadButton('downloadPlot', 'Download Plot')
),
mainPanel(
h4("Here is your scatterplot"),
plotOutput("plot1")
)
))
)
server.R
library(foreign)
shinyServer(function(session,input, output) {
DataInput <- reactive({
infile <- input$datafile
if (is.null(infile)) {
return(NULL)
}
read.csv(infile$datapath)
})
output$varselect1 <- renderUI({
if (identical(DataInput(), '') || identical(DataInput(),data.frame())) return(NULL)
cols <- names(DataInput())
selectInput("var1", "Select a variable:",choices=c("---",cols[3:length(cols)]), selected=("---"))
})
output$varselect2 <- renderUI({
if (identical(DataInput(), '') || identical(DataInput(),data.frame())) return(NULL)
cols <- names(DataInput())
selectInput("var2", "Select a variable:",choices=c("---",cols[3:length(cols)]), selected=("---"))
})
plotInput <- reactive({
a <- which(names(DataInput())==input$var1)
x_lab <- as.numeric(DataInput()[,a])
b <- which(names(DataInput())==input$var2)
y_lab <- as.numeric(DataInput()[,b])
main.text <- paste("Scatterplot of the variables",colnames(DataInput())[a],"and", colnames(DataInput())[b],sep = " ", collapse = NULL)
plot(x_lab, y_lab, main=main.text, xlab=colnames(DataInput())[a], ylab=colnames(DataInput())[b], xlim=c(min(x_lab),max(x_lab)*1.05), ylim=c(min(y_lab), max(y_lab)*1.05))
observations <- DataInput()[,1]
text(x_lab, y_lab, labels=observations, pos=3)
})
output$plot1 <- renderPlot({
print(plotInput())
})
output$downloadPlot <- downloadHandler(
filename = "Shinyplot.png",
content = function(file) {
png(file)
print(plotInput())
dev.off()
})
})
A workaround for this strange scenario was discussed on the shiny-discuss google group. What you can do is simply change your reactive plotInput statement into a normal function. Not sure why downloadHandler doesn't play nice with reactive objects.
# change
plotInput <- reactive({...})
# into this
plotInput <- function(){...}
You can also remove the print statement in the downloadHandler call:
output$downloadPlot <- downloadHandler(
filename = "Shinyplot.png",
content = function(file) {
png(file)
plotInput()
dev.off()
})

Resources