简体   繁体   中英

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)

Here is a way.

在此处输入图像描述

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 .

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.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM