2

该代码的目的是在 X 轴上的指定子集上生成一个带有阴影垂直区域的交互式绘图图表。

第一步是构造一个 ggplot2 对象，使用 geom_rect 构造阴影垂直区域，然后使用 ggplotly 生成一个 plotly 对象。

由于 ggplotly 不再生成包含阴影垂直区域的输出，因此我使用 plotly 函数 add_lines 将它们添加到 ggplotly 输出（这是一个 plotly 对象）。

但是，这种方法行不通。可行的方法是从本地构建的 plotly 对象开始，然后使用 plotly 函数 add_lines。

这是否意味着 ggplotly 的输出不是功能齐全的 plotly 对象？

可重现的示例如下。可以更改逻辑变量 useOnlyPlotly（第 67 行）和 useGeomRect（第 66 行）的值以查看上述行为

require(tidyverse)
require(plotly)
require(lubridate)

plotShadedAreaUsingGeomBarsFunc <- function(colorArea, dataY){
  ggplot2::geom_bar(data = trimmedRecessionsDates, inherit.aes = FALSE,
                    aes_(x = quote(MidPoint), y = base::max(dataY)), # y = Inf doesn't work
                    stat = "identity",width = 0.1, 
                    # position = "stack", 
                    fill = colorArea, alpha = 0.2) 
}

plotShadedAreaUsingGeomRectFunc <- function(colorArea, dataY){
  ggplot2::geom_rect(data = trimmedRecessionsDates, inherit.aes = FALSE,
                     aes(xmin = as.Date(Peak), xmax = as.Date(Trough), ymin = -Inf, ymax = +Inf),
                     fill = colorArea,
                     alpha = 0.2)
}

# dates
dateOne <- lubridate::ymd("2000-1-1")
dateTwo <- lubridate::ymd("2004-1-1")
dateThree <- lubridate::ymd("2009-1-1")
dateFour <- lubridate::ymd("2013-1-1")
dateFive <- lubridate::ymd("2017-12-31")

PeakDates <- c(lubridate::ymd("2001-03-01"), lubridate::ymd("2007-12-01"))
TroughDates <- c(lubridate::ymd("2001-11-01"), lubridate::ymd("2008-08-31"))

sequenceDates <- seq(dateOne, dateFive, by="month")
sequenceInRecession <- c(rep(0,length(sequenceDates)))
sequenceInRecession <- base::replace(sequenceInRecession, list = c(15,16,17,18,19,20,21,22,23,96,97,98,99,100), values = c(rep(1,14)))
sequenceInRecession <- base::replace(sequenceInRecession, list = c(101,102,103,104,105,106,107,108,109,110,111,112,113,114), values = c(rep(1,14)))

dataFrameRecessionDates <- data.frame(Dates = sequenceDates, InRecession = sequenceInRecession)

dataFrameRecessionDates$Dates <- lubridate::as_date(dataFrameRecessionDates$Dates)

#data
theDataFrame <- data.frame(Dates = c(dateOne, dateTwo, dateThree, dateFour, dateFive), SomeValues = c(0.2, 2.8, 4.5, 9.8, -0.3), 
                           season = c("SeasOne","SeasTwo","SeasOne","SeasOne","SeasTwo"))

trimmedRecessionsDates <- data.frame(Peak = PeakDates,  Trough = TroughDates)

# define midPoint as middle point between Peak and Trough
trimmedRecessionsDates$MidPoint = trimmedRecessionsDates$Peak + floor((trimmedRecessionsDates$Trough - trimmedRecessionsDates$Peak)/2)
trimmedRecessionsDates$MidPoint <- base::as.Date(trimmedRecessionsDates$MidPoint)

colNamesDataFrame <- colnames(theDataFrame)[2:2]
valMax <- base::max(sapply(theDataFrame[colNamesDataFrame], max, na.rm = TRUE))
valMin <- base::min(sapply(theDataFrame[colNamesDataFrame], min, na.rm = TRUE))

