R Shiny - 如何在反应性ggplot上标记水平和垂直线？ （日期和数字列）

Question

有没有人知道如何在闪亮的反应性ggplot上标记水平和/或垂直线？

我的所有数据都基于过滤的数据表，因此截距会根据输入数据而变化。过滤后的数据显示在ggplot上，用户可以选择x和y轴来显示。 x轴上的一个选择是日期列：这使得它变得困难（加上一些列是数字/某些因素）。

我的水平和垂直线也是反应性的（取决于过滤后的数据）

代码：

library(shiny)
library(shinydashboard)
library(ggplot2)
library(scales)
library(reshape2)
library(dplyr)
library(DT)

data_melt <- structure(list(Block = 1:20, Limits = structure(c(18L, 
                                                               18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 
                                                               18L, 18L, 18L, 18L, 18L, 18L), .Label = c("0.13", "0.15", "0.18", 
                                                                                                         "0.2", "0.21", "0.23", "0.25", "0.26", "0.28", "0.3", "0.32", 
                                                                                                         "0.37", "0.4", "0.45", "0.48", "0.5", "0.52", "0.55", "0.56", 
                                                                                                         "0.59", "0.6", "0.64", "0.7", "0.8", "1"), class = "factor"), 
                            Date = structure(c(16439, 16439, 16439, 16439, 16439, 16439, 
                                               16439, 16439, 16439, 16439, 16439, 16439, 16439, 16439, 16439, 
                                               16439, 16439, 16439, 16439, 16439), class = "Date"), X = c(0.24, 
                                                                                                          0.25, 0.23, 0.24, 0.23, 0.24, 0.22, 0.24, 0.21, 0.22, 0.23, 0.24, NA_real_, NA_real_, NA_real_, 5.5, NA_real_, 
                                                                                                          NA_real_, NA_real_, 0.27)), .Names = c("Block", "Limits", "Date", 
                                                                                                                                                "X"), row.names = c(NA, 20L), class = "data.frame")

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(selectInput(inputId = "yaxis", 
                               label = "Y-axis (Plots/Histogramm)",
                               choices = list("X" = "X"), 
                               selected = c("X")),
                   selectInput(inputId = "xaxis", 
                               label = "X-axis (Plots)",
                               choices = names(data_melt), 
                               selected = "WertNr")),
  dashboardBody(
    fluidRow(
      tabBox(status = "primary", width = NULL, height = "1000px", 
             tabPanel(title="Tabelle filtern", div(style = 'overflow-y: scroll; overflow-x: scroll;max-height: 950px; position:relative;', 
                                                   dataTableOutput("tabelle"))),
             tabPanel("plot", plotOutput("plot", height=800)))))
      )

server <- function(input, output, session) {
  output$tabelle <- renderDataTable({

    datatable(data_melt,class = 'cell-border stripe', filter="top", 
              options = list(pageLength = 50, columnDefs = list(list(width = '200px', targets = "_all"), list(bSortable = FALSE, targets = "_all"))))
})

  output$plot <- renderPlot({

    filtered_data <- input$tabelle_rows_all
    data_filt <- data_melt[filtered_data,]  

    vec <- quantile(data_filt[ ,input$yaxis], c(.00135,.50,.99865), na.rm = TRUE)

    data_filt$Limits <- as.numeric(as.character(data_filt$Limits))

    widedata <- subset(data_filt, select=c(input$xaxis, input$yaxis))

    longdata <- melt(widedata, id.vars=c(input$xaxis), variable.name="Variables", value.name="Value_y")

    longdata$WertNr <- as.numeric(1:nrow(longdata))


        ggplot()+ 
          geom_line(data=longdata, aes_string( x=input$xaxis, y="Value_y"),colour= "gray40", size=1.5) + 
          geom_hline(data=data_filt, aes(yintercept=(Limits*2)*0.75), linetype = "dotdash", size = 1, color="red") +
          geom_hline(data=data_filt, aes(yintercept=0), linetype = "dotdash", size = 1, color="red") +
          scale_y_continuous(breaks = pretty_breaks(n = 10)) +
          theme(axis.text.y=element_text(size=15), 
                axis.text.x=element_text(size=15), 
                axis.title.x = element_text(size=18, face="bold"),
                axis.title.y = element_text(size=18, face="bold"),
                legend.position="bottom", legend.title=element_blank(),
                legend.text=element_text(size=14))
      })
}

  shinyApp(ui = ui, server = server)

感谢您的帮助！

我尝试了geom_text，annotate，甚至创建了单独的data.frame，但是当选择x轴上的日期时，它只会给我一个错误。

toly <- ((data_filt$Limits*2)*0.75)
txty <- data.frame(x=1.5, y=toly[1], lab="OSG") in `renderPlot` and then

geom_text(data=txty, aes(label=lab), size=5, angle = 90, hjust = 0, vjust = 0) in ggplot --> is not working (i get error straight away)

 Error: geom_text requires the following missing aesthetics: x, y

添加x＆amp; ÿ

 geom_text(data=txty, aes(x=1.5, y=toly[1],label=lab), size=5, angle = 90, hjust = 0, vjust = 0)

它正在工作（但是标尺在刻度上移动以匹配x = 1.5，我真的希望它在一个地方保持在x轴上，无论x缩放）对于数字列而是对于日期列：< / p>

Error: Invalid input: date_trans works with objects of class Date only

我正在尝试找到解决方案，无论选择哪种类型的x轴（数字，日期或因子），让我标记水平线，让标签保持在同一位置（水平旁边）线）无论什么数字在规模上

Answer 1

如果绘图的x值具有类型Date，则geom_text对象的x值也必须是Date类型的对象。尝试

geom_text(data=txty, aes(x=as.Date("2015-01-04"), y=toly[1], label=lab),
          size=5, angle = 90, hjust = 0, vjust = 0)

它有效。

但无论如何我并没有真正得到你打算做的事。请尝试下一次关注您问题的最小例子。

Answer 2

我找到了解决问题的方法。

我必须定义哪些列是日期，数字和因子，然后我使用server中的If ... else语句，并为每个列创建单独的图。

 if (input$xaxis == "1st factor column" | input$xaxis == "2nd factor column"){
  g <-ggplot(...) + geom_line() + 
    annotate("text", x=0.5, y=...)
  }
else{
  g <-ggplot(...) + geom_line() + 
    annotate("text", x=min(data_filt[ ,input$xaxis]), y= ...)
  }g

不是优雅的解决方案，但它的工作：）