add division to the calendar.

gistfile1.r

calendar.division <- function(...)
{
  xyetc <- list(...)
  subs <- dat[xyetc$subscripts,]
  dates.fsubs <- dat[dat$yr == unique(subs$yr),]
  y.start <- dates.fsubs$dotw[1]
  y.end   <- dates.fsubs$dotw[nrow(dates.fsubs)]
  dates.len <- nrow(dates.fsubs)
  adj.start <- dates.fsubs$woty[1]
  

for (k in 0:6) {
    if (k < y.start) {
      x.start <- adj.start + 0.5
    } else {
      x.start <- adj.start - 0.5
    }
    if (k > y.end) {
      x.finis <- dates.fsubs$woty[nrow(dates.fsubs)] - 0.5
    } else {
      x.finis <- dates.fsubs$woty[nrow(dates.fsubs)] + 0.5
    }
    grid.lines(x = c(x.start, x.finis), y = c(k -0.5, k - 0.5), 
               default.units = "native", gp=gpar(col = "grey", lwd = 1))
  }
  if (adj.start <  2) {
    grid.lines(x = c( 0.5,  0.5), y = c(6.5, y.start-0.5), 
               default.units = "native", gp=gpar(col = "grey", lwd = 1))
    grid.lines(x = c(1.5, 1.5), y = c(6.5, -0.5), default.units = "native",
               gp=gpar(col = "grey", lwd = 1))
    grid.lines(x = c(x.finis, x.finis), 
               y = c(dates.fsubs$dotw[dates.len] -0.5, -0.5), default.units = "native",
               gp=gpar(col = "grey", lwd = 1))
    if (dates.fsubs$dotw[dates.len] != 6) {
      grid.lines(x = c(x.finis + 1, x.finis + 1), 
                 y = c(dates.fsubs$dotw[dates.len] -0.5, -0.5), default.units = "native",
                 gp=gpar(col = "grey", lwd = 1))
    }
    grid.lines(x = c(x.finis, x.finis), 
               y = c(dates.fsubs$dotw[dates.len] -0.5, -0.5), default.units = "native",
               gp=gpar(col = "grey", lwd = 1))
  }
  for (n in 1:51) {
    grid.lines(x = c(n + 1.5, n + 1.5), 
               y = c(-0.5, 6.5), default.units = "native", gp=gpar(col = "grey", lwd = 1))
  }
  x.start <- adj.start - 0.5
  
  if (y.start > 0) {
    grid.lines(x = c(x.start, x.start + 1),
               y = c(y.start - 0.5, y.start -  0.5), default.units = "native",
               gp=gpar(col = "black", lwd = 1.75))
    grid.lines(x = c(x.start + 1, x.start + 1),
               y = c(y.start - 0.5 , -0.5), default.units = "native",
               gp=gpar(col = "black", lwd = 1.75))
    grid.lines(x = c(x.start, x.start),
               y = c(y.start - 0.5, 6.5), default.units = "native",
               gp=gpar(col = "black", lwd = 1.75))
    if (y.end < 6  ) {
      grid.lines(x = c(x.start + 1, x.finis + 1),
                 y = c(-0.5, -0.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
      grid.lines(x = c(x.start, x.finis),
                 y = c(6.5, 6.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
    } else {
      grid.lines(x = c(x.start + 1, x.finis),
                 y = c(-0.5, -0.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
      grid.lines(x = c(x.start, x.finis),
                 y = c(6.5, 6.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
    }
  } else {
    grid.lines(x = c(x.start, x.start),
               y = c( - 0.5, 6.5), default.units = "native",
               gp=gpar(col = "black", lwd = 1.75))
  }
  
  if (y.start == 0 ) {
    if (y.end < 6  ) {
      grid.lines(x = c(x.start, x.finis + 1),
                 y = c(-0.5, -0.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
      grid.lines(x = c(x.start, x.finis),
                 y = c(6.5, 6.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
    } else {
      grid.lines(x = c(x.start + 1, x.finis),
                 y = c(-0.5, -0.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
      grid.lines(x = c(x.start, x.finis),
                 y = c(6.5, 6.5), default.units = "native",
                 gp=gpar(col = "black", lwd = 1.75))
    }
  }
  for (j in 1:12)  {
    last.month <- max(dates.fsubs$seq[dates.fsubs$month == j])
    x.last.m <- dates.fsubs$woty[last.month] + 0.5
    y.last.m <- dates.fsubs$dotw[last.month] + 0.5
    grid.lines(x = c(x.last.m, x.last.m), y = c(-0.5, y.last.m),
               default.units = "native", gp=gpar(col = "black", lwd = 1.75))
    if ((y.last.m) < 6) {
      grid.lines(x = c(x.last.m, x.last.m - 1), y = c(y.last.m, y.last.m),
                 default.units = "native", gp=gpar(col = "black", lwd = 1.75))
      grid.lines(x = c(x.last.m - 1, x.last.m - 1), y = c(y.last.m, 6.5),
                 default.units = "native", gp=gpar(col = "black", lwd = 1.75))
    } else {
      grid.lines(x = c(x.last.m, x.last.m), y = c(- 0.5, 6.5),
                 default.units = "native", gp=gpar(col = "black", lwd = 1.75))
    }
  }
}