Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/75.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R 你能在shiny中选择一个单选按钮图像吗?_R_Shiny - Fatal编程技术网

R 你能在shiny中选择一个单选按钮图像吗?

R 你能在shiny中选择一个单选按钮图像吗?,r,shiny,R,Shiny,我尝试使用Shiny作为多项选择题的评估工具。因此,在某些情况下,我希望有一个图像作为选择。而是显示原始HTML。这可以用闪亮的颜色来做吗 library(shiny) choices <- c('\\( e^{i \\pi} + 1 = 0 \\)' = 'equation', '<img src="Rlogo.png">' = 'logo') ui <- shinyUI(fluidPage( withMathJax(),

我尝试使用Shiny作为多项选择题的评估工具。因此,在某些情况下,我希望有一个图像作为选择。而是显示原始HTML。这可以用闪亮的颜色来做吗

library(shiny)

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)
库(闪亮)

选项单选按钮中不显示
img
,因为名称保存在
span
中,并使用
标记$span
生成,因此所有HTML都被转义

如果只需执行一次,则可以复制
单选按钮('test',带有MathJax选项的单选按钮',choices=choices,inline=TRUE)
,将其放入
标记$div
,并添加图像:

      fluidRow(column(width=12,
                        tags$div(HTML('<div id="test" class="form-group shiny-input-radiogroup shiny-input-container shiny-input-container-inline">
  <label class="control-label" for="test">Radio buttons with MathJax choices</label>
                                      <div class="shiny-options-group">
                                      <label class="radio-inline">
                                      <input type="radio" name="test" value="equation" checked="checked"/>
                                      <span>\\( e^{i \\pi} + 1 = 0 \\)</span>
                                      </label>
                                      <label class="radio-inline">
                                      <input type="radio" name="test" value="logo"/>
                                      <span><img src="http://i1.wp.com/www.r-bloggers.com/wp-content/uploads/2016/02/Rlogo.png?resize=300%2C263"/></span>
                                      </label>
                                      </div>
                                      </div> ')),
                        br(),
                        h3(textOutput('selected'))
        ))
与原来的不同之处在于调用
generateOptions\u with HTML
来创建按钮的名称,我在
标记$span
中添加了
HTML()
函数来防止转义。您可以将这些函数放在另一个文件中并使用
source

然后,您可以将
单选按钮与HTML一起使用('test',带有MathJax选项的单选按钮',choices=choices,inline=TRUE)
来创建您的
单选按钮

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)
}