Time Series Plots

Time Series Plots

Static

### Copied from:
### https://codingclubuc3m.rbind.io/post/2020-03-03/
library(lattice)
library(ggplot2)
# latticeExtra must be loaded after ggplot2 to prevent masking of `layer`
library(latticeExtra)
library(RColorBrewer)
# lattice and latticeExtra configuration
myTheme <- custom.theme.2(
  pch=19, cex=0.7, region=rev(brewer.pal(9, 'YlOrRd')),
  symbol=brewer.pal(n=8, name="Dark2"))
myTheme$strip.background$col = myTheme$strip.shingle$col =
  myTheme$strip.border$col = 'transparent'

myArgs <- list(
  as.table=TRUE, between=list(x=0.5, y=0.2),
  xscale.components = function(...)
    modifyList(xscale.components.default(...), list(top=FALSE)),
  yscale.components = function(...)
    modifyList(yscale.components.default(...), list(right=FALSE)))

lattice.options(default.theme=myTheme, default.args=modifyList(
  lattice.options()$default.args, myArgs))

library(zoo) 

setwd("C:/Users/s-das/Syncplicity Folders/MyProjects_IMP/MY_Papers_V2/HACKING_CONTESTs/Awesome_Dec2019/timeseries")
load('aranjuez.RData')
load('navarra.RData')
load('CO2.RData')

head(aranjuez)

##            TempAvg TempMax TempMin HumidAvg HumidMax WindAvg WindMax Radiation
## 2004-01-01    4.04   10.71   -1.97     88.3     95.9    0.75    3.53      5.49
## 2004-01-02    5.78   11.52    1.25     83.3     98.5    1.08    6.88      6.54
## 2004-01-03    5.85   13.32    0.38     75.0     94.4    0.98    6.58      8.81
## 2004-01-04    4.41   15.59   -2.58     82.0     97.0    0.63    3.70      9.79
## 2004-01-05    3.08   14.58   -2.97     83.2     97.0    0.39    2.24     10.30
## 2004-01-06    2.30   11.83   -3.38     84.5     96.5    0.44    2.14      9.94
##            Rain   ET
## 2004-01-01    0 0.54
## 2004-01-02    0 0.77
## 2004-01-03    0 0.84
## 2004-01-04    0 0.69
## 2004-01-05    0 0.52
## 2004-01-06    0 0.49

head(navarra)

##             Arzr  Adó  Lmbr  Ancn  Artj  Aibr  SMdU  MrdA  Lern  Brgt  Olit
## 2011-01-01 7.200 7.400 5.702 8.290 7.350 6.470 7.210 6.307 7.050 6.307 7.200
## 2011-01-02 7.610 4.711 4.382 6.258 5.744 4.514 7.200 7.470 7.410 7.470 7.610
## 2011-01-03 6.957 5.697 8.470 7.810 6.223 7.930 7.640 6.021 5.873 6.021 6.957
## 2011-01-04 4.257 3.835 5.000 3.720 3.861 4.699 3.789 0.125 3.638 0.125 4.257
## 2011-01-05 3.123 1.446 2.711 1.261 1.982 1.632 2.506 2.079 1.320 2.079 3.123
## 2011-01-06 5.747 5.441 5.202 5.392 5.017 3.852 4.883 4.836 4.617 4.836 5.747
##             Flcs  Mrdf  Trbn  Srtg  BR.P  Funs  BR.B  Cdrt  Crll  Tudl  Fitr
## 2011-01-01 6.443 7.690 6.906 6.627 6.505 7.131 6.371 6.559 7.110 6.222 5.802
## 2011-01-02 7.750 5.643 6.497 7.510 8.780 6.490 8.140 6.363 7.490 8.600 4.340
## 2011-01-03 5.799 8.480 6.361 6.941 6.691 6.334 5.768 6.044 8.820 7.410 8.510
## 2011-01-04 3.697 4.211 4.333 4.473 4.438 4.078 4.119 4.215 4.608 4.844 4.886
## 2011-01-05 2.680 2.781 3.336 1.474 3.147 2.348 3.278 3.327 3.106 2.634 2.802
## 2011-01-06 4.969 4.688 4.897 3.953 4.337 4.255 5.427 4.788 3.304 2.674 4.823
##             Cscn  Ablt  LsAr  Sesm
## 2011-01-01 6.760 6.663 6.702 6.070
## 2011-01-02 6.025 6.520 5.110 4.813
## 2011-01-03 9.090 8.940 7.330 6.021
## 2011-01-04 5.545 6.178 3.452 1.245
## 2011-01-05 2.594 2.448 1.032 0.892
## 2011-01-06 3.467 3.071 4.421 3.243

head(CO2)

