设置工具提示时遇到问题(R Shiny)

时间:2017-04-28 20:20:56

标签: r ggplot2 shiny

我正在尝试在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))

上面的脚本不显示工具提示。我错过了什么?

0 个答案:

没有答案