我正在尝试使用Shiny作为多项选择项的评估工具。因此,在某些情况下,我希望有一个图像作为选择。而是显示原始HTML。这可以用Shiny来完成吗?
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)
您必须将R徽标放在放置此www
脚本的app.r
目录中。以下是徽标的直接链接:http://i1.wp.com/www.r-bloggers.com/wp-content/uploads/2016/02/Rlogo.png?resize=300%2C263
答案 0 :(得分:3)
img
未显示在单选按钮中,因为这些名称保存在span
中并使用tags$span
生成,因此所有HTML都会被转义。
如果您只需执行一次,则可以复制radioButtons('test', 'Radio buttons with MathJax choices', choices = choices, inline = TRUE)
的输出,将其放在tags$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'))
))
如果您需要多次执行此操作,可以定义radioButtons_withHTML
函数:
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)
}
与原始版本的不同之处在于调用generateOptions_withHTML
来创建按钮的名称,并在HTML()
中的name
周围添加了tags$span
函数以防止逃跑。您可以将这些函数放在另一个文件中,然后使用source
。
然后,您可以使用radioButtons_withHTML('test', 'Radio buttons with MathJax choices',choices = choices, inline = TRUE)
创建radioButtons
。