dataFrameRecessionDates$InRecession[dataFrameRecessionDates$InRecession %in% 1] <- valMax + 0.2*base::abs(valMax)
dataFrameRecessionDates$InRecession[dataFrameRecessionDates$InRecession %in% 0] <- valMin - 0.2*base::abs(valMin)


ggplotObjUsingGeomBar <- ggplot2::ggplot(data = theDataFrame, aes(x = Dates, y = SomeValues, color = season)) +
   ggplot2::geom_line() +
   plotShadedAreaUsingGeomBarsFunc('turquoise3', theDataFrame$SomeValues)

ggplotObjUsingGeomRect <- ggplot2::ggplot(data = theDataFrame, aes(x = Dates, y = SomeValues)) +
  ggplot2::geom_line() +
  plotShadedAreaUsingGeomRectFunc('turquoise3', theDataFrame$SomeValues)+
  ggplot2::theme_bw()

useGeomRect = TRUE
useOnlyPlotly = TRUE

thePlotlyObjToAnalyze <- plot_ly()
if (useOnlyPlotly)
{
  thePlotlyObjToAnalyze <- plot_ly(data = theDataFrame, x = ~Dates, y = ~SomeValues)  %>%
      add_lines(data = theDataFrame, x = ~Dates, y = ~SomeValues,
                line = list(width = 3), hoverinfo = "x + y")
} else {
    if (useGeomRect)
    {
      thePlotlyObjToAnalyze <- hide_legend(ggplotly(ggplotObjUsingGeomRect)) 
    } else {
        thePlotlyObjToAnalyze <- hide_legend(ggplotly(ggplotObjUsingGeomBar))
    }
}

(thePlotlyObjToAnalyze  %>%
      plotly::add_lines(data = dataFrameRecessionDates, 
            x = ~Dates, y = ~InRecession,
            line = list(width = 0),
            fill = "tozerox",
            fillcolor = "rgba(64, 64, 64, 0.3)",
            showlegend = F,
            hoverinfo = "none"))

更新：下面是基于在此处输入链接描述中提供的答案的代码，但不幸的是它对我不起作用

library(plotly)
library(ggplot2)

useOnlyPlotly <- FALSE

thePlot <- plot_ly()

if (useOnlyPlotly)
{
  thePlot <- plot_ly() %>%
          add_trace(data = economics, x = ~date, y = ~unemploy, type="scatter", mode = "lines")
}else{
    theGgplot2Obj <- ggplot(data = economics, aes(x = date, y = unemploy)) + geom_line()
    thePlot <- ggplotly(theGgplot2Obj)

    thePlot[['x']][['layout']][['shapes']] <- c()
}


( thePlot <- layout(thePlot,
               shapes = list(
                 list(type = "rect",
                      fillcolor = "blue", line = list(color = "blue"), opacity = 0.5,
                      x0 = "1980-01-01", x1 = "1990-01-01",
                      y0 = 6000, y1 = 8000
                 )
               )
 )
)
4

1 回答 1

1

您使用add_lines组合的想法filltozero很好，但是您的色调之间的差距会出现问题，您可能需要NaN在两者之间添加以使其正确。

真正的问题是您的输入日期是字符串，并且 Plotly 将日期存储为整数（自纪元以来的毫秒数）。所以我们需要先转换日期然后绘制它们。

x0 = as.integer(as.POSIXct(trimmedRecessionsDates$Peak[[i]])) * 1000

thePlotlyObjToAnalyze$x$layout$shape <- c()
shapes = list()
for (i in 1:length(trimmedRecessionsDates$MidPoint)) {
  shapes[[i]] = list(type = "rect",
                     fillcolor = "blue", line = list(color = "blue"), opacity = 0.5,
                     x0 = as.integer(as.POSIXct(trimmedRecessionsDates$Peak[[i]])) * 1000, 
                     x1 = as.integer(as.POSIXct(trimmedRecessionsDates$Trough[[i]])) * 1000,
                     y0 = 0, 
                     y1 = 1,
                     yref = 'paper'
                     )

}
thePlotlyObjToAnalyze <- layout(thePlotlyObjToAnalyze,
                                shapes = shapes
)

在此处输入图像描述

于 2017-09-07T15:21:17.763 回答