我正在尝试在R Shiny中应用这个tooltip函数,但它目前无效,我还没有完全理解这个工具提示函数是如何工作的。这是我传递给R Shiny的数据:
library(shiny)
library(ggplot2)
library(scales)
mydf <- structure(list(Resp = c("Resp_A\n(n=45)", "Resp_A\n(n=45)",
"Resp_A\n(n=45)", "Resp_A\n(n=45)", "Resp_A\n(n=45)",
"Resp_A\n(n=45)", "Resp_A\n(n=45)", "Resp_A\n(n=45)",
"Resp_A\n(n=45)", "Resp_A\n(n=45)", "Resp_A\n(n=45)",
"Resp_A\n(n=45)", "Resp_A\n(n=45)", "Resp_B\n(n=33)",
"Resp_B\n(n=33)", "Resp_B\n(n=33)", "Resp_B\n(n=33)",
"Resp_B\n(n=33)", "Resp_B\n(n=33)", "Resp_B\n(n=33)",
"Resp_B\n(n=33)"), Rating = structure(c(4L, 3L, 2L, 1L, 4L,
3L, 2L, 1L, 8L, 7L, 6L, 5L, 1L, 4L, 3L, 2L, 1L, 4L, 3L, 2L, 1L
), .Label = c("DK/NA", "Dissatisfied", "Neutral", "Satisfied",
"Strongly Disagree", "Somewhat Disagree", "Somewhat Agree", "Strongly Agree"
), class = "factor"), Question = structure(c(3L, 3L, 3L, 3L,
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L), .Label = c("q6", "q1", "q7"), class = "factor"), prop = c(0.533333333333333,
0.155555555555556, 0.244444444444444, 0.0666666666666667, 0.311111111111111,
0.333333333333333, 0.355555555555556, 0, 0.222222222222222, 0.333333333333333,
0.177777777777778, 0.0222222222222222, 0.244444444444444, 0.242424242424242,
0.121212121212121, 0.606060606060606, 0.0303030303030303, 0.0909090909090909,
0.212121212121212, 0.636363636363636, 0.0606060606060606), Label = structure(c(3L,
3L, 3L, 3L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L,
2L, 2L, 2L, 2L), .Label = c("Question_3", "Question_2", "Question_1"),
class = "factor")), .Names = c("Resp", "Rating", "Question", "prop", "Label"),
row.names = c(NA, 21L), class = c("tbl_df", "tbl", "data.frame"))
我也在为我的图表标签应用手动颜色:
Labels_Colours <- c("Satisfied" = "#59A14F", "Neutral" = "#76B7B2", "Dissatisfied" = "#F28E2B", "Strongly Agree" = "#638B66", "Somewhat Agree" = "#BFBB60", "Somewhat Disagree" = "#FBB04E", "Strongly Disagree" = "#E15759", "DK/NA" = "#BAB0AC")
以下是我闪亮代码的简化版本:
ui <- fluidPage(
fluidRow(
column(2,
wellPanel(
h4("Resp A Filters")
) #I have a bunch of filters regarding respondents A
),
column(8,
h3("Title"),
div(
style = "position:relative",
plotOutput("Chart", height = 300,
hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")),
uiOutput("hover_info"))
),
column(2,
wellPanel(
h4("Resp B Filters")
) #I have a bunch of filters regarding respondents B
)
)
)
server <- function(input, output){
#I omitted stuff here that creates the mydf object after using filters for Respondents A and/or B
output$Chart <- renderPlot({
Chart <- ggplot(mydf, aes(x = Label, y = prop, fill = Rating)) +
geom_col() +
geom_text(aes(label = ifelse(prop == 0, NA, percent(round(prop, 2)))), position = position_stack(vjust = 0.5), size = 4.5) +
scale_fill_manual(values = Labels_Colours) +
coord_flip() +
facet_grid(~ Resp, drop = FALSE) +
guides(fill = FALSE) +
labs(x = "", y = "") +
theme_minimal() +
theme(axis.text.y = element_text(size = 13),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
strip.text = element_text(size = 14))
Chart
})
output$hover_info <- renderUI({
hover <- input$plot_hover
point <- nearPoints(mydf, hover, maxpoints = 1, addDist = TRUE)
if (nrow(point) == 0) return(NULL)
# calculate point position INSIDE the image as percent of total dimensions
# from left (horizontal) and from top (vertical)
left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left)
top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom)
# calculate distance from left and bottom side of the picture in pixels
left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left)
top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top)
# create style property for tooltip
# background color is set so tooltip is a bit transparent
# z-index is set so we are sure our tooltip will be on top
style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85); ",
"left:", left_px + 2, "px; top:", top_px + 2, "px;")
# actual tooltip created as wellPanel
wellPanel(
style = style,
p(tags$b("Proportion:"), percent(round(point$prop,2)), br(),
class = "well-sm")
)
})
}
runApp(list(ui = ui, server = server))
上面的脚本不显示工具提示。我错过了什么?