Puoi avere un'immagine come scelta di un pulsante radio in lucido?

Question

Sto cercando di utilizzare Shiny come strumento di valutazione per articoli a scelta multipla. Come tale, in alcuni casi mi piacerebbe avere un'immagine come scelta. Invece, viene mostrato il codice HTML non elaborato. Questo può essere fatto in 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) 

Si dovrà mettere il logo R nella directory www in cui si colloca questo script app.r. Ecco un link al logo: http://i1.wp.com/www.r-bloggers.com/wp-content/uploads/2016/02/Rlogo.png?resize=300%2C263

Answer 1

Il img non viene visualizzato nei pulsanti di scelta perché i nomi sono tenuti in span e generati utilizzando tags$span così tutto HTML è sfuggito.

Se avete a che fare solo una volta, è possibile copiare l'output di radioButtons('test', 'Radio buttons with MathJax choices', choices = choices, inline = TRUE), metterla in un tags$div, e aggiungere l'immagine:

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

Se avete bisogno di fare questo molte volte, si può definire una funzione 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) 
} 

la differenza con l'originale è chiamate generateOptions_withHTML per creare i nomi dei pulsanti, e ho aggiunto la funzione HTML() intorno name nel tags$span per impedire l'escape. È possibile inserire queste funzioni in un altro file e utilizzare source.

È quindi possibile utilizzare radioButtons_withHTML('test', 'Radio buttons with MathJax choices',choices = choices, inline = TRUE) per creare il numero radioButtons.