Need Help, I would like to upload an image file display it on shiny and the image can be remove.
I already tried but the problem is first attemp upload file is OK but second attemp is the image are not displayed.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
fileInput("myFile", "Choose a file", accept = c('image/png', 'image/jpeg')),
actionButton('reset', 'Reset Input')
)
),
mainPanel(
div(id = "image-container", style = "display:flexbox")
)
)
)
server <- function(input, output) {
observeEvent(input$myFile, {
inFile <- input$myFile
if (is.null(inFile))
return()
b64 <- base64enc::dataURI(file = inFile$datapath, mime = "image/png")
insertUI(
selector = "#image-container",
where = "afterBegin",
ui = img(src = b64, width = 600, height = 600)
)
})
observeEvent(input$reset, {
removeUI(
selector = "#image-container",
)
})
}
shinyApp(ui = ui, server = server)
Any solution is really appreciated
With your removeUI you are removing the container. Remove its content instead:
observeEvent(input$reset, {
removeUI(
selector = "#image-container > *"
)
})
Related
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)
on the UI side I have 2 elements:
actionButton("flip_button", "Flip coin"),
htmlOutput("flip_outcome")
When a button is clicked, I would like to display a flipping animation followed by the outcome of the coin flip. I can react to the button click with ObserveEvent, however elements are only updated once at the end of observe event, so I cannot make 2 changes.
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
actionButton("flip_button", "Flip coin"),
htmlOutput("flip_outcome")
)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
coin_image <- reactiveVal("stationary_coin.jpg")
output$flip_outcome<- renderText({
c('<img src="',coin_image(),'">')
})
observeEvent(input$flip_button, {
coin_image("flipping.gif")
Sys.sleep(4)
outcome<-sample(c("heads.jpg","tails.jpg"), 1)
coin_image(outcome)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The above for example, will only update the image once.
Here is a JavaScript solution. The www subfolder contains the files coinTossing.gif, coin_head.png, coin_tail.png, and coin.js.
R code:
library(shiny)
ui <- fluidPage(
tags$head(
tags$script(src = "coin.js")
),
br(),
actionButton("btn", "Coin tossing", onclick = "coinTossing();"),
br(),
tags$div(
id = "imgContainer",
style = "display: none;",
tags$img(id = "anim", src = "coinFlipping.gif", width = 400)
)
)
server <- function(input, output, session){}
shinyApp(ui, server)
JavaScript code (file 'coin.js'):
function coinTossing(){
$("#imgContainer").show();
var $img = $("#anim");
var src = $img.attr("src");
if(src !== "coinFlipping.gif"){
$img.attr("src", "coinFlipping.gif");
coinTossing();
}else{
var u = Math.random();
src = u < 0.5 ? "coin_head.png" : "coin_tail.png";
setTimeout(function() {
$img.attr("src", src);
}, 3000);
}
}
EDIT
Following the question in the comment.
R code:
library(shiny)
ui <- fluidPage(
tags$head(
tags$script(src = "coin.js")
),
br(),
actionButton("btn", "Coin tossing", onclick = "coinTossing();"),
br(),
tags$img(id = "anim", src = "coin_head.png", width = 400)
)
server <- function(input, output, session){}
shinyApp(ui, server)
JavaScript code (file 'coin.js'):
function coinTossing(){
var $img = $("#anim");
var src = $img.attr("src");
if(src !== "coinFlipping.gif"){
$img.attr("src", "coinFlipping.gif");
coinTossing();
}else{
var u = Math.random();
src = u < 0.5 ? "coin_head.png" : "coin_tail.png";
setTimeout(function() {
$img.attr("src", src);
}, 3000);
}
}
Here is a shiny solution using observe, invalidateLater and a flag vals$flag:
library(shiny)
ui <- fluidPage(
br(),
actionButton("btn", "Coin tossing"),
br(),
uiOutput("coin")
)
server <- function(input, output, session){
vals <- reactiveValues(img = "coin_d.jpg",
flag = FALSE)
observeEvent(input$btn, {
vals$flag <- TRUE
if (vals$flag) vals$img <- "coinFlipping.gif"
})
observe({
input$btn
if (isolate(vals$flag)) {
vals$flag <- FALSE
invalidateLater(4000)
} else {
vals$img <- sample(c("coin_c.jpg","coin_d.jpg"), 1)
}
})
output$coin <- renderUI({
tags$div(
tags$img(id = "anim", src = vals$img, width = 800)
)
})
}
shinyApp(ui, server)
I want to create a shiny application which will the user the ability to browse and load an image and then display it. My question is whether this is supported by shiny.
#ui.r
pageWithSidebar(
headerPanel('Image Recognition'),
sidebarPanel(
fileInput("file1", "Choose Image",
accept = c(
".jpg")
))
,
mainPanel(
imageOutput("file1")
)
)
#server.r
library(shiny)
function(input, output, session) {
(shiny.maxRequestSize=30*1024^2)
output$myImage <- renderImage({
# A temp file to save the output.
# This file will be removed later by renderImage
file1 <- tempfile(fileext = '.png')
# Generate the PNG
png(file1, width = 400, height = 300)
dev.off()
# Return a list containing the filename
list(src = file1,
contentType = 'image/png',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
}
Here is a solution using base64 encoding of the uploaded file.
library(shiny)
library(base64enc)
options(shiny.maxRequestSize = 30*1024^2)
ui <- fluidPage(
fileInput("upload", "Upload image", accept = "image/png"),
uiOutput("image")
)
server <- function(input, output){
base64 <- reactive({
inFile <- input[["upload"]]
if(!is.null(inFile)){
dataURI(file = inFile$datapath, mime = "image/png")
}
})
output[["image"]] <- renderUI({
if(!is.null(base64())){
tags$div(
tags$img(src= base64(), width="100%"),
style = "width: 400px;"
)
}
})
}
shinyApp(ui, server)
I have two inputs to be removed from the ui.R
fileInput(inputId = "FileInput",label = "Choose a csv file",accept = '.csv'),
uiOutput("SKU")
Inside server i am using an observeEvent to remove these 2 inputs and insert one. Though the insertUi is working I am not able to remove the other 2.
PFB the code:
observeEvent(input$Save,{
removeUI(
selector = "div:has(> #FileInput)"
)
insertUI(
selector = "#Save",
where = "afterEnd",
ui =fluidPage(
tags$hr(),
fluidRow(column(offset=0,1,actionButton("clean","Start cleaning the Data")))
)
)
})
It seems you have to treat it the same way in which the shiny blog example treats text by wrapping it in a div with id.
tags$div(
fileInput(inputId = "FileInput",label = "Choose a csv file",accept = '.csv'),
id='FileInput'
)
Example
ui <- fluidPage(
mainPanel(
tags$div(fileInput('element1','Input file...'),id='element1'),
actionButton('remove','Remove File Input')
)
)
server <- function(input, output) {
observeEvent(input$remove,{
removeUI(selector = '#element1')
})
}
shinyApp(ui = ui, server = server)
Using the code below, I am only getting the alt text to appear.
Any suggestions on what may be the problem?
From server.R:
output$face <- renderImage({
list(src = "http://www.clipartbest.com/cliparts/yco/GGE/ycoGGEacE.png",
filetype = "image/png",
alt = "YOU MUST BE KIDDING ME!")
}, deleteFile = FALSE)
From ui.R:
imageOutput("face")
Thanks,
Chad
Adding to the explanation of the problem - I am not just trying to display the image. Rather, I am trying to make it reactive - and display a different image, based on inputs... per the server.R code below:
output$imagegauge <- renderImage({
if (is.null(IRR_calc()))
return(NULL)
if (IRR_calc() > .085) {
return(list(
src = "http://www.i2symbol.com/images/abc-123/o/white_smiling_face_u263A_icon_256x256.png",
contentType = "image/png",
alt = "Smiley Face"
))
} else {
return(list(
src = "http://www.clipartbest.com/cliparts/yco/GGE/ycoGGEacE.png",
filetype = "image/png",
alt = "Sad Face"
))
}
}, deleteFile = FALSE)
Thanks again,
Chad
renderImage takes a file as src input rather then a url. You can just include this image directly using tags$img :
library(shiny)
runApp(list(
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
numericInput('n', 'Number of obs', 100),
numericInput('m', 'Select image (Happy (1) or Sad(2))', 1, min = 1, max = 2),
uiOutput('test')
),
mainPanel(
plotOutput('plot')
)
)
),
server = function(input, output) {
output$plot <- renderPlot({ hist(runif(input$n)) })
output$test <- renderUI({
images <- c("http://www.i2symbol.com/images/abc-123/o/white_smiling_face_u263A_icon_256x256.png"
, "http://www.clipartbest.com/cliparts/yco/GGE/ycoGGEacE.png")
tags$img(src= images[input$m])
})
}
))