如何使用 session$sendCustomMessage 发送 HTML 代码？

Question

首先，您将使用 sendCustomMessage:

突出显示要发送到 JS 的函数

fx <- function(x) {

  if (x <= 33) {
  
    "<p style='color:black;background-color:white;'>Hello</p>"
  
  } else if (x <= 66) {
  
    "<p style='color:yellow;background-color:red;'>World</p>"
  
  } else ("<p style='color:orange;background-color:green;'>!</p>")

}

我也会突出显示自定义消息：

session$sendCustomMessage(
  type = "box1", 
  list(
    text = fx(
      x = pred_1()
      )
    )
  )

我的 shinyApp：

library(shiny)
library(shinydashboard)

header <- dashboardHeader(
  
  title = "Dashboard", 
  titleWidth = 300
  
)

sidebar <- dashboardSidebar(
  
  width = 300
  
)

body <- dashboardBody(
  
  sliderInput(
    inputId = "s1", 
    label = "S1", 
    value = 5, 
    min = 1, 
    max = 100, 
    step = 1
  ), 
  
  sliderInput(
    inputId = "s2", 
    label = "S2", 
    value = 5, 
    min = 1, 
    max = 100, 
    step = 1
  ), 
  
  box(
    id = "g1", title = "My gauge", background = "black", status = "warning", 
    width = 6, collapsible = T, collapsed = F, 
    footer = "This is my first gauge", 
    flexdashboard::gaugeOutput(
    outputId = "value1"
    )
  )
  
)

ui <- dashboardPage(
  
  header = header, sidebar = sidebar, body = body, skin = "red"
  
)

server <- function(session, input, output) {
  
  fsum <- function(x, y) {
    
    x + y
    
  }
  
  fx <- function(x) {
    
      if (x <= 33) {
      
      "<p style='color:black;background-color:white;'>Hello</p>"
      
    } else if (x <= 66) {
      
      "<p style='color:yellow;background-color:red;'>World</p>"
      
    } else ("<p style='color:orange;background-color:green;'>!</p>")
    
  }
  
  reac_0 <- reactive({
    
    tibble::tibble(
      s1 = input$s1,
      s2 = input$s2
      )
    
  })
  
  pred_1 <- reactive({
    
    temp <- reac_0()
    fsum(
      x = temp$s1, 
      y = temp$s2
    )
    
  })
  
  output$value1 <- flexdashboard::renderGauge({
    
    session$sendCustomMessage(
      type = "box1", 
      list(
        text = fx(
          x = pred_1()
          )
        )
      )
    
    expr = flexdashboard::gauge(
      value = pred_1(), min = 1, max = 100, symbol = " +", 
      flexdashboard::gaugeSectors(
        c(1, 33), c(34, 66), c(67, 1000), colors = c("red", "orange", "green")
      ), 
      label = ""
    )
    
  })
  
}

shinyApp(ui, server)

在 .js 文件中，我插入此代码：

Shiny.addCustomMessageHandler(
  type = "box1",
  data => $("#value1.html-widget.gauge svg text[font-size='10px'] 
  tspan:eq(0)").html(data.text)
  );

设置仪表标签的样式。但是，不起作用。

另一方面，当我将 fx 替换为 fy（仅文本）时：

  fy <- function(x) {

    if (x <= 70) {
  
      "Hello"
  
    } else if (x <= 100) {
  
      "World"
  
    } else ("!")

  }

工作正常。

编辑

我尝试在 if 结构中添加 URLencode：

  fx <- function(x) {

    if (x <= 70) {
  
      URLencode("<p style='color:black;background-color:white;'>Hello</p>")
  
    } else if (x <= 100) {
  
      URLencode("<p style='color:yellow;background-color:red;'>World</p>")
  
    } else (URLencode("<p style='color:orange;background-color:green;'>!</p>"))

  }

和 decodeURI 在 .js 文件中：

Shiny.addCustomMessageHandler(
  type = "box1",
  data => $("#value1.html-widget.gauge svg text[font-size='10px'] 
  tspan:eq(0)").html(decodeURI(data.text))
  );

但是，不起作用。

那么如何使用 sendCustomMessage 将 HTML 从 R 传递到 JavaScript/ jQuery？

Answer 1

尝试用 URLencode 编码 R 端的 html 并用 decodeURI 在 Javascript 端解码它。

如何使用 session$sendCustomMessage 发送 HTML 代码？

How to send a HTML code with session$sendCustomMessage?

javascript

jquery

r

shiny

shinydashboard