單選按鈕 r shiny 的圖像

Question

我正在學習如何將圖像用作單選按鈕。

我找到了這個頁面並且一直在玩它： 你能在 shiny 中有一個圖像作為單選按鈕選項嗎？

這里的答案非常有用，但應用程序不會為單選按鈕加載 Rlogo（使用函數使用答案的第二部分時）。 我已將圖像保存到 www 文件中。 我嘗試了編寫'<img src="Rlogo.png">' = 'logo'行的不同變體，例如刪除引號，將其替換為img(src='Rlogo.png') = 'logo' ，替換它與 web 鏈接，但一直不成功。 請有人指出我哪里出錯了，或者原始代碼是否適合你！

徽標在這里： http://i1.wp.com/www.r-bloggers.com/wp-content/uploads/2016/02/Rlogo.png?resize=300%2C263

代碼是從頁面復制過來的：

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)

Answer 1

這是一種方法。

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)

信用。

Answer 2

這也將起作用：

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)

在您的 www 文件夾中，您的 Rlogo.png 圖像和 style.css 文件包含：

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

隨心所欲定制。