First, you will highlight the function you want to send to JS with 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>")
}
I will also highlight the custom message:
session$sendCustomMessage(
type = "box1",
list(
text = fx(
x = pred_1()
)
)
)
My 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)
Inside .js file, I insert this code:
Shiny.addCustomMessageHandler(
type = "box1",
data => $("#value1.html-widget.gauge svg text[font-size='10px']
tspan:eq(0)").html(data.text)
);
To style the gauge label. But, doesn't work.
On the other hand, when I replace fx with fy (text only):
fy <- function(x) {
if (x <= 70) {
"Hello"
} else if (x <= 100) {
"World"
} else ("!")
}
Works fine.
Edit
I tried add URLencode in if structure:
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>"))
}
And decodeURI in .js file:
Shiny.addCustomMessageHandler(
type = "box1",
data => $("#value1.html-widget.gauge svg text[font-size='10px']
tspan:eq(0)").html(decodeURI(data.text))
);
But, doesn't work.
So how to pass an HTML from R to JavaScript/ jQuery with sendCustomMessage?
CodePudding user response：
Try to encode the html on the R side with URLencode and decode it on the Javascript side with decodeURI.