首先，您將突出顯示要發送到的JS函式sendCustomMessage：
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()
)
)
)
我的閃亮應用：
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 ("!")
}
作業正常。
編輯
我嘗試添加URLencode結構if：
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))
);
但是，不起作用。
那么如何傳遞HTMLfrom Rto JavaScript/ jQuerywithsendCustomMessage呢？
uj5u.com熱心網友回復：
嘗試在 R 端使用 html 對 html 進行編碼，URLencode并在 Javascript 端使用decodeURI.
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/422569.html
標籤：