Question 42741 in Html Question posted in
Some basic documentation can be found here.

How to insert a custom image into Shiny plot header? – Html

In the almost-MWE code posted at the bottom, I’m trying to pull a custom image into the plot header. In the full App the user clicks on the image in order to trigger an explanatory modal dialogue. However, I can’t get the image to render in the plot header in this case. In other cases where this works for me fine, I use renderUI(), but in this case I’m trying to render the image inside the renderPlot() function. Image below explains better than these words. Is there a way to do this inside renderPlot()?

enter image description here

MWE code:

library(shiny)
library(survival)

### define function ###
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape,scale=scale, lower.tail=F)

ui <- fluidPage(
  selectInput("distSelect","Select distribution:",c("Weibull","Gamma")),
  sliderInput('shape','Adjust shape:',min=0,max=3,step=0.1,value=1.5),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$plot <- renderPlot({
    curve(
      weibSurv(x, shape=input$shape,scale=1/0.03), 
      from=0, to=80,
      main = 
        fluidRow(
          paste(input$distSelect), # leave paste, actual App has more objects to include here
          tags$button(
            id = "explainBtn",
            class = "btn action-button",
            tags$img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png")
          )
        ) 
    )
  })
}
shinyApp(ui, server)
Tags:

2

Answers


  1. Chosen as BEST ANSWER
    0

    For anyone who favors renderUI, here's a solution though I would defer to ismirsehregal's actionLink() solution above as it is cleaner.

    library(shiny)
library(survival)

### define functions used in App
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape,scale=scale, lower.tail=F)

ui <- fluidPage(
  selectInput("distSelect","Select distribution:",c("Weibull","Gamma")),
  sliderInput('shape','Adjust shape:',min=0,max=3,step=0.1,value=1.5),
  uiOutput("plotHeader"),
  fluidRow(plotOutput("plot"))
)

server <- function(input, output, session) {
  output$plot <- renderPlot({
    curve(
      weibSurv(x, shape=input$shape,scale=1/0.03), 
      from=0, 
      to=80
    )
  })
  
  output$plotHeader <- renderUI({
    fluidRow(
      align = 'center',
      paste(input$distSelect), 
      tags$button(
        id = "explainBtn",
        class = "btn action-button",
        tags$img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png")
      )
    )
  })
}
shinyApp(ui, server)

  2. 0

    I’d use shiny’s actionLink in this scenario:

    library(shiny)
library(survival)

### define function ###
weibSurv <- function(t, shape, scale) pweibull(t, shape=shape,scale=scale, lower.tail=F)

ui <- fluidPage(
  selectInput("distSelect","Select distribution:",c("Weibull","Gamma")),
  sliderInput('shape','Adjust shape:',min=0,max=3,step=0.1,value=1.5),
  column(12, align="center",
         actionLink(inputId = "explainBtn", label = strong("Weibull"), icon = NULL, br(), img(src = "https://images.plot.ly/language-icons/api-home/python-logo.png"))
  ),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$plot <- renderPlot({
    par(mar=c(5,4,0,2)+0.1) # reduce space above Plot
    curve(
      weibSurv(x, shape=input$shape,scale=1/0.03), 
      from=0, to=80,
    )
  })
  
  observeEvent(input$explainBtn, {
    showModal(modalDialog("do something useful"))
  })
  
}
shinyApp(ui, server)
    Login or Signup to reply.
Please signup or login to give your own answer.

Back To Top
Search