Example function for R support

gistfile1.r

line.plot.fun<-function(data1, space.columns=1,
                        num.major.horiz=4,
                        num.major.verts=5, 
                        x.unit="Month of Year", 
                        new.x.vals=FALSE,
                        line.width=3, 
                        line.type=1, ylab="set y label in params",
                        xlab="Month of year", 
                        set.y.min=FALSE,y.min=0, round.y=1,
                        set.y.max=FALSE, y.max=1, 
                        set.x.min = FALSE, x.min=0,
                        set.x.max = FALSE, x.max=100, ylab.adj=1, 
                        xlab.adj=1, y.cex=1, x.cex=1, y.font=2, x.font=2, 
                        y.axis.cex=1, x.axis.cex=1, x.vals.adj=1,convert.to.proportion=FALSE, 
                        col.names=FALSE, sig.figs.y=2, start.date=FALSE,
                        plot.legend=TRUE, legend.cex=1, 
                        legend.x.adj=1,legend.y.adj=1,
                        plot.y.axis=TRUE, plot.x.axis=TRUE,
                        plot.data.secondary=FALSE, data.secondary=NA, 
                        plot.data.tertiary=FALSE, data.tertiary=NA,
                        line.width.data2=1, lty.data2=1, 
                        line.width.data3=1, lty.data3=1, lwd.gradient=TRUE, 
                        bg = grey.colors(n=20)[20],
                        text.colors ="#00000090", 
                        connect.data1=FALSE,
                        connect.data2=FALSE, 
                        connect.data3=FALSE,
                        connect.lwd=1, 
                        connect.data2.lwd=1, 
                        connect.data3.lwd=1,
                        first.line.color=FALSE,
                        last.line.color=FALSE, 
                        add.other.data=FALSE,
                        other.data=NA,
                        other.data.lwd=1,other.data.lty=1,
                        other.data.col="black") {

  
  require(date)
  require(chron)
  require(colorspace)
  #get rid of odd last column that shows up.
  data2<-data1[,-ncol(data1)]
  
  #convert data (not time) into proportion of population
  if (convert.to.proportion==TRUE) data<-data.frame(data2[,1],data2[,-1]/1e6) else data<-data2
  #name columns as time and then for the prop vaccinated.
  if(col.names==FALSE) colnames(data)<-c("time",seq(0,(ncol(data)-2),1))  else colnames(data) <-col.names

  #create a sequence of dates to use, beginning at Sept 1.. 2000 is just arbitrary
  
  if (start.date==FALSE) date.to.start="2008-08-01" else date.to.start = start.date
  data$time<-seq.Date(as.Date(date.to.start), by="1 day", length.out=nrow(data))
  data$time<-as.Date(data$time)
  
  
  
  #Going to convert dates to weeks now.
  dts<-data$time
  
  dts.posx <- as.POSIXct(dts) 
  weeks  <- as.integer(format(dts.posx,format="%W"))
  
  months<-months(dts.posx)
  #we will use weeks to label our axes later
  

  
  
  ggplotColours <- function(n=6, h=c(0, 360) +15){
    if ((diff(h)%%360) < 1) h[2] <- h[2] - 360/n
    hcl(h = (seq(h[1], h[2], length = n)), c = 100, l = 65)
  }
  
  
  
  
  
  col<-text.colors
  line.wd<-line.width #for lines of chart
  lty=line.type #for type of lines in chart
  
  
  xlab=xlab
  ylab=ylab
  
  
  if(xlab=="Month of year") x.units<-months else x.units<-weeks
  
  if(set.y.min==FALSE) ymin<-signif(min(data[,2:ncol(data)]), sig.figs.y) else ymin=y.min
  if(set.y.max==FALSE) ymax<-signif(max(data[,2:ncol(data)]),sig.figs.y) else ymax=y.max
  
  if(set.x.min==FALSE) xmin<-round(min(data$time),0) else xmin=x.min
  if(set.x.max==FALSE) xmax<-round(max(data$time),0) else xmax=x.max
  
  num.major.verts<-num.major.verts
  num.minor.verts<-2*num.major.verts
  
  vert.line.spacing.minor<-round((xmax-xmin)/num.minor.verts,0)
  vert.line.spacing.major<-round((xmax-xmin)/num.major.verts,0)
  
  vert.lines.major.lwd=3
  vert.lines.minor.lwd=1
  
  
  vert.lines.major<-seq(xmin,xmax,(vert.line.spacing.major-1))
  vert.lines.minor<-vert.lines.major+.5*(vert.line.spacing.major-1)
  
  
  
  
  num.major.horiz<-num.major.horiz
  num.minor.horiz<-2*num.major.horiz
  horiz.line.spacing.minor<-(ymax-ymin)/num.minor.horiz
  horiz.line.spacing.major<-(ymax-ymin)/num.major.horiz
  horiz.lines.major.lwd=3
  
  horiz.lines.minor1<-seq(ymin,ymax,horiz.line.spacing.minor)
  horiz.lines.major1<-seq(ymin,ymax,horiz.line.spacing.major)
  horiz.lines.major<-signif(horiz.lines.major1,digits=sig.figs.y)
  horiz.lines.minor<-horiz.lines.major-.5*(horiz.lines.major[2]-horiz.lines.major[1])
  horiz.lines.minor.lwd=1
  
  
  
  
  par(mar=c(9,9,4,6))
  par(xpd=FALSE)
  plot(data[,2]~data[,1], pch=NA,axes=FALSE,
       xlab=NA,
       ylab="",
       ylim=c(ymin, ymax), 
       xlim=c(xmin, xmax))
  
  
  a<-ggplotColours(n=((ncol(data)-1)))
  if(first.line.color!=FALSE) a[length(a)]<-first.line.color
  if(last.line.color!=FALSE) a[1]<-last.line.color
  leg.col<-a[seq((length(a)-0),1,-space.columns)]
  
  l<-legend(fill=rep(bg, length(leg.col)), x=par("usr")[2], xjust=.1*legend.x.adj,
            y=par("usr")[4], yjust =1.1*legend.y.adj, 
            names(data[,seq(2,ncol(data),space.columns)]), 
            ncol=1,
            text.col="white",border=NA, xpd=TRUE, box.lwd=NA, 
            cex=1.2, bg=NA, box.col="white", plot=FALSE)
  
  legend(fill=rep(bg, length(leg.col)), x=l$rect$left,
         y=l$rect$top, 
         names(data[,seq(2,ncol(data),space.columns)]), ncol=1,
         text.col="white",border=NA, xpd=TRUE, box.lwd=NA, 
         cex=1.2*legend.cex, bg=NA, box.col="white",plot=plot.legend)
  
  legend( x=l$rect$left,
          y=l$rect$top, 
          names(data[,seq(2,ncol(data),space.columns)]), 
          ncol=1, bg=NA, box.lwd=NA, lty=1, lwd=5, 
          col=leg.col, text.col=col,
          seg.len=.8, xpd=TRUE, cex=1.2*legend.cex, box.col="white", 
          plot=plot.legend)
  
  rect(par("usr")[1],par("usr")[3],par("usr")[2],par("usr")[4],col = bg, border=NA)
  
  #make minor vertical white lines
  segments(x0=vert.lines.minor, x1=vert.lines.minor, 
           y0=par("usr")[3], y1=par("usr")[4], 
           col="white", lwd=vert.lines.minor.lwd)
  
  segments(x0=vert.lines.major, x1=vert.lines.major, 
           y0=par("usr")[3], y1=par("usr")[4], 
           col="white", lwd=vert.lines.major.lwd)
  
  segments(y0=horiz.lines.minor, y1=horiz.lines.minor, 
           x0=par("usr")[1], x1=par("usr")[2], 
           col="white", lwd=horiz.lines.minor.lwd)
  
  segments(y0=horiz.lines.major, y1=horiz.lines.major, 
           x0=par("usr")[1], x1=par("usr")[2], 
           col="white", lwd=horiz.lines.major.lwd)
  

  
  
  
  if(plot.y.axis==TRUE) {
    axis(side=2,at=horiz.lines.major, 
         labels=horiz.lines.major,
         cex.axis=1.8*y.axis.cex, 
         las=2, font=2, 
         col.axis=col, col.tick=col, 
         col=col, lwd=0, 
         lwd.tick=2)  
  }
  
  if(new.x.vals==FALSE) {
  if(plot.x.axis==TRUE) axis(side=1, cex.axis=1.4*x.axis.cex, padj=-.3*x.vals.adj,col=col,col.axis=col,lwd=0, font=2,
       lwd.tick=2,
       at=c(vert.lines.major), 
       labels=weeks[which(c(data$time,  data$time[365]+1) %in% vert.lines.major)])}
  
  if(new.x.vals!=TRUE) {
    if(plot.x.axis==TRUE) {
      axis(side=1, cex.axis=1.4*x.axis.cex, padj=-.3*x.vals.adj,col=col,col.axis=col,lwd=0, font=2,
           lwd.tick=2,
           at=c(vert.lines.major), 
           labels=new.x.vals)}}
    
  
  which(c(data$time,  data$time[365]+1) %in% vert.lines.major[2])
    
  mtext(side=2, ylab, padj=ylab.adj*(-2.8), cex=y.cex*2.3, font=y.font, col=col)
  mtext(side=1, xlab, padj=xlab.adj*2, cex=x.cex*2.3, font=x.font, col=col)
 
 
  line.wd<-line.width
  lty=line.type
  for (i in seq(ncol(data),2,-space.columns)) {
    lines(data[,i]~data[,1], lwd=line.wd, lty=1,
          col=a[(length(a)+2)-i])
    if(lwd.gradient==TRUE) line.wd=line.wd*1.05
  }
  
  if (connect.data1==TRUE) {
    for (i in seq(ncol(data),2,-space.columns)) {
      lines(data[,i]~data[,1], lwd=connect.lwd, lty=1,
            col=a[(length(a)+2)-i])
     
    }
  }

  
  if(plot.data.secondary==TRUE) {
    line.wd=line.width
    data2<-data.secondary[,-ncol(data.secondary)]
  
  #convert data (not time) into proportion of population
  if (convert.to.proportion==TRUE) data<-data.frame(data2[,1],data2[,-1]/1e6) else data<-data2
  #name columns as time and then for the prop vaccinated.
  if(col.names==FALSE) colnames(data)<-c("time",seq(0,(ncol(data)-2),1))  else colnames(data) <-col.names
  
  
  #create a sequence of dates to use, beginning at Sept 1.. 2000 is just arbitrary
  
  if (start.date==FALSE) date.to.start="2008-08-01" else date.to.start = start.date
  data$time<-seq.Date(as.Date(date.to.start), by="1 day", length.out=nrow(data))
  data$time<-as.Date(data$time)
  
    line.wd=line.width.data2
    for (i in seq(ncol(data),2,-space.columns)) {
      
      lines(data[,i]~data[,1], lwd=line.wd, lty=lty.data2,
            col=a[(length(a)+2)-i])
      if(lwd.gradient==TRUE) line.wd=line.wd*1.05
    }
    if (connect.data2==TRUE) {
      for (i in seq(ncol(data),2,-space.columns)) {
        lines(data[,i]~data[,1], lwd=connect.data2.lwd, lty=1,
              col=a[(length(a)+2)-i])
        
      }
    }
  }
  
  
  if(plot.data.tertiary==TRUE) {
    data2<-data.tertiary[,-ncol(data.tertiary)]
    
    #convert data (not time) into proportion of population
    if (convert.to.proportion==TRUE) data<-data.frame(data2[,1],data2[,-1]/1e6) else data<-data2
    #name columns as time and then for the prop vaccinated.
    if(col.names==FALSE) colnames(data)<-c("time",seq(0,(ncol(data)-2),1))  else colnames(data) <-col.names
    
    
    #create a sequence of dates to use, beginning at Sept 1.. 2000 is just arbitrary
    
    if (start.date==FALSE) date.to.start="2008-08-01" else date.to.start = start.date
    data$time<-seq.Date(as.Date(date.to.start), by="1 day", length.out=nrow(data))
    data$time<-as.Date(data$time)
    
    line.wd=line.width.data3
    for (i in seq(ncol(data),2,-space.columns)) {
      
      lines(data[,i]~data[,1], lwd=line.wd, lty=lty.data3,
            col=a[(length(a)+2)-i])
      if(lwd.gradient==TRUE) line.wd=line.wd*1.05
    }
    if (connect.data3==TRUE) {
      for (i in seq(ncol(data),2,-space.columns)) {
        lines(data[,i]~data[,1], lwd=connect.data3.lwd, lty=1,
              col=a[(length(a)+2)-i])
        
      }
    }
  }

  if(add.other.data==TRUE) {
    other.data<-data.frame(other.data)
    for (i in 1:ncol(other.data)){
      lines(other.data[,i]~data[,1], 
            lwd=other.data.lwd, 
            lty=other.data.lty, 
            col=other.data.col)
    }
  }
  
}