There was a thread a while ago about monthly sequences, and the "end- 
end" convention used for interbank deposits.  I've done some more  
work on this, and come up with a version of the seq.Date function  
(from base R) that I think can handle the convention.  Generating  
sequences of swap payment dates should be facilitated by this  
function.  Basically, all you do is add an 'end.end=TRUE' flag to  
your regular 'seq' function call.

The replacement function is printed below.  It is verbatim the  
'seq.Date' function, with commented addenda.  No additional packages  
are required.

If anyone finds the function helpful, I would appreciate your  
thoughts on style, etc . . .

Franklin Parlamis

-----

seq.Date <-
##  enhances base R seq.Date function by allowing the
##  end.end convention for monthly and yearly sequences
function (from, to, by, length.out = NULL, along.with = NULL, end.end  
= FALSE,
     ...)
{
     if (missing(from))
         stop("'from' must be specified")
     if (!inherits(from, "Date"))
         stop("'from' must be a Date object")
     if (length(as.Date(from)) != 1)
         stop("'from' must be of length 1")
     if (!missing(to)) {
         if (!inherits(to, "Date"))
             stop("'to' must be a Date object")
         if (length(as.Date(to)) != 1)
             stop("'to' must be of length 1")
     }
     if (!missing(along.with)) {
         length.out <- length(along.with)
     }
     else if (!missing(length.out)) {
         if (length(length.out) != 1)
             stop("'length.out' must be of length 1")
         length.out <- ceiling(length.out)
     }
     status <- c(!missing(to), !missing(by), !is.null(length.out))
     if (sum(status) != 2)
         stop("exactly two of 'to', 'by' and 'length.out' /  
'along.with' must be specified")
     if (missing(by)) {
         from <- unclass(as.Date(from))
         to <- unclass(as.Date(to))
         res <- seq.default(from, to, length.out = length.out)
         return(structure(res, class = "Date"))
     }
     if (length(by) != 1)
         stop("'by' must be of length 1")
     valid <- 0
     if (inherits(by, "difftime")) {
         by <- switch(attr(by, "units"), secs = 1/86400, mins = 1/1440,
             hours = 1/24, days = 1, weeks = 7) * unclass(by)
     }
     else if (is.character(by)) {
         by2 <- strsplit(by, " ", fixed = TRUE)[[1]]
         if (length(by2) > 2 || length(by2) < 1)
             stop("invalid 'by' string")
         valid <- pmatch(by2[length(by2)], c("days", "weeks",
             "months", "years"))
         if (is.na(valid))
             stop("invalid string for 'by'")
         if (valid <= 2) {
             by <- c(1, 7)[valid]
             if (length(by2) == 2)
                 by <- by * as.integer(by2[1])
         }
         else by <- if (length(by2) == 2)
             as.integer(by2[1])
         else 1
     }
     else if (!is.numeric(by))
         stop("invalid mode for 'by'")
     if (is.na(by))
         stop("'by' is NA")
     if (valid <= 2) {
         from <- unclass(as.Date(from))
         if (!is.null(length.out))
             res <- seq.default(from, by = by, length.out = length.out)
         else {
             to <- unclass(as.Date(to))
             res <- seq.default(0, to - from, by) + from
         }
         return(structure(res, class = "Date"))
     }
     else {
         r1 <- as.POSIXlt(from)
         if (valid == 4) {
             if (missing(to)) {
                 yr <- seq(r1$year, by = by, length = length.out)
             }
             else {
                 to <- as.POSIXlt(to)
                 yr <- seq(r1$year, to$year, by)
             }
             r1$year <- yr
### begin FP addenda
			if (end.end && r1$mon==1 && r1$mday>27) {
				r1$mon <- rep(r1$mon, length(r1$year))
				r1$mday <- rep(r1$mday, length(r1$year))
				natyr <- r1$year+1900
				leap <- natyr %% 4 == 0 &
						(natyr %% 100 != 0 | natyr %% 400 == 0) ## thx Diethelm Wuertz
				mdayadj <- (r1$mon == 1) * (r1$mday == 28) * (leap) -
             				(r1$mon == 1) * (r1$mday == 29) * (!leap)
             	r1$mday <- r1$mday + mdayadj
             }
### end FP addenda
             res <- .Internal(POSIXlt2Date(r1))
         }
         else if (valid == 3) {
             if (missing(to)) {
                 mon <- seq(r1$mon, by = by, length = length.out)
             }
             else {
                 to <- as.POSIXlt(to)
                 mon <- seq(r1$mon, 12 * (to$year - r1$year) +
                   to$mon, by)
             }
             r1$mon <- mon
### begin FP addenda
			if (end.end && r1$mday>27) {
				r1$mday <- rep(r1$mday, length(r1$mon))
				natyr <- r1$year + 1900 + r1$mon %/% 12
				leap <- natyr %% 4 == 0 &
						(natyr %% 100 != 0 | natyr %% 400 == 0) ## thx Diethelm Wuertz
             	last <- c(31,28,31,30,31,30,31,31,30,31,30,31)[r1$mon % 
% 12 + 1]
             	last <- last + (last == 28)*(leap)
             	if (last[1] == r1$mday[1]) {
             		r1$mday <- last
             	}
             	else r1$mday <- pmin(last, r1$mday)
             }
### end FP addenda
             res <- .Internal(POSIXlt2Date(r1))
         }
         return(res)
     }
}
			
  
  
	[[alternative HTML version deleted]]

