RG#98: Horizon plot (time series data)

require(latticeExtra)

#example data 
set.seed(123)
mydat <- ts(matrix(cumsum(rnorm(150 * 10)), ncol = 10))
colnames(mydat) <- paste("TS", letters[1:10], sep = "-")

#simple line plot
xyplot(mydat, scales = list(y = "same"))


# panel with different origin and scale:
horizonplot(mydat, layout = c(1,12), colorkey = TRUE) +  

 layer(panel.scaleArrow(x = 0.99, digits = 1, col = "grey",

                         srt = 90, cex = 0.7)) +
  layer(lim <- current.panel.limits(),
    panel.text(lim$x[1], lim$y[1], round(lim$y[1],1), font = 2,

        cex = 0.7, adj = c(-0.5,-0.5), col = "blue")) 

RG#83: Multi-faceted (Trellis) plot of time series plot (weather data example)

st <- as.Date("2009-1-1")
en <- as.Date("2011-12-28")
date1 <- seq(st, en, "1 day")
avgtm <- round (rnorm (length(date1), 50,5), 1)
maxtm <- round (avgtm + 8 + abs(rnorm (length (avgtm), 0, 1)),1)
mintm <-  round (avgtm - 8 + abs(rnorm (length (avgtm), 0, 1)), 1)
myd <- data.frame(date1, maxtm, mintm, avgtm)

# extract month
month <- function(x)format(x, '%m')
year <- function(x)format(x, '%Y')

require(lattice)
require(latticeExtra)

xyplot(avgtm ~ date1 | year(date1), data=myd,
       type='l', layout=c(1, 3),
       scales=list(x=list(relation='free')),
       xlab='', ylab='',
       panel=function(x, y, ...){
           panel.xblocks(x, month,
                         col = c("lightblue", "lightgreen"),
                         border = "darkgray")
           panel.xyplot(x, y, lwd = 1, col='red', ...)
           })

RG#82: Time series plot (weather data with monthly averages connected)

# data 
st <- as.Date ("2009-1-1")
en <- as.Date ("2009-6-28")
date1 <- seq(st, en, "1 day")
year <- format(date1, "%Y")
month <- format (date1, "%b")
day <- as.numeric (format(date1, "%d"))

set.seed(1234)

# average temperature 
avgtm <- round (rnorm (length(date1), 50,5), 1)
# maximum temperature 
maxtm <- round (avgtm + 8 + abs(rnorm (length (avgtm), 0, 1)),1)
# minimum temperature 
mintm <-  round (avgtm - 8 + abs(rnorm (length (avgtm), 0, 1)), 1)
# record maximum temperature 
rmaxtm <- round (maxtm + 15 + abs(rnorm (length (avgtm), 0, 1)), 1)
# record minimum temperature 
rmintm <-  round (mintm - 15 + abs(rnorm (length (avgtm), 0, 1)), 1)
myd <- data.frame ( year, month, day, avgtm, maxtm, mintm, rmaxtm, rmintm )
myd$date <- as.Date(paste(myd$year, myd$month, myd$day), format='%Y %b %d')
levels (myd$month) <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug","Sep", "Oct", "Nov", "Dec")

# find the position to plot for week points or lines 
# for weeks lines
tw = as.numeric (as.Date (seq(st, en, "weeks")), origin = "1970-1-1")
# find the position to plot for month points or lines 
# for month lines
tm = as.numeric (as.Date (seq(st, en, "months")), origin = "1970-1-1")


# plot
  plot(myd$date, myd$avgtm, type = "p", col = "black", xlab = "Date", ylab = "temperature", pch = 19, ylim = c(20, 80), cex = 0.5)

points(myd$date, myd$maxtm, type = "p", col = "red", xlab = "Date", ylab = "temperature", pch = 19, cex = 0.5)
  points(myd$date, myd$mintm, type = "p", col = "green4", xlab = "Date", ylab = "temperature", pch = 19, cex = 0.5)
  points(myd$date, myd$rmintm, type = "p", col = "lightgreen", xlab = "Date", ylab = "temperature", pch = 1, cex = 0.5)
  points(myd$date, myd$rmaxtm, type = "p", col = "pink", xlab = "Date", ylab = "temperature", pch = 1, cex = 0.5)

abline(v = tw, lty = 1, col = "gray50", lwd = 1)
abline(v = tm, lty = 1, col = "blue4", lwd=3)



 # calculating average mean
out1 <- data.frame (with (myd,  tapply(avgtm, month, mean)))
names(out1) <- c("meanavgtm")
out1$grp <- rownames (out1)
out1$tm <- tm

# ploting mean connected with lines
points (out1$tm, out1$meanavgtm, type = "b", col = "black", pch = 19, cex = 3)
text (out1$tm, out1$meanavgtm, labels = round (out1$meanavgtm, 0), col = "white", font = 2)

 # calculating mean maximum
