Nothing
".seasxlab" <-
function(width, start.day) {
str <- if (is.numeric(width))
gettextf("%s-day group", round(width, 1))
else if (any(grep("mon", width)))
gettext("Monthly")
else if (any(grep("zod", width)))
gettext("Zodiac")
else if (width == "DJF")
gettext("Quarterly (seasonal)")
else if (width == "JFM")
gettext("Quarterly (annual)")
else if (width == "JF")
gettext("Two months")
else as.character(width[1])
if (!is.null(start.day) && start.day != 1) {
if (inherits(start.day, c("POSIXct", "Date"))) {
mday <- as.integer(format(start.day, "%d"))
fmt <- if (mday == 1)
getOption("seas.label")$month
else
getOption("seas.label")$monthday
st <- format(start.day, fmt)
} else {
mday <- 2
st <- gettextf("day %i of the year", start.day)
}
str <- gettextf(ngettext(mday,
"%s, starting in %s",
"%s, starting on %s"), str, st)
}
return(str)
}
".seasylab" <-
function(var, long.name = NULL, units = NULL) {
ylab <- if (is.null(long.name)) var else long.name
if (!is.null(units))
ylab <- sprintf(getOption("seas.label")$fmt, ylab, units)
ylab
}
".seastitle" <-
function(main = NULL, id = NULL, name = NULL,
orig = NULL, fun = NULL, range = NA) {
op <- getOption("seas.main")
if (is.null(main)) {
if (is.null(name) && !is.null(id) && op$show.id)
name <- getstnname(id)
if (!is.null(name) && !is.null(id) && op$show.id)
main <- paste(name, id)
else if (!is.null(name) && (!op$show.id || is.null(id)))
main <- name
else if (!is.null(id) && op$show.id)
main <- id
else if (!is.null(orig))
main <- orig[[1]]
else
main <- ""
}
if (!is.null(fun) && op$show.fun)
main <- paste(main, fun, sep=ifelse(main == "", "", " "))
if (length(range) == 2 && all(is.finite(range))) {
range <- ifelse(range[1] == range[2],
range[1],
paste(range[1], range[2], sep=op$rngsep))
main <- sprintf(op$fmt, main, range)
}
main
}
".seasmonthgrid" <-
function(width, days, start = 1, rep = 0, start.day = 1, month.label) {
op <- getOption("seas.month.grid")
if (is.numeric(width)) {
num.bin <- length(days)
num <- num.bin + rep
year.length <- round(sum(days))
month.days <- c(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
if (year.length != 366) {
if (year.length == 365)
month.days[2] <- 28
else
month.days <- rep(year.length / 12, 12)
}
if (inherits(start.day, c("POSIXct", "Date"))) {
start.std <- as.Date(format(start.day, "2000-%m-%d"))
start.yday <- as.integer(format(start.std, "%j"))
} else {
start.yday <- start.day
}
if (start > 1)
start.yday <- round(sum(start.yday-1,
days[1:(start - 1)])) %% year.length + 1
start.date <- as.Date(sprintf("2000-%03i", as.integer(start.yday)), "%Y-%j")
sel.bin <- seq(start - 1, start + num - 2) %% num.bin + 1
bdf <- data.frame(pos=1:num, bin=sel.bin, width=days[sel.bin])
bdf$yday <- cumsum(bdf$width) - bdf$width + start.yday
yday2pos <- function(yday) { # y=mx+b, using intervals
p <- findInterval(yday, bdf$yday)
if (p < 1) p <- 1
m <- 1 / bdf$width[p]
b <- bdf$pos[p] - m * bdf$yday[p]
return(m * yday + b - 0.5)
}
ym <- as.numeric(format(start.date, "%m"))
yd <- ifelse(ym > 1, sum(month.days[1:(ym - 1)]), 1)
pos <- yday2pos(yd)
ln <- 1
while (pos[ln] < num) {
ym[ln + 1] <- ym[ln] %% 12 + 1
yd <- yd + month.days[ym[ln + 1]]
pos[ln + 1] <- yday2pos(yd)
ln <- length(ym)
}
fit <- pos < num + 1.4
pos <- pos[fit]
ym <- ym[fit]
month <- months(as.Date(paste(2001, ym[-length(ym)],
15, sep="-")), op$abb)
if (is.numeric(op$len))
month <- strtrim(month, op$len)
abline(v=pos, col=op$col, lwd=op$lwd * par("lwd"), lty=op$lty)
m <- pos[-length(ym)] + diff(pos) / 2
fit <- m > 0.2
m <- m[fit]
month <- month[fit]
if (missing(month.label))
month.label <- op$label
if (month.label) {
if (op$force)
mtext(month, at=m, cex=par("cex") * par("cex.axis"))
else
axis(3, m, month, tick=FALSE, line=-1)
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.