How to replicate a Monthly Cycle Chart in R

Question

I\'d like to output a chart similar to the one represented on this page (on the right) using R and any package that would make it look good:

http://processtrends.com/pg_

Answer 1

An awful piece of R coding here by me, but it might give you some ideas on how to do it:

This was the data I used taken from the excel file on the linked site:

> dput(redata)
structure(c(1093L, 1182L, 1299L, 1372L, 1319L, 1362L, 1239L, 
1162L, 1059L, 921L, 815L, 720L, 835L, 853L, 1034L, 1030L, 1240L, 
1388L, 1429L, 1319L, 1231L, 1184L, 1076L, 825L, 991L, 1093L, 
854L, 808L, 1079L, 1092L, 1220L, 1251L, 1130L, 1131L, 1052L, 
951L, 950L, 1006L, 1112L, 1119L, 1250L, 1322L, 1347L, 1310L, 
1215L, 1128L, 1035L, 992L, 1079L, 1018L, 1112L, 1224L, 1323L, 
1344L, 1326L, 1267L, 1171L, 1075L, 916L, 932L, 888L, 904L, 939L, 
1018L, 1140L, 1174L, 1285L, 1311L, 1298L, 1231L, 1091L, 1088L, 
991L, 1028L, 1177L, 1322L, 1322L, 1398L, 1389L, 1174L, 1196L, 
1115L, 756L, 496L, 693L, 673L, 748L, 777L, 820L, 948L, 966L, 
1027L, 960L, 865L, 767L, 675L, 765L, 732L, 613L, 632L, 659L, 
705L, 684L, 734L, 715L, 626L, 551L, 487L, 500L, 536L, 575L, 595L, 
736L, 798L, 832L, 797L, 792L, 726L, 650L, 584L, 567L, 524L, 574L, 
571L, 591L, 657L, 699L, 756L, 867L, 795L, 760L, 685L, 609L, 588L, 
521L, 581L, 614L, 623L, 668L, 702L, 777L, 697L, 647L, 562L, 523L, 
508L, 493L, 504L, 534L, 586L, 621L, 620L, 636L, 600L, 549L, 557L
), .Dim = 12:13, .Dimnames = list(c("Jan", "Feb", "Mar", "Apr", 
"May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"), c("X1993", 
"X1994", "X1995", "X1996", "X1997", "X1998", "X1999", "X2000", 
"X2001", "X2002", "X2003", "X2004", "X2005")))

And here's my woeful coding... so much cleanup is possible here, but it is a quick test of the possibilities.

monthnames <- c(
"Jan",
"Feb",
"Mar",
"Apr",
"May",
"Jun",
"Jul",
"Aug",
"Sep",
"Oct",
"Nov",
"Dec"
)


# size of window
windows(w=6,h=3)

# margins
par(
mar=c(5.1,5.1,2.1,2.1),
cex.axis=0.7
)

# set up plot with the number of categories and the y limits 
# yaxs="i" sets the yaxis as having no separation from the corner point

ylimlp <-  c(0,max(redata))*1.06
plot(1:156, type="n", xaxt="n", ylim=ylimlp, ann=FALSE, yaxs="i", xaxs="i", bty="l", las="1")

abline(v=seq(13,156,13),lty=1,col="grey")

title(xlab="Month", col.lab=rgb(0,0,0), font.lab=2, cex.lab=0.75)
title(ylab="Listings", col.lab=rgb(0,0,0), font.lab=2, cex.lab=0.75)

lines(redata[1,],type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*1),redata[2,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*2),redata[3,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*3),redata[4,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*4),redata[5,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*5),redata[6,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*6),redata[7,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*7),redata[8,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*8),redata[9,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*9),redata[10,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*10),redata[11,]),type="l",pch=NA,lwd=1,col="grey")
lines(c(rep(NA,13*11),redata[12,]),type="l",pch=NA,lwd=1,col="grey")

redatamonthmean <- apply(redata,1,mean)

lines(rep(redatamonthmean[1],13),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*1),rep(redatamonthmean[2],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*2),rep(redatamonthmean[3],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*3),rep(redatamonthmean[4],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*4),rep(redatamonthmean[5],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*5),rep(redatamonthmean[6],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*6),rep(redatamonthmean[7],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*7),rep(redatamonthmean[8],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*8),rep(redatamonthmean[9],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*9),rep(redatamonthmean[10],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*10),rep(redatamonthmean[11],13)),type="l",pch=NA,lwd=1,col="black")
lines(c(rep(NA,13*11),rep(redatamonthmean[12],13)),type="l",pch=NA,lwd=1,col="black")

mtext(monthnames[1], side=1, cex=0.7, at=6.5)
mtext(monthnames[2], side=1, cex=0.7, at=6.5*3)
mtext(monthnames[3], side=1, cex=0.7, at=6.5*5)
mtext(monthnames[4], side=1, cex=0.7, at=6.5*7)
mtext(monthnames[5], side=1, cex=0.7, at=6.5*9)
mtext(monthnames[6], side=1, cex=0.7, at=6.5*11)
mtext(monthnames[7], side=1, cex=0.7, at=6.5*13)
mtext(monthnames[8], side=1, cex=0.7, at=6.5*15)
mtext(monthnames[9], side=1, cex=0.7, at=6.5*17)
mtext(monthnames[10], side=1, cex=0.7, at=6.5*19)
mtext(monthnames[11], side=1, cex=0.7, at=6.5*21)
mtext(monthnames[12], side=1, cex=0.7, at=6.5*23)

And the example image