out2 <- data.frame (with (myd,  tapply(maxtm, month, mean)))
names(out2) <- c("meanavgtm")
out2$grp <- rownames (out2)
out2$tm <- tm

# ploting mean connected with lines
points (out2$tm, out2$meanavgtm, type = "b", col = "red4", pch = 19, cex = 3)
text (out2$tm, out2$meanavgtm, labels = round (out2$meanavgtm, 0), col = "white", font = 2)

 # calculating mean minimum
out3 <- data.frame (with (myd,  tapply(mintm, month, mean)))
names(out3) <- c("meanavgtm")
out3$grp <- rownames (out3)
out3$tm <- tm

# ploting mean connected with lines
points (out3$tm, out3$meanavgtm, type = "b", col = "green4", pch = 19, cex = 3)
text (out3$tm, out3$meanavgtm, labels = round (out3$meanavgtm, 0), col = "white", font = 2)

RG#78: Time series area plot (with temperature data as example)

st <- as.Date ("2009-1-1")
en <- as.Date ("2009-12-28")
date1 <- seq(st, en, "1 day")
year <- format(date1, "%Y")
month <- format (date1, "%b")
day <- as.numeric (format(date1, "%d"))

# average daily temperature avgtm <- round (rnorm (length(date1), 50,1), 1)

# maximum daily temperature 
maxtm <- round (avgtm + 5 + abs(rnorm (length (avgtm), 0, 1)),2)

# minimum daily temperature 
mintm <-  round (avgtm - 5 + abs(rnorm (length (avgtm), 0, 1)), 2)

# record maximum daily temperature 
rmaxtm <- round (maxtm + 10 + abs(rnorm (length (avgtm), 0, 3)), 2)

# record minimum daily temperature 
rmintm <-  round (mintm - 10 +  abs(rnorm (length (avgtm), 0, 1)), 3)


myd <- data.frame ( year, month, day, avgtm, maxtm, mintm, rmaxtm, rmintm )
myd$date <- as.Date(paste(myd$year, myd$month, myd$day), format='%Y %b %d')

# for weeks lines 
tw = as.numeric (as.Date (seq(st, en, "weeks")), origin = "1970-1-1")
tw <- data.frame (tw=tw)# for month lines 
tm = as.numeric (as.Date (seq(st, en, "months")), origin = "1970-1-1")
tm <- data.frame (tm=tm)

# plot
require(ggplot2)  # need to install ggplot2 
plt <- ggplot(myd, aes(x= date))
plt1 <- plt + geom_ribbon(aes(ymin= rmintm,  ymax= mintm), fill ="lightblue") + geom_ribbon(aes(ymin= mintm,  ymax= avgtm),fill="blue") + 
geom_ribbon(aes(ymin= avgtm,  ymax= maxtm),fill="red") +
geom_ribbon(aes(ymin= maxtm,  ymax= rmaxtm),fill="pink") +  geom_line(aes(y=avgtm), col = "black", lwd = 1.5) + theme_bw()
print (plt1) 

# adding vertical lines at week and month interval 
 plt1 +  geom_vline(data = tm, aes(xintercept = tm), lwd = 1.5, col = "yellow") + geom_vline(data = tw, aes(xintercept = tw), lwd = 0.5, col = "black")

# multiple years 

st <- as.Date ("2009-1-1")
en <- as.Date ("2011-6-28")
date1 <- seq(st, en, "1 day")
year <- format(date1, "%Y")
month <- format (date1, "%b")
day <- as.numeric (format(date1, "%d"))

avgtm <- round (rnorm (length(date1), 50,1), 1)
maxtm <- round (avgtm + 5 + abs(rnorm (length (avgtm), 0, 1)),2)
mintm <-  round (avgtm - 5 + abs(rnorm (length (avgtm), 0, 1)), 2)
rmaxtm <- round (maxtm + 10 + abs(rnorm (length (avgtm), 0, 3)), 2)
rmintm <-  round (mintm - 10 +  abs(rnorm (length (avgtm), 0, 1)), 3)


myd <- data.frame ( year, month, day, avgtm, maxtm, mintm, rmaxtm, rmintm )
myd$date <- as.Date(paste(myd$year, myd$month, myd$day), format='%Y %b %d')

# for weeks lines 
ty = as.numeric (as.Date (seq(st, en, "year")), origin = "1970-1-1")
ty <- data.frame (ty=ty)# for month lines 
tm = as.numeric (as.Date (seq(st, en, "months")), origin = "1970-1-1")
tm <- data.frame (tm=tm)

