Skip to content

Instantly share code, notes, and snippets.

@agstudy
Last active June 27, 2019 04:56
Show Gist options
  • Save agstudy/5013606 to your computer and use it in GitHub Desktop.
Save agstudy/5013606 to your computer and use it in GitHub Desktop.
add division to the calendar.
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))
}
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment