Image output in shiny app - r

I am trying to include an image in a shiny app. I want: "if it is type 1 plot "this image", if it is type 0 plot "this other image". I know that I have to put the jpg files into the folder where the app.R is and then call it but I do not know how.
This is the code I have used until now (it works), I just have to include the images in the render.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Myapp"),
#Inputs
dateInput(inputId = "dob", label="Birth"),
dateInput(inputId = "ad", label="Date"),
actionButton("Submit", icon("fas fa-magic"), label="Submit"),
#Outputs
textOutput(outputId = "textR"),
imageOutput(outputId = "imageR1"),
imageOutput(outputId="imageR2")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#my output should be named textR and imageR1, imageR2
observeEvent(input$Submit,
output$textR<-renderText({
v1<-as.numeric(as.Date(input$ad,format="%Y/%m/%d") - as.Date(input$dob, format="%Y/%m/%d"))/30.5
value_v1<-ifelse(v1>48, "type1", "type2")
print(value_v1)
}))
}
# Run the application
shinyApp(ui = ui, server = server)

It is bad practice to define an output object inside an observeEvent. In this case, independent on the choice of how to switch the images, I would advice to use an eventReactive - let's call that myval. That creates a reactive which only changes when a certain event happens, in this case a click on the submit button. We can then refer to this in the body of the renderText statement, so that can simply become:
output$textR<-renderText({
print(myval())
})
Secondly, for the outputting of images, you should place those in the www directory, see here. We can then create an ui element with renderUI and UIOutput, in which we use the value of our eventReactive myval() to select the image to display.
A working example is given below. Note that I saved it as app.R, and used the folder structure of the referred link, so:
| shinyApp/
| app.R
| www/
| zorro.jpg
| notzorro.jpg
Hope this helps!
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Myapp"),
#Inputs
dateInput(inputId = "dob", label="Birth"),
dateInput(inputId = "ad", label="Date"),
actionButton("Submit", icon("fas fa-magic"), label="Submit"),
#Outputs
textOutput(outputId = "textR"),
uiOutput(outputId = "my_ui")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
myval <- eventReactive(input$Submit,
{
v1<-as.numeric(as.Date(input$ad,format="%Y/%m/%d") - as.Date(input$dob, format="%Y/%m/%d"))/30.5
return(ifelse(v1>48, "type1", "type2"))
})
output$textR<-renderText({
print(myval())
})
output$my_ui<-renderUI({
if(myval()=='type1')
img(src='zorro.jpg', height = '300px')
else
img(src='notzorro.jpg', height = '300px')
})
}
# Run the application
shinyApp(ui = ui, server = server)

Related

how to print sampled output from actionButton on multiple lines in R Shiny