# plot
require(ggplot2)  # need to install ggplot2 
plt <- ggplot(myd, aes(x= date))
plt1 <- plt + geom_ribbon(aes(ymin= rmintm,  ymax= mintm), fill ="lightblue") + geom_ribbon(aes(ymin= mintm,  ymax= avgtm),fill="blue") + 
geom_ribbon(aes(ymin= avgtm,  ymax= maxtm),fill="red") +
geom_ribbon(aes(ymin= maxtm,  ymax= rmaxtm),fill="pink") +  geom_line(aes(y=avgtm), col = "black", lwd = 1.5) + theme_bw()
print (plt1) 

# adding vertical lines at month and year interval 
 plt1 +  geom_vline(data = ty, aes(xintercept = ty), lwd = 1.5, col = "yellow") + geom_vline(data = tm, aes(xintercept = tm), lwd = 0.5, col = "black")

RG#74: Time series plots (weather data example)

st <- as.Date ("2009-1-1")
en <- as.Date ("2009-12-28")
date1 <- seq(st, en, "1 day")
year <- format(date1, "%Y")
month <- format (date1, "%b")
day <- as.numeric (format(date1, "%d"))

avgtm <- round (rnorm (length(date1), 50,5), 1)
maxtm <- round (avgtm + abs(rnorm (length (avgtm), 0, 5)),1)
mintm <-  round (avgtm - abs(rnorm (length (avgtm), 0, 5)), 1)
rmaxtm <- round (maxtm + abs(rnorm (length (avgtm), 0, 5)), 1)
rmintm <-  round (mintm - abs(rnorm (length (avgtm), 0, 5)), 1)


myd <- data.frame ( year, month, day, avgtm, maxtm, mintm, rmaxtm, rmintm )
myd$date <- as.Date(paste(myd$year, myd$month, myd$day), format='%Y %b %d')

# for weeks lines 
tw = as.numeric (as.Date (seq(st, en, "weeks")), origin = "1970-1-1")

# for month lines 
tm = as.numeric (as.Date (seq(st, en, "months")), origin = "1970-1-1")

# plot

   plot(myd$date, myd$avgtm, type = "l", col = "red", xlab = "Date", ylab = "temperature")
   points(myd$date, myd$maxtm, type = "p", col = "green", xlab = "Date", ylab = "temperature", pch = "+", cex = 0.5)
  points(myd$date, myd$mintm, type = "p", col = "blue", xlab = "Date", ylab = "temperature", pch = "-", cex = 0.75)


  abline(v = tw, lty = 1, col = "gray50", lwd = 1)
   abline(v = tm, lty = 1, col = "blue4", lwd=3)

# plot multiple year single plot

st <- as.Date ("2009-1-1")
en <- as.Date ("2012-12-28")
date1 <- seq(st, en, "7 day")
year <- format(date1, "%Y")
month <- format (date1, "%b")
day <- as.numeric (format(date1, "%d"))

avgtm <- round (rnorm (length(date1), 50,5), 1)
maxtm <- round (avgtm + abs(rnorm (length (avgtm), 0, 5)),1)
mintm <-  round (avgtm - abs(rnorm (length (avgtm), 0, 5)), 1)
rmaxtm <- round (maxtm + abs(rnorm (length (avgtm), 0, 5)), 1)
rmintm <-  round (mintm - abs(rnorm (length (avgtm), 0, 5)), 1)


myd <- data.frame ( year, month, day, avgtm, maxtm, mintm, rmaxtm, rmintm )
myd$date <- as.Date(paste(myd$year, myd$month, myd$day), format='%Y %b %d')

# for weeks lines 
ty = as.numeric (as.Date (seq(st, en, "years")), origin = "1970-1-1")

# for month lines 
tm = as.numeric (as.Date (seq(st, en, "months")), origin = "1970-1-1")

# plot

   plot(myd$date, myd$avgtm, type = "l", col = "red", xlab = "Date", ylab = "temperature")
   points(myd$date, myd$maxtm, type = "p", col = "green", xlab = "Date", ylab = "temperature", pch = "+", cex = 0.5)
  points(myd$date, myd$mintm, type = "p", col = "blue", xlab = "Date", ylab = "temperature", pch = "-", cex = 0.75)

abline(v = tm, lty = 1, col = "gray70", lwd=1)


 abline(v = ty, lty = 1, col = "blue", lwd=4)

RG#57: Heatmap plot of calender

 # data               
st <- as.Date("2010-2-17")
en <- as.Date("2013-4-7")
datell <- seq(st, en, "1 day")
myd <- data.frame (date1 = datell, heatvar = rnorm (length (datell), 50, 20))


# plot 
# using function written by Paul Bleicher
# requires lattice, chron, grid packages 

require(lattice)
require(chron)
require(grid)

source ("http://blog.revolution-computing.com/downloads/calendarHeat.R")
                
calendarHeat(myd$date1, myd$heatvar, varname="VAR name")

calendarHeat(myd$date1, myd$heatvar, varname="VAR name", ncolors=99,color="r2b" )