jl121
jl121

Reputation: 179

Images for radiobutton r shiny

I am learning how to use images as radiobuttons.

I found this page and have been playing around with it: Can you have an image as a radioButton choice in shiny?

The answer here has been very useful but the app doesn't load the Rlogo for the radiobutton (when using the second part of the answer using the functions). I have saved the image into a www file. I have tried different variations of writing the line '<img src="Rlogo.png">' = 'logo' like removing the quotations, replacing it with img(src='Rlogo.png') = 'logo' , replace it with the web link, but have been unsuccessful. Please can someone point out where I am going wrong or if the original code works for you!

logo is here: http://i1.wp.com/www.r-bloggers.com/wp-content/uploads/2016/02/Rlogo.png?resize=300%2C263

code is copied over from the page:

library(shiny)

radioButtons_withHTML <- function (inputId, label, choices, selected = NULL, inline = FALSE, 
          width = NULL) 
{
        choices <- shiny:::choicesWithNames(choices)
        selected <- if (is.null(selected)) 
                choices[[1]]
        else {
                shiny:::validateSelected(selected, choices, inputId)
        }
        if (length(selected) > 1) 
                stop("The 'selected' argument must be of length 1")
        options <- generateOptions_withHTML(inputId, choices, selected, inline, 
                                   type = "radio")
        divClass <- "form-group shiny-input-radiogroup shiny-input-container"
        if (inline) 
                divClass <- paste(divClass, "shiny-input-container-inline")
        tags$div(id = inputId, style = if (!is.null(width)) 
                paste0("width: ", validateCssUnit(width), ";"), class = divClass, 
                shiny:::controlLabel(inputId, label), options)
}

generateOptions_withHTML <- function (inputId, choices, selected, inline, type = "checkbox") 
{
        options <- mapply(choices, names(choices), FUN = function(value, 
                                                                  name) {
                inputTag <- tags$input(type = type, name = inputId, value = value)
                if (value %in% selected) 
                        inputTag$attribs$checked <- "checked"
                if (inline) {
                        tags$label(class = paste0(type, "-inline"), inputTag, 
                                   tags$span(HTML(name)))
                }
                else {
                        tags$div(class = type, tags$label(inputTag, tags$span(HTML(name))))
                }
        }, SIMPLIFY = FALSE, USE.NAMES = FALSE)
        div(class = "shiny-options-group", options)
}

    choices <- c('\\( e^{i \\pi} + 1 = 0 \\)' = 'equation',
                 '<img src="Rlogo.png">' = 'logo')


  ui <- shinyUI(fluidPage(
    withMathJax(),
    img(src='Rlogo.png'),
    fluidRow(column(width=12,
        radioButtons('test', 'Radio buttons with MathJax choices',
                     choices = choices, inline = TRUE),
        br(),
        h3(textOutput('selected'))
    ))
))

server <- shinyServer(function(input, output) {
    output$selected <- renderText({
        paste0('You selected the ', input$test)
    })
})

shinyApp(ui = ui, server = server)

Upvotes: 2

Views: 1164

Answers (2)

Cristina
Cristina

Reputation: 11

This will also work:

library(shiny)
library(shinyWidgets)

ui <- shinyUI(fluidPage(
  withMathJax(),
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "style.css")),
  fluidRow(column(width=12,
                  radioGroupButtons('test', 'Radio buttons with MathJax choices',
                               choiceNames = c('\\( e^{i \\pi} + 1 = 0 \\)',
                                           '<i class="icon_rlogo"></i>'),
                               choiceValues = c('equation', 'logo')),
                  br(),
                  h3(textOutput('selected'))
  ))
))

server <- shinyServer(function(input, output) {
  output$selected <- renderText({
    paste0('You selected the ', input$test)
  })
})

shinyApp(ui = ui, server = server)

With in your www folder your Rlogo.png image and a style.css file with:

.icon_rlogo {background: url(Rlogo.png) no-repeat center;
  background-size: contain;
  display: inline-block;
  width: 30px;
  height: 20px;}

To be customised as you wish.

Upvotes: 1

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84619

Here is a way.

enter image description here

library(shiny)

radioImages <- function(inputId, images, values){
  radios <- lapply(
    seq_along(images),
    function(i) {
      id <- paste0(inputId, i)
      tagList(
        tags$input(
          type = "radio",
          name = inputId,
          id = id,
          class = "input-hidden",
          value = as.character(values[i])
        ),
        tags$label(
          `for` = id,
          tags$img(
            src = images[i]
          )
        )
      )
    }
  )
  do.call(
    function(...) div(..., class = "shiny-input-radiogroup", id = inputId), 
    radios
  )
}

css <- HTML(
  ".input-hidden {",
  "  position: absolute;",
  "  left: -9999px;",
  "}",
  "input[type=radio] + label>img {",
  "  width: 50px;",
  "  height: 50px;",
  "  transition: 500ms all;",
  "}",
  "input[type=radio]:checked + label>img {",
  "  border: 1px solid #fff;",
  "  box-shadow: 0 0 3px 3px #090;",
  "  transform: rotateZ(-10deg) rotateX(10deg);", 
  "}"
)


ui <- fluidPage(
  tags$head(tags$style(css)),
  br(),
  wellPanel(
    tags$label("Choose a language:"),
    radioImages(
      "radio",
      images = c("java.svg", "javascript.svg", "julia.svg"),
      values = c("java", "javascript", "julia")
    )
  ),
  verbatimTextOutput("language")
)

server <- function(input, output, session){
  output[["language"]] <- renderPrint({
    input[["radio"]]    
  })
}

shinyApp(ui, server)

Credit.

Upvotes: 5

Related Questions