##   Plant   Type  Treatment conc uptake
## 1   Qn1 Quebec nonchilled   95   16.0
## 2   Qn1 Quebec nonchilled  175   30.4
## 3   Qn1 Quebec nonchilled  250   34.8
## 4   Qn1 Quebec nonchilled  350   37.2
## 5   Qn1 Quebec nonchilled  500   35.3
## 6   Qn1 Quebec nonchilled  675   39.2

theme_set(theme_bw(base_size = 12))
xyplot(aranjuez, layout = c(1, ncol(aranjuez))) 

autoplot(aranjuez) + facet_free() 

avRad <- zoo(rowMeans(navarra, na.rm = 1), index(navarra))
pNavarra <- xyplot(navarra - avRad,
                   superpose = TRUE, auto.key = FALSE,
                   lwd = 0.5, alpha = 0.3, col = 'midnightblue') 
pNavarra 

horizonplot(navarra - avRad,
            layout = c(1, ncol(navarra)),
            origin = 0, ## Deviations in each panel are calculated
            ## from this value
            colorkey = TRUE,
            col.regions = brewer.pal(6, "RdBu")) 

Ta <- aranjuez$TempAvg
timeIndex <- index(aranjuez)
longTa <- ave(Ta, format(timeIndex, '%j'))
diffTa <- (Ta - longTa) 

years <- unique(format(timeIndex, '%Y'))

horizonplot(diffTa, cut = list(n = 8, overlap = 0),
            colorkey = TRUE, layout = c(1, 8),
            scales = list(draw = FALSE, y = list(relation = 'same')),
            origin = 0, strip.left = FALSE) +
  layer(grid.text(years[panel.number()], x  =  0, y  =  0.1, 
                  gp = gpar(cex = 0.8),
                  just = "left")) 

year <- function(x)as.numeric(format(x, '%Y'))
day <- function(x)as.numeric(format(x, '%d'))
month <- function(x)as.numeric(format(x, '%m')) 
myTheme <- modifyList(custom.theme(region = brewer.pal(9, 'RdBu')),
                      list(
                        strip.background = list(col = 'gray'),
                        panel.background = list(col = 'gray')))

maxZ <- max(abs(diffTa))

levelplot(diffTa ~ day(timeIndex) * year(timeIndex) | factor(month(timeIndex)),
          at = pretty(c(-maxZ, maxZ), n = 8),
          colorkey = list(height = 0.3),
          layout = c(1, 12), strip = FALSE, strip.left = TRUE,
          xlab = 'Day', ylab = 'Month', 
          par.settings = myTheme)

library(scales) 
## The packages scales is needed for the pretty_breaks function.
df <- data.frame(Vals = diffTa,
                 Day = day(timeIndex),
                 Year = year(timeIndex),
                 Month = month(timeIndex))
head(df)

##                Vals Day Year Month
## 2004-01-01 -1.24500   1 2004     1
## 2004-01-02 -0.06875   2 2004     1
## 2004-01-03  1.27125   3 2004     1
## 2004-01-04 -0.26000   4 2004     1
## 2004-01-05 -1.35375   5 2004     1
## 2004-01-06 -3.05875   6 2004     1

ggplot(data = df,
       aes(fill = Vals,
           x = Day,
           y = Year)) +
    facet_wrap(~ Month, ncol = 1, strip.position = 'left') +
    scale_y_continuous(breaks = pretty_breaks()) + 
    scale_fill_distiller(palette = 'RdBu', direction = 1) + 
    geom_raster() +
    theme(panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()) 

aranjuezDF <- as.data.frame(aranjuez)
aranjuezDF$Month <- format(index(aranjuez), '%m') 
## Red-Blue palette with black added (12 colors)
colors <- c(brewer.pal(n = 11, 'RdBu'), '#000000')
## Rearrange according to months (darkest for summer)
colors <- colors[c(6:1, 12:7)] 
splom(~ aranjuezDF[1:10], ## Do not include "Month"
      groups = aranjuezDF$Month,
      auto.key = list(space = 'right', 
                      title = 'Month', cex.title = 1),
      pscale = 0, varname.cex = 0.7, xlab = '',
      par.settings = custom.theme(symbol = colors,
                                  pch = 19),
      cex = 0.3, alpha = 0.1)

library(GGally)

ggpairs(aranjuezDF,
 columns = 1:10, ## Do not include "Month"
 upper = list(continuous = "points"),
 mapping = aes(colour = Month, alpha = 0.1)) 

library(reshape2)

aranjuezRshp <- melt(aranjuezDF,
                     measure.vars = c('TempMax',
                                      'TempAvg',
                                      'TempMin'),
                     variable.name = 'Statistic',
                     value.name = 'Temperature')

ggplot(data = aranjuezRshp, aes(Radiation, Temperature)) +
   facet_grid(Statistic ~ Month) +
   geom_point(col = 'skyblue4', pch = 19, cex = 0.5, alpha = 0.3) +
   geom_rug() +
   stat_smooth(se = FALSE, method = 'loess',
     col = 'indianred1', lwd = 1.2) +
   theme_bw() 

