2

The purpose of the code is to produce an interactive plotly chart with shaded vertical areas on specified subsets on X-axis.

The first step is to construct a ggplot2 object, with shaded vertical areas constructed using geom_rect, then use ggplotly to produce a plotly object.

Since ggplotly does not produce an output which contains the shaded vertical areas anymore, I am adding them to ggplotly output (which is is a plotly object) by using plotly function add_lines.

However, this approach does not work. The approach that works is to start from a natively-built plotly object and then using plotly function add_lines.

Does this mean that output from ggplotly is not a full-featured plotly object?

The reproducible example is below. One can change values of logical variables useOnlyPlotly (line 67) and useGeomRect (line 66) to see the behaviors described above

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"))

Update: Below is code based on answer provided in enter link description here, but unfortunately it did not work for me

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
                 )
               )
 )
)
Aex
  • 131
  • 1
  • 11
  • Did you inspect your plotly object before and after the addition of your lines? – Maximilian Peters Sep 07 '17 at 11:51
  • Yes. I have also came across your answer in [link](https://stackoverflow.com/questions/43529060/partially-shaded-background-for-ggplotly-object?rq=1). Unfortunately when I have run the code that you have posted, I did not get the shaded area (I am on Windows 7, plotly version 4.1., ggplot2 version 2.2.1) – Aex Sep 07 '17 at 12:18
  • Thanks for catching this one! I updated the answer in the linked question. Please check if it is helpful. – Maximilian Peters Sep 07 '17 at 13:31
  • Thank you. Now I am able to get the shaded area for updated code in [linl(https://stackoverflow.com/questions/43529060/partially-shaded-background-for-ggplotly-object?rq=1). I am not clear, though, on what features I need to reset for the plotly object ( the ggplotly output) such that I can obtain a shaded area with add_line, rather than the list(type="rect".... approach (for which I would need to add explicitly one by one the desired areas) – Aex Sep 07 '17 at 14:19

1 Answers1

1

Your idea of using add_lines combined with filltozero is good but the gaps between your shades will be problematic, you would probably need to add NaN in between to get it right.

The real problem is that your input dates are strings and Plotly stores the dates as integers (milliseconds since the epoch). So we would need to convert the dates first and then plot them.

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
)

enter image description here

Maximilian Peters
  • 30,348
  • 12
  • 86
  • 99