R 闪亮的 GGPlotly 标签移动到不正确的位置

Question

我试图将标签放在 GGplotly 水平条形图中的条形上方。最初，标签似乎嵌入在图的最顶部。我希望他们移动到栏的右侧。

我尝试使用

aes

参数

nudge_y

进行实验。我找到了合适的微移值，但是当我更改仪表板中的一些选择输入时，标签移动到了错误的位置。

如何让标签反射性地停留在条形图上方，以便当用户更改输入参数时，标签会跟随条形图进行调整。请参阅下面的完整代表

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(stringr)
library(ggplot2)
library(plotly)

rrc_df <- structure(list(display_date = c("Mar 2023", "Mar 2023", "Mar 2023", 
                                          "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", 
                                          "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", 
                                          "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", "Mar 2023", 
                                          "Mar 2023", "Mar 2023", "Mar 2023"), 
                         reporting_period = structure(c(19422,19422, 19422, 19422, 19422, 19422, 19422, 19422, 19422, 19422, 
                                                        19422, 19422, 19422, 19422, 19422, 19422, 19422, 19422, 19422, 
                                                        19422, 19422, 19422, 19422, 19422), 
                                                      class = "Date"),
                         region_names = c("Colorado","Colorado", "Colorado", "Colorado", "Colorado", "Colorado", "Colorado", 
                                          "Colorado", "Georgia", "Georgia", "Georgia", "Georgia", "Georgia",  "Georgia", 
                                          "Georgia", "Hawaii", "Hawaii", "Hawaii", "Hawaii", "Hawaii", "Hawaii", "Hawaii", "Hawaii", "Hawaii"), 
                         `Provider Type` = c("All",  "All", "All", "Contracted", "Contracted", "Contracted", "PMG", 
                                             "PMG", "All", "All", "All", "Contracted", "Contracted", "Contracted", 
                                             "PMG", "All", "All", "All", "All", "Contracted", "Contracted", 
                                             "Contracted", "Contracted", "PMG"), 
                         ln_summary = c("Bad Phone",    "Inactive Address", "Inactive Practitioner", "Bad Phone", "Inactive Address", 
                                        "Inactive Practitioner", "Inactive Address", "Inactive Practitioner", 
                                        "Bad Phone", "Inactive Address", "Inactive Practitioner", "Bad Phone", 
                                        "Inactive Address", "Inactive Practitioner", "Inactive Address", 
                                        "Bad Phone", "Inactive Address", "Inactive Other", "Inactive Practitioner", 
                                        "Bad Phone", "Inactive Address", "Inactive Other", "Inactive Practitioner", 
                                        "Inactive Address"), 
                         Counts = c(645L, 331L, 64L, 645L, 325L, 60L, 6L, 4L, 28L, 376L, 2L, 28L, 371L, 2L, 5L, 177L, 356L, 8L, 
                                    26L, 177L, 355L, 8L, 26L, 1L)), 
                    class = "data.frame", row.names = c(NA,-24L))
# 3. Create Layout -------------------------------------------------------------

header <- dashboardHeader(title = "DG Metrics",
                          titleWidth = 400)

sidebar <- dashboardSidebar(width = 400,
                            sidebarMenu(
                              id = "pages",
                              menuItem("Red High Risk Historical Data", tabName = "redreccat",
                                       icon = icon("chart-gantt"))
                              
                            ))

body <- dashboardBody(
  tabItems(tabItem(tabName = "redreccat",
                   
                   fluidRow(box = 12, plotlyOutput("redreccatplot",  width = "100%")),
                   
                   fluidRow(
                     box(width = 4,
                         radioButtons("pmgindicatorInput4", "Provider Type",
                                      choices = c("All","Contracted","PMG"),
                                      selected = "All")),
                     
                     box(width = 4,
                         selectInput("regionInput4", "Region",
                                     choices = c("Colorado","Georgia","Hawaii","Mid Atlantic",
                                                 "Northern California","Northwest","Southern California","Washington")),
                         selected="Washington", multiple =FALSE, selectize = TRUE)),
                   
                   box(width = 4,
                       dateRangeInput(inputId = "date4", label = "Date Range",
                                      start = min(rrc_df$reporting_period),
                                      end = max(rrc_df$reporting_period))))
  ))

ui <- dashboardPage(header,sidebar,body)



# Server -----------------------------------------------------------------------


server <- function(input, output, session) {
  
  l <- reactive({
    rrc_df %>% 
      filter(`Provider Type` == input$pmgindicatorInput4,
             region_names == input$regionInput4, 
             reporting_period >= input$date4[1] & reporting_period <= input$date4[2])  
  })
  
  
  # 4. Red Record Counts by Category -------------------------------------------
  
  output$redreccatplot <- renderPlotly({
    lp <- l() %>% 
      ggplot(aes(x=reporting_period, y=Counts)) +
      geom_bar(stat='identity', fill = "#0078B3")+
      theme_classic() +
      geom_text(
        aes(label = Counts),
        size = 3.5, 
        # hjust = -1.5,
        nudge_x = 0,
         nudge_y = 38,
        color = "black", 
        fontface = "bold")+
      coord_flip()+
      labs(x = "Reporting Month")+
      scale_x_date(date_labels = "%b %Y",date_breaks  ="1 month")+
      facet_wrap(vars(ln_summary))
    
    
    ggplotly(lp) 
    
  })
  
} 



# Run the application ----------------------------------------------------------
shinyApp(ui = ui, server = server)

Answer 1

这是一个可能的选项，它不使用

nudge_x

直接将标签的位置移动一定量

.025 * max(Counts)

以添加一些填充，增加比例的扩展以为标签腾出空间，最后将标签与通过操作

plotly

对象留下，即我将

textposition

属性设置为

"middle right"

（不幸的是，

h/vjust

对象的

ggplot

参数没有传递到

plotly

对象）。

 output$redreccatplot <- renderPlotly({
    lp <- l() %>%
      ggplot(aes(x = Counts, y = reporting_period)) +
      geom_bar(
        stat = "identity", fill = "#0078B3",
        orientation = "y"
      ) +
      theme_classic() +
      geom_text(
        aes(
          x = Counts + .025 * max(Counts),
          label = Counts
        ),
        size = 3.5,
        color = "black",
        fontface = "bold"
      ) +
      labs(y = "Reporting Month") +
      scale_y_date(date_labels = "%b %Y", date_breaks = "1 month") +
      scale_x_continuous(expand = c(.05, 0, .15, 0)) +
      facet_wrap(vars(ln_summary))

    ggp <- ggplotly(lp)

    n_facets <- length(unique(l()$ln_summary))
    
    for (i in seq_len(n_facets) + n_facets) {
      ggp$x$data[[i]]$textposition <- "middle right"
    }
    ggp
  })