14

我希望 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。

而且，据我所知，我无法将这个条件逻辑移到 UI 中。

例如，这样的事情在 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 = ""))
)}

有人有什么创意吗？

4

5 回答 5

9

受jenesaisquoi 的回答启发，我尝试了以下方法，它对我有用。它是反应式的，不需要额外的包。特别看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)
于 2017-09-03T03:18:55.127 回答
4

来寻找类似问题的答案。尝试了一种适合我需要的简单方法。它使用内联 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 中运行。我没有。也许是解决常见情况下问题的简单方法。

于 2017-05-06T18:39:03.533 回答
2

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

关键功能是removeClass()和，它们在shinyjsaddClass()各自的帮助文件中有详细记录：

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  {}
        })
    })
于 2015-10-28T07:41:55.913 回答
2

这是一个更灵活的答案，用于shinyjs::extendShinyjs()为 R 提供一种生成一些参数化 JavaScript 代码的方法。与我的其他答案相比，这个答案的优点是可以使用相同的函数对多个数字输出进行反应性着色。

library(shiny)
library(shinyjs)

jsCode <-
"shinyjs.setCol = function(params){
     var defaultParams = {
         id: null,
         color : 'red'
     };
     params = shinyjs.getParams(params, defaultParams);
     $('.shiny-text-output#' + params.id).css('color', params.color);
 }"
setColor <- function(id, val) {
    if(is.numeric(as.numeric(val)) & !is.na(as.numeric(val))) {
        cols <- c("green", "orange", "red")
        col <- cols[cut(val, breaks=c(-Inf,3.5, 6.5, Inf))]
        js$setCol(id, col)
    }
}

shinyApp(
    ui = fluidPage(
        useShinyjs(),  ## Set up shinyjs
        extendShinyjs(text = jsCode),
        numericInput("n", "Enter a number", 1, 1, 10, 1),
        "The number is: ", textOutput("n", inline=TRUE),
        br(),
        "Twice the number is: ", textOutput("n2", inline=TRUE)
        ),
    server = function(input, output) {
        output$n  <- renderText(input$n)
        output$n2 <- renderText(2 *  input$n)
        observeEvent(input$n, setColor(id = "n", val = input$n))
        observeEvent(input$n, setColor(id = "n2", val = 2 * input$n))
    })
于 2015-10-28T17:51:49.977 回答
2

听起来您正试图将其全部保留在客户端，因此您可以只使用几个conditionalPanels，它们接受 javascript 作为条件代码。例如，为文本着色以响应numericInputid 为“len”的框中的当前值，

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);
        });
    "))
))
于 2015-10-28T07:59:34.593 回答