代码之家  ›  专栏  ›  技术社区  ›  Patrick Balada

R:renderText可以输出颜色吗?

  •  2
  • Patrick Balada  · 技术社区  · 8 年前

    我正在尝试使用软件包shinydashboard创建一个盒子。我无法在服务器端创建它(这是另一个问题,但就我的问题而言)。然而,我想动态设置颜色,并想知道使用renderText是否有可能。我现在在服务器端有一个renderText,它输出NULL或颜色“栗色”。然而,这给了我以下错误:

    Warning: Error in validateColor: Invalid color
    

    1 回复  |  直到 8 年前
        1
  •  4
  •   Community CDub    7 年前

    简而言之,无法使用直接更改颜色 renderText 但是有很多方法可以动态改变文本的颜色。

    要提到一些方法,您可以:

    使用CSS类并在它们之间切换:

    require(shiny)
    require(shinydashboard)
    
    ui <- dashboardPage(
      dashboardHeader(title = "Basic dashboard"),
      dashboardSidebar(),
      dashboardBody(
        tags$head(
          tags$style(
            HTML("
                  .toggle{
                    color: red;
                  }
                 ")
            ),
          tags$script(
            HTML("
              Shiny.addCustomMessageHandler ('toggleClass',function (m) {
                      var element = $('#'+m.id); // Find element to change color of
                      element.toggleClass('toggle');
              });
                 ")
          )
        ),
        fluidRow(
          box( id='test',
               title = "Box",
               status = "warning",
               solidHeader = TRUE,
               height = 400,
               textOutput('txtOut')
          )
        ),
        actionButton('btn','Generate Color')
      ) #end dashboardBody
    )
    
    server <- function(input, output, session) {
    
      # Helper function, calls javascript
      toggleClass <- function(id){
        session$sendCustomMessage(type = 'toggleClass', message = list('id'=id))
      }
    
      output$txtOut <- renderText({ "Static text" }); # Text can be re-rendered independantly
    
      observeEvent(input$btn,{
        toggleClass('txtOut') # Add  / remove class
      })
    
    }
    shinyApp(ui, server)
    

    使用Javascript绑定更改元素的颜色(可能是最强大的方法):

       require(shiny)
       require(shinydashboard)
    
        ui <- dashboardPage(
          dashboardHeader(title = "Basic dashboard"),
          dashboardSidebar(),
          dashboardBody(
            tags$head(
              tags$script(
                HTML("
                  // Change color inside of element with supplied id
                  Shiny.addCustomMessageHandler ('changeTxtColor',function (m) {
                          var element = $('#'+m.id); // Find element to change color of
                          element.css({ 'color': 'rgb('+m.r+','+m.g+','+m.b+')' }); // Change color of element
                  });
    
                  // Change color of shinydashboard box
                  Shiny.addCustomMessageHandler ('changeBoxColor',function (m) {
                          var parent  = $('#'+m.id).closest('.box');
                          var element = parent.children('.box-header');
                          var rgbStr  = 'rgb('+m.r+','+m.g+','+m.b+')';
                          element.css({ 'background-color':  rgbStr});
                          parent.css({ 'border-color' :  rgbStr})
                  });
                    ")
              )
            ),
            fluidRow(
              box( id='test',
                title = "Box",
                status = "warning",
                solidHeader = TRUE,
                height = 400,
                textOutput('txtOut'),
                div(id='target') 
                # Since you can't specify the id of shinydashboard boxes
                # we need a child with id to change the color of the box.
              )
            ),
            actionButton('btn','Generate Color')
          )
        )
    
        server <- function(input, output, session) {
    
          randomColor <- reactive({
            input$btn
            name <- sample(colors(),1)
            rgb  <- col2rgb(name)
            return( list(name=name, rgb=rgb) )
          })
    
          # Helper function, calls javascript
          changeTxtColor <- function(id,rgb){
            session$sendCustomMessage(type = 'changeTxtColor', message = list('id'=id,'r'=rgb[1],'g'=rgb[2],'b'=rgb[3]))
          }
          changeBoxColor <- function(id,rgb){
            session$sendCustomMessage(type = 'changeBoxColor', message = list('id'=id,'r'=rgb[1],'g'=rgb[2],'b'=rgb[3]))
          }
    
          output$txtOut <- renderText({
            rgb <- randomColor()$rgb
            changeTxtColor('txtOut',rgb)
            changeBoxColor('target',rgb)
            sprintf("Generated color with name %s ", randomColor()$name)
          })
    
        }
        shinyApp(ui, server)
    

    只需输出HTML而不使用renderText,就可以精确地 HTML控件生成请参见 question :

    require(shiny)
    require(shinydashboard)
    
    ui <- dashboardPage(
      dashboardHeader(title = "Basic dashboard"),
      dashboardSidebar(),
      dashboardBody(
        fluidRow(
          box( id='test',
               title = "Box",
               status = "warning",
               solidHeader = TRUE,
               height = 400,
               htmlOutput('txtOut')
          )
        ),
        actionButton('btn','Generate Color')
      ) #end dashboardBody
    )
    
    server <- function(input, output, session) {
    
      # Reactive variable
      randomColor <- reactive({
        input$btn
        name <- sample(colors(),1)
        rgb  <- col2rgb(name)
        return( list(name=name, rgb=rgb) )
      })
    
      # Helper function, calls javascript
      toggleClass <- function(id){
        session$sendCustomMessage(type = 'toggleClass', message = list('id'=id))
      }
    
      output$txtOut <- renderUI({
        rgb    <- randomColor()$rgb
        rgbStr <- sprintf('rgb(%d,%d,%d)',rgb[1],rgb[2],rgb[3])
        print(rgb)
        div( HTML(sprintf("<text style='color:%s'> Generated color with name %s </text>", rgbStr, randomColor()$name) ) )
      })
    
    }
    shinyApp(ui, server)
    

    对不起,文字量太大了。