Question

我希望Shiny根据矢量的大小打印出一些不同的颜色文本。我想的是：

  output$some_text <- renderText({ 
    if(length(some_vec) < 20){
      paste("This is red text")
      <somehow make it red>
    }else{
    paste("This is blue text")
      <somehow make it blue>

...但后来我意识到，我在服务器上做这个，而不是用户界面。

而且，据我所知，我无法将此条件逻辑移动到用户界面中。

例如，像这样的东西在UI中不起作用：

    if(length(some_vec)< 20){
         column(6, tags$div(
         HTML(paste("This text is ", tags$span(style="color:red", "red"), sep = ""))
      )}
    else{
         tags$div(HTML(paste("This text is ", tags$span(style="color:blue", "blue"), sep = ""))
)}

有没有人有任何创意？

Answer 1

受到jenesaisquoi's answer的启发，我尝试了以下内容，它对我有用。它是反应性的，不需要额外的包装。特别要看output$text3

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Reactive"),
  sidebarLayout(
    sidebarPanel(
      helpText("Variables!"),
      selectInput("var", 
                  label = "Choose Variable",
                  choices = c("red", "blue",
                              "green", "black"),
                  selected = "Rojo"),
      sliderInput("range", 
                  label = "Range:",
                  min = 0, max = 100, value = c(0, 100))
    ),
    mainPanel(
      textOutput("text1"),
      textOutput("text2"),
      htmlOutput("text3"),
      textOutput("text4")
    )
  )
))

server <- function(input, output) {
  output$text1 <- renderText({ 
    paste("You have selected variable:", input$var)
  })

  output$text2 <- renderText({ 
    paste("You have selected range:", paste(input$range, collapse = "-"))
  })

  output$text3 <- renderText({
    paste('<span style=\"color:', input$var, 
          '\">This is "', input$var, 
          '" written ', input$range[2], 
          ' - ', input$range[1], 
          ' = ', input$range[2] - input$range[1], 
          ' times</span>', sep = "")
  })

  output$text4 <- renderText({ 
    rep(input$var, input$range[2] - input$range[1])
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 2

寻找类似问题的答案。尝试了一种适合我需要的简单方法。它使用内联html样式和htmlOutput。

library(shiny)

ui <- fluidPage(
 mainPanel(
 htmlOutput("some_text")
 )
)

和

server <- function(input, output) {

   output$some_text <- renderText({ 

     if(length(some_vec) < 20){
     return(paste("<span style=\"color:red\">This is red text</span>"))

     }else{
     return(paste("<span style=\"color:blue\">This is blue text</span>"))
     }
   })
 }

条件运行服务器端 - 我不清楚打开问题，作者需要条件在UI中运行。我没有。也许是在常见情况下解决问题的简单方法。

Answer 3

好吧，我有一个想法的核心，但我对HTML / CSS / JavaScript相关的任何东西都相当新，所以我相信它可以改进很多。也就是说，就目前而言，这似乎运作得相当好。

关键功能是removeClass()和addClass()，这些功能在 shinyjs 各自的帮助文件中有详细记录：

library(shiny)
library(shinyjs)

shinyApp(
    ui = fluidPage(
        useShinyjs(),  ## Set up shinyjs
        ## Add CSS instructions for three color classes
        inlineCSS(list(.red   = "color: red",
                       .green = "color: green",
                       .blue  = "color: blue")),
        numericInput("nn", "Enter a number",
                     value=1, min=1, max=10, step=1),
        "The number is: ", span(id = "element", textOutput("nn", inline=TRUE))
        ),
    server = function(input, output) {
        output$nn <- renderText(input$nn)
        observeEvent(input$nn, {
            nn <- input$nn
            if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn))) {
                ## Clean up any previously added color classes
                removeClass("element", "red")
                removeClass("element", "green")
                removeClass("element", "blue")
                ## Add the appropriate class
                cols <- c("blue", "green", "red")
                col <- cols[cut(nn, breaks=c(-Inf,3.5, 6.5, Inf))]
                addClass("element", col)
            } else  {}
        })
    })

Answer 4

听起来你试图将它全部保留在客户端，所以你可以使用几个conditionalPanel s，它接受javascript作为条件代码。例如，将文本着色以响应numericInput框中当前值为id＆＃34; len＆＃34;，

library(shiny)
ui <- shinyUI(
    fluidPage(
        fluidRow(
            numericInput('len', "Length", value=19),
            conditionalPanel(
                condition = "$('#len').val() > 20",
                div(style="color:red", "This is red!")),
            conditionalPanel(
                condition = "$('#len').val() <= 20",
                div(style="color:blue", "This is blue!"))
        )
    )
)

server <- function(input, output, session) {}
shinyApp(ui = ui, server=server)

您还可以添加一个事件监听器来使用javascript更新文本。它有点丑陋的内联（我不太了解javascript），但您可以将脚本移到wwww/中的文件并使用includeScript。与前面的示例一样，server不执行任何操作。

ui <- shinyUI(bootstrapPage(
    numericInput('len', "Length", value=19),
    div(id="divvy", style="color:blue", "This is blue!"),
    tags$script(HTML("
        var target = $('#len')[0];
        target.addEventListener('change', function() {
            var color = target.value > 20 ? 'red' : 'blue';
            var divvy = document.getElementById('divvy');
            divvy.style.color = color;
            divvy.innerHTML = divvy.innerHTML.replace(/red|blue/g, color);
        });
    "))
))

Answer 5

这是一个更灵活的答案，它使用trainControl(method = "none")为R提供了一种生成一些参数化JavaScript代码的方法。与我的其他答案相比，这个问题的优势在于可以使用相同的功能对多个数字输出进行反应性着色。

shinyjs::extendShinyjs()

在Shiny中有条件地输出不同颜色的文本

5 个答案: