Est-ce que la sortie de ggplotly n'est pas un objet complot complet?

Question

Le but du code est de produire un graphique intrigue interactif avec des zones verticales ombrées sur des sous-ensembles spécifiés sur l'axe X.

La première étape consiste à construire un objet ggplot2, avec des zones verticales ombrées construites en utilisant geom_rect, puis utiliser ggplotly pour produire un objet plotly. Comme ggplotly ne produit plus de sortie contenant les zones verticales ombrées, je les ajoute à la sortie ggplotly (qui est un objet d'intrigue) en utilisant la fonction plot add_lines.

Cependant, cette approche ne fonctionne pas. L'approche qui fonctionne est de commencer à partir d'un objet intrigue construit nativement, puis en utilisant la fonction plot_line add_lines. Est-ce que cela signifie que la sortie de ggplotly n'est pas un objet complot complet?

L'exemple reproductible est ci-dessous. On peut modifier les valeurs des variables logiques useOnlyPlotly (ligne 67) et useGeomRect (ligne 66) pour voir les comportements décrits ci-dessus

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

Mise à jour: le code ci-dessous est fonction de la réponse fournie à enter link description here, mais malheureusement, il n'a pas fonctionné pour moi

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

Answer 1

Votre idée d'utiliser add_lines combiné avec filltozero est bonne, mais les écarts entre vos lunettes de soleil sera problématique, vous auriez probablement besoin d'ajouter NaN entre pour obtenir ce droit.

Le vrai problème est que vos dates d'entrée sont des chaînes et que Plotly stocke les dates comme des entiers (millisecondes depuis l'époque). Nous aurions donc besoin de convertir les dates d'abord, puis les tracer.

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 
)