I would like to have an action button in R Shiny that samples three elements of a character variable and returns each on its own line. I have seen that htmltools can be used to break the text of the action button itself onto new lines, but I don't see an obvious way to pass such commands into the output of the button, especially when using the sample() function.
In the toy shiny app below, the actionButton prints three greek letters on one line,
alpha beta delta
I would like each sampled element to appear on its own line,
alpha
beta
delta
Below is the toy app
library(shiny)
# Define UI ----
ui <- fluidPage(
titlePanel("Toy"),
# Copy the line below to make an action button
actionButton("greek", label = "Greek letters"),
verbatimTextOutput("text")
)
# Define server logic ----
server <- function(input, output, session) {
observeEvent(input$greek, {
greek <- c("alpha","beta","gamma","delta")
})
observeEvent(input$greek,{
output$text <- renderText(sample(greek,3))
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Here, try this:
library(shiny)
library(glue)
# Define UI ----
ui <- fluidPage(
titlePanel("Toy"),
# Copy the line below to make an action button
actionButton("greek", label = "Greek letters"),
verbatimTextOutput("text")
)
# Define server logic ----
server <- function(input, output, session) {
greeks <- eventReactive(input$greek, {
sample(c("alpha", "beta", "gamma", "delta"), size = 3)
})
output$text <- renderText(
sample(greeks(), 3) |> glue_collapse(sep = "\n")
)
}
# Run the app ----
shinyApp(ui = ui, server = server)

In R Shiny, how do you reformat the font of input labels when you update them?

In R Shiny, I know you can use update*Input functions to adjust the labels/placeholders/values of inputs in response to user actions via linked observeEvent calls. For example, in the code below, the label for my textInput changes as soon as you start typing anything into it.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
textInput(inputId = "name",
label = "Enter your name!",
placeholder = "Placeholder")
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observeEvent(input$name, {
req(input$name)
updateTextInput(session,
"name",
label = "Wow, you're really doing it!")
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
However, I can't figure out how to change the formatting of the updated labels. In particular, I want to make them either bold or a different color so they stand out more. I've tried stuff like label = HTML(<b>"This is bold"</b>) and label = p(strong("This is bold")) and various variations on them inside the updateTextInput() call. I've looked at other related articles like How to make a label of a shiny widget the same as plain text? and How to format parts of a label bold? and How to change the pickerinput label to fine instead of bold and I'm just spinning my wheels! It looks like the update*Input functions work a bit differently than their corresponding *Input functions, so what works for one may not work for the other...
Yep, that doesn't work. Here is a trick. The label is bold by default so I change it to a red label instead.
library(shiny)
# UI ####
ui <- fluidPage(
textInput(inputId = "name",
label = uiOutput("thelabel", inline = TRUE),
placeholder = "Placeholder")
)
# Server ####
server <- function(input, output, session) {
TheLabel <- reactiveVal("Enter your name")
output[["thelabel"]] <- renderUI({
TheLabel()
})
observeEvent(input[["name"]], {
req(input[["name"]])
TheLabel(span("This is red", style = "color: red;"))
}, ignoreInit = TRUE)
}
# Run ####
shinyApp(ui = ui, server = server)

In R Shiny, how do you paste a user's selected input from UI into a reactive object in server?

super new to shiny, have a problem that seems like it should be basic reactive programming but I haven't been able to find a solution that's worked so far.
Essentially, I want to take the user's selected input from the UI and paste it into a simple object in the server that will react/update when a new input is chosen.
The object will be concatenated into a full API call, and I wish to rerun the API call in the server with the reactive object updated each time a new input is chosen for it (note: the API cannot be run without an access code which is part of a corporate account, so apologies for my hesitance to put my full code but I just need help with this one functionality.)
In code below:
with Dollar General as the default selection in the selectInput, I would like the object, query, to be the character string "dollar%20general", and reactively change to "walmart" should Walmart be selected
Thanks!
ui <- fluidPage
sidebarLayout(
sidebarPanel(
selectInput("company", "Choose company:",
c("Dollar General" = "dollar%20general",
"Dollar Tree" = "dollar%20tree",
"Walmart" = "walmart"))
...
server <- function(input,output) {
...
query <- paste(input$company)
...
you can use reactiveValues() and observe. This should work:
library(shiny)
# Define UI for application
ui <- fluidPage(
# your input
sidebarLayout(
sidebarPanel(
selectInput("company", "Choose company:",
c("Dollar General" = "dollar%20general",
"Dollar Tree" = "dollar%20tree",
"Walmart" = "walmart"))
),
# Determine Output
mainPanel(
textOutput("showInput") # you need to render this in your server file
)
)
)
server <- function(input, output) {
# Show what was selected
query <- reactiveValues()
observe(
query$test <- paste(input$company, "and test", sep = " ")
)
output$showInput <- renderText({ #based on what you defined in the ui
query$test
})
}
# Run the application
shinyApp(ui = ui, server = server)
Create two files named ui.R and server.R store the UI logic in ui.R and backend/object logic in server.R. Below is the implementation.
UI file
# UI of app
ui <- fluidPage(
# input
sidebarLayout(
sidebarPanel(
selectInput("company", "Choose company:",
c("Dollar General" = "dollar%20general",
"Dollar Tree" = "dollar%20tree",
"Walmart" = "walmart"))
),
# Output
mainPanel(
textOutput("Input")
)
)
)
Server/Backend File
server <- function(input, output) {
# Show what was selected
output$Input <- renderText({ #based on what you defined in the ui
input$company
})
}
Now store these in a directory and then call runApp function.
~/newdir
|-- ui.R
|-- server.R
runApp("newdir")

Hide/show outputs Shiny R

I am trying to find out how to show and hide my outputs like graphics and tabels each time when the user change something in the widgets. For instance I have a sliderInput for my variable called "gender" with 2 choices : male and female. I also have a button which executes estimations when the user click on it. I want to hide the outputs each time when the user changes at least one choice between the different widgets. For instance after one estimation the user decides to change only the level of education and when the user click on the sliderInput box, I would like to hide the previous results.
I tried to use the R package shinyjs and the functions hide/show but they are not working for outputs.
Do you have any idea how to do it without using shinyjs package?
Here is a part of my code:
shinyUI(fluidPage(
sidebarLayout(
fluidRow(
column(4, wellPanel(
fluidRow(
column(5,selectInput("gender",
label = div("Sexe",style = "color:royalblue"),
choices = list("Male", "Female"),
selected = "Female")),
# other different widjets..
column(8, plotOutput('simulationChange')),
column(4, tableOutput('simulationChangeTable'),
tags$style("#simulationChangeTable table {font-size:9pt;background-color: #E5E4E2;font-weight:bold;margin-top: 121px; margin-left:-30px;overflow:hidden; white-space:nowrap;text-align:left;align:left;}",
media="screen",
type="text/css"),
fluidRow(
column(6, tableOutput('simulationChangeEsperance'),
tags$style("#simulationChangeEsperance table {font-size:9pt;background-color: #E5E4E2;font-weight:bold;margin-top: -10px; margin-left:-30px;overflow:hidden; white-space:wrap;word-break: break-word;width:173px;text-align:left;}"))
)
)
)
)
)
))
shinyServer(function(input, output, session) {
# part of my server.R code
observe({
if (input$gender|input$age|input$birthplace|input$education){
shinyjs::hide("simulationChange")
shinyjs::hide("simulationChangeTable")
shinyjs::hide("simulationChangeEsperance")
}
})
Thank you.
The reason your code didn't work is because you didn't make a call to useShinyjs() (if you read the documentation or look at any examples of using shinyjs, you'll see that you HAVE to call useShinyjs() in the UI).
I couldn't replicate your code because it had too many errors, but just to demonstrate that it does work with outputs, here's a small example you can run. In your project, just add shinyjs::useShinyjs() somewhere in the UI.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("hideshow", "Hide/show plot"),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(100))
})
observeEvent(input$hideshow, {
# every time the button is pressed, alternate between hiding and showing the plot
toggle("plot")
})
}
shinyApp(ui = ui, server = server)
As mentioned by Dieter in the comments you need to use conditionalPanel. For example, in your ui.R, instead of
plotOutput('simulationChange')
use
conditionalPanel("output.show", plotOutput('simulationChange'))
And in your server.R add the following:
values <- reactiveValues()
values$show <- TRUE
observe({
input$gender
input$age
input$birthplace
input$education
values$show <- FALSE
})
output$show <- reactive({
return(values$show)
})
Also, don't forget to change values$show, when clicking on your button:
observeEvent(input$button, {
...
values$show <- TRUE
})
The other answers here don't seem to provide the right/complete answer. The solution is actually quite simple.
You need to use outputOptions(output, 'show', suspendWhenHidden = FALSE)
Below is a sample code that displays the text inside a conditionalPanel if the dropdown selection is 2 and hides if it is 1.
library(shiny)
ui <- fluidPage(
selectInput("num", "Choose a number", 1:2),
conditionalPanel(
condition = "output.show",
"The selected number is 2 so this text is displayed. Change it back to 1 to hide."
)
)
server <- function(input, output, session) {
output$show <- reactive({
input$num == 2 # Add whatever condition you want here. Must return TRUE or FALSE
})
outputOptions(output, 'show', suspendWhenHidden = FALSE)
}
shinyApp(ui = ui, server = server)

conditionalPanel in R/shiny

Quick question on conditionalPanel for shiny/R.
Using a slightly modified code example from RStudio, consider the following simple shiny app:
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "input.n > 20",
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
My objective is to hide the graph and move up the HTML text to avoid a gap. Now, you can see that if the entered value is below 20, the graph is hidden and the text "Bottom" is moved up accordingly. However, if the entered value is larger than 20, but smaller than 50, the chart function returns NULL, and while no chart is shown, the text "Bottom" is not moving up.
Question is: is there a way I can set a conditionalPanel such that it appears/is hidden based on whether or not a plot function returns NULL? The reason I'm asking is because the trigger a bit complex (among other things it depends on the selection of input files, and thus needs to change if a different file is loaded), and I'd like to avoid having to code it on the ui.R file.
Any suggestions welcome,
Philipp
Hi you can create a condition for conditionalPanel in the server like this :
n <- 200
library("shiny")
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "output.cond == true", # here use the condition defined in the server
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output, session) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
# create a condition you use in the ui
output$cond <- reactive({
input$n > 50
})
outputOptions(output, "cond", suspendWhenHidden = FALSE)
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
Don't forget to add the session in your server function and the outputOptions call somewhere in that function.

Resources