r语言 - 是否可以在 gpplot2 中使用像素而不是轴值调整数据点和数据标签之间的距离

Question

你好，下面我提供了一个scater 图，正如你所看到的，每个数据点的汽车类型都是不同的。这个情节是静态的nudge_x=0.05所以很合适。在我的例子中，绘图已更新，因此轴范围可以从 0 到 10 到 0 到 10000。在这种情况下，0.05 距离似乎毫无用处，因为与 10000 相比，它的值非常小，并且数据标签显示在数据点上。我想知道是否可以将距离设置为像素而不是 0.05 或其他可以使数据点和数据标签之间的距离不受轴值影响的东西。

    p <- ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars)))
    p + geom_point() + geom_text(hjust = 0, nudge_x = 0.05)

我的实际代码：

#ui.r
library(shiny)
library(ggplot2)
library(plotly)
fluidPage(
  # App title ----
  titlePanel(div("CROSS CORRELATION",style = "color:blue")),
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(
      # Input: Select a file ----
      fileInput("file1", "Input CSV-File",
                multiple = TRUE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),
      # Horizontal line ----
      tags$hr(),
      # Input: Checkbox if file has header ----
      checkboxInput("header", "Header", TRUE),
      # Input: Select separator ----
      radioButtons("sep", "Separator",
                   choices = c(Comma = ",",
                               Semicolon = ";",
                               Tab = "t"),
                   selected = ","),

      # Horizontal line ----
      tags$hr(),
      # Input: Select number of rows to display ----
      radioButtons("disp", "Display",
                   choices = c(Head = "head",
                               All = "all"),
                   selected = "head")


    ),
    # Main panel for displaying outputs ----
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Table",
                           shiny::dataTableOutput("contents")),
                  tabPanel("Correlation Plot",
                           tags$style(type="text/css", "
           #loadmessage {
                                      position: fixed;
                                      top: 0px;
                                      left: 0px;
                                      width: 100%;
                                      padding: 5px 0px 5px 0px;
                                      text-align: center;
                                      font-weight: bold;
                                      font-size: 100%;
                                      color: #000000;
                                      background-color: #CCFF66;
                                      z-index: 105;
                                      }
                                      "),conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                                                          tags$div("Loading...",id="loadmessage")
                                      ),
                           fluidRow(
                             column(3, uiOutput("lx1")),
                           column(3,uiOutput("lx2"))),
                           hr(),
                           fluidRow(
                             tags$style(type="text/css",
                                        ".shiny-output-error { visibility: hidden; }",
                                        ".shiny-output-error:before { visibility: hidden; }"
                             ),
                           column(3,uiOutput("td")),
                           column(3,uiOutput("an"))),
                           fluidRow(
                           plotlyOutput("sc"))
      ))
  )))
#server.r
function(input, output) {

  output$contents <- shiny::renderDataTable({
    iris
  })

  output$lx1<-renderUI({
    selectInput("lx1", label = h4("Select 1st Expression Profile"), 
                choices = colnames(iris[,1:4]), 
                selected = "Lex1")
  })
  output$lx2<-renderUI({
    selectInput("lx2", label = h4("Select 2nd Expression Profile"), 
                choices = colnames(iris[,1:4]), 
                selected = "Lex2")
  })
  output$td<-renderUI({
    radioButtons("td", label = h4("Trendline"),
                 choices = list("Add Trendline" = "lm", "Remove Trendline" = ""), 
                 selected = "")
  })
  output$an<-renderUI({
    radioButtons("an", label = h4("Correlation Coefficient"),
                 choices = list("Add Cor.Coef" = cor(subset(iris, select=c(input$lx1)),subset(iris, select=c(input$lx2))), "Remove Cor.Coef" = ""), 
                 selected = "")
  })  

 output$sc<-renderPlotly({
   p1 <- ggplot(iris, aes_string(x = input$lx1, y = input$lx2))+
     # Change the point options in geom_point
     geom_point(color = "darkblue") +
     # Change the title of the plot (can change axis titles
     # in this option as well and add subtitle)
     labs(title = "Cross Correlation") +
     # Change where the tick marks are
     scale_x_continuous(breaks = seq(0, 2.5, 30)) +
     scale_y_continuous(breaks = seq(0, 2.5, 30)) +
     # Change how the text looks for each element
     theme(title = element_text(family = "Calibri", 
                                size = 10, 
                                face = "bold"), 
           axis.title = element_text(family = "Calibri Light", 
                                     size = 16, 
                                     face = "bold", 
                                     color = "darkgrey"), 
           axis.text = element_text(family = "Calibri", 
                                    size = 11))+
     theme_bw()+
     geom_smooth(method = input$td)+
     annotate("text", x = 10, y = 10, label = as.character(input$an))
   ggplotly(p1) %>%
     layout(hoverlabel = list(bgcolor = "white", 
                              font = list(family = "Calibri", 
                                          size = 9, 
                                          color = "black")))
 }) 


}

Answer 1

您可以使用

hjust而不是nudge_x。如果nudge_x以绘图单位工作，则hjust用于通过调整文本的开始位置来水平对齐文本。值 0 表示左对齐，0.5 表示居中，值 1 表示右对齐：

       Point where text starts:
       |
       |Hjust 0
Hjust 1|

您可以使用任何值。负值会将起始字母向右移动得比左对齐值 0 更靠右，并且此调整基于文本的长度，而不是绘图坐标。

这有点奇怪，因为更长的字符串会移动得更多，但作为一种简单的黑客，它工作得很好。这无关紧要，除非你有非常不同的字符串长度。在这个例子中，您可以看到它比较"菲亚特 128"和"丰田卡罗拉"。

查看相同hjust值的相似结果，即使wt和hp相差约 100 倍：

p <- ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars)))
p + geom_point() + geom_text(hjust = -.05)
q <- ggplot(mtcars, aes(hp, mpg, label = rownames(mtcars)))
q + geom_point() + geom_text(hjust = -.05)