useOuterStrips(
   xyplot(Temperature ~ Radiation | Month * Statistic,
    data = aranjuezRshp,
    between = list(x = 0),
    col = 'skyblue4', pch = 19,
    cex = 0.5, alpha = 0.3)) +
   layer({
 panel.rug(..., col.line = 'indianred1',
       end = 0.05, alpha = 0.6)
 panel.loess(..., col = 'indianred1',
         lwd = 1.5, alpha = 1)
   }) 

## lattice version
xyplot(GNI.capita  ~ CO2.capita, data = CO2data,
xlab = "Carbon dioxide emissions (metric tons per capita)",
ylab = "GNI per capita, PPP (current international $)",
groups = Country.Name, type = 'b') 

nCountries <- nlevels(CO2data$Country.Name)
pal <- brewer.pal(n = 5, 'Set1')
pal <- rep(pal, length = nCountries) 

## Rank of average values of CO2 per capita
CO2mean <- aggregate(CO2.capita ~ Country.Name,
          data = CO2data, FUN = mean)
palOrdered <- pal[rank(CO2mean$CO2.capita)]  

## simpleTheme encapsulates the palette in a new theme for xyplot
myTheme <- simpleTheme(pch = 19, cex = 0.6, col = palOrdered) 
## lattice version
pCO2.capita <- xyplot(GNI.capita  ~ CO2.capita,
           data = CO2data,
           xlab = "Carbon dioxide emissions (metric tons per capita)",
           ylab = "GNI per capita, PPP (current international $)",
           groups = Country.Name,
           par.settings = myTheme,
           type = 'b')

pCO2.capita 

## ggplot2 version
gCO2.capita <- ggplot(data = CO2data,
           aes(x = CO2.capita,
           y = GNI.capita,
           color = Country.Name)) +
   geom_point() + geom_path() +
   scale_color_manual(values = palOrdered, guide = FALSE) +
   xlab('CO2 emissions (metric tons per capita)') +
   ylab('GNI per capita, PPP (current international $)') +
   theme_bw() 

## lattice version
pCO2.capita <- pCO2.capita +
   glayer_(panel.text(...,
        labels = CO2data$Year[subscripts],
          pos = 2, cex = 0.5, col = 'gray'))
pCO2.capita 

## ggplot2 version
gCO2.capita <- gCO2.capita + geom_text(aes(label = Year),
                colour = 'gray',
                size = 2.5,
                hjust = 0, vjust = 0)

library(directlabels)

## lattice version
direct.label(pCO2.capita,
      method = 'extreme.grid') 

## ggplot2 version
direct.label(gCO2.capita, method = 'extreme.grid') 

Interactive

library(dygraphs)
dyTemp <- dygraph(aranjuez[, c("TempMin", "TempAvg", "TempMax")],
                  main = "Temperature in Aranjuez",
                  ylab = "ºC")

dyTemp

dyTemp %>%
  dyHighlight(highlightSeriesBackgroundAlpha = 0.2,
              highlightSeriesOpts = list(strokeWidth = 2)) 

dyTemp %>%
  dyHighlight(highlightSeriesBackgroundAlpha = 0.2,
              highlightSeriesOpts = list(strokeWidth = 2)) 

dygraph(aranjuez[, c("TempMin", "TempAvg", "TempMax")],
        main = "Temperature in Aranjuez",
        ylab = "ºC") %>%
  dySeries(c("TempMin", "TempAvg", "TempMax"),
           label = "Temperature") 

library(highcharter)
library(xts)

aranjuezXTS <- as.xts(aranjuez)

highchart() %>%
  hc_add_series(name = 'TempMax',
                aranjuezXTS[, "TempMax"]) %>%
  hc_add_series(name = 'TempMin',
                aranjuezXTS[, "TempMin"]) %>%
  hc_add_series(name = 'TempAvg',
                aranjuezXTS[, "TempAvg"]) 

aranjuezDF <- fortify(aranjuez[,
                               c("TempMax",
                                 "TempAvg",
                                 "TempMin")],
                      melt = TRUE)

summary(aranjuezDF) 

##      Index                Series         Value        
##  Min.   :2004-01-01   TempMax:2898   Min.   :-12.980  
##  1st Qu.:2005-12-29   TempAvg:2898   1st Qu.:  7.107  
##  Median :2008-01-09   TempMin:2898   Median : 13.560  
##  Mean   :2008-01-03                  Mean   : 14.617  
##  3rd Qu.:2010-01-03                  3rd Qu.: 21.670  
##  Max.   :2011-12-31                  Max.   : 41.910  
##                                      NA's   :10

library(plotly)

plot_ly(aranjuezDF) %>%
  add_lines(x = ~ Index,
            y = ~ Value,
            color = ~ Series)