tseries/0000755000175100001440000000000014674236060011756 5ustar hornikuserstseries/README0000644000175100001440000000104613374612646012643 0ustar hornikusersPackage for time series analysis and computational finance Authors: A. Trapletti B. LeBaron (./src/bdstest.c) D. M. Gay (./src/dsumsl.f) In addition, the following people have contributed code, bug reports, and documentation: M. Bruns, P. Buehlmann, D. Eddelbuettel, X. G. Fan, K. Hornik, W. Koller, F. Leisch, M. Maechler, K. Nieradko, D. Murdoch, M. Parzen, A. Shah, M. Stigler, A. Zeileis License: GPL-2 Depends on the following R packages: stats (included in the R distribution), portfolio.optim needs package quadprog tseries/MD50000644000175100001440000000654414674236060012277 0ustar hornikusersfb299556f0e8da6bad1037bedf77b0ca *ChangeLog 048434ca47eef1c1126b83b7d5b2a84e *DESCRIPTION cdc8894457c6efd2f1e49cfa79272d7b *NAMESPACE 06290f3ea287a06d96e34079acdbf807 *R/arma.R dc4e8457ecf24346fee6bd8a1b4a2687 *R/finance.R baa1edf1487cf4c0d577f5d00573ccd5 *R/garch.R decf4a3134c069cf9d2dbc79b1b60706 *R/irts.R 5962afbee7294c6b9495b497186a5730 *R/test.R 9db11950b82d51c34320a7baea82bd52 *R/tsutils.R 6474314852bc0951b0cc3848febd98dc *R/zzz.R 5e4d9899b4d9967986461369024bd0bf *README aa5e5a2cbfaea3d9b6cdbe378ac48cee *build/partial.rdb cea82a661e79b85fa78f7f429f5d4fb2 *data/NelPlo.rda 20fbcb99770f7fdcc8e7e41e961c501d *data/USeconomic.rda 46aa2e516184e741a5e3b038b30b13ca *data/bev.rda 65878b11342780992918aecf9bd74bea *data/camp.rda d6a12e4d7104ebdbc4498cf4ebc22fca *data/ice.river.rda 5fe6d881d39007ebf29854d0fd0181a3 *data/nino.rda f83e3377efcba0074627e24a461f14fb *data/tcm.rda 724b763e145e06795690e6d0155f8e8b *data/tcmd.rda 614968d6b6167ed86f46274eff8f1459 *man/NelPlo.Rd a3fd00105442c79dbe9d8097b5877f40 *man/USeconomic.Rd 92d75e6305fcc13d56aaa716ff489583 *man/adf.test.Rd f5b98a0cc9d1fc856692cf6f169c1ab5 *man/arma-methods.Rd 51bcd384cff3224af080545728dbf1cf *man/arma.Rd 0af8ffa412780c9547c010b1d12869f8 *man/bds.test.Rd af544e3ec3d8abaab6402a886d5429cf *man/bev.Rd 96eca9b4b82e7bf3e6f743ce21a5d9d8 *man/camp.Rd 35c28a6707e4e01f789be2117c646664 *man/garch-methods.Rd 6e9e94d717f01d4208a8fa29e0ea28d2 *man/garch.Rd c22acb9192d7e819848cb71a08fc04c9 *man/get.hist.quote.Rd dad4d5b3dc8d236fa5455b0abbd294b2 *man/ice.river.Rd a6cbcad093fb530e27bf50ed3446d935 *man/irts-functions.Rd 82628e1b908072d5572db16d8d4fd2fa *man/irts-methods.Rd 98a04ff66d5647b616d4957e316b0011 *man/irts.Rd ebbc531e16bbbbf4ce7e6851456d0d83 *man/jarque.bera.test.Rd c743f25be85f1614cb550ff8c4c39830 *man/kpss.test.Rd 8694b77930d8f87608e74cb3a098ffdb *man/maxdrawdown.Rd df57497fe0c4420af39d4372edbd0e4a *man/na.remove.Rd 8b1ad34100f18edcd9a81c22ff7cabf9 *man/nino.Rd 32d4b5b2e3866dddb511432a5fa82082 *man/plotOHLC.Rd 28de929d9cd77e7668189e1d566ee781 *man/po.test.Rd 085dbd437c66034802b1950a62353a4b *man/portfolio.optim.Rd 069ec663f7f2bb9ca51b230efff6783f *man/pp.test.Rd 63abbd22859186fe414d4925b07c1f8a *man/quadmap.Rd 45d3e3dba09d59ab456af5ce708cd22d *man/read.matrix.Rd 9e68273b8bf81cd21281578dcd2f4c1f *man/read.ts.Rd 5fbfb899c5ddc2ec5a63a0d141847033 *man/runs.test.Rd d09cb5b1d2393a7c4322fbbcac08a4ab *man/seqplot.ts.Rd bfcc917c778c5e7bc20ccd55bef1b2b7 *man/sharpe.Rd 0f0985c9193c6a1abc7d0a95c84fab3b *man/sterling.Rd f68c9086587b1ef305dabcf0b049c927 *man/summary.arma.Rd 6dab9c77bde3ff53df7ce05d93a5f2c3 *man/summary.garch.Rd a3c2485d54c24048dafc807b29a8c2d9 *man/surrogate.Rd b93b5cfd0a64d0df9985e72a41bcdf64 *man/tcm.Rd dffcc13ff6f7ad05696b9847e359a993 *man/tcmd.Rd 88f871f36b018e81fc9cc27e51d6c34b *man/terasvirta.test.Rd a63fd0e0e404b1a196f9de52221659a2 *man/tsbootstrap.Rd 6b89e394a1b8f1d0aedd0ce325dcf28e *man/white.test.Rd 2fa4c7011c2bc0f7449ae151d5cc44ae *src/Makevars 3b89f280404ab59ecff6d2e36d8e68a4 *src/arma.c 6f5325ce1373b88a04cf55bc9c5854c4 *src/bdstest.c 8dbd6e977d226eac7f7e18ff39ef47d8 *src/boot.c 996e3e3f932209858e83681bdd14bfd9 *src/cfuncs.f90 ca68c9c583eaabd708417b4cd04cf2fe *src/dsumsl.f fcc7996d15fcd1b9c215fdbc3868444c *src/formats.c c9e04ab34ac308889d0509eab8718ca3 *src/garch.c 728b829670d1b3f59d710e6715034966 *src/init.c 49cd32e3a939bf03635388adff3918a7 *src/ppsum.c 82c18ab81d94bec813d53d52819e6f44 *src/tsutils.c tseries/R/0000755000175100001440000000000014534030057012150 5ustar hornikuserstseries/R/tsutils.R0000644000175100001440000002617013041164116014004 0ustar hornikusers## Copyright (C) 1997-2001 Adrian Trapletti ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## A copy of the GNU General Public License is available via WWW at ## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by ## writing to the Free Software Foundation, Inc., 59 Temple Place, ## Suite 330, Boston, MA 02111-1307 USA. ## ## Various time series related routines ## read.ts <- function(file, header = FALSE, sep = "", skip = 0, ...) { x <- read.matrix(file, header = header, sep = sep, skip = skip) x <- ts(x, ...) return(x) } fftsurr <- function(x) { ## This is algorithm 1, p. 183 from "Theiler et al. (1992): Using ## Surrogate Data to Detect Nonlinearity in Time Series, in ## Nonlinear Modelling and Forecasting, Editors Casdagli & Eubank, ## Santa Fe Institute, Addison Wesley". Note that Step 7. and 8. are ## only for t = 2,...,N. z <- fft(x) zz <- z*exp(1i*runif(z, max=2*pi)) re <- Re(zz[2:length(zz)]+zz[length(zz):2])/2 im <- Im(zz[2:length(zz)]-zz[length(zz):2])/2 zzz1 <- Re(zz[1]+zz[1])/2+1i*Im(zz[1]-zz[1])/2 zzz <- c(zzz1,re+1i*im) return(Re(fft(zzz, inverse=TRUE))) } ampsurr <- function(x) { ## This is algorithm 2, pp. 183, 184 from "Theiler et al. (1992): ## Using Surrogate Data to Detect Nonlinearity in Time Series, in ## Nonlinear Modelling and Forecasting, Editors Casdagli & Eubank, ## Santa Fe Institute, Addison Wesley". sx <- sort(x) rx <- rank(x) g <- rnorm(x) sg <- sort(g) y <- sg[rx] yy <- fftsurr(y) ryy <- rank(yy) return(sx[ryy]) } surrogate <- function(x, ns = 1, fft = FALSE, amplitude = FALSE, statistic = NULL, ...) { call <- match.call() if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(ns < 1) stop("ns is not positive") n <- length(x) if(is.null(statistic)) { ists <- is.ts(x) if(ists) xtsp <- tsp(x) surrogate <- matrix(x, nrow=n, ncol=ns) if(fft) { if(amplitude) surrogate <- apply(surrogate, 2, ampsurr) else surrogate <- apply(surrogate, 2, fftsurr) } else surrogate <- apply(surrogate, 2, sample, replace = FALSE) if(ists) { attr(surrogate, "tsp") <- xtsp attr(surrogate, "class") <- "ts" } return(drop(surrogate)) } else { orig.statistic <- statistic(x, ...) l.stat <- length(orig.statistic) names(orig.statistic) <- paste("t", 1:l.stat, sep="") stat <- matrix(0, ns, l.stat) if(fft) { if(amplitude) for(i in 1:ns) stat[i,] <- statistic(ampsurr(x), ...) else for(i in 1:ns) stat[i,] <- statistic(fftsurr(x), ...) } else for(i in 1:ns) stat[i,] <- statistic(sample(x, replace=FALSE), ...) colnames(stat) <- names(orig.statistic) bias <- colMeans(stat) - orig.statistic se <- apply(stat, 2, sd) res <- list(statistic = drop(stat), orig.statistic = drop(orig.statistic), bias = drop(bias), se = drop(se), call = call) attr(res, "class") <- "resample.statistic" return(res) } } quadmap <- function(xi = 0.2, a = 4.0, n = 1000) { if(n < 1) stop("n is not positive") if((xi < 0) || (xi > 1)) stop("xi is not in [0,1]") if((a < 0) || (a > 4)) stop("a is not in [0,4]") x <- double(n) res <- .C(tseries_quad_map, x = as.vector(x), as.double(xi), as.double(a), as.integer(n)) return(ts(res$x)) } read.matrix <- function(file, header = FALSE, sep = "", skip = 0) { row.lens <- count.fields(file, sep = sep, skip = skip) if(any(row.lens != row.lens[1])) stop("number of columns is not constant") if(header) { nrows <- length(row.lens) - 1 ncols <- row.lens[2] col.names <- scan(file, what = "", sep = sep, nlines = 1, quiet = TRUE, skip = skip) x <- scan(file, sep = sep, skip = skip + 1, quiet = TRUE) } else { nrows <- length(row.lens) ncols <- row.lens[1] x <- scan(file, sep = sep, skip = skip, quiet = TRUE) col.names <- NULL } x <- as.double(x) if(ncols > 1) { dim(x) <- c(ncols,nrows) x <- t(x) colnames(x) <- col.names } else if(ncols == 1) x <- as.vector(x) else stop("wrong number of columns") return(x) } na.remove <- function(object, ...) UseMethod("na.remove") na.remove.ts <- function(object, ...) { x <- object # generic/method if(!is.ts(x)) stop("method is only for time series") if(any(is.na(x))) { y <- na.remove.default(x) ok <- seq(1,NROW(x))[-attr(y,"na.removed")] xfreq <- frequency(x) start <- tsp(x)[1]+(ok[1]-1)/xfreq end <- tsp(x)[1]+(ok[length(ok)]-1)/xfreq yfreq <- (NROW(y)-1)/(end-start) attr(y, "tsp") <- c(start,end,yfreq) attr(y, "class") <- attr(x, "class") return(y) } else return(x) } na.remove.default <- function(object, ...) { x <- object # generic/method if(any(is.na(x))) { if(is.matrix(x)) { nas <- apply(is.na(x),1,any) y <- matrix(as.vector(x)[rep(!nas,ncol(x))],ncol=ncol(x)) dimnames(y) <- dimnames(x) nas <- which(nas) } else { nas <- which(is.na(x)) y <- x[-nas] } attr(y, "na.removed") <- nas return(y) } else return(x) } seqplot.ts <- function(x, y, colx = "black", coly = "red", typex = "l", typey = "l", pchx = 1, pchy = 1, ltyx = "solid", ltyy = "solid", oma = c(6, 0, 5, 0), ann = par("ann"), xlab = "Time", ylab = deparse(substitute(x)), main = NULL) { if(!is.ts(x) || !is.ts(y)) stop("x or y is not a time series") if(abs(frequency(x)-frequency(y)) > getOption("ts.eps")) stop("x and y do not have the same frequency") nser <- NCOL(x) nsery <- NCOL(y) if(nser != nsery) stop("x and y do not have consistent dimensions") if(nser == 1) { xlim <- range(time(x), time(y)) ylim <- range(x[is.finite(x)], y[is.finite(y)]) plot(x, xlim = xlim, ylim = ylim, col = colx, type = typex, pch = pchx, lty = ltyx, xlab = "", ylab = ylab) points(y, col = coly, type = typey, pch = pchy, lty = ltyy) if(ann) { mtext(xlab, 1, 3) if(!is.null(main)) title(main) } } else { if(nser > 10) stop("cannot plot more than 10 series") if(is.null(main)) main <- deparse(substitute(x)) nm <- colnames(x) if(is.null(nm)) nm <- paste("Series", 1:nser) nc <- if(nser > 4) 2 else 1 oldpar <- par("mar", "oma", "mfcol") on.exit(par(oldpar)) par(mar = c(0, 5.1, 0, 2.1), oma = oma) nr <- ceiling(nser %/% nc) par(mfcol = c(nr, nc)) for(i in 1:nser) { xlim <- range(time(x[,i]), time(y[,i])) ylim <- range(x[is.finite(x[,i]),i], y[is.finite(y[,i]),i]) plot(x[,i], xlim = xlim, ylim = ylim, col = colx, type = typex, pch = pchx, lty = ltyx, axes = FALSE, xlab = "", ylab = "") points(y[,i], col = coly, type = typey, pch = pchy, lty = ltyy) box() axis(2, xpd = NA) mtext(nm[i], 2, 3) if((i%%nr==0) || (i==nser)) axis(1, xpd = NA) } if(ann) { mtext(xlab, 1, 3) if(!is.null(main)) { par(mfcol = c(1,1)) mtext(main, 3, 3, cex=par("cex.main"), font=par("font.main"), col=par("col.main")) } } } invisible() } boot.sample <- function(x, b, type) { return(.C(tseries_boot, as.vector(x, mode = "double"), x = as.vector(x, mode = "double"), as.integer(length(x)), as.double(b), as.integer(type))$x) } tsbootstrap <- function(x, nb = 1, statistic = NULL, m = 1, b = NULL, type = c("stationary","block"), ...) { call <- match.call() type <- match.arg(type) if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(nb < 1) stop("nb is not positive") n <- NROW(x) if (n <= m) stop("x should contain more than m observations") const <- 3.15 if(type == "stationary") { type <- 0 if(is.null(b)) b <- const*n^(1/3) b <- 1/b if((b <= 1/n) || (b >= 1)) stop(paste("b should be in (1,length(x))", "for the stationary bootstrap")) } else { type <- 1 if(is.null(b)) b <- const*n^(1/3) if((b < 1) || (b > n)) stop(paste("b should be in [1,length(x)]", "for the blockwise bootstrap")) } if(is.null(statistic)) { if (m > 1) stop("can only return bootstrap data for m = 1") ists <- is.ts(x) if(ists) xtsp <- tsp(x) boot <- matrix(x, nrow=n, ncol=nb) boot <- apply(boot, 2, boot.sample, b, type) if(ists) { attr(boot, "tsp") <- xtsp attr(boot, "class") <- "ts" } return(drop(boot)) } else { y <- embed(x, m) yi <- 1:NROW(y) orig.statistic <- statistic(drop(y), ...) l.stat <- length(orig.statistic) names(orig.statistic) <- paste("t", 1:l.stat, sep="") stat <- matrix(0, nb, l.stat) for(i in 1:nb) stat[i,] <- statistic(y[boot.sample(yi, b, type), , drop=TRUE], ...) colnames(stat) <- names(orig.statistic) bias <- colMeans(stat) - orig.statistic se <- apply(stat, 2, sd) res <- list(statistic = drop(stat), orig.statistic = drop(orig.statistic), bias = drop(bias), se = drop(se), call = call) attr(res, "class") <- "resample.statistic" return(res) } } print.resample.statistic <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:", deparse(x$call), "", sep = "\n") nam <- c("original", "bias", "std. error") stat <- cbind(x$orig.statistic, x$bias, x$se) colnames(stat) <- nam cat("Resampled Statistic(s):\n") print(drop(stat), digits = digits, ...) cat("\n") invisible(x) } tseries/R/irts.R0000644000175100001440000002224611620162572013263 0ustar hornikusers## Copyright (C) 1997-2003 Adrian Trapletti ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## A copy of the GNU General Public License is available via WWW at ## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by ## writing to the Free Software Foundation, Inc., 59 Temple Place, ## Suite 330, Boston, MA 02111-1307 USA. ## ## Irregular time series objects ## value <- function (x, ...) UseMethod ("value") irts <- function(time, value) { if(inherits(time, "POSIXct")) { time <- as.numeric(time) } if(!is.vector(time)) stop("time is not a vector") if(!is.vector(value) && !is.matrix(value)) stop("value is not a vector and not a matrix") if(length(time) != NROW(value)) stop("time and value have not the same number of rows") class(time) <- c("POSIXt", "POSIXct") irts <- list(time = time, value = value) class(irts) <- "irts" return(irts) } is.irts <- function(object) { return(inherits(object, "irts")) } as.irts <- function(object) UseMethod("as.irts") as.irts.default <- function(object) { return(irts(object[,1], object[,-1])) } as.irts.zoo <- function(object, ...) { index <- attr(object, "index") stopifnot(inherits(index, "POSIXct")) attr(object, "index") <- NULL irts(index, unclass(object)) } value.irts <- function(x, ...) { if(!inherits(x, "irts")) stop("method is only for irts objects") return(x$value) } time.irts <- function(x, ...) { if(!inherits(x, "irts")) stop("method is only for irts objects") return(x$time) } print.irts <- function(x, format = "%Y-%m-%d %H:%M:%S", tz = "GMT", usetz = TRUE, format.value = NULL, ...) { if(!inherits(x, "irts")) stop("method is only for irts objects") n <- length(x$time) for(i in 1:n) { cat(format(x$time[i], format = format, tz = tz, usetz = usetz)) cat(" ") if(is.vector(x$value)) cat(formatC(x$value[i], format = format.value, ...)) else cat(formatC(x$value[i,], format = format.value, ...)) cat("\n") } invisible(x) } read.irts <- function(file, format = "%Y-%m-%d %H:%M:%S", tz = "GMT", ...) { seqN <- function(from, to) { if((0 == length(from)) || (0 == length(to))) NULL else if(to-from+1 <= 0) NULL else seq(from, to) } data <- read.table(file, as.is = TRUE, ...) n <- length(unlist(strsplit(format, split = " "))) tmp <- data[,1] j <- 2 while(j <= n) { tmp <- paste(tmp, data[,j]) j <- j+1 } time <- as.numeric(as.POSIXct(strptime(tmp, format = format), tz = tz)) value <- as.matrix(data[,-seqN(1, n)]) return(irts(time, value[,,drop = TRUE])) } write.irts <- function(object, file = "", append = FALSE, quote = FALSE, sep = " ", eol = "\n", na = "NA", dec = ".", row.names = FALSE, col.names = FALSE, qmethod = "escape", format = "%Y-%m-%d %H:%M:%S", tz = "GMT", usetz = FALSE, format.value = NULL, ...) { dataframe <- data.frame(time = format(object$time, format = format, tz = tz, usetz = usetz), value = formatC(object$value, format = format.value, ...)) write.table(dataframe, file = file, append = append, quote = quote, sep = sep, eol = eol, na = na, dec = dec, row.names = row.names, col.names = col.names, qmethod = qmethod) invisible(object) } weekday <- function(object, tz = "GMT") { if(!inherits(object, "irts")) stop("function is only for irts objects") return(as.POSIXlt(object$time, tz = tz)$wday) } daysecond <- function(object, tz = "GMT") { if(!inherits(object, "irts")) stop("function is only for irts objects") hour <- as.POSIXlt(object$time, tz = tz)$hour min <- as.POSIXlt(object$time, tz = tz)$min sec <- as.POSIXlt(object$time, tz = tz)$sec return(3600*hour+60*min+sec) } is.businessday <- function(object, tz = "GMT") { if(!inherits(object, "irts")) stop("function is only for irts objects") wday <- as.POSIXlt(object$time, tz = tz)$wday return((0 < wday) & (wday < 6)) } is.weekend <- function(object, tz = "GMT") { if(!inherits(object, "irts")) stop("function is only for irts objects") wday <- as.POSIXlt(object$time, tz = tz)$wday return((0 == wday) | (wday == 6)) } "[.irts" <- function(x, i, j, ...) { if(!inherits(x, "irts")) stop("method is only for irts objects") if(is.vector(x$value)) { if(nargs() > 2) { stop("incorrect number of dimensions") } if(missing(i)) { return(x) } else { return(irts(as.numeric(x$time)[i], x$value[i])) } } else { if(missing(i)) { if(missing(j)) { return(x) } else { return(irts(as.numeric(x$time), x$value[,j,drop = FALSE])) } } else { if(missing(j)) { return(irts(as.numeric(x$time)[i], x$value[i,,drop = FALSE])) } else { return(irts(as.numeric(x$time)[i], x$value[i,j,drop = FALSE])) } } } } approx.irts <- function(object, time, ...) { if(!inherits(object, "irts")) stop("function is only for irts objects") if(!inherits(time, "POSIXct")) stop("time is not of class POSIXct") ovalue <- as.matrix(object$value) otime <- as.numeric(object$time) time <- as.numeric(time) value <- matrix(0, NROW(time), NCOL(ovalue)) for(i in 1:NCOL(ovalue)) { result <- approx(otime, ovalue[,i,drop = TRUE], time, ...) value[,i] <- result$y } return(irts(time, value[,,drop = TRUE])) } plot.irts <- function(x, type = "l", plot.type = c("multiple", "single"), xlab = "Time", ylab = NULL, main = NULL, ylim = NULL, oma = c(6, 0, 5, 0), ...) { seqN <- function(from, to) { if((0 == length(from)) || (0 == length(to))) NULL else if(to-from+1 <= 0) NULL else seq(from, to) } addmain <- function(main, cex.main = par("cex.main"), font.main = par("font.main"), col.main = par("col.main"), ...) { mtext(main, 3, 3, cex = cex.main, font = font.main, col = col.main, ...) } if(!inherits(x, "irts")) stop("method is only for irts objects") t <- time(x) v <- value(x) nser <- NCOL(v) if(is.null(main)) main <- deparse(substitute(x)) if(nser == 1) { if(is.null(ylab)) ylab <- "Series" if(is.null(ylim)) ylim <- range(v[is.finite(v)]) plot(t, v, type = type, xlab = xlab, ylab = ylab, main = main, ylim = ylim, ...) } else if(nser <= 10) { plot.type <- match.arg(plot.type) if(is.null(ylab)) { ylab <- colnames(v) if(is.null(ylab)) ylab <- paste("Series", 1:nser) } if(plot.type == "single") { if(is.null(ylim)) ylim <- range(v[is.finite(v)]) plot.default(t, v[,1], type = type, xlab = xlab, ylab = ylab, main = main, ylim = ylim, xaxt = "n", ...) for(i in seqN(2, nser)) { points(t, v[,i], type = type, xaxt = "n") } axis.POSIXct(1, t) } else if(plot.type == "multiple") { oldpar <- par("mar", "oma", "mfcol") on.exit(par(oldpar)) par(mar = c(0, 5.1, 0, 2.1), oma = oma) nc <- if(nser > 4) 2 else 1 nr <- ceiling(nser/nc) par(mfcol = c(nr, nc)) for(i in seqN(1, nser)) { plot.default(t, v[,i], type = type, xlab = xlab, ylab = "", xaxt = "n", ...) mtext(ylab[i], 2, 3) if((i%%nr == 0) || (i == nser)) axis.POSIXct(1, t) } if(!is.null(main)) { par(mfcol = c(1, 1)) addmain(main, ...) } } } else { stop("cannot plot more than 10 series") } invisible(x) } lines.irts <- function(x, type = "l", ...) { if(!inherits(x, "irts")) stop("method is only for irts objects") t <- time(x) v <- value(x) nser <- NCOL(v) if(nser == 1) { lines(t, v, type = type, ...) } else { stop("cannot plot multivariate irregular time-series object") } invisible(x) } points.irts <- function(x, type = "p", ...) { if(!inherits(x, "irts")) stop("method is only for irts objects") t <- time(x) v <- value(x) nser <- NCOL(v) if(nser == 1) { points(t, v, type = type, ...) } else { stop("cannot plot multivariate irregular time-series object") } invisible(x) } tseries/R/zzz.R0000644000175100001440000000154111620676311013133 0ustar hornikusers.onAttach <- function(libname, pkgname) { mylib <- dirname(system.file(package = "tseries")) ver <- packageDescription("tseries", lib.loc = mylib)["Version"] txt <- c("\n", paste(sQuote("tseries"), "version:", ver), "\n", paste(sQuote("tseries"), "is a package for time series analysis", "and computational finance."), "\n", paste("See", sQuote("library(help=\"tseries\")"), "for details."), "\n") if(interactive() || getOption("verbose")) packageStartupMessage(paste(strwrap(txt, indent = 4, exdent = 4), collapse = "\n")) } tseries/R/finance.R0000644000175100001440000002056714220267402013706 0ustar hornikusers## Copyright (C) 1997-2003 Adrian Trapletti ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## A copy of the GNU General Public License is available via WWW at ## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by ## writing to the Free Software Foundation, Inc., 59 Temple Place, ## Suite 330, Boston, MA 02111-1307 USA. ## ## Financial time series analysis ## portfolio.optim <- function (x, ...) UseMethod ("portfolio.optim") portfolio.optim.ts <- function (x, ...) { if(!is.ts(x)) stop("method is only for time series") if(NCOL(x) == 1) stop("x is not a multivariate time series") res <- portfolio.optim.default(as.matrix(x), ...) res$px <- ts(res$px, start = start(x), frequency = frequency(x)) return(res) } portfolio.optim.default <- function(x, pm = mean(x), riskless = FALSE, shorts = FALSE, rf = 0.0, reslow = NULL, reshigh = NULL, covmat = cov(x), ...) { if(NCOL(x) == 1) stop("x is not a matrix") if(any(is.na(x))) stop("NAs in x") k <- dim(x)[2] if(!is.matrix(covmat)) { stop("covmat is not a matrix") } if((dim(covmat)[1] !=k) || (dim(covmat)[2] !=k)) { stop("covmat has not the right dimension") } Dmat <- covmat dvec <- rep.int(0, k) big <- 1e+100 if(!is.null(reslow) && is.null(reshigh)) { reshigh <- rep.int(big, k) } if(is.null(reslow) && !is.null(reshigh)) { reslow <- -rep.int(big, k) } if(!is.null(reslow)) { if(!is.vector(reslow)) { stop("reslow is not a vector") } if(length(reslow) != k) { stop("reslow has not the right dimension") } } if(!is.null(reshigh)) { if(!is.vector(reshigh)) { stop("reshigh is not a vector") } if(length(reshigh) != k) { stop("reshigh has not the right dimension") } } if(riskless) { a1 <- colMeans(x) - rf if(shorts) { a2 <- NULL b2 <- NULL } else { a2 <- matrix(0, k, k) diag(a2) <- 1 b2 <- rep.int(0, k) } if(!is.null(reslow) && !is.null(reshigh)) { a3 <- matrix(0, k, k) diag(a3) <- 1 Amat <- t(rbind(a1, a2, a3, -a3)) b0 <- c(pm-rf, b2, reslow, -reshigh) } else { Amat <- t(rbind(a1, a2)) b0 <- c(pm-rf, b2) } res <- solve.QP(Dmat, dvec, Amat, bvec=b0, meq=1) } else { a1 <- rep.int(1, k) a2 <- colMeans(x) if(shorts) { if(!is.null(reslow) && !is.null(reshigh)) { a3 <- matrix(0, k, k) diag(a3) <- 1 Amat <- t(rbind(a1, a2, a3, -a3)) b0 <- c(1, pm, reslow, -reshigh) } else { Amat <- t(rbind(a1, a2)) b0 <- c(1, pm) } } else { a3 <- matrix(0, k, k) diag(a3) <- 1 b3 <- rep.int(0, k) if(!is.null(reslow) && !is.null(reshigh)) { Amat <- t(rbind(a1, a2, a3, a3, -a3)) b0 <- c(1, pm, b3, reslow, -reshigh) } else { Amat <- t(rbind(a1, a2, a3)) b0 <- c(1, pm, b3) } } res <- solve.QP(Dmat, dvec, Amat, bvec=b0, meq=2) } y <- c(tcrossprod(res$solution, x)) ans <- list(pw = res$solution, px = y, pm = mean(y), ps = sd(y)) return(ans) } get.hist.quote <- function(instrument = "^gdax", start, end, quote = c("Open", "High", "Low", "Close"), provider = c("yahoo"), method = NULL, origin = "1899-12-30", compression = "d", retclass = c("zoo", "ts"), quiet = FALSE, drop = FALSE) { if(missing(start)) start <- "1991-01-02" if(missing(end)) end <- format(Sys.Date() - 1, "%Y-%m-%d") provider <- match.arg(provider) retclass <- match.arg(retclass) periodicity <- match.arg(compression, c("daily", "weekly", "monthly")) ## Be nice. ind <- pmatch(quote, "AdjClose", nomatch = 0L) quote[ind] <- "Adjusted" start <- as.Date(start) end <- as.Date(end) x <- getSymbols(instrument, src = "yahoo", from = start, to = end, return.class = "zoo", periodicity = periodicity, auto.assign = FALSE) colnames(x) <- sub(".*\\.", "", colnames(x)) nser <- pmatch(quote, colnames(x)) if(any(is.na(nser))) stop("this quote is not available") if(any(i <- duplicated(time(x)))) x <- x[!i, , drop = FALSE] n <- nrow(x) dat <- index(x) if(!quiet && (dat[1] != start)) cat(format(dat[1], "time series starts %Y-%m-%d\n")) if(!quiet && (dat[n] != end)) cat(format(dat[n], "time series ends %Y-%m-%d\n")) if(retclass == "ts") { jdat <- unclass(julian(dat, origin = as.Date(origin))) ## We need unclass() because 1.7.0 does not allow adding a ## number to a "difftime" object. ind <- jdat - jdat[1] + 1 y <- matrix(NA, nrow = max(ind), ncol = length(nser)) y[ind, ] <- as.matrix(x[, nser, drop = FALSE]) colnames(y) <- colnames(x)[nser] y <- y[, seq_along(nser), drop = drop] return(ts(y, start = jdat[1], end = jdat[n])) } else { x[ , nser, drop = drop] } } maxdrawdown <- function(x) { if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") cmaxx <- cummax(x)-x mdd <- max(cmaxx) to <- which(mdd == cmaxx) from <- double(NROW(to)) for (i in 1:NROW(to)) from[i] <- max(which(cmaxx[1:to[i]] == 0)) return(list(maxdrawdown = mdd, from = from, to = to)) } sharpe <- function(x, r = 0, scale = sqrt(250)) { if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(NROW(x) == 1) return(NA) else { y <- diff(x) return(scale * (mean(y)-r)/sd(y)) } } sterling <- function(x) { if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(NROW(x) == 1) return(NA) else { return((x[NROW(x)]-x[1]) / maxdrawdown(x)$maxdrawdown) } } plotOHLC <- function(x, xlim = NULL, ylim = NULL, xlab = "Time", ylab, col = par("col"), bg = par("bg"), axes = TRUE, frame.plot = axes, ann = par("ann"), main = NULL, date = c("calendar", "julian"), format = "%Y-%m-%d", origin = "1899-12-30", ...) { if ((!is.mts(x)) || (colnames(x)[1] != "Open") || (colnames(x)[2] != "High") || (colnames(x)[3] != "Low") || (colnames(x)[4] != "Close")) stop("x is not a open/high/low/close time series") xlabel <- if (!missing(x)) deparse(substitute(x)) else NULL if (missing(ylab)) ylab <- xlabel date <- match.arg(date) time.x <- time(x) dt <- min(lag(time.x)-time.x)/3 if (is.null(xlim)) xlim <- range(time.x) if (is.null(ylim)) ylim <- range(x[is.finite(x)]) plot.new() plot.window(xlim, ylim, ...) segments(time.x, x[, "High"], time.x, x[, "Low"], col = col[1], bg = bg) segments(time.x - dt, x[, "Open"], time.x, x[, "Open"], col = col[1], bg = bg) segments(time.x, x[, "Close"], time.x + dt, x[, "Close"], col = col[1], bg = bg) if (ann) title(main = main, xlab = xlab, ylab = ylab, ...) if (axes) { if (date == "julian") { axis(1, ...) axis(2, ...) } else { n <- NROW(x) lab.ind <- round(seq(1, n, length.out = 5)) D <- as.vector(time.x[lab.ind]*86400) + as.POSIXct(origin, tz = "GMT") DD <- format.POSIXct(D, format = format, tz ="GMT") axis(1, at=time.x[lab.ind], labels=DD, ...) axis(2, ...) } } if (frame.plot) box(...) } tseries/R/test.R0000644000175100001440000006360314534030057013262 0ustar hornikusers## Copyright (C) 1997-2002 Adrian Trapletti ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## A copy of the GNU General Public License is available via WWW at ## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by ## writing to the Free Software Foundation, Inc., 59 Temple Place, ## Suite 330, Boston, MA 02111-1307 USA. ## ## Mostly time series tests ## runs.test <- function (x, alternative = c("two.sided", "less", "greater")) { if(!is.factor(x)) stop("x is not a factor") if(any(is.na(x))) stop("NAs in x") if(length(levels(x)) != 2) stop("x does not contain dichotomous data") alternative <- match.arg(alternative) DNAME <- deparse(substitute(x)) n <- length(x) R <- 1 + sum(as.numeric(x[-1] != x[-n])) n1 <- sum(levels(x)[1] == x) n2 <- sum(levels(x)[2] == x) m <- 1 + 2*n1*n2 / (n1+n2) s <- sqrt(2*n1*n2 * (2*n1*n2 - n1 - n2) / ((n1+n2)^2 * (n1+n2-1))) STATISTIC <- (R - m) / s METHOD <- "Runs Test" if(alternative == "two.sided") PVAL <- 2 * pnorm(-abs(STATISTIC)) else if(alternative == "less") PVAL <- pnorm(STATISTIC) else if(alternative == "greater") PVAL <- pnorm(STATISTIC, lower.tail = FALSE) else stop("irregular alternative") names(STATISTIC) <- "Standard Normal" structure(list(statistic = STATISTIC, alternative = alternative, p.value = PVAL, method = METHOD, data.name = DNAME), class = "htest") } bds.test <- function(x, m = 3, eps = seq(0.5*sd(x),2*sd(x),length.out=4), trace = FALSE) { if((NCOL(x) > 1) || is.data.frame(x)) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(m < 2) stop("m is less than 2") if(length(eps) == 0) stop("invalid eps") if(any(eps <= 0)) stop("invalid eps") DNAME <- deparse(substitute(x)) n <- length(x) k <- length(eps) cc <- double(m+1) cstan <- double(m+1) STATISTIC <- matrix(0,m-1,k) for(i in (1:k)) { res <- .C(tseries_bdstest_main, as.integer(n), as.integer(m), as.vector(x, mode="double"), as.vector(cc), cstan = as.vector(cstan), as.double(eps[i]), as.integer(trace)) STATISTIC[,i] <- res$cstan[2:m+1] } colnames(STATISTIC) <- eps rownames(STATISTIC) <- 2:m PVAL <- 2 * pnorm(-abs(STATISTIC)) colnames(PVAL) <- eps rownames(PVAL) <- 2:m METHOD <- "BDS Test" PARAMETER <- list(m = 2:m, eps = eps) structure(list(statistic = STATISTIC, p.value = PVAL, method = METHOD, data.name = DNAME, parameter = PARAMETER), class = "bdstest") } print.bdstest <- function(x, digits = 4, ...) { if(!inherits(x, "bdstest")) stop("method is only for bdstest objects") cat("\n\t", x$method, "\n\n") cat("data: ", x$data.name, "\n\n") if(!is.null(x$parameter)) { cat("Embedding dimension = ", format(round(x$parameter$m, digits)), sep = " ", "\n\n") cat("Epsilon for close points = ", format(round(x$parameter$eps, digits)), sep = " ", "\n\n") } if(!is.null(x$statistic)) { colnames(x$statistic) <- round(as.numeric(colnames(x$statistic)), digits) colnames(x$statistic) <- paste("[",colnames(x$statistic),"]") rownames(x$statistic) <- round(as.numeric(rownames(x$statistic)), digits) rownames(x$statistic) <- paste("[",rownames(x$statistic),"]") cat("Standard Normal = \n") print(round(x$statistic, digits)) cat("\n") } if(!is.null(x$p.value)) { colnames(x$p.value) <- round(as.numeric(colnames(x$p.value)), digits) colnames(x$p.value) <- paste("[",colnames(x$p.value),"]") rownames(x$p.value) <- round(as.numeric(rownames(x$p.value)), digits) rownames(x$p.value) <- paste("[",rownames(x$p.value),"]") cat("p-value = \n") print(round(x$p.value, digits)) cat("\n") } cat("\n") invisible(x) } adf.test <- function(x, alternative = c("stationary", "explosive"), k = trunc((length(x)-1)^(1/3))) { if((NCOL(x) > 1) || is.data.frame(x)) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(k < 0) stop("k negative") alternative <- match.arg(alternative) DNAME <- deparse(substitute(x)) k <- k+1 x <- as.vector(x, mode="double") y <- diff(x) n <- length(y) z <- embed(y, k) yt <- z[,1] xt1 <- x[k:n] tt <- k:n if(k > 1) { yt1 <- z[,2:k] res <- lm(yt ~ xt1 + 1 + tt + yt1) } else res <- lm(yt ~ xt1 + 1 + tt) res.sum <- summary(res) STAT <- res.sum$coefficients[2,1] / res.sum$coefficients[2,2] table <- cbind(c(4.38, 4.15, 4.04, 3.99, 3.98, 3.96), c(3.95, 3.80, 3.73, 3.69, 3.68, 3.66), c(3.60, 3.50, 3.45, 3.43, 3.42, 3.41), c(3.24, 3.18, 3.15, 3.13, 3.13, 3.12), c(1.14, 1.19, 1.22, 1.23, 1.24, 1.25), c(0.80, 0.87, 0.90, 0.92, 0.93, 0.94), c(0.50, 0.58, 0.62, 0.64, 0.65, 0.66), c(0.15, 0.24, 0.28, 0.31, 0.32, 0.33)) table <- -table tablen <- dim(table)[2] tableT <- c(25, 50, 100, 250, 500, 100000) tablep <- c(0.01, 0.025, 0.05, 0.10, 0.90, 0.95, 0.975, 0.99) tableipl <- numeric(tablen) for(i in (1:tablen)) tableipl[i] <- approx(tableT, table[, i], n, rule=2)$y interpol <- approx(tableipl, tablep, STAT, rule=2)$y if(!is.na(STAT) && is.na(approx(tableipl, tablep, STAT, rule=1)$y)) if(interpol == min(tablep)) warning("p-value smaller than printed p-value") else warning("p-value greater than printed p-value") if(alternative == "stationary") PVAL <- interpol else if(alternative == "explosive") PVAL <- 1 - interpol else stop("irregular alternative") PARAMETER <- k-1 METHOD <- "Augmented Dickey-Fuller Test" names(STAT) <- "Dickey-Fuller" names(PARAMETER) <- "Lag order" structure(list(statistic = STAT, parameter = PARAMETER, alternative = alternative, p.value = PVAL, method = METHOD, data.name = DNAME), class = "htest") } white.test <- function(x, ...) UseMethod("white.test") white.test.default <- function(x, y, qstar = 2, q = 10, range = 4, type = c("Chisq","F"), scale = TRUE, ...) { DNAME <- paste(deparse(substitute(x)), "and", deparse(substitute(y))) x <- as.matrix(x) y <- as.matrix(y) if(any(is.na(x))) stop("NAs in x") if(any(is.na(y))) stop("NAs in y") nin <- dim(x)[2] t <- dim(x)[1] if(dim(x)[1] != dim(y)[1]) stop("number of rows of x and y must match") if(dim(x)[1] <= 0) stop("no observations in x and y") if(dim(y)[2] > 1) stop("handles only univariate outputs") if(!missing(type) && !is.na(pmatch(type, "chisq"))) { warning(paste("value 'chisq' for 'type' is deprecated,", "use 'Chisq' instead")) type <- "Chisq" } else type <- match.arg(type) if(scale) { x <- scale(x) y <- scale(y) } xnam <- paste("x[,", 1:nin, "]", sep="") fmla <- as.formula(paste("y~",paste(xnam,collapse= "+"))) rr <- lm(fmla) u <- residuals(rr) ssr0 <- sum(u^2) max <- range/2 gamma <- matrix(runif((nin+1)*q,-max,max),nin+1,q) phantom <- (1+exp(-(cbind(rep.int(1,t),x)%*%gamma)))^(-1) phantomstar <- as.matrix(prcomp(phantom,scale.=TRUE)$x[,2:(qstar+1)]) xnam2 <- paste("phantomstar[,", 1:qstar, "]", sep="") xnam2 <- paste(xnam2,collapse="+") fmla <- as.formula(paste("u~",paste(paste(xnam,collapse= "+"), xnam2,sep="+"))) rr <- lm(fmla) v <- residuals(rr) ssr <- sum(v^2) if(type == "Chisq") { STAT <- t*log(ssr0/ssr) PVAL <- 1-pchisq(STAT,qstar) PARAMETER <- qstar names(STAT) <- "X-squared" names(PARAMETER) <- "df" } else if(type == "F") { STAT <- ((ssr0-ssr)/qstar)/(ssr/(t-qstar-nin)) PVAL <- 1-pf(STAT,qstar,t-qstar-nin) PARAMETER <- c(qstar,t-qstar-nin) names(STAT) <- "F" names(PARAMETER) <- c("df1","df2") } else stop("invalid type") ARG <- c(qstar,q,range,scale) names(ARG) <- c("qstar","q","range","scale") METHOD <- "White Neural Network Test" structure(list(statistic = STAT, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, arguments = ARG), class = "htest") } white.test.ts <- function(x, lag = 1, qstar = 2, q = 10, range = 4, type = c("Chisq","F"), scale = TRUE, ...) { if(!is.ts(x)) stop("method is only for time series") if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(lag < 1) stop("minimum lag is 1") if(!missing(type) && !is.na(pmatch(type, "chisq"))) { warning(paste("value 'chisq' for 'type' is deprecated,", "use 'Chisq' instead")) type <- "Chisq" } else type <- match.arg(type) DNAME <- deparse(substitute(x)) t <- length(x) if(scale) x <- scale(x) y <- embed(x, lag+1) xnam <- paste("y[,", 2:(lag+1), "]", sep="") fmla <- as.formula(paste("y[,1]~",paste(xnam,collapse= "+"))) rr <- lm(fmla) u <- residuals(rr) ssr0 <- sum(u^2) max <- range/2 gamma <- matrix(runif((lag+1)*q,-max,max),lag+1,q) phantom <- (1+exp(-(cbind(rep.int(1,t-lag),y[,2:(lag+1)])%*%gamma)))^(-1) phantomstar <- as.matrix(prcomp(phantom,scale.=TRUE)$x[,2:(qstar+1)]) xnam2 <- paste("phantomstar[,", 1:qstar, "]", sep="") xnam2 <- paste(xnam2, collapse="+") fmla <- as.formula(paste("u~",paste(paste(xnam,collapse= "+"), xnam2,sep="+"))) rr <- lm(fmla) v <- residuals(rr) ssr <- sum(v^2) if(type == "Chisq") { STAT <- t*log(ssr0/ssr) PVAL <- 1-pchisq(STAT,qstar) PARAMETER <- qstar names(STAT) <- "X-squared" names(PARAMETER) <- "df" } else if(type == "F") { STAT <- ((ssr0-ssr)/qstar)/(ssr/(t-lag-qstar)) PVAL <- 1-pf(STAT,qstar,t-lag-qstar) PARAMETER <- c(qstar,t-lag-qstar) names(STAT) <- "F" names(PARAMETER) <- c("df1","df2") } else stop("invalid type") ARG <- c(lag,qstar,q,range,scale) names(ARG) <- c("lag","qstar","q","range","scale") METHOD <- "White Neural Network Test" structure(list(statistic = STAT, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, arguments = ARG), class = "htest") } terasvirta.test <- function(x, ...) UseMethod("terasvirta.test") terasvirta.test.default <- function(x, y, type = c("Chisq", "F"), scale = TRUE, ...) { DNAME <- paste(deparse(substitute(x)), "and", deparse(substitute(y))) x <- as.matrix(x) y <- as.matrix(y) if(any(is.na(x))) stop("NAs in x") if(any(is.na(y))) stop("NAs in y") nin <- dim(x)[2] if(nin < 1) stop("invalid x") t <- dim(x)[1] if(dim(x)[1] != dim(y)[1]) stop("number of rows of x and y must match") if(dim(x)[1] <= 0) stop("no observations in x and y") if(dim(y)[2] > 1) stop("handles only univariate outputs") if(!missing(type) && !is.na(pmatch(type, "chisq"))) { warning(paste("value 'chisq' for 'type' is deprecated,", "use 'Chisq' instead")) type <- "Chisq" } else type <- match.arg(type) if(scale) { x <- scale(x) y <- scale(y) } xnam <- paste("x[,", 1:nin, "]", sep="") fmla <- as.formula(paste("y~",paste(xnam,collapse= "+"))) rr <- lm(fmla) u <- residuals(rr) ssr0 <- sum(u^2) xnam2 <- NULL m <- 0 for(i in (1:nin)) { for(j in (i:nin)) { xnam2 <- c(xnam2,paste("I(x[,",i,"]*x[,",j,"])",sep="")) m <- m+1 } } xnam2 <- paste(xnam2,collapse="+") xnam3 <- NULL for(i in (1:nin)) { for(j in (i:nin)) { for(k in (j:nin)) { xnam3 <- c(xnam3, paste("I(x[,", i, "]*x[,", j, "]*x[,", k ,"])", sep="")) m <- m+1 } } } xnam3 <- paste(xnam3,collapse="+") fmla <- as.formula(paste("u~",paste(paste(xnam,collapse= "+"), xnam2,xnam3,sep="+"))) rr <- lm(fmla) v <- residuals(rr) ssr <- sum(v^2) if(type == "Chisq") { STAT <- t*log(ssr0/ssr) PVAL <- 1-pchisq(STAT,m) PARAMETER <- m names(STAT) <- "X-squared" names(PARAMETER) <- "df" } else if(type == "F") { STAT <- ((ssr0-ssr)/m)/(ssr/(t-nin-m)) PVAL <- 1-pf(STAT,m,t-nin-m) PARAMETER <- c(m,t-nin-m) names(STAT) <- "F" names(PARAMETER) <- c("df1","df2") } else stop("invalid type") METHOD <- "Teraesvirta Neural Network Test" ARG <- scale names(ARG) <- "scale" structure(list(statistic = STAT, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, arguments = ARG), class = "htest") } terasvirta.test.ts <- function(x, lag = 1, type = c("Chisq", "F"), scale = TRUE, ...) { if(!is.ts(x)) stop("method is only for time series") if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") if(lag < 1) stop("minimum lag is 1") if(!missing(type) && !is.na(pmatch(type, "chisq"))) { warning(paste("value 'chisq' for 'type' is deprecated,", "use 'Chisq' instead")) type <- "Chisq" } else type <- match.arg(type) DNAME <- deparse(substitute(x)) t <- length(x) if(scale) x <- scale(x) y <- embed(x, lag+1) xnam <- paste("y[,", 2:(lag+1), "]", sep="") fmla <- as.formula(paste("y[,1]~",paste(xnam,collapse= "+"))) rr <- lm(fmla) u <- residuals(rr) ssr0 <- sum(u^2) xnam2 <- NULL m <- 0 for(i in (1:lag)) { for(j in (i:lag)) { xnam2 <- c(xnam2,paste("I(y[,",i+1,"]*y[,",j+1,"])",sep="")) m <- m+1 } } xnam2 <- paste(xnam2,collapse="+") xnam3 <- NULL for(i in (1:lag)) { for(j in (i:lag)) { for(k in (j:lag)) { xnam3 <- c(xnam3, paste("I(y[,", i+1, "]*y[,", j+1, "]*y[,", k+1, "])", sep="")) m <- m+1 } } } xnam3 <- paste(xnam3,collapse="+") fmla <- as.formula(paste("u~",paste(paste(xnam,collapse= "+"), xnam2,xnam3,sep="+"))) rr <- lm(fmla) v <- residuals(rr) ssr <- sum(v^2) if(type == "Chisq") { STAT <- t*log(ssr0/ssr) PVAL <- 1-pchisq(STAT,m) PARAMETER <- m names(STAT) <- "X-squared" names(PARAMETER) <- "df" } else if(type == "F") { STAT <- ((ssr0-ssr)/m)/(ssr/(t-lag-m)) PVAL <- 1-pf(STAT,m,t-lag-m) PARAMETER <- c(m,t-lag-m) names(STAT) <- "F" names(PARAMETER) <- c("df1","df2") } else stop("invalid type") METHOD <- "Teraesvirta Neural Network Test" ARG <- c(lag,scale) names(ARG) <- c("lag","scale") structure(list(statistic = STAT, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, arguments = ARG), class = "htest") } jarque.bera.test <- function(x) { if((NCOL(x) > 1) || is.data.frame(x)) stop("x is not a vector or univariate time series") if(any(is.na(x))) stop("NAs in x") DNAME <- deparse(substitute(x)) n <- length(x) m1 <- sum(x)/n m2 <- sum((x-m1)^2)/n m3 <- sum((x-m1)^3)/n m4 <- sum((x-m1)^4)/n b1 <- (m3/m2^(3/2))^2 b2 <- (m4/m2^2) STATISTIC <- n*b1/6+n*(b2-3)^2/24 PVAL <- 1 - pchisq(STATISTIC,df = 2) PARAMETER <- 2 METHOD <- "Jarque Bera Test" names(STATISTIC) <- "X-squared" names(PARAMETER) <- "df" structure(list(statistic = STATISTIC, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME), class = "htest") } pp.test <- function(x, alternative = c("stationary", "explosive"), type = c("Z(alpha)", "Z(t_alpha)"), lshort = TRUE) { if((NCOL(x) > 1) || is.data.frame(x)) stop("x is not a vector or univariate time series") type <- match.arg(type) alternative <- match.arg(alternative) DNAME <- deparse(substitute(x)) x <- as.vector(x, mode="double") z <- embed(x, 2) yt <- z[,1] yt1 <- z[,2] n <- length(yt) tt <- (1:n)-n/2 res <- lm(yt ~ 1 + tt + yt1) if(res$rank < 3) stop("Singularities in regression") res.sum <- summary(res) u <- residuals(res) ssqru <- sum(u^2)/n if(lshort) l <- trunc(4*(n/100)^0.25) else l <- trunc(12*(n/100)^0.25) ssqrtl <- .C(tseries_pp_sum, as.vector(u, mode="double"), as.integer(n), as.integer(l), ssqrtl=as.double(ssqru))$ssqrtl n2 <- n^2 trm1 <- n2*(n2-1)*sum(yt1^2)/12 trm2 <- n*sum(yt1*(1:n))^2 trm3 <- n*(n+1)*sum(yt1*(1:n))*sum(yt1) trm4 <- (n*(n+1)*(2*n+1)*sum(yt1)^2)/6 Dx <- trm1-trm2+trm3-trm4 if(type == "Z(alpha)") { alpha <- res.sum$coefficients[3,1] STAT <- n*(alpha-1)-(n^6)/(24*Dx)*(ssqrtl-ssqru) table <- cbind(c(22.5, 25.7, 27.4, 28.4, 28.9, 29.5), c(19.9, 22.4, 23.6, 24.4, 24.8, 25.1), c(17.9, 19.8, 20.7, 21.3, 21.5, 21.8), c(15.6, 16.8, 17.5, 18.0, 18.1, 18.3), c(3.66, 3.71, 3.74, 3.75, 3.76, 3.77), c(2.51, 2.60, 2.62, 2.64, 2.65, 2.66), c(1.53, 1.66, 1.73, 1.78, 1.78, 1.79), c(0.43, 0.65, 0.75, 0.82, 0.84, 0.87)) } else if(type == "Z(t_alpha)") { tstat <- (res.sum$coefficients[3,1]-1)/res.sum$coefficients[3,2] STAT <- sqrt(ssqru)/sqrt(ssqrtl)*tstat-(n^3) / (4*sqrt(3)*sqrt(Dx)*sqrt(ssqrtl))*(ssqrtl-ssqru) table <- cbind(c(4.38, 4.15, 4.04, 3.99, 3.98, 3.96), c(3.95, 3.80, 3.73, 3.69, 3.68, 3.66), c(3.60, 3.50, 3.45, 3.43, 3.42, 3.41), c(3.24, 3.18, 3.15, 3.13, 3.13, 3.12), c(1.14, 1.19, 1.22, 1.23, 1.24, 1.25), c(0.80, 0.87, 0.90, 0.92, 0.93, 0.94), c(0.50, 0.58, 0.62, 0.64, 0.65, 0.66), c(0.15, 0.24, 0.28, 0.31, 0.32, 0.33)) } else stop("irregular type") table <- -table tablen <- dim(table)[2] tableT <- c(25, 50, 100, 250, 500, 100000) tablep <- c(0.01, 0.025, 0.05, 0.10, 0.90, 0.95, 0.975, 0.99) tableipl <- numeric(tablen) for(i in (1:tablen)) tableipl[i] <- approx(tableT, table[, i], n, rule=2)$y interpol <- approx(tableipl, tablep, STAT, rule=2)$y if(is.na(approx(tableipl, tablep, STAT, rule=1)$y)) if(interpol == min(tablep)) warning("p-value smaller than printed p-value") else warning("p-value greater than printed p-value") if(alternative == "stationary") PVAL <- interpol else if(alternative == "explosive") PVAL <- 1 - interpol else stop("irregular alternative") PARAMETER <- l METHOD <- "Phillips-Perron Unit Root Test" names(STAT) <- paste("Dickey-Fuller", type) names(PARAMETER) <- "Truncation lag parameter" structure(list(statistic = STAT, parameter = PARAMETER, alternative = alternative, p.value = PVAL, method = METHOD, data.name = DNAME), class = "htest") } po.test <- function(x, demean = TRUE, lshort = TRUE) { if(NCOL(x) <= 1) stop("x is not a matrix or multivariate time series") DNAME <- deparse(substitute(x)) x <- as.matrix(x) dimx <- ncol(x) if(dimx > 6) stop("no critical values for this dimension") if(demean) res <- lm(x[,1]~x[,-1]) else res <- lm(x[,1]~x[,-1]-1) z <- embed(residuals(res), 2) ut <- z[,1] ut1 <- z[,2] n <- length(ut) res <- lm(ut ~ ut1 - 1) if(res$rank < 1) stop("Singularities in regression") res.sum <- summary(res) k <- residuals(res) ssqrk <- sum(k^2)/n if(lshort) l <- trunc(n/100) else l <- trunc(n/30) ssqrtl <- .C(tseries_pp_sum, as.vector(k, mode="double"), as.integer(n), as.integer(l), ssqrtl=as.double(ssqrk))$ssqrtl alpha <- res.sum$coefficients[1,1] STAT <- n*(alpha-1)-0.5*n^2*(ssqrtl-ssqrk)/(sum(ut1^2)) if(demean) { table <- cbind(c(28.32, 34.17, 41.13, 47.51, 52.17), c(23.81, 29.74, 35.71, 41.64, 46.53), c(20.49, 26.09, 32.06, 37.15, 41.94), c(18.48, 23.87, 29.51, 34.71, 39.11), c(17.04, 22.19, 27.58, 32.74, 37.01), c(15.93, 21.04, 26.23, 31.15, 35.48), c(14.91, 19.95, 25.05, 29.88, 34.20)) } else { table <- cbind(c(22.83, 29.27, 36.16, 42.87, 48.52), c(18.89, 25.21, 31.54, 37.48, 42.55), c(15.64, 21.48, 27.85, 33.48, 38.09), c(13.81, 19.61, 25.52, 30.93, 35.51), c(12.54, 18.18, 23.92, 28.85, 33.80), c(11.57, 17.01, 22.62, 27.40, 32.27), c(10.74, 16.02, 21.53, 26.17, 30.90)) } table <- -table tablep <- c(0.01, 0.025, 0.05, 0.075, 0.10, 0.125, 0.15) PVAL <- approx(table[dimx-1,], tablep, STAT, rule=2)$y if(is.na(approx(table[dimx-1, ], tablep, STAT, rule=1)$y)) if(PVAL == min(tablep)) warning("p-value smaller than printed p-value") else warning("p-value greater than printed p-value") PARAMETER <- l METHOD <- "Phillips-Ouliaris Cointegration Test" if(demean) names(STAT) <- "Phillips-Ouliaris demeaned" else names(STAT) <- "Phillips-Ouliaris standard" names(PARAMETER) <- "Truncation lag parameter" structure(list(statistic = STAT, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME), class = "htest") } kpss.test <- function(x, null = c("Level", "Trend"), lshort = TRUE) { if((NCOL(x) > 1) || is.data.frame(x)) stop("x is not a vector or univariate time series") DNAME <- deparse(substitute(x)) null <- match.arg(null) x <- as.vector(x, mode="double") n <- length(x) if(null == "Trend") { t <- 1:n m <- lm(x ~ t) table <- c(0.216, 0.176, 0.146, 0.119) } else if(null == "Level") { m <- lm(x ~ 1) table <- c(0.739, 0.574, 0.463, 0.347) } ## Warn for essentially perfect fit: suggested by Christoph Hanck, ## following ## ## Not straightforward as the warning from summary.lm() may get ## translated, so we need to duplicate the code w/out translation. resvar <- suppressWarnings(summary(m)$sigma^2) f <- m$fitted.values if(is.finite(resvar) && (resvar < (mean(f)^2 + var(c(f))) * 1e-30)) warning("essentially perfect fit: test may be unreliable") e <- residuals(m) tablep <- c(0.01, 0.025, 0.05, 0.10) s <- cumsum(e) eta <- sum(s^2)/(n^2) s2 <- sum(e^2)/n if(lshort) l <- trunc(4*(n/100)^0.25) else l <- trunc(12*(n/100)^0.25) s2 <- .C(tseries_pp_sum, as.vector(e, mode="double"), as.integer(n), as.integer(l), s2=as.double(s2))$s2 STAT <- eta/s2 PVAL <- approx(table, tablep, STAT, rule=2)$y if(!is.na(STAT) && is.na(approx(table, tablep, STAT, rule=1)$y)) if(PVAL == min(tablep)) warning("p-value smaller than printed p-value") else warning("p-value greater than printed p-value") PARAMETER <- l METHOD <- paste("KPSS Test for", null, "Stationarity") names(STAT) <- paste("KPSS", null) names(PARAMETER) <- "Truncation lag parameter" structure(list(statistic = STAT, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME), class = "htest") } tseries/R/arma.R0000644000175100001440000002152114413265673013226 0ustar hornikusers## Copyright (C) 1997-2000 Adrian Trapletti ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## A copy of the GNU General Public License is available via WWW at ## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by ## writing to the Free Software Foundation, Inc., 59 Temple Place, ## Suite 330, Boston, MA 02111-1307 USA. ## ## ARMA class ## arma <- function(x, order = c(1, 1), lag = NULL, coef = NULL, include.intercept = TRUE, series = NULL, qr.tol = 1e-07, ...) { seqN <- function(N) { if(0==length(N)) NULL else if(N<=0) NULL else seq(N) } err <- function(coef) { u <- double(n) u[seqN(max.order)] <- 0 u <- .C(tseries_arma, as.vector(x, mode = "double"), u = as.vector(u), as.vector(coef, mode = "double"), as.integer(lag$ar), as.integer(lag$ma), as.integer(ar.l), as.integer(ma.l), as.integer(max.order), as.integer(n), as.integer(include.intercept))$u return(sum(u^2)) } resid <- function(coef) { u <- double(n) u[seqN(max.order)] <- 0 u <- .C(tseries_arma, as.vector(x, mode = "double"), u = as.vector(u), as.vector(coef, mode = "double"), as.integer(lag$ar), as.integer(lag$ma), as.integer(ar.l), as.integer(ma.l), as.integer(max.order), as.integer(n), as.integer(include.intercept))$u return(u) } arma.init <- function() { k <- round(1.1*log(n)) e <- na.omit(drop(ar.ols(x, order.max = k, aic = FALSE, demean = FALSE, intercept = include.intercept)$resid)) ee <- embed(e, max.order+1) xx <- embed(x[-(1:k)], max.order+1) if(include.intercept == TRUE) { if(is.null(lag$ar)) coef <- lm(xx[,1]~ee[,lag$ma+1])$coefficients else if(is.null(lag$ma)) coef <- lm(xx[,1]~xx[,lag$ar+1])$coefficients else coef <- lm(xx[,1]~xx[,lag$ar+1]+ee[,lag$ma+1])$coefficients coef <- c(coef[-1], coef[1]) } else { if(is.null(lag$ar)) coef <- lm(xx[,1]~ee[,lag$ma+1]-1)$coefficients else if(is.null(lag$ma)) coef <- lm(xx[,1]~xx[,lag$ar+1]-1)$coefficients else coef <- lm(xx[,1]~xx[,lag$ar+1]+ee[,lag$ma+1]-1)$coefficients } return(coef) } if(!is.null(order) && !is.null(lag)) warning("order is ignored") if(is.null(order) && is.null(lag)) stop("order or lag must be given") if(is.null(lag) && !is.null(order)) lag <- list(ar=seqN(order[1]), ma=seqN(order[2])) lag$ar <- unique(lag$ar) lag$ma <- unique(lag$ma) max.order <- max(unlist(lag),0) ar.l <- length(lag$ar) ma.l <- length(lag$ma) if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(is.null(series)) series <- deparse(substitute(x)) ists <- is.ts(x) x <- as.ts(x) xfreq <- frequency(x) if(any(is.na(x))) stop("NAs in x") if(ists) xtsp <- tsp(x) n <- length(x) if(!is.null(unlist(lag))) if((min(unlist(lag)) < 1) || (max(unlist(lag)) > (n-1))) stop("invalid lag") ncoef <- length(unlist(lag))+as.numeric(include.intercept) if(is.null(coef)) { if(!is.null(unlist(lag))) coef <- arma.init() else coef <- 0 } if(length(coef) != ncoef) stop("invalid coef") md <- optim(coef, err, gr=NULL, hessian=TRUE, ...) coef <- md$par rank <- qr(md$hessian, qr.tol)$rank if(rank != ncoef) { vc <- matrix(NA, nrow = ncoef, ncol = ncoef) warning("singular Hessian") } else { vc <- 2*md$value/n*solve(md$hessian) if(any(diag(vc) < 0)) warning("Hessian negative-semidefinite") } e <- resid(coef) e[seqN(max.order)] <- NA f <- x-e if(ists) { attr(e, "tsp") <- xtsp attr(e, "class") <- "ts" attr(f, "tsp") <- xtsp attr(f, "class") <- "ts" } nam.ar <- if(!is.null(lag$ar)) paste("ar", lag$ar, sep = "") else NULL nam.ma <- if(!is.null(lag$ma)) paste("ma", lag$ma, sep = "") else NULL nam.int <- if(include.intercept) "intercept" else NULL nam.coef <- c(nam.ar, nam.ma, nam.int) names(coef) <- nam.coef colnames(vc) <- rownames(vc) <- nam.coef arma <- list(coef = coef, css = md$value, n.used = n, residuals = e, fitted.values = f, series = series, frequency = xfreq, call = match.call(), vcov = vc, lag = lag, convergence = md$convergence, include.intercept = include.intercept) class(arma) <- "arma" return(arma) } coef.arma <- function(object, ...) { if(!inherits(object, "arma")) stop("method is only for arma objects") return(object$coef) } vcov.arma <- function(object, ...) { if(!inherits(object, "arma")) stop("method is only for arma objects") return(object$vcov) } residuals.arma <- function(object, ...) { if(!inherits(object, "arma")) stop("method is only for arma objects") return(object$residuals) } fitted.arma <- function(object, ...) { if(!inherits(object, "arma")) stop("method is only for arma objects") return(object$fitted.values) } print.arma <- function(x, digits = max(3, getOption("digits") - 3), ...) { if(!inherits(x, "arma")) stop("method is only for arma objects") cat("\nCall:\n", deparse(x$call), "\n\n", sep = "") cat("Coefficient(s):\n") print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE) cat("\n") invisible(x) } summary.arma <- function(object, ...) { if(!inherits(object, "arma")) stop("method is only for arma objects") ans <- NULL ans$residuals <- na.remove(object$residuals) tval <- object$coef / sqrt(diag(object$vcov)) ans$coef <- cbind(object$coef, sqrt(diag(object$vcov)), tval, 2 * (1-pnorm(abs(tval)))) dimnames(ans$coef) <- list(names(object$coef), c(" Estimate"," Std. Error"," t value","Pr(>|t|)")) ans$call <- object$call ans$nn <- object$nn ans$css <- object$css ans$var <- var(ans$residuals) ans$aic <- (object$n.used * (1+log(2*pi)) + object$n.used * log(ans$var) + 2 * length(object$coef)) ans$p <- max(object$lag$ar, 0) ans$q <- max(object$lag$ma, 0) class(ans) <- "summary.arma" return(ans) } print.summary.arma <- function(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...) { if(!inherits(x, "summary.arma")) stop("method is only for summary.arma objects") cat("\nCall:\n", deparse(x$call), "\n", sep = "") cat("\nModel:\nARMA(",x$p,",",x$q,")\n", sep = "") cat("\nResiduals:\n") rq <- structure(quantile(x$residuals), names = c("Min","1Q","Median","3Q","Max")) print(rq, digits = digits, ...) cat("\nCoefficient(s):\n") printCoefmat(x$coef, digits = digits, signif.stars = signif.stars, ...) cat("\nFit:\n") cat("sigma^2 estimated as ", format(x$var, digits = digits), ", Conditional Sum-of-Squares = ", format(round(x$css, 2)), ", AIC = ", format(round(x$aic, 2)), "\n", sep = "") cat("\n") invisible(x) } plot.arma <- function(x, ask = interactive(), ...) { if(!inherits(x, "arma")) stop("method is only for arma objects") op <- par() par(ask = ask, mfrow = c(2, 1)) data <- eval.parent(parse(text = x$series)) if(any(is.na(data))) stop(paste("NAs in", x$series)) plot(data, main = x$series, ylab = "Series") plot(x$residuals, main = "Residuals", ylab = "Series") acf(data, main = paste("ACF of", x$series)) acf(x$residuals, main = "ACF of Residuals", na.action = na.remove) pacf(data, main = paste("PACF of", x$series)) pacf(x$residuals, main = "PACF of Residuals", na.action = na.remove) par(ask = op$ask, mfrow = op$mfrow) invisible(x) } tseries/R/garch.R0000644000175100001440000002307514144530254013367 0ustar hornikusers## Copyright (C) 1997-1999 Adrian Trapletti ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## A copy of the GNU General Public License is available via WWW at ## http://www.gnu.org/copyleft/gpl.html. You can also obtain it by ## writing to the Free Software Foundation, Inc., 59 Temple Place, ## Suite 330, Boston, MA 02111-1307 USA. ## ## GARCH class ## garch <- function (x, order = c(1, 1), series = NULL, control = garch.control(...), ...) { if(NCOL(x) > 1) stop("x is not a vector or univariate time series") if(!is.vector(order)) stop("order is not a vector") switch(control$grad, analytical = (agrad <- TRUE), numerical = (agrad <- FALSE)) if(is.null(series)) series <- deparse(substitute(x)) ists <- is.ts(x) x <- as.ts(x) xfreq <- frequency(x) if(any(is.na(x))) stop("NAs in x") if(ists) xtsp <- tsp(x) x <- as.matrix(x) n <- nrow(x) e <- double(n) ncoef <- order[1]+order[2]+1 hess <- matrix(0.0, ncoef, ncoef) small <- 0.05 coef <- control$start if(is.null(coef)) coef <- c(var(x)*(1.0-small*(ncoef-1)),rep.int(small,ncoef-1)) if(!is.vector(coef)) stop("coef is not a vector") if(ncoef != length(coef)) stop("incorrect length of coef") nlikeli <- 1.0e+10 fit <- .C(tseries_fit_garch, as.vector(x, mode = "double"), as.integer(n), coef = as.vector(coef, mode = "double"), as.integer(order[1]), as.integer(order[2]), as.integer(control$maxiter), as.double(control$abstol), as.double(control$reltol), as.double(control$xtol), as.double(control$falsetol), nlikeli = as.double(nlikeli), as.integer(agrad), as.integer(control$trace)) pred <- .C(tseries_pred_garch, as.vector(x, mode = "double"), e = as.vector(e, mode = "double"), as.integer(n), as.vector(fit$coef, mode = "double"), as.integer(order[1]), as.integer(order[2]), as.integer(FALSE)) com.hess <- .C(tseries_ophess_garch, as.vector(x, mode = "double"), as.integer(n), as.vector(fit$coef, mode = "double"), hess = as.matrix(hess), as.integer(order[1]), as.integer(order[2])) rank <- do.call(qr, c(list(x = com.hess$hess), control$qr))$rank if(rank != ncoef) { vc <- matrix(NA, nrow = ncoef, ncol = ncoef) warning("singular information") } else vc <- solve(com.hess$hess) sigt <- sqrt(pred$e) sigt[1:max(order[1],order[2])] <- rep.int(NA, max(order[1],order[2])) f <- cbind(sigt,-sigt) colnames(f) <- c("sigt","-sigt") e <- as.vector(x)/sigt if(ists) { attr(e, "tsp") <- attr(f, "tsp") <- xtsp attr(e, "class") <- attr(f, "class") <- "ts" } names(order) <- c("p","q") coef <- fit$coef nam.coef <- "a0" if(order[2] > 0) nam.coef <- c(nam.coef, paste("a", seq(order[2]), sep = "")) if(order[1] > 0) nam.coef <- c(nam.coef, paste("b", seq(order[1]), sep = "")) names(coef) <- nam.coef colnames(vc) <- rownames(vc) <- nam.coef garch <- list(order = order, coef = coef, n.likeli = fit$nlikeli, n.used = n, residuals = e, fitted.values = f, series = series, frequency = xfreq, call = match.call(), vcov = vc) class(garch) <- "garch" return(garch) } garch.control <- function(maxiter = 200, trace = TRUE, start = NULL, grad = c("analytical","numerical"), abstol = max(1e-20, .Machine$double.eps^2), reltol = max(1e-10, .Machine$double.eps^(2/3)), xtol = sqrt(.Machine$double.eps), falsetol = 1e2 * .Machine$double.eps, ...) { rval <- list(maxiter = maxiter, trace = trace, start = start, grad = match.arg(grad), abstol = abstol, reltol = reltol, xtol = xtol, falsetol = falsetol) rval$qr <- list(...) rval } coef.garch <- function(object, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") return(object$coef) } vcov.garch <- function(object, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") return(object$vcov) } residuals.garch <- function(object, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") return(object$residuals) } fitted.garch <- function(object, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") return(object$fitted.values) } print.garch <- function(x, digits = max(3, getOption("digits") - 3), ...) { if(!inherits(x, "garch")) stop("method is only for garch objects") cat("\nCall:\n", deparse(x$call), "\n\n", sep = "") cat("Coefficient(s):\n") print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE) cat("\n") invisible(x) } summary.garch <- function(object, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") ans <- NULL ans$residuals <- na.remove(object$residuals) tval <- object$coef / sqrt(diag(object$vcov)) ans$coef <- cbind(object$coef, sqrt(diag(object$vcov)), tval, 2*(1-pnorm(abs(tval)))) dimnames(ans$coef) <- list(names(object$coef), c(" Estimate"," Std. Error"," t value","Pr(>|t|)")) ans$call <- object$call ans$order <- object$order Residuals <- ans$residuals ans$j.b.test <- jarque.bera.test(Residuals) Squared.Residuals <- ans$residuals^2 ans$l.b.test <- Box.test(Squared.Residuals, type = "Ljung-Box") class(ans) <- "summary.garch" return(ans) } plot.garch <- function(x, ask = interactive(), ...) { if(!inherits(x, "garch")) stop("method is only for garch objects") op <- par() par(ask = ask, mfrow = c(2,1)) data <- eval.parent(parse(text=x$series)) if(any(is.na(data))) stop(paste("NAs in", x$series)) plot(data, main = x$series, ylab = "Series") plot(x$residuals, main = "Residuals", ylab = "Series") hist(data, main = paste("Histogram of", x$series), xlab = "Series") hist(x$residuals, main = "Histogram of Residuals", xlab = "Series") qqnorm(data, main = paste("Q-Q Plot of", x$series), xlab = "Normal Quantiles") qqnorm(x$residuals, main = "Q-Q Plot of Residuals", xlab = "Normal Quantiles") acf(data^2, main = paste("ACF of Squared", x$series)) acf(x$residuals^2, main = "ACF of Squared Residuals", na.action = na.remove) par(ask = op$ask, mfrow = op$mfrow) invisible(x) } print.summary.garch <- function(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...) { if(!inherits(x, "summary.garch")) stop("method is only for summary.garch objects") cat("\nCall:\n", deparse(x$call), "\n", sep = "") cat("\nModel:\nGARCH(", x$order[1], ",", x$order[2], ")", "\n", sep = "") cat("\nResiduals:\n") rq <- structure(quantile(x$residuals), names = c("Min","1Q","Median","3Q","Max")) print(rq, digits = digits, ...) cat("\nCoefficient(s):\n") printCoefmat(x$coef, digits = digits, signif.stars = signif.stars, ...) cat("\nDiagnostic Tests:") print(x$j.b.test) print(x$l.b.test) invisible(x) } predict.garch <- function(object, newdata, genuine = FALSE, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") if(missing(newdata)) { newdata <- eval.parent(parse(text=object$series)) if(any(is.na(newdata))) stop("NAs in newdata") } if(NCOL(newdata) > 1) stop("newdata is not a vector or univariate time series") ists <- is.ts(newdata) if(ists) newdata.tsp <- tsp(newdata) newdata <- as.matrix(newdata) n <- nrow(newdata) if(genuine) h <- double(n+1) else h <- double(n) pred <- .C(tseries_pred_garch, as.vector(newdata, mode = "double"), h = as.vector(h, mode = "double"), as.integer(n), as.vector(object$coef, mode = "double"), as.integer(object$order[1]), as.integer(object$order[2]), as.integer(genuine)) pred$h <- sqrt(pred$h) pred$h[1:max(object$order[1],object$order[2])] <- rep.int(NA, max(object$order[1],object$order[2])) pred$h <- cbind(pred$h,-pred$h) if(ists) { attr(pred$h, "tsp") <- if(genuine) c(newdata.tsp[1], newdata.tsp[2] + 1 / newdata.tsp[3], newdata.tsp[3]) else newdata.tsp attr(pred$h, "class") <- "ts" } return(pred$h) } logLik.garch <- function(object, ...) { if(!inherits(object, "garch")) stop("method is only for garch objects") n <- length(na.remove(object$residuals)) val <- (-object$n.likeli) - 0.5*n*log(2*pi) attr(val, "df") <- length(object$coef) class(val) <- "logLik" return(val) } tseries/data/0000755000175100001440000000000012213262741012657 5ustar hornikuserstseries/data/USeconomic.rda0000644000175100001440000001171414674232237015431 0ustar hornikusers‹íXy8•]×7ÅãÑà>t†J•¡"”ÖBÓS)E©H”f2¦ò³¤¹ƒÌÇì˜Ç %ÍJó ”BšRÑwëÞñ~Ïõ]ßõ^ï÷ýÙý‡ßYk¯õÛk¯½öºÝ{鬓åVȉ‰‰IˆII‰‹IHÒ?¥$è?âbRb²4JÎ]dNÿU †à±oSz<öô ýÔaÄx±Þ#þfôzè1ã‚`f\PN䂵Äî*#G*1räl†'Ò8Š~¢1rã)Íè!Ä/øé“ñZFŽb1~QáŒ>Ê“`6£æ0þу¾è?‰}=ѳ‰Þ…È7ùøVÆîøcˆ_Œ%c3`&ƒ±ŠÌ¼±¡/2ú87&θbÆ?^Š‘ãǼÅèÔ9a‘/0q$Ž 8ŽÑ'ZÜÂð'9ŽÈ v1~IšÌx’7ß”Dä8&Τ&‚/½P‚ñOzKô$IuŒ,@üˆýjf\hÃð =‰LöAØÂÈÉsò 62þ)6Œ]Ê‚DŒ 'ÛÌÄ•2“è}r £On`xSt‰½?±ÉÈ©âYŒ]ê†'5™7µ›±OsgôiŒ]Z3žnÅø§dôé ¿ñK¿ÃŒg¸2$ž â—Ixrˆ_ã—áÅÈDö'òXÆ?ý,ñ¿G0åFì=È|·»ÌùŒ>³“áͲdü²©—¬Œ^DΉh#Ã#Šax²ˆüƒñËVbäìIŒ}6Ésv#Ó3™ÏIcžÿÞZ<Ü]hèm-’¸ÄÿÁ ¢Øÿä"½ÎÑÞÝþ¡ø/J ^MÏ?L%Ìtúú_“‰‹oÎó󙸼e ®$x”`ÁdfÝÞ%Œ¿÷!‚ ˜õ{“þãMú ÿAÂók¾¿¿yIâ¯#véÄ_œÌGν7éüjâWHìIŸå—½Y©[~=Ar쇓xõÎ#ó‘¾í=Øo™ŸÔ³7©KR> ™qŸ"‚]Lœ¾$n_²>_kÆß·’è¿ÿ…dÜ•Ø“ýð}ÅŒûi3ñùÍgæõ[ÌØûm%@ô9ÏûT"ó ÙW?²_~ÚDOÖí÷_O0‚øç»_¼ŸÙŸäÁß‚ñ÷'ïR/þ~ÄÎŽ ñGø~Å·œA_’_ßp’’ßHÆÏ—Ô/©—>ýf’¯_~§‰\Aìî’y’ùåÉúIR„‡ì³¯á!uè;„Ñûì"uù«¾¦ºP õ2”ñã>Ùw>ÿû=©câ×'“÷g©ŸYï“8dH~(ï"¯øG^Þ‘uêuæ’ý%õéOö?€ðä1övO1ã$odÿ‹þ¥ Iüø÷š•ä«?É-³X¿Îy›³ÓæuLŸ’à!åÚfóðí¤MÇ+xÛ±F)~ÍŒÉ+‘Úmª¶ÿò¤¼uMn±."åßÚsóˆ8=qFã²"¤ö›|“ÐG*Ô"}bÖT:ÎÒó»N¡ãæv·r9ô<'ƒÊ=‘¬ùjÿŽ;aÏÁ—a"zÝu‘éOÊ–m¸Yá„TþÉÕûªþFªD,â…Ûg¤*ÇlÜìd‡Ô¥‹çØCiû›ÅcšŸÖ U?{ËÅÉ:HݽýâÈÛóH=ž!výßö•v:O“?Z’ïÇ—v7C¦+!Õ<Ü;d"Rm“½¥eè8Þ'Ã=‹T¤~tì5.@–Œ—Q÷$d H»tþz#²|_Ϲg¬¡£šØF+Å©jQ}zY£_zQÍCÖˆ›Ë‡[Ý@–Ò…EÞdÉMù¸x Í# æjF–ØÄ™††È’¨’×|9•ÖÏý¸NÌYò£œé@õeû£Èâ.™÷ÒúyµøÀŠ±B–î½¹:Y³ƒdÖ7¾C–¥­ÕfMd­œoét Y‹»wˆºé¸ç¥&ä-PC–áa3;ßåÈÒÜê·Ñ½?>Ù­Û§) è|Ôk؆w!õüÅ‹êX¤ZÖ¥²´Ü¡(Üž…Ô£ºn{j$ROŒy_u·öë›þ¼]®×ï÷JïµÁ›Ût¾7íÒ9¯ŠÔ›Ûœê;ê{,¥Jïs§‹å¾R_f¬Q=u©Ïƒf6Þ Dê­3‡2»FïƒO^‡BR·ªø[›_Òû(¡|Oâ#R5ƒ†>z8“>CB Ò“ ½îùpcœìÍÍ&±®•È^ÙrƦûÍ÷´riƒ/²ç¯­³Ó™ìµæ~ánd{Í•7j ;¸µT7é2²£g̽—&@ö±ŸÄý ÈŽ›>Þ;ŽŽ/7mvaÈud‹Š]m ÷ùVÊd'?Ùr^æÏÝ©/ºììÊQ¡=†6È®Í-oî…ì&wßUYd¿¹Ø4_ÒÙ]kC.ó#Gâ¡iJ“;rÄ5Æ>…7A͋ˑÖ˾¨ÍSíÊöùÈÑ&e;79 KÞ²³ÌcòôÖnä¬)}6¯ë!r”Û"ÇkÇÞ¢mÈ 9[ç劜È÷ až~ÈÉ›s}Ëxäœ5KkW}…œó>s!çÆÆ€qúZȹëèš<} rêt=nNEN󨯌œwÿ” £ù;ŠUzÊŒ‘+±ûýj›·Èr¥Õ`ÅY䪖¿Ôÿ°¹*'¥Ä¦¿C®ºìü3k‘«á<ÿj„5rµ‡x|!¹~Ü°{&‰Ü1¹c¢:º‘«VëÍ?¼¹:š­M“ã‘;î)¿.¸¹¦ÒªÒöbÈ5yû±êð-äΛpãþª©4Ž\p?"¹¶ËF×.´D®›|®{ "—ŸúãѬ äÎÓü6Ô ¹inòÅçb›©hgw͹ 2ÕA!·`’wÍäŠÜOM\·¹¹«Þø½Ð@nâ«snc‹Ùq!¹A™Ûš¶¤Ð|²fy^ÈM˜eÊ @nŽãç÷_éuœö:'5l rÏŒw½³¹µs5¿Í¿€ÜÛÎ%:+eÛì`vF4 ¹ÎݹòÑy’G +¯E!OÃO×å Oæ”~SÃnä Ïì~Ñ ŽÈ›ùG‚˜±ò()~qFÞ’§{&%ô o™¶Ð÷“)ò¬+e‡BÞê ÊÊ>Ë‘gçS!Sªˆ¼õ¢‡«O­GÞæM‹®m@ž«™´¨…ŽÇÅhí–Ãø3~h!Ï}Kìê.òv©mZp°y¾ö¾§˜ o·äeï£4Ϩ·O¸S ˜³ØsM}ø¥ë£ øßX4½N7vOçx7KÀÞ«Ö8ßäÁ¡ƒÐ Á7 lhìµ -ˆ²zfDD®‘éŸãÑñà©+]ú0ÞvŤ˜ÑC!Áð›Ï‘HP÷¿1ëOHüI¿9}3b§AèÕ’ñ?ûBPKå­U»Càh@FØ '!fïÐÕinN#¨3¶uĽ:•om¤¬Û¾N½R¥¨0Ê-¬}\YïõpˆO†g—Øà Òÿkí*?ˆÔˆÒ>)ÿ"—Ï—þÑž ‚[Ó›l­APëu,¥3¢l¶µhÉ̇…““á9¿®n Š€X ¦o 1EçFVÌ2Ø+ëÞól nô¹}×Þ@ÂeuÛ8UYH|16u›ÚHR wœµZIÞ?™(·d@Òm¥qùÒ ì¼zøž |$蘰å%ÏØÁE)2Ïàyå%mH;!–õ|ÆhH y¿á½^d4ŒºþÌÎÒÜ©ïæó”!m’ÎÂrK9H*{TuA&RM—z.Ëtÿ¯73Ïx@Æ«˜òÕ‹ Ò)¨(¯|™5Kë‚èho@zë|“ûáéaÈýðôÐ>×F(Sñ1à„‚ŠÁ]¯ØPp¬µ)ooäÿõÈ<¾ó+äYÙÇ&N>Y®ÛŒ°èwïÎÀÃõ}ñ¥ˆJÞ‡È<…ÄðÑüË1ëA¨y»¼Uú¤»·nL„ôÛÝKf'èÉöŽî‘? ¯ýõWÓžÕPìµÓqÔ&9(TpÀiRz¶§&+„bõä=Ó¿‚â©GÊð½$œëÒxÿçEÈ‘=þÀ )ÈJi± S yz±âß@6ËD—½§ 2l¶=ˆ[™ò™ì‡.ÙK/{ÒKÞ 9;Ò²žºäH@zɦH¿o_A$#þ|çcuÈÝêž–^ªy›ö‹\å!/²íö«.ݾ¼”诜ÿé=”Ò»öâÎF(íy¹æB¡”¥±ŸGßž'§mis'ÁiÃP¡´ÅX8Qn« ü7Pšb,¾¹Nð¯6h'Ԭ˲‹pª†šŸÇ@ Î,ŽZõÀ‘ '/Ä02Œƒj¿õ—L8Eê·ì¾Ë‚1(Z¬íYz¢ ŠrË™‰C1½K«f@iPh›u°J®ìöŒ²Rûx…Ù²81ùõ|%(÷:¾$S%_ÎDFü>kXC¡‰÷“ºúP eª®5 ‹ƒžéB~â̲ý!wmIŽ÷r'Y¦6œò²¬fféy)öÉÙ«.;n^ 9O%Ê´: §2oݵ…lˆ®)˜?oˆº{Ö\jb+Dùþ$‚èy6Ü¥Ò †§㛸ÄÜ;!³é‚Ä~z> ‡±‚Ÿ‰…ØÆw†¸8ÕÑÛ!AB ]¢DðÌÎxï´…Pã¸Þ­|a_%‘zýÕDá’›nØC˜ÑCÞ)–AÒÜÙúo§Þá´£YÞv‘,ŸfZê)É—v¿sÞ<«ïÜ¥,[¶b²ÕH‰?³Rdòr]%B@ø³! $‹í¿iü‚>¯‚¼9Ç<@¸K¥ùÒ8Zoõz«@ð7$Æáýíú}¼Bºêºd!Ù.Ó¡æ‹>ïx7B²ì¼š»&ù}úäÖ:N×Åûæë‹Ç¼ãÞ’Ñ]¢wêÓ†%2Ùž¯ú€Žø¯nrï×óÓDaâ%:;±¶:P Ò,Uzœ!mÇèíCú.£û¾kKûê?µ"òBs€1¤³½OÍó½&Ó:EO‡@ÖüÑÕío ³~_Q«ŠdÓZ¹í dt•MTÉh…¬j½æöÃݨ´0iäÌ9±!{áÛþss"×%ôaäÕ­ˆ>£SùÛ(ä˨=ÒRI€<¹Wºæ;œ!ûzÍæýfÕ}<Ù.Â{rF® 2˜B·Ñ«sË ¢ŽEöqŠ ºú]ÞhÃ.³#r§;¬!¹M[’kKV@^‹Ž´/òxg§´XB^÷Æ—‹g<‚‚Áõž@( ¶šçCþƒAÚÙC¶B¾:UôuhjŸ\0>÷þ¶Mô9÷n6l úòéb·Ô²ïäÛ?í\ß½òzé-¾@þ'“!‘Z¹P ñ˜õX¼ òº²³)(°ü¹¡ðs×·–CÑÏבoÿ¹ývÖ‹·Ÿ‚â(ùË©¢~,Ž­÷±€2Á-1­P¹ßô˜¿Ì8‘¼»áJT'”G\Ÿ.І*òÞ9Ùûzzv ª§,לJƒž¦³Å;Õo§ÞM´§õ¦jɤWBõÑÙ;rÖZÂ)’¯rÒËKÏk¸š”A9¿6ë‰éHè}Ëî k„Êïe5®È@ÕAÙÖi/vBµ‘ƳFpJ æaqè#T±’¯ç®‚* ÍœïÔݱm9TŒø¹qp‚ü_PRÛ²Ý{Ü0(²zíÜ¢²Š´«¸(B‘’t¥¸p8û笎Pü©îÙe”â·ø±¦Pš\3Ö/öŸ÷Ûhï½Bé½Æí½_ù‡É@Úd›½ÓúÞ –!Ä®‡\¿H›ŽÎÇ›é¨ÿréç.2ÿ%K¸¹÷ýrüoz$~Eìäáþ¿_J÷NÁ\Jÿn–¿›åïfù»Yþßšåÿó¥to3üÕŸ~ þþüý1øûcð?üüÿêOb=ÿU±¡y¥$tseries/data/bev.rda0000644000175100001440000000130414674232237014133 0ustar hornikusersBZh91AY&SYíh¶åìÿþ1@Aÿÿÿÿÿÿÿý€@@‚@@@@@@@» î»nSÌSSMM¨ ªxH§©£ÔzŒ‡¤zL™6¦@ O"j£@2¢“T©0Œ 0ÐŒ ‚dÀh`˜˜É ’(¦€Ð4h h4daM MImÙ ä‡ÅŒUPT¢QE¢ÑB@!&€P€`¡(Ÿ Š"ï*‹2B4ÄAQŠ(!Y™P@|d`ȪÏ`Å^1.Åb£³…eerÝ‚²Ïó,²¼¨$ox̯nSòfSU-7•å 4­!‡…JI`଩‡( LÉ$ÄÚBkF¦Ï^" Œ*¯Ó 9V,qI ¡¸›A![•l»q!~ò/ð«Lb¤@¾©û<§9ÀünÍB¨%]€¯ÞÇtó}–áQ˜@–H9˜@s9Á’Oõ%$*˜`3h¼{/õ+=ñàñ¡É‘‘1ŽÁXzZ{[¹--6lµŠfÓYõÔ*MÉAÖØ«æf¼4j^¡©$~&§åý¿«©Œ@ÃHLZHQTcXªŠ¨(¤Q@P„X¤Qb(Å‚ÅŠŒPPŠ±b‘EŠEX² ȤQdQ@DX,U€bµ`T`L&He!úxR «¡1ívÛÏß\j’Z x¡/Y!l½÷A!â01o%F«O¿ªZ{U }S"x'cT¢Ð¬c=YΖ2¼]4€‘§#}Ö«Nø¸Õ£X¬óD›u‚§FÈ+~—sŸ[¼"Iuüõ™0’pÙx" YšÒ,½QÄ; êfFì´+îÿQiä†0>%U¶Ê¬—Ò‡ø»’)„‡kE·(tseries/data/tcmd.rda0000644000175100001440000010707114674232237014316 0ustar hornikusersBZh91AY&SY¨Åp/v"ÿÿÿÿÿÿÿÿúrVÔ´Å/¯îzR”¦óIHB‡ …! CQàùè(¥(@  P À&#É„LL €!„`!0&`ha14À„Ä`™0ƒ ‰00Œ0&Â`ŒM &&˜ƒ˜Œ&a10&†€†À˜L€ ¡„ÄÓ`‚d &&ÀÂ0À˜ ‚040˜š`@TÕ*’MS5<§þ”¦ýSõ&§¦ýOòh¦›PSÒIúŸªiê~¤›ÐzF›S! PÓÑd1§“ª§€ªPР€ ü­ƒ~'÷óòM·åõnã/™6ϳ~bM¶“ýVùL"$ÄÒ3ËDØ>TÙ$d™¤ÆßšDc1i$Ÿœšm&Ù¿ÖM4¤ÛžÄ˜o榒?A34IƒÜ‚I³oÀlÝ3ªFÞFvfóz#Lù“h{Ñ7ΉŸM½I¡2D}-õŸðç瞘ó͆üÿ«âëñ1¶Øús®[ýï½ðûÙñlþ¿ü_ÇŸÙ·ñóòìçßÌÆÙì?c88OÊ|G>Ïgù?äûÿ{6ûþÜæc7éM°3ù<ÏŠ?‘~EU÷ñAñl[´Æþ˜Ûnmì³}ɉÅÉ3ˆ8’iÄâ4šBN!Ä4!#ˆ‘$L“B"M¤“$8ˆqI8‚D‘ÇNq$Hq2$„“h™ÄÚDâm&‰LÒ'8Ä‘4qÂ8âq'8š'&“ˆãI$M¸N8Òqpœn&qÇIœIÄÑ7„‰Ç ¸ˆâq3ˆ„šN&šqÆáÇDáÄÎ#‰8pãŽHã8I'N"Gâ8œq8œiÄ’D‰ÄœqÂI8á8Ž8âNI$ÜN8ÓN'Ç ÄãŽ8HˆI7dqÄœN'qÇ"M'ŽŽ#‡i8æ}æÌf}àÙ™÷±ì„|I›}á á!ÆâFÜ3H8ˆâ2$Hq6I68ÍÄH™’n8˜É³I’FĆâ8›‰’i„‰$Ä„Üq'Žn&q"N8â@áÇ8™Çmq¸ãq#‡ 8áÄÑ"M6Òm!ÄÜ$㈜8'i#‰Æ#M8àˆÓqÃ$‰4!&ˆq6á8Ž8Ä‚FG¤œN8âqÆH’pḓ‡„“ˆ#ˆpœpàI#ˆâqq6š$›Ž$™4‰4‡ââ8â‰8œpq8I!$™Ân&Òb&qg ¸pœpàâ$ÙÂ4›D„ˆÑ8N"BC‰"qÄšH‰8œ8ãŽ&âL8’iG '4’FšI&M8CˆHd›ˆ‘Æ’ ƒâ‘DŠ( Š(‘@Š$E$N7‰'Ç' ÄIq›qG $â8’Dˆ’h’M$Ž#DŽ'ÄÒN8Î ‰'p’!ÇIœIÄâLIÄãŽ$“‰Än#‰Â‰¤É“ˆâN8á'Hœ8ÜI ¢CD“Ž8ÜIljÄN88’I#‡p’DMÂN8Ž'ã8ˆ‘#„ÜIÄq8áÄŽ"qÄÑ!#q8™¸Äq&âqp‡I¸qœq#qÇ ‡q8ÎN8âMÇdp㉎8ãq8‰ÄãHãHŽ&âqÃÄpHN#$ˆ’I£Ž$"qqqÇD“Ž$gp8œG“q7#Ž8‰Â‘|Š ‹äQD‰DQp“"N8â"N8âH’i£„â8LáÄq âhœM4Î$ÜqÈàâq’pãpœpI¤Úi4‰¸›qn$›Ç4‰¦qŽ8âI"I$á'Hãˆã"&I4É$q8™Â8œIÇ$’'Hã„œqˆá#‰&ÜICN8‰œAM8p‘LjšIÃŽ8’&“hœpâ!"N#ˆ‰&ÜC‰4I¸qÃÂ8šI#‰Ç#Ž'p‰Äá&ÉÄá8ÓŒŽ'‰¸‰&Ž'Bq8I8q'"‚/‘DE( AQDƒˆãI£Ž6q$ÜDˆœI'$á8MÄqÇn&HâN'G 8âN&“ˆâI8áÄ’H’DâpI''Âq'ˆpⓉ#ˆDqBDŽ8ãIÄDDœ$’&›„á$‘ÄâI$š(‘EDù$QA i8œH7q"DI¢qÂq8pãŽ2dCAPAQDŠ Š$Q ‚/‘Aq7d™¸šIÇ ÄÉ$ãŽqÇM!§‰Ä›Ž$'qLÒGN&Ñ&âq‰´LÜMÄH8›!"LÜI$ÜqÁ2Fâc‡&ãŽ6Î&㎠IÆâi$âgã‡DÛH7 œIœHIÇq4qÂp‰$N"n&“Hq8á"IqÂMDˆ’N"Š(¢€ˆŠ( @‚$Qq8ãqqÁ8„à’I8ãI"8ÜC„pã‰Äq¸“Ž&âq8IÇǤÒg 8Gq¦‘Â( ‚(AEH Š‘EH§‘8qgò™~l}ëV"Ûɼ†Ï##@òa&yÈÏ$äÛɼ‘’F“Lò?Á'v߉’ÄÃe±›ö?ϸl†l7Òú}†?ÌHÙó™¾àßÌ}øû[gÚfúRl>Ó3íI´›dƒí6ϵ6Ɇ}¢&4€ûR$ÁÜ›m#M¶~J$šFÍö£4I&“ ŸjDÒ@I›íF“FßjI$f<ÓIŒy°ÞllÞm·›cÍ晡挃Í#Í7šCÍ3Ìó<ߨìÙ¶ë¦i"#d˜&Ù&“$$˜“4dŒI1"LÒi¤‘´$ÄL‰ "4HHÑ$’I2$I"H‰2Bi&H™"Mi$DÉ$’D&L’B&M?5ÇþMØ͛F?©c|óË?£œ °ùocälß >A¾CoÛä3äoÏ‘¾DѾA¤|†ùùùæfÛŦcf=ˆnC0Ïñ6lÆŒØ7ê0þƒgê6Ï´cç3g΂6ß;fùÐ’ùÁ¾tÓmŸ:#6{‘ó¸c"hÛçM$’C7΄3|è’cH6ùÌo0’I8àâlHÍó¦Ò#çA6HÙ»"iLgcc³Ù‡fÎȆìÛ²Lvc³;6ì’lò;7œ"y:³M¶ö$‚LI&’4Ñ&ÛDCm6I£I±$Ä›išI¤ÄÄ‚bHI“d¤’4É´hA$ȉ“¤‰4’MOô?¸{±³âc3a÷ž‡33øÛŒ ›ã6øÂOŒÛãm¾6ß¾3ãHc3æ3o˜Æ|ÈdÒcgÌÄâIlÛæm&É ß2o™8ØÜLI4Œ$m&ÇÌ6Hù‘´Ò6Ï™ £fù’Ù&“3va»&›mØÛ²Fv±¤ìÙ8㇒vg Ù7fìò<˜`~ºm#bBD™"DÒ"!3HÒd›¶A‘ ˆ6Úi6“4h›M’!$Œ‘¢h‘™12#M&""DÚ4‘¤‰4M¤’&’&$"$‘4ÒXãcm¶y˜3LÃ1›Ä!™¶Ïm¼LoM‡ˆx¶x³w¼Y6Þ-¼Xñx¦ÒLðM¢LñDIž ií ˜}YÇÛm±û&Ù¶Èß[mõ¶}lÛë=„ͳÐ7¡&oDÙoFÛ=I¶oD›$ͤmž'¢i$›oDÍ´"coD’coCI´ƒ=M³z"DÄŒÏD„†ÛÑ#6ê™4›fêcuuT›ª6›n­C©ÔuB7W£>‡A¶Øúˆb’i’cI¤$šA$›Ñ!#&hdi2$Ù 6šM"I´š$É4ÒHDÓ$&šDÒ4“i$’i4"HI4'ÆÜqu6m¶ÈÛɳx¶ÙâŠM›Ä,­™°ß[4cëëlÝ[©¶êmÕ2$“$6êmM·RLͺ¦&ÁÔ“HÌuD¨LÚMQ¶“$†ÛªIÝRlÇT$šFÍÕ $Cc¢&fèft ègCn€èÙÐI·F݈pƒÑ&ÝM'C::&Lú^í¶Ø´ƒH$‘2LÄ„›D™²cI‘&i›H›dÙ4DÓd„š$i ‰"D“$“F’!l™#I$ÄM¤&H“i$&™"B ¤I‘4’#û)¶caäýw˜úÿ]ö¿Ú¢ÿv‚h¢Šd‘Eÿu4_íÿ*E"ºÑQ5P‚ D’¤š &‚(¨’I ü‚@ªù*¢™tDEdÑ$ùgÉ"‹þŠ >A&šk"ŠŒ¨’Š ª©MT(’H¨ù$AB"‚i?צùWø¨¦ùUQYÿ"k2šoþh”AtÐ\Š(¤ù„QM4ÑAWÿETÖI1%_ôŸýÓQE Eêÿ‰"Šˆ>¤Q"J&ÕÓ;~EÙÍ”]L7Ô™AŸ–auQP™H¨DŠ¦ù5Aùº,(›òeœ®«ÔMd“,²ÄŸð¿Å¡f"E‹¿‰?ÀÑdÜ"›óeUEEA%H¹4‘M4_Îà0ù5IdOð Ëò¬*©U› þEEUò)¦Â+´Q”P¢*2¢l*Š¯‘M¨’#*0’åh“/ð0IP"ƒV‰AuH¦•SjU’E$~U¢ÄÙl“ä$AB+0™DAE|ˆº‰ ÃDÒ}M5]"Š$Z$š,;Q¢ (ƒDàHšˆ&E6‰2Š‰*ÊS]5×$& ªÈ&] ¢E"ˆ(’•U"H‘4I4 ú¢L¬aÑATEê*¨’‹°Âˆ´$šê"«äA}EŸM‚)˜YT|¢¤ùʤ%IuYDP*ú‚i"š(¬EòH Êh¦ºÏ˽XŠ«$$ž¢Ñ2åWE¢o•2麫¨¢M¢’OS$š(®éùùT®‚OÍÛ¨›)5hõ6Y—h(š¨&“ò¼Qd~I"Eò üŠ( ¹‘AŸp²+>MQE&ˆ¬ÃVMt”AtÔI ’ ¨¢i¨›d °’k ², Y$A4R.Šh$šH ‹ 7U^°Ã ,¹î2ÑÔ5pËUM”˜MDEQ ùù²ª(ši¤›¤ˆ’E ‘‘ATQQù',.e& &‚¯|$Íš®Ê UdAPa$IU$ƒ*¦¢h"Šh$ÃóU—A•Xšl ‹äQE4S@‹ò) ÑRAÍ*¢‹2üšEd˜YÊ$ÔSYdH ‚¨ƒ(&ùm(Â(&¢ $ŠK"ÙȪšI ¢ÉQ•QePAªmÒ"™ "Âh š¨&ÑÍLšI¤Š(*šI¦ÂJ(²K¤’ª ªiXšª(¡a"(?"ùFDY7oML¢MTYA†Iò ¢$‚~Iò¯š UD_>E ¢Aºo¨*áDÒUMPah²heËT0ø3'I¢A¢L ’ PEUÔUü‚j¢Š ¤’H¢‰R*’IYòHET‘|Šf«ªº(xˆ.Â̤íTU|‚ ¤‰WH(ƒù4•A$ÓL’ •M4‘lÑ4ÑAò+*ŠÈ M©*Ë *š) Š¨4I$ÓERI"/‘DŠ(‘z‹êj¤IDUAdPIò­I"Q$”Lª .IAQAQ|‚$Š‰pš( ²ª&@Š($Š©¨£ùGÉ‘H’ª$’K"‰dÈA Š ‚É$šI ’ªŠ(¾Q"i¦“ò©¤›+,šˆ¤ePID>MY"H¢‰dš*QEDš‹ ù|‚H*šd“AȤ«*¦‚I¨›ãt–I*‚H AEPA”D’ ¦ˆõR&š(¦‚* ü’¨$Š(‚I¿*šÅ$‰² þAD &‘IAòD Š˜Q”YõTØaËM%‘M$P|Š("M%&¢+({UÔAEP*Ëù% ¾A²+&Š ¦‚I‘&’,’J $H¨Š(>IùTSM„RArŠ$‚ ‘|‚(”@‚* ù"$QA$ Q4’EEòˆ ’(8Q5–|Š¨¬ù‘I$PEÄP D@Šˆ"Ši¢ Š) Mº ¢þIATQAII|»DÊ•UPT™4$‚HM2”M$EQEò("A$Š) M$PE'É ‚QD‚&Š($šUCäP(MŽÒHYÊ>IQAB) ‚¤‚-z¢Ì"ú‚" ]’TºH‚$I$AE”ßR*¢2‚J"²0‚) Š¨ AIDIª ,Šh"A"""J" š) ’¤Š"‚dÑ"› "ù4PA?E.SL‚)¢A'È&‚)¢³äœ ™TADRI ‘EEI"ùAñ4 š (Š(¨‘ ’i$QÊ ’ˆ(Š (‘Fé&’h “äI‘A>|‚ ’BI EÑIò (M$PEQEA$ª,šˆ$™4’@ù(&’)"IIHDEA$RHŠ"‹âdPA’I4Lƒä M…RPѺN]Ú AMT$‚IDEH ‚ ùMRAP ùH"‘h¤’¨¶Hš$‰ UPTƒò *ù4‘E$‘A$PA_"‚ˆ ùT¦‚>EQEQA4D7HšH¾ATQ ƒf‹&š%Õvšˆ"‚K‘A•IA!|ŠÒEò ’„HíÒ_nÝ5Ÿ"‘,”ˆ¾IE2ÊDÐM@‚ ²‰¬²‰ ’(‘"‚(Dª¤’$|Š$ŠI$“ä " Š%U2L"«„T>I‘"@°‚$H‰M$ˆ ‚ ùdQAÏ–AòÉ,ÝP ’ •EUQM4 ‰H6EDÑAòd¢‰¢Š($‘ DŠ$Tªi›¸DþarKEò$‘Iˆ"‘I„ÑME”@’ DQ’A¢ÍÐIGJ¿ Ê›"ETUA(¢AH Š(Eò’IòI&’( ‰š?›¦›²»„ ƒ ¢“äÑjÕ!%PEò•EñP\‚MI¢"šh õL¦ršë @‚ê"6PŠÈ  ªÈ$ši>Dši &EEÒAW?"±Et–Iã ¤@¢( ¡QD’’Aò ‚iAòH>Eh š’IÉTX]gÏ(Â)  Â"H ö"C؇âobdžÄÒp‚RDH“äH ‚P|A$RAÈ7A ø‰4PIwæPEI'ÍPM"‰¨°‚H¦E$PEEäEEeRE4È4U«u‹½aÂÄPAò °“( nŠH º ’‰8@‰•´xÃtYI„Ì“IÉ Ih$š(¢@MQ"‚ “´’"‚h$‚&SM¡º‰¤íÈ ª$P@ŠÈ›‰£M#؉"G~[Ø‘' ª"I"A'È4ví$ÑråVrÁ¢ê$²¤MÊ&‹âH&Ž!Â'Hq$ÜqÂM¢ù|AÉ$“ä‘EADȦš(ü‰2I©$EQA$‘I"ADQ ’‰&$Ð|‚'D˜Y¢Éˆ*ùò/–I$‚( ù ÑÉ á6ˆ$š ùeŸ”M4Þ9PÝ ÑH²(½EÉ €Š‘Eòé Š( ‚  Õ'åz³òj.ŠÈ˜E>E ¢ŠNRxÜÝ6‰¾°]» "‹äQ@Ši$’®Yª©ª³–Ê,™I'ˆ°²Š8QtÕMEß ‚*Aò‰¦‘òé?.°õER › Ù&Ãæ[¢² ¼A¨¢ƒóT˜E7ÔQARA”ܾ¬ŠÉ Ñ¢ ‚è ‚¤L¤«(·QV¨:$Ãê$S}A "ºMÑUó*¨ÑùÒL åUÐntÂN(Š¬¹eâ RXÑÒ‰´Q$µrŠ*ñ²‰"«Š"U$Úª‹t—|²o¨¤ùÊ掙E–Ë<`ºJA›8adVY7(¼]}rÙ‹>Iâ«=råÛU\4I©T’Q£¦É¼j¢Ì"Ë ºnÊܵY„YM7ÍPŠ­2ÊʪÊAfSE”Ø}AtA„Z°ËóEQn}UTA&èµIunåV6E‡ 9hÃ*&’Ï]7I6²Ê š¤“tWh£dU~vü“t°~e”z»…›&ƒ—™rù£¦RIÞ"eÓ×lÃÐjªh=9AeRlË”Pa£EM…’UeYÊ  «•›Q5‘püƒ,5Ií“hѲM*ËT”? Ý7J²’ ‹¦Ì¿>ªát˜M#„\:Mɳ ¹}nõVïS~xŠÎ ùn« ¢p²ê"¢J²‚ê £”Ÿ.ìéÊ)vÕâÉ¢ƒ†èhÝʬ”|íÒ¥›¦»WI"Ê&Œ;a•TQ³¦›V®Q¢ ·n’,¦Q³VÉ.Ê·E“tU£Rj(ŠOjB ªáÊ»níÊJ0á¡eWA%TA«‡h0“Å’l³´ÑAƒ¤Û¨Ê®–n}QFÊ:I“Uß“.ƒGL‘A«EMù³—,¨»v„Ú ED´EXQ4PUâé7`ªË4]v¤²è ª«2‚N×r“òïXj„YQ³d(ÕVÌ*M4ÕhÕPpÙg ¤Ë"’jŠ WI¢ÑV¬Õ…ÐU£ ¤åªž½vÑX4MËÇ.ÕpѲ‰®á•e•_š4z« 2Ö$ÙU$›tI…ÐIDÎP~QEVeUh‰êȹAÍZ"²ˆ ‚0²(*ŠH¢Ñ5AÕhªŒ(ŠÈrí•›$Š­R]VPaRQ“eCê쬒Ϭ®’Že¢I¤«µË$ÑTQ9M‰2«Q£Æ̦ВíÒa6h£nÑuUEC( ÙWk®Ê­´e„ ;Mu "ªI5~EÓFPe£F‹(I‡j.ºhªÔ’ >¢«(ªít–AWYv‰¬¢ê¿ »´OZ¢ªÎ?6efÌ"²H¨‹¥EFPed”UE,“êÎE,*Õóó,®ÝZ íù…hªNW"]U–Q%IâMUòi½euX ’OVEê¢ívˆ,«*¦«gÖE(’ë0š®P`ÉËAfè5tšE ºhÕvYEƒ) é7L2ªnE "ÝÂ.2’©¼At ¢’-–EuZ¨Š‹š$š j鮋² 4.’O« “ ¿0’­UM—($ÉW¨5tåuÒQ…T]&TpÂ+*šË(áË´›´a³´|Ù£ ºAe ¢ñuÛ5M²‰·E Ñø›G ¦å²h(å¤Û6jÙƒv¬¨›dØa&]U\Ñ»(¼YÒÉšh›(0ª ¦“ÆléÃvN›,Øš ¬™v]¸]BJ üƒÇÉ(éV®pñâ̾®õ5—rátÚ «×‰(º)¤ÊŠ6IUp’Ƚef\ªáÛv®a¢dÝÉ„UMœ$å–`ƒ„MER š $E ’Œ6Mªë,Š¬¢Âj Á%ŸVxõÃG扲å‡h¨íÑ(,z£G%˜híÚˆ$ƒÅQQE:x‘dœ¤Ý¢ hºÎEóFË"²nPYeTL²ê¤Ñ³v‹´l冩<~M&î]8tÙWœ.«¤¦áÉ ³(²³ &éL¦Ë¤(“…œ ²É.᪬,¢MPI7ÍPpÑ4VzŠ.¢Ý² ™]E\›$£t’~på¢gZª’é,ªh¢’¬&»*œª¢J®ºˆ®A•Ef.¬8Mw¨6YÚ=Q…ªĄ̂Ñw-p‰ÂI$ùÓD2£•J$›•UªDÊÈ5Hºé4QWʬ«²²© ª ²…[&Ñ–Š6hÙvW]³¦ˆ,ÕÒ (Ãw(M&ë ³–p‚¨0áÊi¦ÂDÓE0‚i5Yóê ¤‚k;MÓ„ÐxÙ„ÓUÒh¸Q¡+½lÊ+:vŠë6a«ÆÊ,“„_7EFÄÓ ü‚è ª ¤á4^¨ŠÉ¢á„&ÊÊ»p› °‹W«°£†‹]•Û¤“¥VMFíÛªŠ§ ¢pÕ•”dõ6jÕt]Ó) ‚« ’É´M$‘E$ÚºQ„ÒA²Ï¬Ê ¢£(,ËU,šë(Eã¶ë:p²è0â“ÆÏÊ»]Tn‹ÖzéT]ªåºL$ʈ¨“¤.ƒTXíUSjà .ª.Q&PUª 8]ETY«¤TY²é0ƒvÉ(í'*v‚*åõUO®œµQÅÝ¢Ñ5&ÐíÓU ùTa…H$¹W×K“@‚VhÂì¿0ÙÒ.Ð4e5@‚̵Ye]E’EUܦÝ,²’K¸A"‡çˆ®²è¤‚ "]ëeReë¦ú»Å×EÊI2ÕÛ–‰7IUYe7(55]³Rë·p«PpÝW,¹nŠ]«-Q4×QW+¤Õ5É&“GÔa4–YuH¦ú«µUÒî“9E—­P› &M“VSY•É ›°»êNTe\ Ë&Š(™Ò Z¶]„Ú¤š).áDÙ`‹,¨LÂnËTŠ,³Eš ñU›9A„“tí&¬´e²MQ‡(š$üáõÃvÑIùÕÝj³Ô—HÕG ´IFª"]ã‡I.íÊNÛµnѫ너´U’hŠÍL› eGN”]…’e†ZªÂOÉ7.©n‰”lüÑ7-¾¦² 9AÛ»*ŠI¢õÒí"ñ«Ä°Õã…Ì áwäÓpÂ-U’©µQÔhÕu\¬ítÙjQ"É$¡ù4lå㶬(³óT˜Mf=M£–]²Ý³eÍ”ERŽ_S"“’O\´0YÒ µQf̪›ë Þªáe&‚,¢‹EÙhŠM˜aëvŒ(ÃGå5Q_•jš¬¦Ãó…’Q—L*‚ê´~EE ®›T\(º«®Ùõ”VjúõeTp«)·E&¯É¬²·PÑëUÔjŠ¦PzÝÛ —D«DSQ,éFˆEÛ$ʨª«d›µDÙ”ÒQY&¨¸EÂÈ(²ÎEÚ(®ª)0ÕÊé&ÂMÒMu(‰Oª2éuÒjÃ)´Q6©´U¤‹)$eÞªéùÒìž5nƒGŠU–ë¬Ùd4E2mM²‰.‚gÔÔLú‚Kµt’ê&Š…Y$\ ‰XE$2ÕÐAâH¨Õr©¬å³dš,á»”ÓhÔüÕP|Ý6í¨¢ê¤EAŠ®¢ (õ7ʺQõ«–¨4]£+¢áe9rÙÊé$ÊÍIw.ÊZ"AÊH;A£I…‘l±* Qt4tº®YuÕE$\*»†_Xj‚J$ñ¢*5]GäUnÑn«¦Uz¢+6l 8Ej ²îQv袂ë®Ý%š¢ª :E$ ü‚+¶tѪ ¢Ù5™nËêJ®EËvè&¢Éj¢H¼r«”]¤’ÏYŸ](íUhé¤Sewh4e» Aù—,¢á'/ÎÙ]º)¢áù„’A&¨²›¤ÑAT’]³eXE³´Ú xËEÔ}AWL¶hÙ3)¹Id(¡4™Q…IÓb+°á•Þ?5E7NhÕ»s…—Y%]ÒÍ\,‚l ÕW)¬Ã/¯©¬Ãw+0«t‘A² Í”UUhÊ*¦Ãó6IÚ VEëv稢Ֆ­Ú¢åE»ATXQ–];M¢J¬Mª)(å'*&Ëw‰72Ê,¨’j º-ÙjáV\5v£$ž6jÑÊ%•A«Cò¨9H“ "éÛ¶Y(»t]ÊoÎ\éve$¶eu–l²É~Dš®ÕEœ$Ãe‘hñ»uQ,åÒÉ ‘v‹ºh²dL5M†¨”|ÝËV¯UYV]*‹¤4l媈¸t²®VAdÞ»QDž$ËGL²»V*Ê©0‚).›tš š©®ÉÃ/®ÙVŠµh›DTr¢©*üÑt–níTj¢H²’¨ÑËV®š&ÕFŽ›=]«U›*ÊF¨¦Õõu×j‹¦ÎI„Û,ÙEÈ"í•Ý¢±Ú$œ,eDÔQD ¨Ãó†Íh“FŽlå¦ØE 5hÝ»tnƒWÕtÑÉ2 Z.‚Ì(ª,üšÄ[(íêEù[4lr»tÚ"“eZ¬úË´ÖA³D^¢‹¦]”ÕUÊMÕIºH,Њ)¦£¤•MÒ+7jš¨(õ^4e£„š7EùÛÔVMD9I¢g ÔhÃgÕ®õ·-¶t«‡J&à °Á†I×haõdRA£)0›×ˆ–.ÙªË=]†eÚnlõ»T¨‚ˆ¢²Ïª°‚ÓUuM²L¢ÕÒNQ}TáË(¶MÛ†ª&ƒFÎ\²’‰$²¬·aÒè¬ÑÖ]GH´Mvˆ®š¯h™Á®Âܵzª«5nÝF[(rݪˆ(éh“µšª¡En‚H¸Eºi¿"‹fîµQ'Õtèå7K*»–QEÐthå5jñD×jéù•]ªŠFë¶ ÕÃêIªá]²ÌªÐÂ*.Ùa&V"ÂŒ>´`Ñt®ÃTId™Y¢ª6EùºË @ªÊ(“=2Šé·IvxÂ.‘IêΞ$¢ÏHªH²Ù7L¨£ÄQ|Â0ƒT´M£š¬ÕFŒ4Q%¢vʪ¢AËD•A#%“Mà ÔE5ÓM4ÖL’H¦ÂH¼EÜ¢YêNž¢õ…\¦õ†îVEdÞ¸]ºª=r«e”]íXYrË0šo}eBi¸]…eÓÄÝ*å׊¸YM$•j‚ijÑr‰¶AêNPz©4jáDÓ]†ŽÑzËÔ Ñß“eôž0Ñ„™nÂnMÂ* éÊëªá±âäXYU2Ë4hÕPaS©,Ñ4rÃÄ]ÂȾ˜E”ÑDá[ ¢DMEªkª›uQUÓ)"‚k¶Qó· 4jÙ#tQv¯¼5MãuÚ8vìåi’x‹¦Q7*2ƒuV0í%–]wh¢ƒ¶QdÙ…Vlá&Z"õëTœ8nHá\¢¢Ê:láõ†RE²,¬¢†TQºv£òÉ ñ$Yh4téÛ¥š0Âí[´IÓë¦]KºlÊîÔ$‚¯TrÉFK"Šè$º xÑ$ÓMÒJ2‹Ô—U5—a¤šNÒ;nÊMVnp‹¤e¢ ¦‹ó ”eVå‘Iæ­UÑÂé.åv§äAeTjÊ­&ú¡Ó¶Prõ»ó–­—xå¨6YÂȤIÊ©5M0IÚ+¨átMcÕAÚ ®²ê¹I4U`õ×­R]” “VŽ¦Õ߉At\>¦õ…MŒ*Õ¢Š4e&~~MVíPUgÔ¶:}Yº­*átÑaªªšJ$ª.Ú¬£Ú$³FYcò."›êK¨éâh°EÓ„Òa6YU—‰²“ 0å%–a5TIÒ(2ª ®Ãó”—=At‘]¢-Z½n‚¨·atRa$ÔrÉ’l»µYU²N— Š 6Yªo_–YGç ¶jŠª›*ƒ-¤ñG‰9nƒejƒ*¤ªoUº%] ²Ê9páë/š4MÂ%Ü2ªÍt’_](ªØj²i:,ñDܪ¢ª,›Gm•rÑâ̺h²iºhñÓ,´=n£¦¢Ã YrÝ4š»IÓf°Ý²©¹nº ¨ŠÍQ|º(¨Ñ»†ê®±Vˆ·jªÈµU¢]&“¹e40“¤ ÊdX5]Êl»a%—eÒ$ž0ªÎ,Ù«”TMêOʵtåfVM“j‹ÄÍž7Y7ÔÔUUÝ,ŠMÞµhñ¢Ë&Õ5š¦Ý•Û4I†af®Ú¢ÊL´Y’YÒÌ å%ß(ŠÌ ¢ ”YꉺUQ|‚m•lñùu—pÊï,Ë ™zÕÊK*á&¨Ã¤5 z¨5eÂd(’ïXp¢_š,ÂÍxѪʚ,£–®6Iù—I8aù£TDÉÛ†IT"‚)¦Â ²ƒ†‹ šOV]‡Ô•~h‚©¸A«)9zº«="‹U‘Iº&©(í4j‚,$‚„Î(º 2úÃGŠªQ«¹Q»†MÛ‡ÔØQ4jÑÑËlj*»óòdÚ0ì¢mޮ "ív‰¶lõ»V;aõeÝ?<]ˆSh£G©$³/WMDW9zvüÜáõ¬ºU„ÓlŠI$£F­PYõ($¡vÎ6]C†ê5QÒn™IÚmÒjéTA¢¯ÍhÃb¨ åfWrÝXMXE¢¢h=EdµEÛ8hõUÐeìIe‘t#Tß"’¤‰Úi°Š ršÖH¡Ò ½n²¬°²ë¤Šh4E6ÆïIù–hÕÛ„”I«bI ¢ì¢úÝSDÑv™Ë-]%PMõuÓY†«&‘¨¬Â¤š$ªnUUºŠU'W]T]°’Ä2‹ò,¦¡;D³, ÑÚ…ÐMªn¼]wWjЂÊ7n£F骢‹4r’È5n²J;EW-Pe5Z»xÂkY‹¦’æ¨ ›D\¤í†ž5a‡æ©$ËÇ©*‹C„Ý¢ÝtÈ šJ(ƒêhª’ °Êgª"õ£¶É’M†ˆ“0£W­¬tñõª‹*]REu"ŠÍ›¬šÊ¿"›F*²¨2“d^¾–lª.WE&TvéõEA‹(éw .‘tÐAë ªªª¾ ƒUEYÚé0³-SA•‘ršNI6¯®˜YG-Qlùºíœ˜n‹u’]”I»z«eÐawÌ7lË*$“fŽ´Q”jŠ*9E£Gª Ê­lº­»Aã)8A£ó,;E”˜hÑ6ˆ¨‹dÒj‹gÎT£„Ug× ~YdÕeuQõA…U£ÇçH°í5‘Aë†TQ( º ¶6AfïÈ·Qš¢Ñ…Z¨ºì9lÝ4$r麭œ›4eãÖÊ°Âî]³EÛ´A»–QAVhš®M—¨¹xŠ*2‚˶h²¬·Mã•Ú Š 0ÃGÕß]·xéÜ=lõãÖzÑÓG'«¨ÝVZ¸nÕF© Á†Š4UK>µYõÄEV«v‹VªµEªÈ6U¹³G׌¢“ š"áÒïWAwÌ9p“fª6jÝêêºIv¬"Ýgi:0Â(.ƒeXU³´›¾¬›Õ¼p¡7M[»p²J5A,8A‰¨²(¦£D“A"Ïtšì6YÍj£¶Ç.ÔU†È¶z¢Oª4U$Z9@ƒv]¤šN™hl‚¤W(Ù#+¹eeÔYUQdÐn¢M<}tºëµM–‹"Ñõfªƒvæ̨é«w4l£VîRDƒMØ$‰ÂÍš?8Yrë,ª&£¤Ø}jñºÉ¸e˧«¸nÕ »A©ÒJ4l«…pŠI&"«TÚ¢’H$ú›GÍ ²¬ ›*¬²é(íõ¡•VhåZ»nʬºl™ˆªÙ–IçÔšnáëòÖz¢ì—tún]'/_VI4ÙAê©2üËGÙIâ)nÝÛWo¯«ªÁ©^ADß]$“„Wx™â¬¹jðª Ut܃Sꈶ.ºEY7.’Q£-|«-j‚/ª¨üõã×F¬"Šˆ´t“¤nÕVPYùõ„¢Ù£ëÖ^8QÇ(–Iù©ºlüƒÅhÙB(0‚ .› ¸QF³ëXIªŽQP’^.‘vê»nåQnÊ-ÑpÊ(µ,¹4K?5xÙù\Aê [²ñ”¢eEPM‚ˆ ³Fé Ýõ³ (ƒ´Ÿš®åê-_MÚ­;~Y&¯~I²M[,íÛ ºU&\$Õe“xáUQeÐ}j«FÉ(«¶©¦õtPU.UËuWrñ'ʲ‚©.ü‰8Aù#ÄŽ½pÑãuXl“†PM„ ²‹uVtüᩪh»ví\5~Uãë•Ô]£æéHõȪ›t”DÕ£µ_I¢Ð‚¬»tÊH®Õ« (ƒ Ylñ„P³(¢‚$H‡ˆ:A³Tµ}h£ VQ&®Ý9a»¥VjÕáãòª¨ÁtUQ4‘QÊ¢¢ªš«,Êît‹§l(‹F]2ÔÝâë;a¢H=IõêŠ š,·0á6ʬI4eRK‘rá ´n©7Ôš6j’­¹EbÏ¢»Æè,’ˆ,‹Ö`ºmV`£ÕŸ“hÑè½x‹._^°U×]³¤\¦á³/4Ib§(¿"Šé’rš $ü£ÕQhšË°åeUIõwO«Pj«…“.Ëe:a*›ëÆPú›ÇÍ],ú›U$퉿$‹R $úíÒïhÂ.U~Iº«,ñ”WlË ¬õòM›²ÕH»YùVê®ñÛv®TYtÞ «\>¨ª¦º+¢dÙù¢ÍUë-(üŠì"³´Ñ~aË.‘n’fŠ»Mõ”TxŠÍ^ á6PQõI6zúüåE;aËt¹]ëÓGL ‹g+0‹óDV]¢Ì7Mùò (õ©%]Ëó(°Ùu]0«VUY„˜]VŒ*åõÃëf¢éŒœ·M•Žx£”MOZ7e«vVY„Ve$¸aÐ7UVÈ°ñ ¼YÐYTÓIÃ)¢ƒF­R ‚íYIãwO2Ýt°‹TSY³tÕQâ­Ù]g(:jÑ&Z5HÃò*"Ëu–]ÚoÍ›(›„µeÛTÜ®£¦_”0£.Ðp’Í8n¢ë¬üÝ£F2šÏYz‡-9e\»Púñ ’NEª =@ªM ±õ(6abÏ(‹DYtÕdÚ0ºn™~D¡ÛÇI4påf ÝËÆVIvQv“†ˆ2üÊÌ;]³‡k:l»ÔÍRI£W×I7]õëfŒ»zƒD´}l›V9IFȤõÚ)4Yªl¹jÃÅÙI%(üéTÏxƒg¨¾h©ªmPAG.nØáëë 5]ë5jõÒÍ]ë•“aj鬮IFé ²($ŠÊ8E5RIG.]Âê¹Y2­ LÝÃfîY¢é$]£ "Ë+¬Ed‹¤¡‡©´MtjºÊ—M1UAuÓa&©®›T&Ý$^5j¢•]SÕ*hD£óÔSQòž¢š[¬Ë–éY”PE—N¦ªîš5já&ÑMã”Ú·Qɲj&š (UÉ ˜Ñ'mØv²I.ÑËÄ› átZ¹n’l¼Ys*8hƒG©µrí%["‚,$Ê-\6IUUAõêi}Eòè2á˜;YÄ—IVMwO(²j=hºŽ6}Y²Èž>µI6]&¢Z6]%¬«T‹¦A–I5ž(ŠL(ÙêH¾¦ŠHª}Iâ&Ùêæ‹´Y7åZ5j£ƒ·*>¼ET]0›·æAâ ¹MvSAƒfŒ=j‹¶è4pÃGh¦Ë„YU„Û¦šˆ ÑêJ ’I õ…H®šÉ´E5ÐA«Fì°ÃD˜lšIjÐú‚(>rõÂȾ¦’ˆ*Ë*£Wª,ˇ©²¢ŽÖlš¨:M$VE"é&›TI,ÊeÔE²®WMF\6Iç,¸jºY0Ù$üõ6QMTZ°«¤“I‚jdº(??.²Šªå¢ª&©•E‹¤å5ß}]«§ŽPU£tPjåù” üåvˆ0’í á²Ë°»e]EºæQ]&ˆ*Y$Öa”K8jõGÖ¯Ë&ÃGå–Q7.Ór韛0Õª¨4Y—mYpvÊhªí&Uadzäõ&R~pá5’t²PAE µQt"¢è"‚i˜TšÄIùºOÌ Õ„tíÛ*5IÛ8jáwå‘n›.[•,á6\.£”^¿7e»t•nÕ‡ÕÞ ƒUÐI„’Hà 4}j’Žtõ6†ÍªÝ%\¦²mιEù”EÃ’¬µ8AÒeVaÚ+ Ý•Ú¦“/"Â0ñªÎ]½t’ Z¿$š·rÊEâ ;eÚRaº.ª“†ª¢ ´eWJ8e4AíQÚË9U¶rÕt|ºkµAÂ-Õ9UFAJ®‹‡M ®ºK¤’$RUª*.áÊí˜U©fXeêÈ·Q³µœ¦õ%œ5E…´Uã¦Ê8vÕD5I7j®³w ,“ò­Ú(¢ÍZ´j¢I.™â-‰&’ˆ,’i´n‚i"ÕwŽ˜rËëgM¨«gL&»+ºv«·ånƒ(²úåÊŽÔEù"íN‘r嫧‹ Š+¿9HÂï¯K¦ñÓ–Z¨åÒ+0õ5ßUjÙãeÔxõ.ÔQ—l¾ºMõÂË4}UÚ©¾IDWAÂʮݺ.rÃdI”Re†„Z8rÑ2 e$—jD“uZ¤¢Ú8MÖY³´R}Mê(,³Fˆ4]ƒ ¹n›.å4hl蛦È&£t×YÚN] Ñ«ç®nå3$0“W ¸`¢´ »$J$Ô¢jª«tÔ0Ù‘a-]6jÕ¢m™U&¬ eVª,ÑV¨¢ÑùŠ,’Hµ\ÑÚ8EVr»´×l‚jµ}p¢Mž$üˤ]¬³.ÒxÙõœ.Ù”Û*Õ¯H©Ó¥W(QZ.ƒ.õº ¸tÑ6ï¶]“gäI$Š¨¾ªIÒê¾UD\¢’H²ÝʤÐxšŠ™r²-QÚޢˆ®MPQ ´I­×Ad”7Aº 0ÙD”&£ ¢« *p»—-aê*»EC):jj£ÓaG¨lÙs-”Y†NWx‚+¦Mª©¨¢¨"v‹EÛ2õ4vUT2“TY5p‚ >jQ4ÑQ'å“aUÐUdŠ š ¶AÚ*µUg©ºní”lÊ©»Y…rÑË*0ÉdO¯Tv›·¾ “g-ݤ¡Vï[°ÊjºM³VÍÛ4hƒ¦VAÃ)"ªŽ‘E%œ9MtØnƒ °šl ªÌ•AvREÃ+´Xªˆ&›œ9tíãfhñ'­ÕEFˤ£u¬ŠÉ9~Et\ªÝuZ¬á4\¬õgåÑMòïWL’PnƒG)"à hõW×j"²æSI”Qx‚¯XYc×Õ¾®ÝêOÈ4lªíÛ½t‚‘Aã”.³×ʶh«ëF«µlúŠ‹*Ô²-på™]ºë¤õ„™AÁÒ)®“Ɖœ4ríÂi*Šè ‚©¤éùꌬa'ˆ¢ªÉ·Q"²õwª®›GH Ë)¨«FÎÜ.hƒQjäÕÃ-XrÐí«)9etx£•™Qº EË„U@ª+<]êTl£ "Š¯Ë»T»fYtËÅš¦“Õ}UÊ ¢úšQAfPhí†ë6I©Û„ÓLÑtÔn]uÎZ²Ù^,›(ªåeWI…[0² ݪª­ ¦š ÓE–=]º ]9E«(¾¢Ôѯ"íW 0Ù&‰0›”®£§‰MY*»·-ßTxåëgŽ]·pé6\6M†St³ ¶pñW¦ï¯µMÓǨµYgòI´E…“z«ò‰´M²I2ÊI ªµe–_̬²æeõ¯¨•AT\ õ$QtéETháT‰¢«„Ó]ù«”Ùpƒëêh ‚˜núÝt>¶jËÆZ ²j¤²9|Õ«GÕ;~Qsdˆ®ñÊ-pƒcRv›§®Q58QlƒòZ0‹Å–aTA„œ ÃNž¤ÝDÛ°ÙÌ¿l‚ˆ¬ªJ¿8M†WjÑ»f«•U‡ ¶eüõª­\4tºmÓvÙà 6jõ–¨(ÕõÓfÎ[¦áb-.áËÕVzŠ+¦Š.UÂ>M5Th÷ 0õ–YQ«W, ›×Ž;tþhè‚mØn‚‹=hš,¶U˵“A£†¯=nƒÖïVEGNÞ íã/r@Ê*YzÊè9e†‡J¬x¢¤ØU‰¸A4–QÃuŸRrüÕêlš•xÙ"‹¥ž=zzÝUØh‘»E_Îʾ¬õ6I6ç–p£UhÃfˆe”ÐYËUÔ}}h¢ç­W}MÓA££ò‰(ñ”Vhúч Òxíªè(‚k4*²,¶råEÚ2ƒV_\A»gŽÑatVQGmjáÂo;E£Æ¨áŠ¸@ÙF¯SI†í4AWˆ¹]ó*¿?0í¢/ã M/_’lÝK¢²,“tÙ£—ÕQu×xÊ( «¥YõtZ¼aˆ¢úÂMȤ%—z‘EµUvh‚H*ƒ×KM†§óª©õÒ©.²®H8QdÉ*’ÍYhËe](š¬ºr³Ä*»wå?(á6Š?0ª«,ÕüÑë…’vü²®”"«ùù ’ ¢ú“Gªª±«"õu £Ö‹·n£óÅßMÔMÕÑMvë?5x“,®þT’LªéfË»ID[·AÚG-nŠ©6IÂ̾¹ríÛf«8hÙ'Nedܨ£–«$ªÉ,Ù—×ç*¬ÊNTMÒ¯7Q ¤šO[¬@éÚȪ›tYtä‚ RA«Gó 7Ye .ºOª´eu“MŠ]T\¶]7$[¹h壕Upš©¶Mê,šgóTOæÆ®\ª«ƒµ[¢’~AÛ‡m®ÊÍ]†Š8}~nƒë³×oæíAËdÕpüգ«¹M†Wv³ç…ÖQ¢j;lÑ£Öé0Ñ%Û¢šiŸ’UBh5AeËÕÕa._ɹA³DŸ[;\ñõÊ._Pe5ßJ5e5˜råt=au\ «ƒò*¢šˆ2ƒ+¿8jéW¯ÊY»2þa$ÙM'òŠ¦Šˆ"Ñg*¢ƒ*»]F[¤ÕËÕ•M뇯äœ4~zÂͺpñ†H¦ºíÞ?žª»WXQW×çÖ ÝâH®lʬ·Q'mœ5EÒ ¿˜I»s–ª$£uš»E¸IÂÍ—I⊮ÙMÖ Ù‡¦ƒU^ºj“-AÚn¶nÑGåQh‹fœ½ITPjºÎš¬á†¨ºnÔ“ ¸a‘a4núšÍYEg µMê*°áª¸e«vˆ=\›ù«…˜xÝùT–vÃë†9M–ʶxáî­ž¹8xa%’M—ÖÉ´~r»g‰(›v¬;eÎhѺϭ]Âì¿·YÂ=(Ù»·ŽETÜ6jÃWÔÕ5e•j»E>·p›¥ÙLѳù†^¨Ñ«)6]«UÓjþY£…Û4QÂek·z»•??"å— 9a4R9UӶʶl›VYU»E×rìÝêR]g ´YãVråÃVî8]UZ¢’ε`³/RaÂnÕtþAÃùõ†U¹õë*¢Ñ»òÍ^*²Ža«ê M”ÒAë—ˆµ"›§‰2éÃYVÌ6EÛ¤ÐAõwG ¨Ñ¢PhÙ•eü¡e»tRz‹„š?I‡+0óÕ[,²ïçå*ŠŠ´A”xá— >¹}zÙdUõ»Ç*¾ aÒ(2Ã׊´UeQEV[¦ŠpÝ4•*“¼E”¾¢“—O¬–zÙÓ¦íß$åÓ Ì¨ªTE$×AÂM›ªŠ ´}U] Ù©—æê??žµ}h’.\´QFO‘lÕ„š5nUÓóòª5täÃ-Öh‚Œ0‚ê?’YV®š¢õüÃv‘Uè¸Inþnúí²Î;H‰³–î“M\¸YuÙ]tVQùãw(4YTœ¸(›,?,£/åVM[¢©£×第Ý˧š¦»ëW×圹Ut÷5a$ŸÎt˦Œ¾»AÂ*µrƒ—ä¹AË.’E•Ú»lÕ4TXü²MPY£Æ²úÝEWQeÚªñªeRU†Ê2᣶ÄΨMG©¨éõª®hƒ ŸÈ°¡†é¨zÙçŽYt©üÝT¬n‚J½2«,áëfïçÔTej¨áÁl©£óÆZ>°›ùÜ2íä&éÓF ²$ ÊÇò*4aS·J8a³ù³¶¨ ðù³D›4t‰–Ê>I4Mâ*¢]gM[ Ã‡+®éÈ(þl“dXA&¿‘Q—¨:núƒWŠ»r݆]¦ÂN]:Iò(»eÑv:$åÓTÒ}lúÕ†4I£VË·IÚJ¸Mfˆºj«*.“åM‘EV©$ÝT"“t4XšJ;@ÊÎRnËÆ«6A”œ"pÕüéªÈ2Õf,±ù£P~|ÂJª›êY‡j:M‡agŒ¤›ÔhEÒ/å›*ªê¨“”tŠíPrá$ˆ¤ªL8}6?4púŠŠ9$‚/âJ²Â)2‰»UØA¥2íaˆ¿ «wj&Ùœ?•]Tßzá†È ›Wm”A6]0éÒj9]çó ¼YrNle³Ç+¤õDÐd²i&Ù&jéT]>ªéÂ-ÕI–Îœ¹EÒŽ40ÝGh»xü“ÔI“EÝ?›¬²É>¦Õüt*ˆWj«ÕÐxáÛÆYVQEê$“v_[¬õÑM»•Ì¢ÑªŒ(åòi›7e&ÏUníº‰pŠîÛ «†ê¨’&¢-ݬÉEaÛµZ,‰Ò-”YDA«ëùÒl³TÝ4v£ë.œ¦“„Õa7ˆ9pí4Ü·A¢j2éù&ç©6nÙvÎ\8láüƒ—O·}Aëøå×-–eRÎPIɶa¢¯äTav‰.ƒ.‘UtÚ7v±Wå»~hå©ù–VxÙ†PAù³–®®á7ÕÑvʪ.£†S]7¯Rj²I8rõ‡Òˆ´l“WòȤ“†ÍT]f‰¾°å³tš*äí6©4A—J¸~]õ»VA$K úÙT å&©´tч,®þ@©%¨›§ä®‚¤7t› U"õ3gŒ¤õâïæ[®Ù„Ú¤²Š8lÑüšm(üÑÊ´~P›´E£å™E£ ¦‚oQX¡6îT9Qg ›¼eÚ”aÊïä_–eT ¹M‡®[¹rþlÂM>²»· ñ‡,&ƒÅš ›*²õ‡M“jÂíš(ÙFÏʦåÃ…œ2A7 4lúÕ«µVMâSnɺÏäÔ`ÕãSgòÍ\ªàܺ-”EÓ—ä úá³ ²åºˆ á´AV\.þdÝ»F^&ŠÎ.ݳó¥Û2rÉVȶEvË»]õ$Óe…ÔYG‹¦Ñ£†Ï­SM©8X“”RhÝä]¿$z³uÖt³äzõ&Œ¿7~}A7I6teõË‚J¼Q'Š8UFZ¼YgH7hé'Öˤº "¢ 2«W,ºj£V^µ(é˜U' ÖAL,³ùT›¿7eº®[»EºÍQt‹eSEüüËê/æ”&ÝdßÎ×IURt›ù³ Ï®ž¨Š©´zéFå}I5[0›·×+> í»…]*õgh:a×OÉ5léuÜ"ª IURrúÃĵnÕùùÖè.Ù¡ùº,‹·NŽ6l›eŸš¿(åÛòÐnéòk4MF§ª(ËFŽŸtþaËùd°å¢-–~M²É5Eʬ·Iêì5pþ8TËùÉË×JªÑ£ó*¾¨ÝÓV¨ üé'j®ÊQeùÊ »}A㳇©(éãfî[9}xñõÓ¤Òa«tÔ}p£·MUMãDÍßžªÑ–ËÇUYVê;vÐüÑõ²mž¾¢áe\*å’Uª*,šˆ¾¦Ñe^´UõTVxþxñ7Š$‹“’…K¸~M«ë”PjÕ7ª&é6ì0ËVªš®£Gl0£¶ª´8UÖ^2¢m‘jþU«ë†(ƒgŠ¶}}"Ý^¨á¨»j›(¬ƒ´Ú6~xʬ˜v±5ÓAË‚g-¸zÑÚ”A³È>¹eDRQÔjÕ«  å¢,9a— ·Aét\¶tËù—Nº?´vüéÛÖ•Uë&©(þlúÂMY Õwª*ñ«g —z«GÕM=Aüü©¸U«×h—ó·òn^8Qc§k ÝÓ *պȤÑõ²Ì?“nþYU$Ù„Û´A£wMÐlåÚJ¸}z‚/ânœ¤áó¤¦üúÕëù—òl¨“EÚ*»gäN~DÕg.š¤Ë,½?~UÉŽY”OȶQ4Z:hƒÕ“xþlñ6É*’­a%Yrü£gMpšÍ]·rƒ·MŸË¿"ñ†\=MÓ¾°íDÞ¿˜]ü«w*,õFÏ[¹háêrÃÇŠ¬Õ•[9QfRM7ç×å8a—ŽM»ùËu×~v›ó”ß“rËó¥QIüú*ƒ¦VUÛ륾¿(þQUZ$ÕŒ=aâ¤_Ïå\2õUœ½Yª(&í¢MÑzúé릭š²áVÈ»}UÛ¼zšYª/ç*®õã%ž8~Y6¯È6v£(ª«/Yn¢(:>µ4&»uŽÞ¸tÝ«ÕPLƒ×NYaõ£Ä\»xƒgäÙrúå²åAË/^"¢j2»f¨²Õ†$ŠOrÝ4ݪñVŽŸš&üѳóÇ­a&îXhñeI²m–túƒ_–pƒwæ˲úÊ®,Q\¬ÑùݦáãDß’zxÙgÖάe6QxÝG?ŸÌ6AE×põüå$ÓzÙäÚ=YÓççI;h£ùUÈ(èšn$¢NÒI² ž°‹$]‡ã-Õtš+:Eù³‡oʵ?›¼"á„°‹•_ÎTËùëùâ.Tn«-rí«ùüú壷 µvõüüÜ£×HºUª¯çi´j£åI7­Ñj‚m°‚ Ú&Ùã–h»(9rõÂnPvÑgn”Yü£µÖrÙ»µ_Z?—]ü«×«²«¦ïÏ­XjáÓÓù²§-pƒNœ=2ᣆºYe×nŠ.]??Š¬«–Vx›ëùõW×æ^$³ë ÍVMgòÎݵzƒó‡JªÃ–¯¯Wrá£ùi5~Uã *›VÏççm;e–~~züÙÔ~tè«êÉ6lQUUn‘fÈ¿™~zÕf¨ñWòÏ«»Y‹½t»²I¼IùÊî—n«„nõËsdܬ«w ÓEJ ²­¤ÕWA¢l½}a5Øzš 7t’/¯®Qõ&é¿›¨«vë?œ®Ý³v®Þ;ní–Í_›.úQ‡/®\¤tüíâi¨þQ£/çó¦ê¬ÑÛZ´U£-Qtºi½|ªÉ8r¢ïªµnÃg˜eËê)»nƒdZ½4}]&¤ƒÇj¬Ë 4eMEvÍtéçò Öt‚(??$ÝËE]B®š*íëÖˆ?“Eë•š´~háÛùËÇÝ7Q\(£ÇŽ—nÃg¤ßȪÝÂ&ïV5QùÛëÆè¼lÑ„ÙIëùVŽÛª›ñºŽ—~j®ÏníâçMÕn«Æ‹< ªK»lõÚîvõ£wæʺAõwo[ªí†ÍÐYíQËål›¦¯^0õ«–¯_™láÂnÙQê(¶nÊi¢Õ ½pÃ¥^5Ig­°Âl7UºJ9QÚ«¼tŠË$ú£·)¨í˜(ÂŽV}AºÍpüég (’H7;IÚk4Y&Ê>¾°»òŽß[¨³FXz£D‘jõ£) Ý놯䞮³†ë$šoçi$›(;It—rzõ]¸LÇ ÕA²Ú,íEßÍhÃëf‹2åùù„RIGNShñf«&å'.Xjù£”ÓQ²®×nÝÓPh›W‰:jí†ä–hñ‡-’Aù$5v²®[µQ‡MÔewåÚ¶*ÑT;j›G¯]®ÝÃTMõ»ss†«2ºÎTzí'Raw概äŸTj³ä˜h‹ùÛf¯­ÑhüªÎÒ]Ã-hÑêj°ÕÇO¬½tŠN›7hþEÓfé?™nÕÛêmOr“‡¯Ë2ƒÅJ;}j›V~}z“ówóùGÕš¾¦Ñ7çÒÏæ‹5"úÊ’x£´YõùÛ·I9v²ÍÕQãëÕY;]»¢¯_ÎZ¢åF¨0“‡›ª›ù㇩ªúñ«¥[¤þI$¿2õ£ó *Ýà Ý:eüå–‹¤ád]¹tÑõ5?4U8Eüñ²­Ú$“‡°»×,¢Õëµ^ºaõõ&p±ËŸÏWEWj=~hÕë/Z=~xú²¯ÊºpƒÏÇj»IVYUUPQ' 8vË)ºxú‹Çó§Öë»A÷oP2ÕÂLª³¥\>²áÒ+ ËWeëWŠ*ñê $ô£ÕaÐ}~~Xí䜽Eºk$þjšH"›WÖîT,º_ÆÈ(³Fè¤Ê/UMÛFé>E”;HšO­–]»•ÓUW­xÙJ4nüåuÛ Ù⌤ѻ-ܼ]â)$›—Ž¿ž;lƒëòí »·k¿˜hË…È´EÃgäÞ&Õ²-”Af좻…–Ygó¦\µvþEªîÔIüáw °’/äž$ÂO~zú‹†a³*µ]4”QùWóÓ}YÊɤÕ"l¤Ý³YMVí‘tÑE›¿–*šNŸÏ¨·eüá³uÝ?UV­–YÂîÛ(íÊ/_]¨²ˆ6h£ùÚ­TE7ó“VÏnÉß™j»WòOç×ÖÏÉ·tºï°þUÊ/ÎÍxõõ®2ƒÖŽœ¢úÙÃu°úÊo­8a³,¾´A„‘~túaËÕn‹óòΖrü£v_zÑb˸}p¢J?9]W0vüú«×H7xY‡l=aª^2ÙÊ"³„SxÁÛ5}hå»ÖÍݵzšê=E¢¯È¾¸zþQðÑÃg®U&Ý»ê¨ú›T]:nõ†­^,“ 5A«W-8]†Í_Vz³V¬2£êI¢ =A£µÜ5EwQEËVŒZ°õüËùËW.˜n» »pŠÎRaâïhMËS·.[¤Ùêhµp~e‹²þzaùÛÕPzåSë”ÏÏTAw©¼IÓ•Š¢³ù7Ö^0éÛtjË—~MÛDÞºxÝùV«&å–‘jþM?¬Ñ”lIwŽßž.ÙËDh›Çò ¨›§ ´]«´UÓù¢j=M·ªdmêØõmêQž¦~SoT›Õ½QÔÞ©7©ùÞóͶÌÌÿÁ"A¤Ø›HÂI¶B!‘4“DÙ&LÑ¢F“!&Ó!1$DÉ$#DDŒ›B$È“Im$šhI&‘“H‘I!ÞÒ~«~¨ÇꙿTÌû›fû“hÇÜÛ>âFfû¤Ù¾á™÷6cîI³îqÆ7iM¶ßsŽ8ˆ’M¶“î$îHÛîLÄ“6I÷6ÒëGˆ€ÞD›I³|lo#mäÙäÛy äˆÛÉ·SÉɼ’cÉ!äò<“ `ûÌáŽæw 'r ¶îmÜnæÎæÎæÎæÃÉ£w$“=®äkë`ÁýÔ‰$Ò4›HI¤4“DbF$’I‰ $Í¢Lm$ÚM$hÉ$’ É!!L‰¢I$Dˆ‰!&‘4‰¢L“!&‰$"HDÒ"D“I´šL‘$‘‡í·ÄýaŸÎcõ›7ë¼Û1æÛo4AžlÙææ7šLhÛI°‰ ·š&I¶o4Ä„晢C$Ò2FÏ4š#šdfy¤„ÉžhdÞhp†âl$I$H$ØÝ‘Ý€ìš`ì7fÛ³gc;²!Ù$ìÜgcv f ý¿¡ÞÌw±»Í·xÎô›áÞ™èIy»Æïnðïi7zn÷{Øq#Úéÿoó›m¾ ¤Æ‘¤ÒI"$HbB$lÒi¤Ò1&ɤl’I2$HdHÚ4„i¤4’I4’d$$F“i´D“ šH‘¢IšHˆ™!4‘"LšH’D“F’"OûßQŸSm¾¦Û|M›z ÏFÙèšdŒÞè“l= 37¡¶ÞˆÈšDÞŽ8Ì8‰¤l=ôI’m›ÐÒcoDF‰‰6’DÛ$6z&ѳz4‘3mÙ4ȘnÌÎÆ›nÌÎÍ·f; Øìgfvf<™äì;FÙ¶Ù;›lî3wnãnãnã;™»»‰æwÜÙÜ“nâ&Îæwiýýãý¼|Lÿ ýhþ‡èû/Ó¾‘¶úYŸIaô¶gÒˆgÒ˜™¶ú[dŒo¤ô¶})˜BM³})1& 1þšam¶úZBLi6},$ÂM¶úR$Áô¤Òm›Õ&Û=XÞ­‡©ž£Õ«gÁêÙ7ªz¸ õ7ªdõG«C¦Í±¶Îßûÿ=¾%ëûÙèÿÑ¿½ý¬ú~¯”fùFß+å>T4gÊ“>S| ùCåo”‘¾T’Hß*q7òÞÄß*h}‡ÈoêÿwûþdzÙìù†lÌÿ1 $Ò&’@M´›I´ÌHšM´ˆ‰²Dhi¤ÛI"2f›D„˜‘2I$„M‘¦Ò$šH’h™"hÈÒI¦H‰$‰þ'ã1øÙ¿Ûñ°}Œ±&Ò6ûFcòY±›o°’&m¾Ä4šDHgØ›4É}‰šD ö&ÜLq!¤6}Œ7ØCD˜o±$¾Â4>Ç1·HÆó žfÏ6ÙæÛy¶Òg›6Ï3y¤g™¼ÓÍÆÑžd›Í‘æv| m‚=¬gµím½¬{M½§µcÚmícÚokDÒ7µ¤Ïj$š{Yí<Ò=£øfÛgÐÛñ ø›‰™øƒn¬£n©1R1¾VÙÕ6ÐÛuM$3:³lêši1Ž£mÔ†›cªbMhšM›u Õ‰PÒA·TD™±ÔÛ:°êØêmÔÛ«gS:ƒ«q7QÕ8œtc«IÔN®£©¶ßäFÌ’DÒ`‘FÙ&‰1$$I™"6Òd$ÈÄš$“L‘“DÂ"$ÙBf‘"m$“BIFDŒ‰‰$DÈ’M$БL“H“$ûî?þCm†>#Àͼð3xà2x¼“gƒ7ƒx àgå¤ãÁ<dx7´ýãlÛgÎÛçc|à|ãgc²c³±‡dCgfÛvH“FÛ²@;"`ì›q6n&Èd4I¤3vLDB@; Ý“$’išI6mÙ24˜gf‘¶“nƒmÑ#mÑø èØè“mÑt3¢'DŽŽ‰‰:8ÒC¡ÑÑÐÍý4Ù#F“"H›lŒÚd‚A!i4’ ‘¤Í#LÚf’b$ #h"M¢FI $ÒM “h!&’BD“II$’M$I4„Ò4$›BI? qÁþg±4ÛÃâx¶g‹6ñmž#x³tlI‰1DÒH™¤l“$ LÚHÄI´š2$I’"$›hÈ‘’M"I&“hÒM#I6‘2d’I¦‘4’I&‘2H“D"$ÑB~â fÀÇ€g‚M¶ð6x6Ï7€;ͼ ƒÀð3ÀÉ#x$ñ¶m³å÷³}} >ƒâ™ŸCfy™›ÌIæfy±žlgšLló$ÛmæÛmæm±ù$H›Í2"co4išd›Í™&mægD 4’óDªŽ ·V¦Û«gVÛ£¨LÝRmÕº¢uI2uI2HÝYÔtn§WQ›m¿y $‘™‰dI$›4‰¶Ñ4DÒÒm$d‘&ѤɲD‚hÚD"M"I²I#Id’MH‰"&“$É&“I"dÓM7ôÓpÌà g€ogƒ7€ÏÛÁ³ÀÞƒÁ<Mà3Á#x<ålm³ºÛ6ß¾}MŸS3ê6Ï©°ôÞƒˆ€ôDÆz7¡˜ôMÏDÄ›$›aèÄŒi1½FÛz$ÚCg¢2 ÞŒÛz4MƒÍgq¢7¶q¶I˜êØuM ºÕÔn£u Õ·Tɳ¨êuGQÔô}£3µ Ò"BA"LÄšM¡´ŒŒ$˜Ñ„’L’FHM¦$™&H’H&HšM&I4lšLšI"HdÒ"4I$‰4ÒH"I4“IDI„ýÜïa»Ø;Ûàïfï3¼nô’3½é¼w’ö;Ç{=ðì͆úÛo¬>±ŸXo¬Æó y¶Ï60Ï4FgšF“lo6ly’d˜o4‚Lmæ™#fói6Íæšfi6gšdm·šH3Í6L“culΠufubMº³tu4n©Ôέº¢qSu:]\N¶ÛmùI’fÒ$Iš"2Ldšm#4˜‘¦H‘ “i´„›dÂM’L˜™&Ñ“$„‰4&MI’h’"$i¢d“I£HM$DI¤ÑDšM¤I¤’h“HþÂC›fæc¹&3¸Ûï3w ÜÍÜ7q½¨›¸w4ƒ¹&îI$k¹'sÈþfÔoPÞ¦£7“0ò3y yžL7’#fy6É!&mžFcÉHmä›lòHi<“d‰4‘I›y&&Ûo#3É&΃nŒ:CIÑŽ†ègAÐè:#LèΉ7¹¶Ûm¿$ÓHI¶Ò&$42M¤!2F$šA&›&I’l˜™¦‰!¢II’Ibi6šI¤ÑBI$’ ¤H’IhÑ&Óøq°fÎæù&mÜÌîaÜÙÜÇq»Cw ÜgrI6w6w"æÎæò lÛlõ6z‡«z¶ÏSlìÛmÙ&7d›gf‘±Ù4Ìv"m™Ù6ÝšFÍÙ6Òm$l;$„‰’lnÈ’q ŽÉ2FmØ꛲@;&ˆ‰±$’D’M¶HÛt4Œn¶èg@èlè3£:7àtLÝt£££c0þ4LÒHГbBF˜Ò #$i’2HÚl‚HI´dI’i&HH›$„$„’I"dI6™i2M$„Ÿžþ7clcÕâÙž&oo†x³x¶Þ,Þ)6ñI<[½âÄÏÓÅ#ï›fÛ=CÔ7«ê‘‡ÈM‡“lÞM¶y1$m1³È‘¶u@ˆ“M#m¼’Hͼ‡’I$Í#o$Ù·’m&3É’co$›3I·¹±½Ìg¸ÛÜ“g¹±îbM½Ì{›~jL÷7¹žà÷3ôÜß0þ$’f‘²LŒÉ $F$M‰4’4’&ˆ“d“mm&’H‘“4Ù6™$‘ ‘4I‘"$šDDÉ$„I´&“DÒm3m¶Ã£Úf{Y·´Íífö™í1ím½¬ßÈÔ›Ú‘#{Fö“CÚè>Í¿ª~Áÿø»’)„…F+xtseries/data/ice.river.rda0000644000175100001440000001473014674232237015254 0ustar hornikusersBZh91AY&SY¨C}Gbÿÿÿÿÿÿÿÿÿÿÿÿÿï?ý˜B€1M`Ð&H¤i,omà.>€P@É1ši0Œ˜CF&0ˆa1ÈÐÀ™&Mhhh4` ™i¦˜É„4`hÓ†  ‘‚a4Ѧ††ƒF@É1ši0Œ˜CF&0ˆa1ÈÐÀ™&Mhhh4` ™i¦˜É„4`hÓ†  ‘‚a4Ѧ††ƒF’ 4!  ©”‚ š&M14ÒM=MLÍ©é™&Кž§ƒTö£Ð“Á ´Í¤ôÑ¥6О¦Åi³ê´lÙ …ET*ªª"ª?³ùñü¸ÿ›gõž—ضlød­ÐÙÃÚ{í›6}‹ä9FïŒÝﺺ4ù.÷-Ÿö>åÙ£—E>Á˹»â4Ú4G ¯ðVîÃM4êùMÞNâ}ÃOK–î狳«ÁçuhêñFž†ÆÏó<î÷sgs½ÜèîçWVÍÑM›»::<“ÌêÓvÈîzá|–iÞåZwº+ÁÂ;Õ²¤CÞurá»r3½§UnòpŽ\º£dC }›…34@BŽ}›…zö^³£gý¯m»EGElÓÐòlÎÍÝŸjÙËf>câèláó3‡’#â4û—VƒÜ|·ÇÜ" ÙQ™DFšgâ!„Gã³?ÖüÆ{ïtø¯ï¾±²éláð>cëï¹|gVÎϬn­›¶=çÅu:»‘ñÝNûÉÙñ£O¬i>+‡ºFÏy÷o¼{ë÷Çþϲ~ú""‘È‚¡Q‘Šªˆ¥TeFV{Yë”õ>«9ttVB2 ȇ^Ú6nÝPB*4ô¹i›#3t}r‘•ÜL>ÈÌÆ}ÇËÛålÁ†|¬LÌÆ>ß)Ÿ‹¿ÛhÌÌØ‚fC0ú_¯ý¬ÿÎ?·q¨c7Ð1†‰þí~ÇínÃ8#Ó÷}^ÞÕ¶ÿG»s33^’æ1’`Æ:L333'„6Žéá3ÂwÎLâfk0™˜Ì 1˜{G¼€èff3lÏÄâã)õ©ˆ¤RŠª„ER¡‘ Dc0ª¨¥TR*ˆ¬Œª¨TU*U•Jª…E***ªª”ˆ"ˆ¬ˆVR²¢¢)¥"ªŠŠUd#¥"ª¢¢#**¢* ¨ÄFTT2¢¡PDˆ…EB£*‘Jˆ¨R2"ˆÌTb¢ Î 89f3–f3378F"ˆ„B ˆd"9Ø5M)J¬ÊUdR*"ªªŒ¨ªªŠB"ª ¢"ªª‘X…UEB"‘UT…A•”ˆ¥db«*¢!HD*2*¢*²„e¤D**•QUUUUUªUB"2T¨ŠŠÈEVTR•Š¥UE*•YªR""*‘P¨¨¥dUB‘YHˆ¨¥#*"²!DVR22*¡ ¥dD!T„!Q…UQHUDT*¢¢‘‘QYEDB"2¢*QªÈR"#*** ¥DB"¡YUP!QUUˆˆEDTUTET")•QYQ”¤!HTDDDeDVR"¢ª¨ÈVB2¡‘ŠÊ‚ª*YHFUB¢¢ ˆEU"ˆª¥)Y¨…UU*! ˆˆ¨¨ªED" …R‘QQª¬¨ÅdDdT)QPŠ¨…D"‘JŠFURª¢™ˆÈȪ¬„Ed*ª*²¡H¥*ª*ª+*"*©YU‘ ª„*YH¨EdDUT*‘ERÊTT3ƒ™ŠAT¤ªÌ¤dUDR!P¤""«BŠŠŠªÅTEUe"•ˆ…UDERª#" ¨VU""2"!dBB¨ÌˆˆˆÄrÎQ™ cM‘U¨ªDE*ª¢!T¨ÈªˆŠUED*ª"ˆ„RUJT•ŠˆBUTdEdEEUeTTUDUEb*ª‘QYB)PŠ¨Rª!HŠÈT*²²+*•U¨R¡•UQH¥R!•Tª¨‚"#ÐÌŒVfnÄ£3L‹ŒqbFf 33c-e!ˆŒDd1„d3 ¸¬ÊÅT2ú¿ò`û1™™›±ˆŒ"÷<1œ1„ 2±”Ef3æ?4ˆŒˆ~¢¶»Ñ•—±¦™ˆC̆2¦@¬È ÈÅ£)Â!ˆŒÂQP@ŒÆFeý&fh Äb Ff™äffCLÍÜfflÆc4ÃÈÄ1ˆŒ#à Fdda‘3#„"#3 C#ù/ËGÐ¥FŒÅ@ÿcOÏ~y»udCHˆ„!ú¬z‘Õ‡aÌ‚<1•‘™ªc2£dV23 ¬ŒÈ™ŒˆÀDGñ31”¤fc# Œ÷!Y—LÌR ̈dˆ!‚2 ÄA"Aº² ÄB1!## „1•ˆÅ!ˆ#Ä#!„!Â!€ý#E™³fC2ˆŒdˆÌÈ„?»˜Ï¹`LÌa£Vb™DFFD# DË++""#ˆ"23øµšdb „!ˆ"+ñY™‡ò‡üŸ\¬ÌÌDgõ!EB ¨B""ãVTDDFDd"""3Jlª4šV‘ ­•¦ši¦ÈSeDlªÙ"£HŠ¨Ù§²÷NìÍó\=víÛ¶?±ôÒ7;Ü?óÎ5ÉÜîVïÐVœ7iËwSwÏpiÞ¯U4ÕÙËg(Ùˆn­‘Õ»†›·WÍW׺+…7TWŒr26x8vpÝ»MÞO&‘Ù³¢9y?AÕÙ»†Qѧè´êÝ*?QËÎŒïráÕÂ+¢+NOBº:£¼îtlŽŽ]îÊêèô¼^.ZiçvpáÜêðx¿1ÜÙ§s—‹–Ï&›.Çé¸DurêýG»^ èC”<ÎÎöœ¸TG¤A¥a]^ûM#37w©ÈÙ„c½²½yŸ’ݳ¡æhzÍÑ‘çp¯3fnˆCe4ˆõž—©óÛ½wÏT=g‹è33>‹!‚ˆDDB#"‘’¨ýd¥*>š"2£ü-3f•¢¢6|Ö#dx½%{-<žÊ†Î ó¹iËÛzæÆï„Ùí:½fÎç/YÜìäît|7¶ñi˽äŽ÷Ggs—mî;ló¼Íwz]Ïuæutv{ˆžê<›>+vÈ÷w‘çUuWƒôZÌúÔcë™FfDf™Ÿ†Á Ø+±˜|wÜ?%€û¦GùÑZWŠCgÏnѲ? Óv™»dF+¢¾ù»v›¢8V‘Ê4›"£ÐÓNöÊDFDnå¦í•ÕM4¨…WsEFC¢2œ•»GTi³JÙ8GÄi¤8Ctfì„Ue*2#¹¢½ T?)º´Ñ§{Mµ\#”iUÑŽZP¨;ÐÎQ¤fTdn¥DVšiË”lÙšFÍ9i•‘ˆŠªEQ¤4ÝJ…AÃ…Tn7TG¯í7lTDB¢ª‘rŠFpáFÍ›´þt;:+„9r­#gVΈªÝ F›¢+wV푲8ná»vÍ"8ï­6{MÞMŽ]OaÜ屺³+uiØ›ló!ÙÏ2+¹Ë«²šlŽ£v3vw¢º:9*Q£—/&œ7iÃsMÛ)ÑѲ¹n®QÞݲ#ÁÕÑÊ»›:©ÂrÓ—FS¹œ+s¹§s«ª»+fÇr8iÕ»›¹uvFrŽQ¹rŽQÃ6vWGB¼ÊÓGGGFêˆÝË¢£J¨lnŠrÝVÍ+MiÊ+bÜÓ‡g28nª‘ÞÓf”DDpª;Ѧ‘ÜŒ¦èR Ñ•æC„iQÞ®­› "² )Ù[¥B;•šCM”¨h¤QȪȨ…b++"2²ª•Yäܺ¸lÇB¤iÙËvlÙ³4ŠÒ8ûJÙâèá¤d"9"£vέlÜ!C³JÒ*"1 šW 34„ "4†Db¸S2²#H…dTR•P¨ÝU„fR2"*QU UD4iiQ¤d"3#HTB"£*¤QFˆÊi¬¨DF•Y¨V!Q¥*"Fi !¥E2YUQ‘‘¤dB4¬ŠªÒ+"¢)M"‘DD#"ŒDc*)DiYPÒ”ˆ„!™„A‘ZR#LÒ¢´Œ„4…Uddf•M*ˆÒ+DDD"«)UUg_-›67eVUulÒ#JØ**³M+¥TFže+6l¬E*+EVŠ"´­+!¢³M#HŠÓJШÈi¦šiQY¦‘¤)QQˆÒ4T+J¨ÍŠR¡¦ŠŠŠÓDSL¨Š¨†‘¦ŒˆÊÒ¥F‘¢£H¥DEi£M+4ÑEediU¤i¥dER• ȪªE*šiHEUCM44Ò(Ò¥R2¢•QTDD+"!Q‘U¨DB"!PÒ4Œi…4ÓHŒ#HöØi[(Ù¥eB"Ê­Ó"**4…U*Vš"*«*2¡P¨TT****¥b"#*4ŒÍ ÒFhŠ¨¥Fˆ4T4*´Ò#"1i¦"F*3#M™¬C;bâ˜ü*Æ1ÿFfgÉc<Ì1Y˜Í3Q ¬fXÃ"™†}ãüÏÑpŒÿ+÷™™œ ?ˆˆ?ôGSòÁ™ñ˜ÈüØÌ3áGɆ}éû!û&˜}nc>_ê˜~Ìš31³™Çå±æþoçi—G_,&Ë ó0jÑ`" î!b((P‚…ÿ*ŠªTBƒ""…UeIÛïQòßñU|—ÕpÓ•}Óí\>c££‡ÀüFÍ#³fŽÎ²ùÍœœ:¾kJبüÖí:¼œ¶VÎŽ_E¦Î]èüW“MÜ«N¾G(èðVî]M•³vî®Þª­Üº¶i±ÙäåÂ;žwEv‰ËÁZw£¹ÞáQË«³†Ï{¹±ë#«¢ŸÀÝLz'°ìýÆή庺»špÍšnÓFdFiTFžº4g{eg©¤dDzQg©ì>CóžËþž³—Ø´ù¯»<ȯiÃÙyœ½§¶¯ˆøÂu#ÃùP„ADÁQñœ½çR²½ez•^eÃO3‡ºœ<ï3Þpá³¹UÜåÙ³â6rŽ–®;œ«Ü{ï{—G{Îîl÷Þ._ÀöÚx8z^—ƒ³w{⼕_ÙÜõžó½àìöÑÜøÏuùmÔþ6ž–ž»àpÓgÝ=ç÷ÏÞþt‚Á‰% Ê¡%û”´˜–bM›)VJˆH¡q<üëå3íÏ÷‡î¡õQ§ï4™²©¢ª• ˆF~ë8ôç‹üxóz|^·†=“ã33?¼ÌÈÆc>YýÆ|§àŸ¡ÊùÅgàŸ„„Db!ûäB#úOÝB!ý/ëfc?m‡ð¢"ôQ„?é˜Ï”Ï–„!pÌgñ˜Ì31òýHÄFgÒ*™„U"(„AUŠÈŒˆAQQTTˆŒŠ„FSÿÄ#"6>ÍZ}²)ŸÖGùŽÜÒ?U¸SHB¢³HTd###2!UM+wý[1§ö#ti”ªˆÙJŒÈ…Fí*#v•ô·4ˆtp®öÊÇfÊÒ":"²>:66FÌ+²2³„VŸœÝ³8n¨Ž÷r´Gí¸V";Û<ʈìûöŽÎ"8}ûÐá§{«‡'z;œ•QõZ<•NZFÎôfÈrèÝ»g.ŠèìVŽ®…nü†í!Â<Î]U•«„iËe|×,Ñ•ér§‚¶iÿ«²·vvttpîpåUÙÑçy9tnêñrù®åw?m»sw.^ Õ»×ullýö‘Q¦yÑ™ë;î÷G©ÃMÔô;ÜŸ‚ìÓ—s³Ò¬ÇÑï;ÿl؇Š)ØüVš#w©^Óª;ša»#=wïs#—{†èðt}{3ô„d2#› >ôˆÌÈûE>BˆÏã¼GÃG/]Ü{‡©+ÝVÏeU¤94øn]¡º´pö›7lÿ;£Ûi_ÕÔîVç¶áì=åx·{Ï îGW“O²ð=ö‘é{î_äìÅñž§©ÕÞôº´ðyܪ6GÚ>Ýäøï}ѧ¬îy>;àWÄäŽç“û¯eìd=Ç®ÌaŸªŒÂ# ÆDfcfDˆFFD#2ˆAˆŒB"!Œˆ"ˆ‘DC"‘ ˆDb"B"3"1„@ÈÆfgÀÇùOÁ`û†c}3÷ÈÈ‚¤ýišV|¶fg²Œf3äýSòòU‡ÒFŒÄAAˆDAb!žŽã>‘ÿrü…E2¡QCò>“Hú f|–3!Œûñ™ÿQ™ˆC„dAóÏØ!°ˆ…~2•R²•_ŠÓM2"„"1 4Fšh„l Ò2ª¬„B*¢ª2´¥DFlÙ¦‘_†ú/šû×ÔGî£÷Ú~ûggT"•FR‘J")U•U™U•‘QEDC+¹F•¥R ªŠŠˆ¥B¢¢¡ˆˆ!ˆDQ••„E"ª©¥DTDR*)ªÌ¨Ê„DDU2¢¢#""*ˆïR£4Š†ES*UTR•‘UˆŒDb!U „B•‘U „ŒˆR!H¨¥TTTU"*"þÙâÀòA„Bd"##? Ã0Ìõæ¡™Ÿ¸ŒÕD"1ŠB©‘UUªˆTDdF•¦•FšÏ”öØþÎ}{£û[¾R6pÙôÛ8nŸ1?³ñŸ´Øݳ—Ù+üÝ‘*£Ìûe4ӣ̛>w£¹[¶Wë<lÙÑÙö¯W]ž”l|·g-7vur­Ü+ê6lrÝ›»4Ùêl¯çg/s„<tDrÓ–Ï2=M›<Ùúï'ƒ³½Ê7lèòW-›#‡ Û#w{LˆîWÈiJÆtB±§‚Ÿ :¼šgÝ!z-œ#unå³ÚnÏ;ÉXõß §³—Uy숨òB«Úiù±ðŸr{æÏ]Üó¿Úú{(ÌÆB1ÄqUÙþ†|¦Â‘»Úfœ;?Mà‡ºðx<œ#DFžÛÖlå4ÓÔô7uu{Ê÷[=§Wz3Ý:7pŠií<^ãO‹ÎêáÝ»³¹=ÇG¼ñCïÞçÅWºô+ЯKÞz^*Ó«OËtzï]ñžóÉézUâó>õŒÏiÆdC fDa™˜„D‘ˆ„22B!2#2!‘ŒD""ŒÈ„#!Db#"""#1ŒŒˆˆÄ@Df""2#"#3F1þÌ~î>ÕþÓ?ÀÀÿ3!ý¬Ìf|'‹) Ê‚2#0DˆÍ1Œ?Öü$D3ôQÿyýdiUD}5i¤i¤Ceei[#阎ðïF†y±óš ˆˆˆˆ„cûF`†TD2#ûçç>{`òú‡ÑgFc¢"Dˆ„@AõØÌüÃ)ŒÙ™± D2#3"0D õ™óØi™šAAC1‘s1Ÿèc&ŒÓB#‘Œ"ˆÄ3ˆŒ†"ŒFa»™YQ‚!‘Ÿv}áÿø»’)„…@Šètseries/data/tcm.rda0000644000175100001440000001113514674232237014145 0ustar hornikusersBZh91AY&SY6WÃ%àÿÿÿÿÿÿÿúCÔÄ0Ä//n8B„1ŒYB† „![ÿà¿ 0L˜`À €˜& €L0`ƒÀLÀ&0A€`& €`  À0À0 €†Œ¨Ñ ˆyŒE= Ÿ¦™’OL$ÑÚµqQD¥D¼J5gaÉRµG%j9•Tw¼¯;Îô=i|Ní”=Ô±ÝòWáY‡„<°“à³ÂÈŠÐþâûùþÉÕ0¥Ä"­ D?Ô_H‡üæ«O-ÖYBb$˜ºD‰D“ ®Kfù™™± å® ˜GÔ‡ò¢þˆKóˆ•qL"‰éD¨Q*”¨’R”¨¢‰ID¥EL* BÑ‹`­m"¤ÂU-(‰RSE) (I)QD’IDI)H¢‰JTJJ%DP¡A)BŠ"„”QBJ(¡*(”¢R¢IJ(”¨¡BŠP”¤¢TP¡$¥BTJ‰JQD¢Š"T(¡E¢…¢‰J‰(•¢Š(¡BRQE JTD”B…¢J(‘$¤•DÂH_"”L%’RˆL!dÄÌD¢E$»Ñí>Wsï>gÌð;^¾Ð2’Q$$”BRˆ"d‚eÄDèDAG`ûä|çz]KèJ#Ø|bQ/;Î|‰{ >3äGƣؗÈQ/bRíD¥u»qØñ½Š”}±R”’”’J%$’„î#÷%r˜xáDMLšÒ£JäÁ„D"dˆ’J"@­ûG‘AôøHæˆùÝJ:(“¢ŽŠ"‰JŠŽj%Ί!ÍQ.ˆä攥4J^s¬ëuº#ð¼Oˆ¼”’J%$¢R‰JJ‚„D! ÏC_:ÂÀB!'ì~ëÀôž’=)zJ"QÚˆì;QÚ—Ò¢TK±R\”QÉ)D¹(—k’RŠ%Í•»\Ê9•(IâT—ˆñ<ï…ð¨ü´DCÄJ$”¥)JQ!(D!Öˆ"D("À{ÏQÌ÷ŽR^ à þ2}o€÷ߺô;Ðw䤗s½ÜQÜ ïw¨”¥RR”¥Üî$îK½ENã¼ïZ¢¥ŠÑãwºÒô_¼!úˆ}Ï­úÞ‡à|j,øϺ|oÚ<Èó%å^ò¼É(<É<¯1$¼É<Ê"QåPò¨ty•,T¬­Q's¸ø_ áw>7ät0F K¥è\üˆˆ#ûŸ9úßｃç\”¥/höŽˆætrKš] *I.bNJ(“¡.ŠÒävºŠ%%ZU+Q.·Z:Þ7Ä—Äîvº>ЈéI)I$¥”¤J$‚õC­üoÒþçÛb­ùÖ?:§Ô½ó-Ùk÷UOü°dûOß~%mK_¡‹—­ljV±*ÚßòTfع+•ªmb©‚¶¥m¬Ò–/ø°VÃ÷¿S'kY¥±­*7¸7¨£[k‹b‹Ú×­Z½šåM›*X©½SKö׋0\Í‚¦µIbki\±¡[>¶–Ö–Ó%©T¦x(©±“{SlÔ^µR§S&Ö*Û‘FkZ´2onjf±zn*Ú[›±¡{ÌÚ—¬d©,ÔZÉ©Á[rJ–±KjækÒ£jÅŒZ–™˜«pQ.¥J1`êiqX£‹k‹6-mM­Ší® j×-fµ[R¥n-­‹6¯om^½ƒŠŒZØ6¶8«VÞ­‹6 œ¸Ù(ÍSzê™43Z±‚Æ–Lڜۉ`½b¶*5·4.VÅ­¡ÅS[‹Kkj×.mim`¢ç—µX/i^ŵGì’Á±’ÅŒÌV±F– —±,mK{Bæ 75°K&åŠÒÖ͹±‚ö–†•«Zظµµ·¸(½Å“zÅKÙ+^à­“{Bµì.`Ö£&Kœ®\jbÐÁ©Šj—¶µ7+mjhfÒÔÉ©½kƒJ6±jpQ‚ä«n1T±¡ƒsJålZ[R­RµÍ-ª-pi`©´Éjæ…Š7¨Ö6¥›CCJÅJœV­`T½R祋ÛÛ°Xââܬڽ-&„·°l\¢ lKW4±hZÍcs6¶öõŠÖ0fÅbçí¬V®K† ¬b­s%ÊÚ”XͱEMIQ©‹{&匘5¬hZ½¡µŠMëÚ–+4¸¯Q’÷Õj3\Á™rÖö…kU(£jåÔqfÍšæKX¶¥$¯nb©EKÚ - Ž-® ÚÛØ86¯VÒŽ¥S­n- بÍ*Öµ*`“%j’±‚å©KK%k™¸+X©‚583n`Ü­š¦† F†L—°]znkIs¥KW´·¸µ¨­›Cc&L˜µ´4±dÁµ½E­î+Ú›\šÖ®ldÞVµzåµ¥F %Z¤ªKJײ\ÐÔÖÔ͹j¦n ZØÚÐÅ©±›5ÌÙ36¸*`£ZõmªÙ›\[ZX6¶µ5¥±½ÁÁ¡¹kjµRÉr[Ú›[V£[Š[š•,ZÖµ)^àà­‚Tk^ЫC†¥jšT¬µ[S&[Sb¥ëªdЭƒ[ZÖ,–.nXØÞÅš¶M ›N. ›‹Ø®n\µÁ’‹V3b­ªo\½­bæ,Ú”\ⵉ±½r¶kZš—0hhqoVÒ½µ¸Íµ¡µc5V+XÅ­©FÆ¥ŒU.dÅ¥EëZÛW¶6«lZÖÁƒSbÇô˜-lJµm*šÚÚ™4-mmZ­­ck‚¶‡æ榶æ.,œ(Å[7k™µ.jq5¶±T\—ÌתTÖà­iF¶•î Mí-N Íê”\ÜÜܹ¹©µ½‹ƒq±­+×°VÅzÖ…«›TbÍk%¬X¨ÒÉcƒ[{5ÆmŒ[Õ+lVàÉbåí­JØ­VÐÍ©zöJ6-`©½%k­½scŠ¶…mŠÎ ÚšÚ\Ù´¸²i`npJ†ÖJØ,nlhJLXªVØй.-‹U1VÍŠ‹–/KZ\Y¶ªh`¢‰q\ØɃjœ´­oT½. W›Ö±kbÁµ½½¡š¶¦´µ.81kpfЩSy©¹%ë•­KZõMMMÉlqZ¹±{ųdà¹bÆ•Í  3\Më–«qhdÒÉ¡¥©b Ò±±EŽ&ÅÍmªÛ—*ZÖÅ‹ƒCê67µ¨­‹s‹ssŠÆ %­¹F–N ’ÐÅZŽ--M©p^Þ©sJ¶õŠ%RŽ fàÍjëÔIZõ%‚ÆL[”d©“[6jØ2bµ©±Å©›së›ÚÚâÁµ¹¥ÀɽEª7²no\Þ¸½[s‹r楌•+d”¬fà´ÉkKkSSCömkÛW¶šÛض5µ®X±RÆ Ú[—4.6.mJ_C6¶–榶Ƕ42kmfêZ¢öµë”hj`±k&†j’£RçRæ/hZ•­ 3mT£©µ’æFçRÖ+\Y:šš[×’\¹‘›q™{‚ÕN JÚÚÙ±Xâàà©ÔÒÚÔØÒ£j8+nkQ©’Ö 5­nd½™½S©SC©S‚ZÍÍM+[–N£ZY·²VÉ‹K©¹ƒ©ƒ[©Á©‹Q¹­­š¦”\ÞÚ©›SJ·RÆ•KLY¶¨ÉÁÔÅ‹JŠ˜³fàÉ“Kƒ©b…kœ·%[Sk·…®,—·:›\ZÖºš˜4+kobÉSƒJÅlÕ0bÖɱ,›[š—¥¹‹&ö×éf±[‚ô·:›˜®bÔ¨Üêohfê\ÜêJæmë^ܸÁ¡a©R§Râ¥Ö7*dÞ£«Ö±V–µ«\]MËœV›KÛWªq,(ââÔÔÅ,1V£Û[–µ¸º˜+kZ¨±Á‹ZŠÖ³mfÅ{[S©›s©ÔÅ¥k7R·öÃ[[%­-/qµî84:”TÚÐÖµ[׸­ÔÁ­s‹Üjf©SK:–¬`͵ZÓ6…TmhhjiTÈêX©[%̪hu1k,\ÞÔÅ­Å¥Y½‚Vµ*VÞ­Á½±¡î1QÁ½jæ -­íì/u4-mu778«K©ÔÅ{BÆ·Ó PètJ]¶—E{ÄùžïDBõJR’R‘)I)K&—à}H}(úŸ•(ö¤‘GÛ{T{^Ãä$J^Ãä{ KµñŸ#ä{+JU;Tìv$—ÔKÄûB!qRÇ[µò>êW»U;ÌJQ)J%$¢Q)JOáx>sà>t|ê;U*J„u»v:N×'%­$¹‰rrZ¢²]ª(”¹(¢Š’íQ.Dv:ÒìQó¹¥/árrxÂ!«z0Zú^/èöy‰H’R%$¿Áü¯KÒô¿(õ#ÔŽö$IÞw9»ÝèïtV—z¤QçzNõwªwªIÞ©Þ¢*QQØQ.Ä»ÞøŸÉé{ÎH‚"°%ƒÈw¯~ÑÏû çèü¿îD"ýè=óà±ùWSâDy+È¡.ôžW•'•Yä<G•Rµg‚µG”ò¥åy]¨sG7•ýnò·Êý§•ýÙ0}úw÷ÿGäÖ’IJIH”¢Q$’}æ-<ïéKØŠ%'Èö%Äðx#Þ{Ïzˆ‘ï=å CÁï<QRIx<•J(K¼æ’^ IÞèö:?3­"¿§âˆïíô¹#×z½moÂ~oø~÷ªª®Â‡êJRˆ”¥)$‰?[ü^ÓÚØI‰íKÌ ”yID¼Ï3'‘æyŠ%ä%æQàó*y‘Sڣ̩SÄ©/ä~Ñô%çk‹%/•%Ä—¡õ0Qét?œ„Cùßcß{Oií{R—µÜ’æ­*œÝG3›š‰K››šTK“’^Õ(è©Ñ܉srz^1Y$¥)I$.E¥Ç777ø#ùŸ÷™ûÉ{OAèJQèGGk“š‡4¥Gj…J#‘Ì”«Iɨä攥e#››šV%¥ZOÂ^3Ææ~åxÄÔ’Q$’$JID¥)JH \\\Xù_ B´C÷ÄýÔ¾w©ê$—¡êJ„¯RQD¥Ú䓵.·aÉ)QE Š;vj’íKµ.ÒTQ/î ˆõ%)”JR’R’.-JRIjÕ«œž3“­±~Wæ5=ñçJ^s­ç<ï¼£ßG$¹­÷Ý%EN‡D’”ÉQÉS£¢Š(©.e J]I.‰KßJN‡c¡.oK¬ˆGrR”’”¢R’RJR”JR„ Z,w-w%ôŸSöúž×ï£åz¢Š¤¥¢>TttrG4’K¢„º9¤“’§DT袵J]ÍÑ.ŽŠ(¢;%Ñ.ÕoSãuˆˆûĤ”$‘.--t{Èýhý„"ÇäzÞ´zÞ§¨õ¡ëΉK¢\ÑGDv¥ÍG4œÕ%)rQÍRŠœÜ‘/š¥7©ã}ÂìJR%)D¥$’”¥$¢I"PˆCÆ’ Iië|eDw#ò?#åzÐõ=i$õ½d½hõ„¹999$õ¹¥ÉÍÒŽJ*IÍRR—3™.Nj’¢%ÌëI/|úNÇ¡ñ¥Úˆ±$‰JR”’’IJ"s%BQ{ÁZÕÉ™#´÷Ê#ÿâîH§ Êøc€tseries/data/nino.rda0000644000175100001440000000610014674232237014321 0ustar hornikusers‹íš¤gyÇ¿sçŽÙFm­™$2‰µš¶óùõÕ±Ê&‘]Ùv1¶Ö®šir'Ö$W¬™d“’(+#–L²¤$bÅŠ‰I"7ÚÝï÷~^¯g3JôOt†Ý{¿ß{Îù<Ÿçy?ïçý<çóÐûy׉GN¬V«Õîî‘ÕÎÑͯ»;›ÿYí®^³ýpñ‰‹Ÿ^­ŽÞ¹ùõãðo>¦/^=wúàgcùîcÛñ3ÿéàÆÕsïó·Ÿ?±¾ô1¿ssõƒŽëÓæÓÍý·Œéð1Ã/·ÿ~5¦KÛ>3æ7]ÛüûúX¾Ü¿/_½òâÏœë÷ûsêæ©›+ÇòÙÍ2§ÿ>–§úç|Ð?ç½3ÛcÞÞuåÅW¿ÿçáa_ùa_¯ü­__·æݸ:íþéjûoÌÚû»nWúÚ¡czšï¿´]æcrÝ›ÝÎòëþ¼úx_¯•­AŸ+û,ÄoìÇu2vå·bÿýùùðqçÆüóà ÇòX¿¿¾?ÝÞr¬ÿ=¤û-á§á'}ý} ¿éþO¯ïv&ÖKø»ÜO|Y_{3ÏÄ/ýåäö‹1ÝÛíˆßp__÷=?ê~®á?÷óWüðù—ò‡î÷ÀÓqüêó;`Ƹ¦‹ýû»Òy¾O¿×³}ÝÊs*¸ª<¯ÏòÑþ3¸û#coa_åîc¿®~¬Ç«>×í¬ø·bwáþü,¸ã¾„_GÜŸßî¾@Ù_ùEÇG5.úMÿ€oó)·t</ɼ¯Sî¯Ü_Àu&Ï3ûLÄ'‰ðùü=žoþ~’ç/ý^\×üñyïïvßè8ž÷é÷ØEœÊ›û÷eŸ|à>ó ì'ž ¿…ÿY/aoz;ø&Ÿ2ù«¿Ãÿø«ÀGÆ)ÃYc¿ùydžîðÙ}à7ý•Éë /$ü7`Ïà>ð»ù0Àÿ“Ø‹ªøÅOU\ÃåLÏSqUî’—ðb¯WâPááb^ñ¼L~'ò:YÀyàèƒð ÀãÀ}xÀÝî|é> ñŠzéóL]Å þŸþ•ŸýÞ:¼J|*×WömÝ >%ÿ öüVy^ÅÁËàÖÏQ_NMy$qÝ>­Sá§'©;úO^9 .Íß’oÖ3ñ£î‘‡ÏNù&ê/øÍä]Ä;̳²'\ÏÕÿÄÉxÔú8`gÖníUè'pSÐ-™:”­WÏÏð ÿüUàõ ¾*vGý¯â>±ÏDfðºÇúŒŽ‹|§à9ì…çB?èwë#|._Æ:øÍçWò¾~ ¾3îêC÷¡îÒ¿Úo=ºB<‰wä1õ°Ÿ*ÿXï´¿˜—QoÅ3þ‹úumš'áwx©ˆ7êDÂþD]KØ•Œ»¼dboèó~>à=ð ¯Tt@Ãÿ ;×سfkü¾†öËKÑwÿÀ“Ÿ©ÓɺNžUêe}í5?’:}Ÿ>èêô@}´ÈÆY=¤Î4^Ä_ÿª‹ñ ]B ½B|äßBVë·uLü‰ñÉsBŸØ'½ÀþÙ‡}JÃOxF£ÞuöOê0ù^*æ uÏz:DŒü?Ø?œñ2Ïð× °.cGð…~QWcwô1êqö™þ/Ùg¡+­O{yÞÏâI½®Ž¯Á?æ-ùPäò³¢Ìë£~ ߉¯Ð›^?Ì×FŸØð3¯Å™8µŸ`?‰x'x×<ɳ¼¯ø¡ù]WĿÈçí ý!~ô;xìÇÈ·ÐëöêGñh?ÿÜtýà3ûZñi_ï÷®Ož'y:úUx²áמšü.+u¼Á×pæLáF=i}p.eüœSÈ—êçzê ÷m\Ä©uBÝáœÝ:¤Óþ¯ZÏÌûyn®CäùÈzé\ʺj¼ÈsçÁM½â>œ{‰Sq-oêõ˜óð:þjêuŽóó͹‚þ‘_}c_c]‘àåx¨ÿÄ›?ý»yà{/y@]b>©ìÛÙ_ÅŸçüÞþŹZàWþq¾.¿ª«Œ'¸¼PÇêwu}–ï·ìcäßÛÙª¯èßš|¿#.Ø¿FÏ­©ñÙþA\©÷‰GSï_ŸÚã{ëÐΰß9¢ó\yU]8ÀîÛΙ¨£œ+÷}ÎÎ^ýø6?^·ÚÏZí<ÜN.¹csÉÅó>±·ùýîþ÷ÕK›ÿÞpø{¿æØö×>?üpÏ»çK]Þ»´ùqçö×ñé'{ó½ýçéÿ&·{ôSç÷öfk½py_w.ïuc¦wuc”í<¼(s /ÊH0 îr  qÿr l*—e˲å@Ùr l9P†¿—e=ÿÙçr l: Z”õ¿/ʦñ‘—eÄC`]v _èuµ@u³zœ}.ÊÀ™8µŸ`?Ë2ð£ß—eûÿƒÊú0k÷åÿlTvìe¦cGþíHìÕ‘C±åÔÚŒdm$›YÓ³œZƒÔ$}IǦۦŦh.>µÿÖTœ/§Öð›yâÛ ‹…Ã"Eþ¼ rX¨8U\‡åÔ|B±YN­Kó…bµœZçŠX‡`Ë©µé[[›ò9µ†n€'–SkàU>´þÙ ‚»åÔ~’?ý¬^tßæ©<å:êC÷¯þTßÙŒÌ^..§Ö¨+ò¦/Kø¼œZ£™–—æا8 ]N­õºê0ß:¤Óþo9µFžú’Ⱦƺ"ÿ,§Öz~È+¾´U_Ñ¿ý_Zûï‡b«—^û›«Ltseries/data/NelPlo.rda0000644000175100001440000002323514674232237014557 0ustar hornikusers‹í| 4•]û÷1ã™ÌŽá¥’î_…Ò@ѬD!sB…TŠJ“Ò ¢ŠÊÒ I©”IQ2'’BdÖÿTçïû<ëýÖ÷}ïð¬÷¿Ükñ»¯½¯=ž=\ûÚ×uÛ[.!µ@ŠD" “DE…HÂ"ÜWQaî?!’(I’‹â¶n>³|V’H"r$’„¤–Täì?’$@iÓäžMý©ò9Ê¡rcÆ•6Ÿ„ÜSÕ¡óLª g-6¯^rŠÍŒ®L2d/»Mϲƒì梉Žò:UyðÄPF]þO¸jÑsƒ`Hw–t ]›ékE·¼7€¼ò¥šÇ<|˜b+ ÿˆüx©³‹ŠÇœWù×!õÀ‡âL;HÞ™ØvHqÄÿ3òÓÿ±_È/çÕŸþÇökÑ.œñ= éñk/Ož<Ò³N²û¤ët?Å1š ;tLÞdï½ >d®5 ”'ÝñkÕ9®ü‹Ù&PÞŽöÒ\°‡çÕõË@ v&+õ‚æÚ—~t(i·^ål™ʽ!î³b[@‰gŸfjJ¸+ù–ü©œþòJËSÈí1¼®>²é®Ýsãå!k¹êù¬QÝÖ<ø¸²×—y:y@öÙ˜ùK—¹Œ—æPÒZ +ÈqFIdënϾ.ÎgÓRWF~SE•>¿eÁ1Aý)ÙQsžf_åÃéóßè™ Z_ü®=ì<¨/îr³_‚Ƽ>Œ®='mêü¨Úë´´Ì©0Ьòè¬-*$”p!@Û½ú‰Û m¿³ÍÒ(´Ãí¯3ìÕAËyWúá:h%N];ŽvVyÌ«bU#hÍ;OZ\­g‚÷ê#• ‹Ç}‘HëÞ±}L—5è¬)W{MýA~Ÿíä´tÛøîµ" {gä$Ë1A?øòõKÉ™ ?ñ=*a †¸½ÅõÕ™` /–0nIÃ~¨]p­{ºj—ÈL£ÇhNkb<äçüÖt ò»{'‰9ÉAþÙÆuâ‹  âU¦øù<¶…?¢…éCQRÿ`ÏF(úf¬â\ʇbJÃ'- (>±én/…â÷˜“ÔPRu/Öʆ’ñ¤³-½Ã¡4»ccÿÍ*(­ ýâÝwûzgýÈô­qDÒ?xˆ‡óf)?ÔO¼x¼­Â–‹£rË.µï%J¿é|yxÜM€ÕÏÙf#óXÙ]¯¼ùBÞŸ_»ƒf8=Š Ì¥š¾fMöøZ1=œh±Î6ï&ZöZŸ}ãþJÊ)Nã*À6éÙfc®m_¾,½¿ó ѾØ@]²W˜ø¾…êÝîDGVrcÌ¥V¢“ziÍõUáD—ŠLïŠbÒ%>Ò J:D.Œ¯ÝUö ¢£2FŒßo2@WùX‡šCÜ\,¾£µâS.}Ëþ¦q“I=ýô;3\’±³?bч³M¯‚H°ÔLçw5s=+æ«7âÏÓ„¶>A: ò‘±ZÛoA"bŬUÃãðiõšÍK@>sÇOåEﲪC,Eq¬žGÏ@}~ØcBÖ*ˆeg¼-ù!ñ·²2óû”@ù¤°G²äúÐËgï• Êáç'YÿªŸF‡ôùޔʆë)¨£+ †œû‚M'æÎE´û]Ñ‹§½ïým¦dÖ‹å”,ìò û*[×}ˆ·É­\¯P<Ç…ò ²>(®È‰ÊhUäá­ÉSÖGË/«Š@]ÕÒ¸Ô •QÞŸAçh•Ø&ê…⪩‘¯@ͳ• ¶}ꓳîI³Ö™…Ën\é.íX÷›“ô }?·Ù²aè󅮺ך¬I¾¢âÕ@/Ê?n©cúEUÉØMÙ çD×»¥mC9ß6n%ÞÆÛ“Å÷€áX™V’ÐûóºÛÁ˜¿æþæuþ`$;§`–FÝÖR5ÈËMñ´á†w§¾­½ yšœ°Ö$.xYd³7äI³†é¹ yŸ{Ï:l‚!¿±çU§|äwn–ÝYzòÖ“3†^…ü'™×g•ª7vþœÝ'ñ¯Eès²u¾0¡Ûº}¤ª$t;/RmtœÁÖ¿©QZñl£99ÍW²ÁÖïŸËÅ᡺ÛgX‚½OT¢`=ÑP¥6ú.pžŒcÌçÂB;ÎÅ;à”j—N-£ƒ3“Ú®šŸŽ¯îí— SÀÉŽ¶»NƆKÙpª…{–ˆPÁé{û^œÆBᜀj­§8Öî|Ýzp^ÞÍ ¼©'¸Öá%ÅìfΊ€âJ°ß*~^*©üWc¢çPnÈ®K%D÷D뜰o«ˆÎ-‹–Í`] "Gê[‰®CJ×eHDç“-;”™óˆŽÏZìO«ç‡„)§¯f]n:wž{D]-ê?ò¦#ºiNa»UÝW’j ²]‰Ž›ßÜnæ÷ðû˜õš”=wˆöiI'[¢ÍÄ:«ÙÌ”øæ=®j½ñM¶Rï›+•hu̽6ó™hùqÅD÷uÈ€±økСM1Dó ;§êZ¢e¤iöª–ËÄ—Q¡lgéR¢™v|w;ëñ¥%JÝßÁŽhŽ=¼dáZ¢) íù´¹{ˆ¦áÞ›·Äøy'2þü[âÓãv'Š^Ÿ"6ªMÐh'êlYûìp Q?‚sµ×y9ñii’‘Æçb~dyL;¤×M4(\½˜™îCÔ?Þ{ÒNóñqª¼Ø-D½ô‘»Û¬‰ú W<è[ˆÚ‘ΕDÜt¢V"]"OÍø[ªº»½@ÿù뢺×Ë툞¬k»¿zäûåwﾞ´EÚîŽ$èQ;®U:÷CO&ã‹®©'ôv›ÛéîÐÓ{u[ò`*ôFP~š¯=‹ùf{YèMÛx"ñ¹2ôæÆ&'ÒýÕóò¿!åþëÁOÝ,÷ÐÒG~>G¹çÝŸÏSÈðâexñr<¤ðø䆴çîY¬?>ò×#@*/=•O奣òãyÈàññQžÇ/Q>´jÊEÐßHYøŸz:÷Ÿ”Å*ЂÿiÐyü4^¾´?äKã¥çÇóëAçµ_J㫳? Ú+É 'óÊ!óÂÅy(Æ‹ã•óGåå/Ê+O„WoQ~>¼p1^¹¢¼rÄÿêPAy’¼üø4yöÏö _ýõY^¾2ÜFr[:Ð>~?ðÂùý@å•CãåCãñ úŸWo%^þª¼ßWƒÇ§ìæpC Î WwÔæL3zž¨òþÕP¿ ÷ó¬aM1Ð‘κ— μm†Â2Ó`°šø}ã€t-pÜj:ž•bH&ÏìY©â6C°~üN¯ÅCí ¿øÿêyôߎP¾óhfµ´6”[¥*æ3d ¢[–v¸b)TÆ&šM› Îý§ÖO…Êì“Ž’æt¨øùžî•ý’kƒÅOð¸Ô¾z9Tú½Smò òäܹL…­ª«8=®‚‹&þœÒ¨cPé:zø˜ê¨†Í~?\jÚ,Ò¬m%`Jž ;d0̳ç×4~= õy‹Æ/ÙfÇë#}ÀL¼f|éP˜½Sg3í¡.›l=ËÚêb·ŸÈ…ú°1 ·Ü¡>IU‹±úÔç§û¯¾Tõ%ÚŽ®õ1=™`òî˜ÃÎ.´ëóƒÚ÷ßû7s¤Ã,I£ç`z>µ¼û¢ÌS &FËMÁ¬wiÐש3UºçJž.˜åçÖE>uš¹QïÕ™P?=Bâ:9 doò®XhʈWÅím„¦ý½ÉÙríÆ›¶=”×f`Ifù -cLÙ¥oÀå©R|,—[ϳ$Þ‚~03r†XǦuN}¬dŠ‡ýó °rG½-Ò| VYõÍç¥Àjõ`|ØK‡–È„ÉÃ/tBK£uGÁÚñÐ2<™~dïRhÃݘ¡вÝmË#Ch-â9]ÝZkâÉ'÷Akë¬ÍÏí¯Aë¨uðŽ¹ ¡u~ìH½ .ý´T7¿¦ZŸ^'d¹=ƒ¶p[VÀ²6h«QŽ¶Ï†¶•Ó´1#Ö@Û«TÝBï´·gÉT»ïƒvzÆç¶Û ]É©k‹% #ûu}aNtÆÜw:.æáÑþЉ<±¸,¤:W&G5ø@'ÿÄ«Â 2Ðiš&E™¹º’‹v7R.råÚ.±±=§¡Ë94$™¶º#s2 b­¡;évïÛŒ}õ<úÏíÛäôÝ…Ì!Yy˜µr$¯ÊÄ}½<’>g‚7ú‡dlÕgåÜ•TXßsÑå,ÈÝGÞûš€|ïÖ°Ùo–ƒ\Ð7\9ù$ebÂ,ïƒä4óËW³h<µ2)Åf =?ÿÎßzpÁ=¢Ù¡Sß_ åÓG~u½R·L^¸\€TÚ™Î7Mû Õa[#Öi“+¿†éÜ ³ s-†ôF÷§ ½Ÿ*6ì®'¤Kx” »™‡ÓSŸ÷‰@.H:Xĺ ”K§7&Ÿ› JÕzâç P×Dw¿å؃rZxúÈ·] ˜Y¬‰g‚âÁz) Ø}²øþî(AÎÝŸ>¸GäÝRë.8]v_ w§˜´¾:nÏ•g¼>ËïM¿ ÙÝ?=îuJùæ4\Np/('R0ôË;È‘øú}ƒÜýUô˜"ÈM\<õõˆ3cù÷4· ‹ ‚fò‚{Kê°Q&¢ßAèmtü~¨Ž¿õŠÔ§Â;Ô{€FœÈ]"1 ´Í”žï[EA[¯û’¸,yªã.hÕíSU¦€öyŠV_øãû?Éþ­ãA7š\² ôÙ÷‹ÞJLÐó¯k-z¸¯ô]Í…ÑE¾ ¹=ÁïÅáýfÍž­-,Ðs)«É½øä nËAoîøn=é-´,SŽ}(c‹Õì>&€áŨ©ÞOã„õøž‘t0jTtŒüyº÷þ‚\´÷¯cêB>u‡×ì Pö¼ö¦o3¦‹¼›W4 »IS{ÔBáUÇ•-ËR¡hØ,ãÓþŠ‘v=-ŽS™(iG| ¿0J6cÔ^J~!±÷‹D ´kµ°T¼9”’kj<ZBéÁ£QÙ‡2 TOH_Üþù¯žŸÿ)$Ú6dù_ºK´¿ÛÜéëºø¾qiŒ3eÑñ"LeÝ‘è6ª.æH Ñ1ÙuLtÎÃð-o(V_´ˆÎèaiOFYÝ{>líBôÖK¼ŽVL#ú‡¯¬=à™’Šìæ„Í4žæžÚ ñ B6y§jÖB(ÿÅÜ/6Ž·q£ØBÄâú—õë!wvÏë“c!²qôy×µ!Ý¥âØr¢×je"îBÌIJðî9»‘»føå-—ö`…æ?øÒƒ­,/B¼yºxôžPg„<$>’;{6g\„”Í4¿kj¤CÖ.1IdÜŽ=Ë W…ô×È¥«3–@†-Ó:ï1Mp?';¦àèÚmªÞórfôI§ä!·â*f>m€Ü¥Ôþï‘»qDªßù>ä’ì2”͹ó[#Iü22jRMOÍ‚ôÃw™">™O9˜Yû¤Ø¾÷!g|~D×ì½Û—û¸qºävjöjä7ƒb|)Ófÿ#P¥ÇV‡¼êŽýi¬O Q¦Iç$Öÿðõ½@O£Ä®îLc‰Y¹ 0®§Ï Æ×Ñ1»"ËÁè{mÕjŒ®‹*Ny§Îsvúà yÓó·?J‡¼w¹”tëzÈïû©™ ùËQ‰3éÂë³„å³ òŸÕ"Vó¡ —ÒX¸ fJßÌ –Baùç¶áPp/Ù\”…ÃI*úñP(|~& q8éS}ÂßAqÖº\e‹Z(&8ŸÞ²¥Š S‡N¾%³7ó½¦iAiOÃÂ'3WAéÅCûÚPê>ÈÐVËâž ,FY´C¹\ÞYr.*ª®x¼ •u›î]ë?•×ß[ÇY&@Õ!ehÃËCP}úRüÑ*u¨i%-`Üœµ€úã×½Cín£ùŒ÷CÀÔЬ/Ú¿Ìkß>M³u›Ý§®r¨OÌH~ˆ+÷io“XõÆÒ[);ho>\ h8—œ ©òý«çç þF0¤®¼¾;i.zÉG2Á˜8ßhôít0Bš¾l‰ F„}«‚c&s•ï·Ö\c†âõD]0Ž\Øu0IŒÄÈ•n Üñ¯¤Ú—9¥ŒV‘'îqã¾ÅÇ\µ#`¸W¦§-}Å7ì1ÇÏs÷Ÿ¹ïäȯŒeû¿,„|®áð²–rÈ÷~«¾1=ò=O.ЙPz|Þ…¹ “oÝ$b¨/µ}îßØù­Åª!C¤À¨ÞC,ã¹ÞÙïË!¯W¬8ÅKòQR‡FdË@A¦ÿìÇÆÑP˜xcTÛ+.½æ±ËUî>ç¼™{ðX…,™ïQÛº 8#n§´Ë(ækWô—\ƒÒTÚ!¡1¸óˆ’·²j,”Ö'*î\|ŠÝO× ØÒèß›ë%(wo¿Z(ihêÕqùªÒ·'BéÉ»Yê¶yPútj¹u‡)”•"R,¥ó¡,)îðFé”ç ÖøÊîmyc„òê_Þ5ÚBÙ3«?䋔ϙ҇EB9¥r:iP~-¬º+PQ’Ò>œ1*„™Ç •,¨¬¾¸ÐrBT²\w-âžïÚUº’mR¡JqÚ0îðf¨Zü¼ûÕù/j·ojƒêl½q¤óÏ ê;é^þ—¨&ïá„Рúò£ÿM¡ Üù¾ä>iõ*¨ÞñòQÃMßbõøƒ jš]C ݯ@mNþëà)c¡æûNôX[Ô|ôü·Í> µùåb"«¡æ¶È(PÛ>Ý7'®jkBJ+3¡öeT’θÃÜscR‡ï0MN®–òSÓQtŽö!ÑÛþÛy])*óîv¢«$÷ôœò{N»&úÍUuDGõWR ?â»÷„÷;[‰VÛœ÷£‚{¿ïgæ¦9õåÝ‚5Ú÷}ö莧·½î£Â*lÓ‰žäyRÏöªe•©ÉÕóö>Ýï%µxOô,nªjžNt;|#oëCtßZ”:¼è>ta˜ƒ® ^=ÞÙ N $º$Zï‘↩s•m‰NÃO×Õ%ŒI+"âKõå߃öù, YõîÑGƸ/¬Òo;'I¯çÄOï%~Ämqy5ÌøA)_Öa ¡˜S±ÇÎC˜gQ¾­RÀOòŒ]8æ=„‡úÄtí¡j™ÎÑ:r„¤êÌíšÏ!¤5ÙïÓw²*WÍ>Ô}öôóê52ÝÁØ#‘ô½&Þ› !sÛg¢A:S5!°”èž¹Wêt„$¹£zx„†&w½òy¡„Éœ+ 2-ñqݤ;¼l'e¿ÄÞô­H˜¾­Ú*C×}…}Ã2œ{>rR#^ ÑOþæ…Õý]SY¿AhÇU+öiO;g3Nì²ÀJ¬Áª0Îã Īf-SÖ‘H›í°&"3“ÃHF¯’|t$„­7ļžw B?Ý£îCd{ÓX‡òÓúsð†ØíBq¥U£!ž%9ºÒ½bw nNú,±–‘6ÂggC,³ìõ!1cÃV¥²XKß³ÞÔ• œ×RDËwÑZ!ÍráìÜ" Ù¸_÷ÉË yÉ< ¹ù'²ZdÛ!—šM&rh’$˜• Üf=˜Åq³õo`î¯XÇ7Ì0ýcQæ§À¼±é¤ÅÌË–^ûÕ ¡nt[I贘݅-ÏoóÚ·q·Áœê]'¬× f¡LD¼ÔG9+Þ•Iкœ±sÍÕ‚zô”ê¦ÄÍPßнètŒ%Ôƒ£Žú¾j†zš^Ì„MP[ãDÎ/³Âó戞×`Ž½÷rž ˜j”Ä­ß’Àô5àXš­óÁÜ}ÂË¡nYäð|GÔNÓ>ê¦wÝ?±ê›vΫÌvƒzAUJÊrh8†–ȤA£àTØ*¯dhZ,Ë{È=ÿjÛ~ ßMG«Y>úÐx&áóî‰/42\ÜV'%ø5n<3n/‹&¹3bdï6hZSS,»1 Wô{;lÙqGhÚNQ9*ÚÍmë£O(3 5y¥k4#ëE4W\*©$m…f,­aôž hÅ:Uû}Ð<6u¡); šÏî–]ÌeA³žœP•iyèî]Vê`iMœAËH4ËZwd«côÇï+@õxb í4Ȧbßs²!ñø¶ã¡ÃË%MGÔƒ\óÙ!´p>ÈÉÏ‹æ‚||nßBRo,W€IǪ¶.ä“jþÇŸí†$½ðâ¥÷tHÊét5˜É8¹7#0!™ÓíyKò$Ç\x°v*¤׫o¯_ɦÄŒQ{!üäÞÕÙ:þ²Íd\2¤v9ÝÙ˜í©c‹ŽgJØAêãõÂÎ-Wô–æj£o®„4{ä“Š"6uÓ© uÒÝ:“ÌŠTùú é•V ¶}0:C §ø¸Eïú®>Ò uR;ƒ, 3žd½¦ì5dú¢óp÷é'wìêiA.¢aC–¹8äšÚƯwz¹Û½íÛ#C §¼$ÛÛü*dßn±\ûC²M{¥×9YANo‡•Çí÷;¬=™õ‘¹Œz¡²:(¤œ1ô®=çúáµ=ª@i׿˜*Ͼ€ª×r%F‹ ª EB”P—,ö½Íª»›î ¨!ãæYè¬56Q…·ÔÔãâ”ÚPÞ’ú¶º(Áö¨ªi%+ƒúùι³ïæ&V»©} 4)‹ ” @ý‘Øê°’šè´‘ú ÙmÙ^ šÕU»Ö\y@Ùüshh2y")i> ˜½³æÙ*Ðf.}t3p?h ïL+Ÿv´qß±ü˜h$›A^ ö'¦ ‚Z¿h­åÛžŸz•!y­ 1u(ÏÃË@SÙ9ž|ÿ hšiTWÐ~ÙÉsë%ÚzQ¢î¯žGÿi$¾›L–ô’‘%º{ÖGîUWáÛ ìäùr¥h³¯éîðm›·î&åÎ ]¾¨îª¸Ä&¢¯µî½ÊtC¢ë·‘ __Ã=îc›o Êáû/ðý)šùç‚“™cOí¹)°ŸäŸ{úW’­5„ç^zÿï HÇçãûyð‘w.â·Oïg‘7¢2‚ú·þÖc ü<¾©Ú†fÏ›,ð·àÅCÈ6̦/TâZÞõ[ݳîMx÷/üu‹,âÒxa9ÄÏ;”cóbSGÿ4@‚Dôhò‹íªÏ]ZF>÷ b7Üz!<Ÿf¶]„èÌýu.ð3áÛ òi~¿ ç?Âï·î‹Msi)‚úÿÑ¥Ç:©%6=Càg"ð;áý>ý¿Ï>>òûM^òMQ&ã¶àÜÉ÷Wáׇ|ý4ßï…ï§"8ßòüUþà¿2pΛãm'hÏ÷_øµô²†íœà=à×26é^à¶lÏZ 1„ae%D»mIcËš‚ăÅí^¡ˆÚ'$f°‰¾á‹âæ“{øíùƒ7¢ˆ«§/dI?I¤MÜ?¹?°¹,~.¾nÜw¯ŸûGýÅËËf¹¿'ïUØÓŸ÷&±ÂÏßÄo¥/Ÿg›ÿÕÍ—ÏDöô 2 p rãÑ’Ü&k]Vp‹û›\\ÝÜy¤´ïJ?·“À •Ë½ùYüäpsáç.ó+ÒÄ?Às¹ ©Ÿ<Ë]ü=ƒ\ø!?Sü]Ib«ý~Öëèÿ»SH"8ö³Í$~#ÑLâ=—Dl¹K` ¯‡„ùùøñË üÝ…_ÐÏ.üåJÚ4è:è:è:èú{‰ýñ·‰ýà­9Bÿç…æ×"÷k¡Y>hm=hm=hmýgkë?O¼¨~âý­ ò{þÍÔjÿJíàŸÇù«~œ $ö߃ÜuЄoЄoЄï›ðýyFþ‹&áÏÃ7§ôgôgÿ ýÙÿ-;Í€æ‡?Ê­¯­¯þBë«Ï(¨Hò…ƒ¾Œƒ¾Œÿ|ÿ<[ÒÿùÙòóþ§Fü¦Úà7Õ¿©6øMµ‹ýï."yšŽA'¥A'¥A'¥ì¤ôoÑtüÅ_>ôñôñÿ_àãÿo‘ÿÖî…?_m\m\ÿظþ[æËß[“ýž1k½á½á½áþ{¼áþ¼2ŒÿçW¾½èoSªAƒóAƒóAƒódpþ/6¥úeKþ{â~ázð ׃_¸þïýÂõŸˆQÿ_ ©ÿÞè)}ktseries/data/camp.rda0000644000175100001440000001023214674232237014277 0ustar hornikusersBZh91AY&SY«”aJöþ1BFUUÿÿÿÿ@(L@D@`?<>àz€R¢Q)O€Üô ÄU?Á€ ši¤Bhš?ÈMMòŒ†Dô“Õ Ðhi   =Tª 4dÐ4ÑÓ#d2õ‰µ<£ ©£i¨ ˜ !RAM ÑÐC@ÈÐ Ó'íTã”)Q h D<° âU\J   1*â-qµkkˆÕ¸£Z Q9Íqª+4E«‹‹qÅEq¸ãWÉƧ9'•¸.2åÎãpg'9F‰ÎsŽë%¹€ì¶bÒMªÕ÷ìÔt‚sk¶aŒI‚¥–€A Öç;8èÚ&úž 1ø÷ü¸üßeØöû:@:}Šµ(WœòuÐCóÖÇöÃßLã{®}‹m;my^´ø Ã]Ûhã²éö­ôx¨CŽ¼%ºB$½ŽœsŸ3½€jËŸµ)&Úu«~ý £9@5K$¼¾çFïeÔÕÎL¶„û=Á÷n¿“⸗˧œÂÐŒysô)aM½ƒy\z²ùà /*ôŸYzdÞ»àR¯=П0÷.%0çàAƒ}|æØ~ƒ¿>Y„"\Är¾ÙSì«ú‡c‘´ ]›v³ôûÇWˆå_%˽nç4 È'Ĥ‹ßžšChšF#+h|Ó”žïPò?&Ó—Bì c>=®x,òÖ;è@#¡eæáT— ]Ššz·=>û’q»¦9ï9vÁñ0~]Ëq×̳i«†~ô9K…ùÓ=úÍÞtÃC#ËâÎúE»Ží'×RÇOhm½%~™œéÆàž¯ZÈ…Ï´EØA´ai˜JDúBJž‘R_F÷•—!Xô‹Ônduí0ø¹Ÿ­ÜÛŽŽŸª[àÙ嘾û·)í‹/Þ»‚¯TEE,<¼hÚ­¼wòþ“.íëíyyÙôùzÝiÑú(uÁ©yS—1¼Ðèe¡¨}[:Â¥^õ88Ïî?eÇžX^Âç}H~{ñÀÄlí˜÷§-­·Xª‡i÷=†,ZUxÏ èøƒ„BéÀÁÑeÐotx†ŒrÓEO7l^ýHæ›ß’rÒªâ,i9ü¦éB4 ý±ì勪;œÝkJ=…«ÏW§ìwJéZZ›@9kÇ=_Ê{”™pIxÍöƒÒê[27o ]õya§7ôºqîìé¨1|.Ζ’ç_žÐ—B|—´í›©ìsµ·(Á§“Z‚ྙï°ÃëÂsãCêpȹ¹JŽÕµTñë׆}ÛÜÀbˆž %@ H\qP¼¼Iõ€/†ÕSaI^"mŸ4Øë«)-~½¬é×-V>"•×y¡cÖÈnW4¿E«ôe–£¬Ãµ#JêTñ`•kf*–ÂñsJù£P^Eg»\Äòý¹’N©ó󷫺G^y<Óo¢‘ý¿NëÖC.¯³ÒzÜ„b’I '†Ýîàžtq'Ó¡+aÖ²ŒÞj:ʤ'd°@˜fe‹¨œþŠxoJÎ’xœ) C÷­mB7¢iI†ãKCæûjñ JÈy-ôy£Ç¡¨ c›*w©FzÖ¤r€Pµ·!¥Ñ+•]µR úÉtÆÄè"S™ÓuTI yO’;¿E‰RUæ¹Æ§˜z½œ•‚e¡üíBÉ“žè%É/ªô(´Ð*µßF´Õª•Sˆ1žz0£ Nd¹,JÅ-# ÆÔZ ›ÔÅ©STü6~…®ÚÎa. º•8v­>­h‹Å³+á[¾ çp::Àp3¤ÂSDåWBó²ñe9ܦcžÝ'ó¸¼ ®±>ÛÙêWø¹¤ .0¡ ^-=R>ü;d.ƒ7l“ˆwæ×nÞ$_–réÑlTÖQD¯‡Áð{¬]”.ŽîOgÒ%I“TçrŒt2œ§óˆaü¢Q|iH÷´ש·Q¬žeÏ]÷¥`ƒâDšÜ$·C"ï”æþ®\”¤GÎeNóªÚY_JZ±Ae_J-YŽm„48¿ë¤¶¡khΣžVZÖÏ#…0U²õ0Ê)^t”ä@%‚¸Œ ƒy¤*ÉB+~þ÷¨I[[œäí~¹‘íǯ;†½gÐé£ÎzS\ûÁ±eÕgc¦þ O"bßÒ5PìAÔúég§rBè'™]ÕT…fË?6憎Í2,‹ö–H¨¦}e‡¨÷kµñnÐÚ&±Uýþg†äÊ:qýÏãØé àË2º³²‡ˆÜêç˜cï´öïº8"Ö;L&»ÌB4yEg…øpq[.Bì‡(J'E@Ë) Ë@¨¾T’Æ Y¤ÃG)’-²4Ö Ðb»óZ¶;¡«ù'ÈõåÓ4ª¦ò2¡]:C» õˆ T]–KÕj €ˆHÈ<w)¹‚ˆØǃuæá× `BÏ%JÒP!L¬ôÆñ•¡ŸÊT¼HÆüòcY‰ü¥dânÚ/‹ào.ð‚QÓgEÑ~>, )7Æ|{KŸ‡®CûðÏŒ'#àÌ,À^AËQä¦ßÐCG•‘Üæ½f;“b~m$R/Êõ© ½ª$Ê/M`ª“©ÀÕÊzžÂa ŸS^Š®­ùt‘ß+ê»úV¬{÷ Þ·H¬ýT±u—‰d¹ãŒýMNOn¯£àûÁ@à…à>¿LŒˆþN\€2”Ñ(Šö„T‚Ôƒ„% P&APà¨OÕê¹Þgþ$Ï <ÎÏkc_#Tâ6#+°åŒ4c1›BŠêº`i¤ˆÚ 4QF¨«Æ4`5¢@ÅcF”Ö1µ™F¢4†@±±mhRÛš6É·®â¥,Å£%21ƒRY+5! ” ÆH@±±!ḇ“bÄh°b‘ME’,h%1´`¤ÔÄÁJFŒ‹…&†bJ1¢™’1fa(ˆÉ¨K&Š`d@Æ*2Y¢"Y„Ê2F”42Rh6"ÔlcM E"E ¢‘F,X‰„‘b1%PÆP–@Œh!FP10ÃhJB)Q†b¤š!ŒhdbHÃ(ƒ„ƒLÊDdˆ”Ä’ ‘™Q„(Ø0%H&fDÈb…$þœ“%II¢LQ$–È’‰0…DlÒI ¢e1€É $™ bD™"dJ 4° FÀÉ–Q€Ì¤’¥B40Ðj"˜‘¤"c%‚ …1™„™4DÄb„RBb˜Y‚# (H¢B˜ÈŒŒ,43ŠI$$€²‘!#4FA$‹YM €4‚Y–b”˜$¨FFŠe&f™`²X–a“‰ a2ŒÄÐ$‚eL‚$Á‘120Š̆AbD1l¥Ab"¥D`c™ Cd‰`&"J&fI#2E”’ÌDD…C –Y Ñ¢ d‚†”¤™ )ŒE˜DA’‰DØH3"[ÙçFH‰ … d%#R&`šbb™” ̆lɦ„XÀÑ% ÄiB)–’BJe(Ã#$4  „DÙ&P4ši“"HR@¥ÈI¦C1$˜Q2›&!$¦„"JSDRfÂ$3°†‘2`d4³)’D0Ê J4Ñ bJ0Fƒ(2R M$„ˆ$i1¢b`¦%$ŒH‚DIdÁ‰ÃÌ ÌÑ)# Âd™¢LÊL”¤!3(ŒÁ%$I¤“@` ÐJ F”@˜Œ2D0¦J Œ‰1DÊA 3$AŒ“2ɤ˜ÌŒ3C$˜É¤°S IF‹ 0"M†L¤‹XRPÍ”1( ±„³H£APFu)T9²‚¢YJ%\?O3åo5ì|%ÆŸ ˜"¶Ycš4_'q œ¡µUÌw~Ô˜Wrež ýÙEŸÌJî¤/‰EygVp¥gIWYC¬³ÀY„* *,°[ð´Ì»ÓNP4) ¹’Pš{t/°‹ ÷´¾>ûL.‘Éa!v C”aÚ£¨ Ÿ8V"…·ŽLˆ Ý=”Ë4ÌÂBÓ) Æ:‡aU Z¢¬†‚6`\N©ªP ˜£ˆ T ÁRÆàzwQ.‰`¬"–e’Û"Ø6˜é âC(¹CwU³&†íÔÝݼf:šˆM¾ÅÑ«/‡"KN⡦|i]†ÖßiIJ–ŒšuVˆu°@a¡¡CÂ}b»ˆc¶ªËÃ:¸ð´¡Ä:2Ú¨ œ:‡„v+8q®–l\\Ö”ðuMAM¯[fmÕˆ{”]Ê”Y•…¬!1/2ï!FEB³* ¼¶Ü´:Bôæ¡Rœ¿ž GJPNÆ• îDzsŒ«Ý¥ury¶­ì¸¼ô*’**™ÜŽHlv'Á¢Û;2 žÑ±Êªæ«&ƒ¶õéŒS * ²¯ˆê&dÏC‘‰V¬Æ†ÓpRÕEg¦BCð5]Ù@ZDµ]¦€Í០‰ÙÆå›’•ˆ½§£]îR6Çgz˜lT£k  Aì$Ϧ®Ã¯ZÈ©€µ¨XŽ|þÍ¢ß\LéO·…קPŒ×S@»TEHë¥~ßm:HVt¶ &N;í)g×·jßUãžÏoúXr!…€ AK< Œ6ˆL0°Fkøùûû[¥ü]ÉáBB®PU„tseries/src/0000755000175100001440000000000014656571417012555 5ustar hornikuserstseries/src/ppsum.c0000644000175100001440000000227613041163364014055 0ustar hornikusers/* Copyright (C) 1997-2000 Adrian Trapletti This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA efficient computation of the sums involved in the Phillips-Perron tests */ void tseries_pp_sum (double* u, int* n, int* l, double* sum) { int i, j; double tmp1, tmp2; tmp1 = 0.0; for (i=1; i<=(*l); i++) { tmp2 = 0.0; for (j=i; j<(*n); j++) { tmp2 += u[j]*u[j-i]; } tmp2 *= 1.0-((double)i/((double)(*l)+1.0)); tmp1 += tmp2; } tmp1 /= (double)(*n); tmp1 *= 2.0; (*sum) += tmp1; } tseries/src/boot.c0000644000175100001440000000572113041164102013641 0ustar hornikusers/* Copyright (C) 1997-1999 Adrian Trapletti This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA time series bootstrap functions */ #include #include static int geodev (double p) /* Return geometric distributed random deviate with p(i) = p*(1-p)^i, where 0 n) return (i-1)%n+1; else return i; } static void StatBoot (double x[], double xBoot[], int n, double p) /* Generates a bootstrap sample xBoot[1..n] from x[1..n] according to the stationary bootstrap resampling scheme (Politis, D. N. and Romano, J. P., 1994, The Stationary Bootstrap, J. Amer. Statist. Assoc. 89, 1303-1313). Input is n, x[1..n], xBoot[1..n] and p, the parameter for the geometric distribution, output xBoot[1..n]. */ { int i, j, I, L; i = 1; while (i <= n) { I = disuni(n); L = geodev(p); j = 0; while ((j < L) && (i <= n)) { xBoot[i] = x[WRAP(I+j,n)]; i++; j++; } } } static void BlockBoot (double x[], double xBoot[], int n, int L) /* Generates a bootstrap sample xBoot[1..n] from x[1..n] according to the blockwise bootstrap resampling scheme (Kuensch, H. R., 1989, The Jackknife and the Bootstrap for General Stationary Observations, Ann. Stat. 17, 1217-1241). Input is n, x[1..n], xBoot[1..n] and L, the blocklength, output xBoot[1..n]. */ { int i, j, I; i = 1; while (i <= n) { I = disuni(n-L+1); j = 0; while ((j < L) && (i <= n)) { xBoot[i] = x[I+j]; i++; j++; } } } void tseries_boot (double *x, double *xb, int *n, double *b, int *type) { GetRNGstate(); if (*type == 0) StatBoot (x-1, xb-1, *n, *b); else if (*type == 1) BlockBoot (x-1, xb-1, *n, (int)*b); else error ("this type of bootstrap is not yet implemented\n"); PutRNGstate(); } tseries/src/init.c0000644000175100001440000000304013041164453013642 0ustar hornikusers#include #include #include void tseries_pp_sum (double* u, int* n, int* l, double* sum); void tseries_quad_map (double *x, double *xi, double *a, int *n); void tseries_arma (double *x, double *u, double *a, int *ar, int *ma, int *arl, int *mal, int *max, int *n, int *intercept); void tseries_bdstest_main (int *N, int *M, double *x, double *c, double *cstan, double *EPS, int *TRACE); void tseries_boot (double *x, double *xb, int *n, double *b, int *type); void tseries_fit_garch (double *y, int *n, double *par, int *p, int *q, int *itmax, double *afctol, double *rfctol, double *xctol, double *xftol, double *fret, int *agrad, int *trace); void tseries_ophess_garch (double *y, int *n, double *par, double *he, int *p, int *q); void tseries_pred_garch (double *y, double *h, int *n, double *par, int *p, int *q, int *genuine); static const R_CMethodDef CEntries[] = { {"tseries_pp_sum", (DL_FUNC) &tseries_pp_sum, 4}, {"tseries_quad_map", (DL_FUNC) &tseries_quad_map, 4}, {"tseries_arma", (DL_FUNC) &tseries_arma, 10}, {"tseries_bdstest_main", (DL_FUNC) &tseries_bdstest_main, 7}, {"tseries_boot", (DL_FUNC) &tseries_boot, 5}, {"tseries_fit_garch", (DL_FUNC) &tseries_fit_garch, 13}, {"tseries_ophess_garch", (DL_FUNC) &tseries_ophess_garch, 6}, {"tseries_pred_garch", (DL_FUNC) &tseries_pred_garch, 7}, {NULL, NULL, 0} }; void R_init_tseries(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } tseries/src/garch.c0000644000175100001440000002732214674232061014000 0ustar hornikusers/* Copyright (C) 1997-1999 Adrian Trapletti This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA GARCH estimation Reference: T. Bollerslev (1986): Generalized Autoregressive Conditional Heteroscedasticity, Journal of Econometrics 31, 307-327. */ #include extern void F77_NAME(dsumsl) (int *n, double *d, double *x, void (*)(int *, double *, int *, double *, int *, double *, void (*)(void)), void (*)(int *, double *, int *, double *, int *, double *, void (*)(void)), int *iv, int *liv, int *lv, double *v, int *uiparm, double *urparm, void (*)(void)); extern void F77_NAME(dsmsno) (int *n, double *d, double *x, void (*)(int *, double *, int *, double *, int *, double *, void (*)(void)), int *iv, int *liv, int *lv, double *v, int *uiparm, double *urparm, void (*)(void)); extern void F77_NAME(ddeflt) (int *alg, int *iv, int *liv, int *lv, double *v); #define BIG 1.0e+10 /* function value if the parameters are invalid */ static double dsqrarg; #define DSQR(a) ((dsqrarg=(a)) == 0.0 ? 0.0 : dsqrarg*dsqrarg) static double dmaxarg1,dmaxarg2; #define DMAX(a,b) (dmaxarg1=(a),dmaxarg2=(b),(dmaxarg1) > (dmaxarg2) ?\ (dmaxarg1) : (dmaxarg2)) struct garch_handler /* used to set up the additional parameters used in calcf and calcg */ { double* y; /* the time series to fit */ double* h; /* the conditional variance (cv) */ double* dh; /* dh_i/dp_j */ int n; /* the number of observations */ int p, q; /* GARCH(p,q) */ }; static struct garch_handler garch_h; static void F77_SUB(calcf) (int *pq, double *p, int *nf, double *f, int *uiparm, double *urparm, void (*F77_SUB(ufparm))(void)) /* compute negative log likelihood apart from the constant and the pre-sample values */ { int i, j, ok; int maxpq = (int) DMAX(garch_h.p,garch_h.q); double temp = 0.0; double sum = 0.0; ok = 1; if (p[0] <= 0.0) ok = 0; for (i=1; i<(*pq); i++) if (p[i] < 0.0) ok = 0; if (ok) /* parameters are valid */ { for (i=maxpq; i #include #include /* NBITS is the number of useable bits per word entry. Technically on the sun this should be 32, as the sun uses 4 byte integers. Since the counting algorithm uses a table lookup method we must keep that table reasonable, so only 15 bits are used. This may be changed if space is a problem. */ #define NBITS 15 #define ALLBITS 0xffff #define PREC double #define TABLEN 32767 static int BDS_DEBUG; /* ----------- grid macro: turn bits on --------------------------- */ #define GRIDON(x,y) \ if(x!=y) { \ if(x>y) { \ ix = y; \ iy = x; \ } \ else { \ ix = x; \ iy = y; \ } \ iy = iy-ix-1; \ ipos = iy / NBITS; \ ibit = NBITS - 1 - (iy % NBITS); \ *(*(start+ix)+ipos) |= bits[ibit];\ } /* define struct */ struct position { PREC value; int pos; }; /* globals */ static int bits[NBITS], *mask; static short int *grid, **start; static int *lookup,first=1; static struct position *postab,*postlast; /* free all memory allocations */ static void freeall(void) { R_Free(grid); R_Free(mask); R_Free(postab); R_Free(start); R_Free(lookup); } /* module function definitions */ /* generate mask mask pattern for row l, nbits: number of bits used omit: number of bits omitted mask: mask[0],mask[1] two word mask */ static void genmask(int l, int n, int nbits, int omit, int mask[]) { int i,k,j,last,itrue; mask[0] = mask[1] = ALLBITS; last = (n-l-1)/nbits; for(i=n-omit;i 2 ) { for (i = *(start+j);i< *(start+j+1)-2;i++) { count += lookup[*i]; if(lookup[*i]>15) Rprintf("%d %d %d\n", (int)(i-grid),*i,lookup[*i]); } for(i = *(start+j+1)-2;i< *(start+j+1);i++) { count += lookup[ (*i) & mask[j*2+ *(start+j+1)-i-1]]; } } else { for(i = *(start+j);i<*(start+j+1);i++) { count += lookup[ (*i) & mask[j*2+ *(start+j+1)-i-1]]; } } } if(BDS_DEBUG) Rprintf("count = %ld\n",count); return ( 2*((double)count)/ (nd*(nd-1))); } static double ipow(double x, int m) { int j; double y; y = 1; for(j=0;jvalue>b->value) return(1); else if(a->valuevalue) return(-1); else return(0); } static void fkc(PREC x[], int n, double *k, double c[], int m, int remove, PREC eps) { /* junk integers */ int i,j; short int *ip; int memsize; int nobs; /* pointers */ register struct position *pt; struct position *p; /* long counts */ long count,tcount; /* double length */ double dlength; double phi; register int ix,iy,ibit,ipos; nobs = n-remove; dlength = (double)nobs; /* allocate memory */ if(first ) { mask = R_Calloc(2*n,int); lookup = R_Calloc(TABLEN+1,int); if(BDS_DEBUG) Rprintf("set up grid\n"); postab = R_Calloc(n,struct position); /* build start : grid pointers */ if(BDS_DEBUG) Rprintf("build start\n"); start = R_Calloc(n+1,short int *); /* find out how big grid has to be */ memsize = 0; for(i=0;i<=n;i++) memsize += (n-i)/NBITS + 1; /* grid is defined as short (2 byte integers) */ grid = R_Calloc(memsize,short); if(grid==NULL) { error("Out of memory\n"); /*exit(-1);*/ } start[0] = grid; for(i=1;i<=n;i++) start[i] = start[i-1] + (n-i)/NBITS + 1; /* bit vector */ bits[0] = 1; for(i=1;i<15;i++) bits[i] = (bits[i-1] << 1); /* table for bit countining */ if(BDS_DEBUG) Rprintf("build lookup\n"); for(i=0;i<=TABLEN;i++){ *(lookup+i) = 0; for(j=0;jvalue = x[i]; (postab+i)->pos = i; } if(BDS_DEBUG) Rprintf("sort\n"); qsort((char *)postab,n,sizeof(struct position),comp); postlast = postab+n-1; /* start row by row construction */ /* use theiler method */ if(BDS_DEBUG) Rprintf("set grid\n"); count = 0; phi = 0; for(p=postab;p<=postlast;p++) { tcount = 0; pt = p ; /* count to right */ while( (pt->value - p->value)<=eps) { GRIDON(p->pos,pt->pos); if( (p->posposvalue - pt->value)<=eps) { if( (p->posposiy){ temp = ix; ix = iy; iy = temp; } iy = iy-ix-1; ipos = iy / NBITS; ibit = NBITS - 1 - (iy % NBITS); *(*(start+ix)+ipos) |= bits[ibit]; if( *(*(start+ix)+ipos)<0) Rprintf("%d %d %d %d\n",ipos,ibit,ix,iy); } */ /* friendly front end - This main program is a friendly front end program that calls the routines to calculate the bds statistic. It allows unix user to: 1.) have an easy to use command imediately 2.) see how to use the calling routines for calculations Users doing montecarlo work will probably want to use the subroutines directly. These routines are: fkc(x,n,k,c,m,n,eps) cstat(c,cm,k,m,n) freeall() fkc(x,n,k,c,m,mask,eps) x = vector of series to test (double *), but it can be modified using the PREC definition. Setting PREC to float or int, will allow the use of other types of series. n = length of series (int) k = returned value of k (double *) c = raw c values c[1],c[2],c[3].... (Note: the correct subscripts are used.) (double *) m = maximum embedding - cstats will calculated for i=1 to m (int) mask = number of points to ignore at the end of the series. Since the calculation of c(2) can effectively use more points then c(3), c(4) ..., often the last several points are ignored so that all statistics are calculated on the same set of points. ie. for m=3 we might only use x(1) through x(n-2) for the calculations of c(2) and c(3). This is generally set to m-1 to allow all c to be estimated on a point set of n-m+1. (int) eps = epsilon value for close points (double) or set to (PREC). cstat(c,cm,k,m,n) This simple routine calculates the standard error and the normalized bds stat. It closely follows formulas in Brock Hsieh and LeBaron on page 43. c = c[1] c for embedding 1 cm = c[m] c for embedding m k = k stat m = embedding n = length of series freeall() The fkc algorithm allocates large amounts of memory. This is time consuming and for montecarlo simulations it is not desirable to reallocate every time. The routine can tell whether it needs to reallocate. For simulations fkc should be called repeatedly. When the program is finally done freeall() should be called to free all the allocated space. This front end module can be removed from the begin front end comment to the end front end comment. The remaining routines can be compiled as a stand alone library to be called by other programs. fkc_slow() This extra routine is also included. It is a slower algorithm which performs exactly the same function as fkc. Its only advantage is that it is simpler and requires much less memory than the fast algorithm. To implement it just replace the call to fkc with fkc_slow() the arguments are exactly the same. */ /* begin front end ---------------------------------- */ void tseries_bdstest_main (int *N, int *M, double *x, double *c, double *cstan, double *EPS, int *TRACE) { int i; double k; int n, m; double eps; n = (*N); m = (*M); eps = (*EPS); BDS_DEBUG = (*TRACE); /* calculate raw c and k statistics : This is the hard part */ fkc(x,n,&k,c,m,m-1,eps); if(BDS_DEBUG) { Rprintf("k = %f\n",k); for(i=1;i<=m;i++) { Rprintf("c(%d) %f\n",i,c[i]); } } /* calculate normalized stats: This is the easy part */ for(i=2;i<=m;i++) { cstan[i] = cstat(c[1],c[i],k,i,n-m+1); } /* free allocated memory: This must be done when finished */ freeall(); } /* end front end ------------------------------------------*/ tseries/src/arma.c0000644000175100001440000000235213041163610013616 0ustar hornikusers/* Copyright (C) 1997-2001 Adrian Trapletti This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ARMA estimation */ void tseries_arma (double *x, double *u, double *a, int *ar, int *ma, int *arl, int *mal, int *max, int *n, int *intercept) /* compute conditional sum of squares */ { int i, j; double sum; for (i=(*max); i<(*n); i++) { if (*intercept) sum = a[(*mal)+(*arl)]; else sum = 0.0; for (j=0; j<(*arl); j++) sum += a[j]*x[i-ar[j]]; for (j=0; j<(*mal); j++) sum += a[j+(*arl)]*u[i-ma[j]]; u[i]=x[i]-sum; } } tseries/src/cfuncs.f900000644000175100001440000000146113475670313014351 0ustar hornikusersmodule cfuncs interface subroutine cnlprt(msg, plen) bind(C, name = 'cnlprt_C') use iso_c_binding character(kind = c_char) :: msg(*) integer(kind = c_int) :: plen end subroutine cnlprt subroutine h100s(i1, i2, d1, d2, d3, d4, a1, a2, d5) bind(C, name = 'h100s_C') use iso_c_binding character(kind = c_char) :: a1, a2 real(kind = c_double) :: d1, d2, d3, d4, d5 integer(kind = c_int) :: i1, i2 end subroutine h100s subroutine h100l(i1, i2, d1, d2, d3, d4, a1, a2, d5, d6, d7) bind(C, name = 'h100l_C') use iso_c_binding character(kind = c_char) :: a1, a2 real(kind = c_double) :: d1, d2, d3, d4, d5, d6, d7 integer(kind = c_int) :: i1, i2 end subroutine h100l end interface end module cfuncs tseries/src/dsumsl.f0000644000175100001440000035636114674232044014237 0ustar hornikusersC C Added to each function and subroutine a "save" and replaced C "stop" with a call to the external function "error". "error" C has to be provided by the caller, A. Trapletti, 14.10.1999 C C *** These routines are from the NIST Core Math LIBrary CML *** C SUBROUTINE DSUMSL(N, D, X, CALCF, CALCG, IV, LIV, LV, V, 1 UIPARM, URPARM, UFPARM) save C C *** MINIMIZE GENERAL UNCONSTRAINED OBJECTIVE FUNCTION USING *** C *** ANALYTIC GRADIENT AND HESSIAN APPROX. FROM SECANT UPDATE *** C INTEGER N, LIV, LV INTEGER IV(LIV), UIPARM(*) DOUBLE PRECISION D(N), X(N), V(LV), URPARM(*) C DIMENSION V(71 + N*(N+15)/2), UIPARM(*), URPARM(*) EXTERNAL CALCF, CALCG, UFPARM C C *** PURPOSE *** C C THIS ROUTINE INTERACTS WITH SUBROUTINE DSUMIT IN AN ATTEMPT C TO FIND AN N-VECTOR X* THAT MINIMIZES THE (UNCONSTRAINED) C OBJECTIVE FUNCTION COMPUTED BY CALCF. (OFTEN THE X* FOUND IS C A LOCAL MINIMIZER RATHER THAN A GLOBAL ONE.) C C-------------------------- PARAMETER USAGE -------------------------- C C N........ (INPUT) THE NUMBER OF VARIABLES ON WHICH F DEPENDS, I.E., C THE NUMBER OF COMPONENTS IN X. C D........ (INPUT/OUTPUT) A SCALE VECTOR SUCH THAT D(I)*X(I), C I = 1,2,...,N, ARE ALL IN COMPARABLE UNITS. C D CAN STRONGLY AFFECT THE BEHAVIOR OF DSUMSL. C FINDING THE BEST CHOICE OF D IS GENERALLY A TRIAL- C AND-ERROR PROCESS. CHOOSING D SO THAT D(I)*X(I) C HAS ABOUT THE SAME VALUE FOR ALL I OFTEN WORKS WELL. C THE DEFAULTS PROVIDED BY SUBROUTINE DDEFLT (SEE IV C BELOW) REQUIRE THE CALLER TO SUPPLY D. C X........ (INPUT/OUTPUT) BEFORE (INITIALLY) CALLING DSUMSL, THE CALL- C ER SHOULD SET X TO AN INITIAL GUESS AT X*. WHEN C DSUMSL RETURNS, X CONTAINS THE BEST POINT SO FAR C FOUND, I.E., THE ONE THAT GIVES THE LEAST VALUE SO C FAR SEEN FOR F(X). C CALCF.... (INPUT) A SUBROUTINE THAT, GIVEN X, COMPUTES F(X). CALCF C MUST BE DECLARED EXTERNAL IN THE CALLING PROGRAM. C IT IS INVOKED BY C CALL CALCF(N, X, NF, F, UIPARM, URPARM, UFPARM) C NF IS THE INVOCATION COUNT FOR CALCF. IT IS INCLUD- C ED FOR POSSIBLE USE WITH CALCG. IF X IS OUT OF C BOUNDS (E.G., IF IT WOULD CAUSE OVERFLOW IN COMPUT- C ING F(X)), THEN CALCF SHOULD SET NF TO 0. THIS WILL C CAUSE A SHORTER STEP TO BE ATTEMPTED. THE OTHER C PARAMETERS ARE AS DESCRIBED ABOVE AND BELOW. CALCF C SHOULD NOT CHANGE N, P, OR X. C CALCG.... (INPUT) A SUBROUTINE THAT, GIVEN X, COMPUTES G(X), THE GRA- C DIENT OF F AT X. CALCG MUST BE DECLARED EXTERNAL IN C THE CALLING PROGRAM. IT IS INVOKED BY C CALL CALCG(N, X, NF, G, UIPARM, URPARM, UFAPRM) C NF IS THE INVOCATION COUNT FOR CALCF AT THE TIME C F(X) WAS EVALUATED. THE X PASSED TO CALCG IS C USUALLY THE ONE PASSED TO CALCF ON EITHER ITS MOST C RECENT INVOCATION OR THE ONE PRIOR TO IT. IF CALCF C SAVES INTERMEDIATE RESULTS FOR USE BY CALCG, THEN IT C IS POSSIBLE TO TELL FROM NF WHETHER THEY ARE VALID C FOR THE CURRENT X (OR WHICH COPY IS VALID IF TWO C COPIES ARE KEPT). IF G CANNOT BE COMPUTED AT X, C THEN CALCG SHOULD SET NF TO 0. IN THIS CASE, DSUMSL C WILL RETURN WITH IV(1) = 65. THE OTHER PARAMETERS C TO CALCG ARE AS DESCRIBED ABOVE AND BELOW. CALCG C SHOULD NOT CHANGE N OR X. C IV....... (INPUT/OUTPUT) AN INTEGER VALUE ARRAY OF LENGTH LIV (SEE C BELOW) THAT HELPS CONTROL THE DSUMSL ALGORITHM AND C THAT IS USED TO STORE VARIOUS INTERMEDIATE QUANTI- C TIES. OF PARTICULAR INTEREST ARE THE INITIALIZATION/ C RETURN CODE IV(1) AND THE ENTRIES IN IV THAT CONTROL C PRINTING AND LIMIT THE NUMBER OF ITERATIONS AND FUNC- C TION EVALUATIONS. SEE THE SECTION ON IV INPUT C VALUES BELOW. C V........ (INPUT/OUTPUT) A FLOATING-POINT VALUE ARRAY OF LENGTH LV C (SEE BELOW) THAT HELPS CONTROL THE DSUMSL ALGORITHM C AND THAT IS USED TO STORE VARIOUS INTERMEDIATE C QUANTITIES. OF PARTICULAR INTEREST ARE THE ENTRIES C IN V THAT LIMIT THE LENGTH OF THE FIRST STEP C ATTEMPTED (LMAX0) AND SPECIFY CONVERGENCE TOLERANCES C (AFCTOL, LMAXS, RFCTOL, SCTOL, XCTOL, XFTOL). C LIV...... (INPUT) LENGTH OF IV ARRAY. MUST BE AT LEAST 60. IF LIV C IS TOO SMALL, THEN DSUMSL RETURNS WITH IV(1) = 15. C IF LIV IS AT LEAST LASTIV (= 44), THEN THE MINIMUM C ACCEPTABLE VALUE OF LIV IS STORED IN IV(LASTIV) C WHEN DSUMSL RETURNS. (THIS IS INTENDED FOR USE C WITH EXTENSIONS OF DSUMSL THAT HANDLES CONSTRAINTS.) C LV....... (INPUT) LENGTH OF V ARRAY. MUST BE AT LEAST 71+N*(N+15)/2. C (AT LEAST 77+N*(N+17)/2 FOR DSMSNO, AT LEAST C 78+N*(N+12) FOR DHUMSL). IF LV IS TOO SMALL, THEN C DSUMSL RETURNS WITH IV(1) = 16. IF LIV IS AT LEAST C LASTV (= 45), THEN THE MINIMUM ACCEPTABLE VALUE OF C LV IS STORED IN IV(LASTV) WHEN DSUMSL RETURNS. C UIPARM... (INPUT) USER INTEGER PARAMETER ARRAY PASSED WITHOUT CHANGE C TO CALCF AND CALCG. C URPARM... (INPUT) USER FLOATING-POINT PARAMETER ARRAY PASSED WITHOUT C CHANGE TO CALCF AND CALCG. C UFPARM... (INPUT) USER EXTERNAL SUBROUTINE OR FUNCTION PASSED WITHOUT C CHANGE TO CALCF AND CALCG. C C *** IV INPUT VALUES (FROM SUBROUTINE DDEFLT) *** C C IV(1)... ON INPUT, IV(1) SHOULD HAVE A VALUE BETWEEN 0 AND 14...... C 0 AND 12 MEAN THIS IS A FRESH START. 0 MEANS THAT C DDEFLT(2, IV, LIV, LV, V) C IS TO BE CALLED TO PROVIDE ALL DEFAULT VALUES TO IV AND C V. 12 (THE VALUE THAT DDEFLT ASSIGNS TO IV(1)) MEANS THE C CALLER HAS ALREADY CALLED DDEFLT AND HAS POSSIBLY CHANGED C SOME IV AND/OR V ENTRIES TO NON-DEFAULT VALUES. C 13 MEANS DDEFLT HAS BEEN CALLED AND THAT DSUMSL (AND C DSUMIT) SHOULD ONLY ALLOCATE STORAGE IN IV AND V. C 14 MEANS THAT A STORAGE HAS BEEN ALLOCATED (E.G. BY A C CALL WITH IV(1) = 13) AND THAT THE ALGORITHM SHOULD BE C STARTED. WHEN CALLED WITH IV(1) = 13, DSUMSL RETURNS C IV(1) = 14 UNLESS LIV OR LV IS TOO SMALL (OR N IS NOT C POSITIVE). DEFAULT = 12. C IV(INITH).... IV(25) TELLS WHETHER THE HESSIAN APPROXIMATION H SHOULD C BE INITIALIZED. 1 (THE DEFAULT) MEANS DSUMIT SHOULD C INITIALIZE H TO THE DIAGONAL MATRIX WHOSE I-TH DIAGONAL C ELEMENT IS D(I)**2. 0 MEANS THE CALLER HAS SUPPLIED A C CHOLESKY FACTOR L OF THE INITIAL HESSIAN APPROXIMATION C H = L*(L**T) IN V, STARTING AT V(IV(LMAT)) = V(IV(42)) C (AND STORED COMPACTLY BY ROWS). NOTE THAT IV(LMAT) MAY C BE INITIALIZED BY CALLING DSUMSL WITH IV(1) = 13 (SEE C THE IV(1) DISCUSSION ABOVE). DEFAULT = 1. C IV(MXFCAL)... IV(17) GIVES THE MAXIMUM NUMBER OF FUNCTION EVALUATIONS C (CALLS ON CALCF) ALLOWED. IF THIS NUMBER DOES NOT SUF- C FICE, THEN DSUMSL RETURNS WITH IV(1) = 9. DEFAULT = 200. C IV(MXITER)... IV(18) GIVES THE MAXIMUM NUMBER OF ITERATIONS ALLOWED. C IT ALSO INDIRECTLY LIMITS THE NUMBER OF GRADIENT EVALUA- C TIONS (CALLS ON CALCG) TO IV(MXITER) + 1. IF IV(MXITER) C ITERATIONS DO NOT SUFFICE, THEN DSUMSL RETURNS WITH C IV(1) = 10. DEFAULT = 150. C IV(OUTLEV)... IV(19) CONTROLS THE NUMBER AND LENGTH OF ITERATION SUM- C MARY LINES PRINTED (BY DITSUM). IV(OUTLEV) = 0 MEANS DO C NOT PRINT ANY SUMMARY LINES. OTHERWISE, PRINT A SUMMARY C LINE AFTER EACH ABS(IV(OUTLEV)) ITERATIONS. IF IV(OUTLEV) C IS POSITIVE, THEN SUMMARY LINES OF LENGTH 78 (PLUS CARRI- C AGE CONTROL) ARE PRINTED, INCLUDING THE FOLLOWING... THE C ITERATION AND FUNCTION EVALUATION COUNTS, F = THE CURRENT C FUNCTION VALUE, RELATIVE DIFFERENCE IN FUNCTION VALUES C ACHIEVED BY THE LATEST STEP (I.E., RELDF = (F0-V(F))/F01, C WHERE F01 IS THE MAXIMUM OF ABS(V(F)) AND ABS(V(F0)) AND C V(F0) IS THE FUNCTION VALUE FROM THE PREVIOUS ITERA- C TION), THE RELATIVE FUNCTION REDUCTION PREDICTED FOR THE C STEP JUST TAKEN (I.E., PRELDF = V(PREDUC) / F01, WHERE C V(PREDUC) IS DESCRIBED BELOW), THE SCALED RELATIVE CHANGE C IN X (SEE V(RELDX) BELOW), THE STEP PARAMETER FOR THE C STEP JUST TAKEN (STPPAR = 0 MEANS A FULL NEWTON STEP, C BETWEEN 0 AND 1 MEANS A RELAXED NEWTON STEP, BETWEEN 1 C AND 2 MEANS A DOUBLE DOGLEG STEP, GREATER THAN 2 MEANS C A SCALED DOWN CAUCHY STEP -- SEE SUBROUTINE DBLDOG), THE C 2-NORM OF THE SCALE VECTOR D TIMES THE STEP JUST TAKEN C (SEE V(DSTNRM) BELOW), AND NPRELDF, I.E., C V(NREDUC)/F01, WHERE V(NREDUC) IS DESCRIBED BELOW -- IF C NPRELDF IS POSITIVE, THEN IT IS THE RELATIVE FUNCTION C REDUCTION PREDICTED FOR A NEWTON STEP (ONE WITH C STPPAR = 0). IF NPRELDF IS NEGATIVE, THEN IT IS THE C NEGATIVE OF THE RELATIVE FUNCTION REDUCTION PREDICTED C FOR A STEP COMPUTED WITH STEP BOUND V(LMAXS) FOR USE IN C TESTING FOR SINGULAR CONVERGENCE. C IF IV(OUTLEV) IS NEGATIVE, THEN LINES OF LENGTH 50 C ARE PRINTED, INCLUDING ONLY THE FIRST 6 ITEMS LISTED C ABOVE (THROUGH RELDX). C DEFAULT = 1. C IV(PARPRT)... IV(20) = 1 MEANS PRINT ANY NONDEFAULT V VALUES ON A C FRESH START OR ANY CHANGED V VALUES ON A RESTART. C IV(PARPRT) = 0 MEANS SKIP THIS PRINTING. DEFAULT = 1. C IV(PRUNIT)... IV(21) IS THE OUTPUT UNIT NUMBER ON WHICH ALL PRINTING C IS DONE. IV(PRUNIT) = 0 MEANS SUPPRESS ALL PRINTING. C DEFAULT = STANDARD OUTPUT UNIT (UNIT 6 ON MOST SYSTEMS). C IV(SOLPRT)... IV(22) = 1 MEANS PRINT OUT THE VALUE OF X RETURNED (AS C WELL AS THE GRADIENT AND THE SCALE VECTOR D). C IV(SOLPRT) = 0 MEANS SKIP THIS PRINTING. DEFAULT = 1. C IV(STATPR)... IV(23) = 1 MEANS PRINT SUMMARY STATISTICS UPON RETURN- C ING. THESE CONSIST OF THE FUNCTION VALUE, THE SCALED C RELATIVE CHANGE IN X CAUSED BY THE MOST RECENT STEP (SEE C V(RELDX) BELOW), THE NUMBER OF FUNCTION AND GRADIENT C EVALUATIONS (CALLS ON CALCF AND CALCG), AND THE RELATIVE C FUNCTION REDUCTIONS PREDICTED FOR THE LAST STEP TAKEN AND C FOR A NEWTON STEP (OR PERHAPS A STEP BOUNDED BY V(LMAX0) C -- SEE THE DESCRIPTIONS OF PRELDF AND NPRELDF UNDER C IV(OUTLEV) ABOVE). C IV(STATPR) = 0 MEANS SKIP THIS PRINTING. C IV(STATPR) = -1 MEANS SKIP THIS PRINTING AS WELL AS THAT C OF THE ONE-LINE TERMINATION REASON MESSAGE. DEFAULT = 1. C IV(X0PRT).... IV(24) = 1 MEANS PRINT THE INITIAL X AND SCALE VECTOR D C (ON A FRESH START ONLY). IV(X0PRT) = 0 MEANS SKIP THIS C PRINTING. DEFAULT = 1. C C *** (SELECTED) IV OUTPUT VALUES *** C C IV(1)........ ON OUTPUT, IV(1) IS A RETURN CODE.... C 3 = X-CONVERGENCE. THE SCALED RELATIVE DIFFERENCE (SEE C V(RELDX)) BETWEEN THE CURRENT PARAMETER VECTOR X AND C A LOCALLY OPTIMAL PARAMETER VECTOR IS VERY LIKELY AT C MOST V(XCTOL). C 4 = RELATIVE FUNCTION CONVERGENCE. THE RELATIVE DIFFER- C ENCE BETWEEN THE CURRENT FUNCTION VALUE AND ITS LO- C CALLY OPTIMAL VALUE IS VERY LIKELY AT MOST V(RFCTOL). C 5 = BOTH X- AND RELATIVE FUNCTION CONVERGENCE (I.E., THE C CONDITIONS FOR IV(1) = 3 AND IV(1) = 4 BOTH HOLD). C 6 = ABSOLUTE FUNCTION CONVERGENCE. THE CURRENT FUNCTION C VALUE IS AT MOST V(AFCTOL) IN ABSOLUTE VALUE. C 7 = SINGULAR CONVERGENCE. THE HESSIAN NEAR THE CURRENT C ITERATE APPEARS TO BE SINGULAR OR NEARLY SO, AND A C STEP OF LENGTH AT MOST V(LMAX0) IS UNLIKELY TO YIELD C A RELATIVE FUNCTION DECREASE OF MORE THAN V(SCTOL). C 8 = FALSE CONVERGENCE. THE ITERATES APPEAR TO BE CONVERG- C ING TO A NONCRITICAL POINT. THIS MAY MEAN THAT THE C CONVERGENCE TOLERANCES (V(AFCTOL), V(RFCTOL), C V(XCTOL)) ARE TOO SMALL FOR THE ACCURACY TO WHICH C THE FUNCTION AND GRADIENT ARE BEING COMPUTED, THAT C THERE IS AN ERROR IN COMPUTING THE GRADIENT, OR THAT C THE FUNCTION OR GRADIENT IS DISCONTINUOUS NEAR X. C 9 = FUNCTION EVALUATION LIMIT REACHED WITHOUT OTHER CON- C VERGENCE (SEE IV(MXFCAL)). C 10 = ITERATION LIMIT REACHED WITHOUT OTHER CONVERGENCE C (SEE IV(MXITER)). C 11 = DSTOPX RETURNED .TRUE. (EXTERNAL INTERRUPT). SEE THE C USAGE NOTES BELOW. C 14 = STORAGE HAS BEEN ALLOCATED (AFTER A CALL WITH C IV(1) = 13). C 17 = RESTART ATTEMPTED WITH N CHANGED. C 18 = D HAS A NEGATIVE COMPONENT AND IV(DTYPE) .LE. 0. C 19...43 = V(IV(1)) IS OUT OF RANGE. C 63 = F(X) CANNOT BE COMPUTED AT THE INITIAL X. C 64 = BAD PARAMETERS PASSED TO ASSESS (WHICH SHOULD NOT C OCCUR). C 65 = THE GRADIENT COULD NOT BE COMPUTED AT X (SEE CALCG C ABOVE). C 67 = BAD FIRST PARAMETER TO DDEFLT. C 80 = IV(1) WAS OUT OF RANGE. C 81 = N IS NOT POSITIVE. C IV(G)........ IV(28) IS THE STARTING SUBSCRIPT IN V OF THE CURRENT C GRADIENT VECTOR (THE ONE CORRESPONDING TO X). C IV(NFCALL)... IV(6) IS THE NUMBER OF CALLS SO FAR MADE ON CALCF (I.E., C FUNCTION EVALUATIONS). C IV(NGCALL)... IV(30) IS THE NUMBER OF GRADIENT EVALUATIONS (CALLS ON C CALCG). C IV(NITER).... IV(31) IS THE NUMBER OF ITERATIONS PERFORMED. C C *** (SELECTED) V INPUT VALUES (FROM SUBROUTINE DDEFLT) *** C C V(BIAS)..... V(43) IS THE BIAS PARAMETER USED IN SUBROUTINE DBLDOG -- C SEE THAT SUBROUTINE FOR DETAILS. DEFAULT = 0.8. C V(AFCTOL)... V(31) IS THE ABSOLUTE FUNCTION CONVERGENCE TOLERANCE. C IF DSUMSL FINDS A POINT WHERE THE FUNCTION VALUE IS LESS C THAN V(AFCTOL) IN ABSOLUTE VALUE, AND IF DSUMSL DOES NOT C RETURN WITH IV(1) = 3, 4, OR 5, THEN IT RETURNS WITH C IV(1) = 6. DEFAULT = MAX(10**-20, MACHEP**2), WHERE C MACHEP IS THE UNIT ROUNDOFF. C V(DINIT).... V(38), IF NONNEGATIVE, IS THE VALUE TO WHICH THE SCALE C VECTOR D IS INITIALIZED. DEFAULT = -1. C V(LMAX0).... V(35) GIVES THE MAXIMUM 2-NORM ALLOWED FOR D TIMES THE C VERY FIRST STEP THAT DSUMSL ATTEMPTS. THIS PARAMETER CAN C MARKEDLY AFFECT THE PERFORMANCE OF DSUMSL. C V(LMAXS).... V(36) IS USED IN TESTING FOR SINGULAR CONVERGENCE -- IF C THE FUNCTION REDUCTION PREDICTED FOR A STEP OF LENGTH C BOUNDED BY V(LMAXS) IS AT MOST V(SCTOL) * ABS(F0), WHERE C F0 IS THE FUNCTION VALUE AT THE START OF THE CURRENT C ITERATION, AND IF DSUMSL DOES NOT RETURN WITH IV(1) = 3, C 4, 5, OR 6, THEN IT RETURNS WITH IV(1) = 7. DEFAULT = 1. C V(RFCTOL)... V(32) IS THE RELATIVE FUNCTION CONVERGENCE TOLERANCE. C IF THE CURRENT MODEL PREDICTS A MAXIMUM POSSIBLE FUNCTION C REDUCTION (SEE V(NREDUC)) OF AT MOST V(RFCTOL)*ABS(F0) C AT THE START OF THE CURRENT ITERATION, WHERE F0 IS THE C THEN CURRENT FUNCTION VALUE, AND IF THE LAST STEP ATTEMPT- C ED ACHIEVED NO MORE THAN TWICE THE PREDICTED FUNCTION C DECREASE, THEN DSUMSL RETURNS WITH IV(1) = 4 (OR 5). C DEFAULT = MAX(10**-10, MACHEP**(2/3)), WHERE MACHEP IS C THE UNIT ROUNDOFF. C V(SCTOL).... V(37) IS THE SINGULAR CONVERGENCE TOLERANCE -- SEE THE C DESCRIPTION OF V(LMAXS) ABOVE. C V(TUNER1)... V(26) HELPS DECIDE WHEN TO CHECK FOR FALSE CONVERGENCE. C THIS IS DONE IF THE ACTUAL FUNCTION DECREASE FROM THE C CURRENT STEP IS NO MORE THAN V(TUNER1) TIMES ITS PREDICT- C ED VALUE. DEFAULT = 0.1. C V(XCTOL).... V(33) IS THE X-CONVERGENCE TOLERANCE. IF A NEWTON STEP C (SEE V(NREDUC)) IS TRIED THAT HAS V(RELDX) .LE. V(XCTOL) C AND IF THIS STEP YIELDS AT MOST TWICE THE PREDICTED FUNC- C TION DECREASE, THEN DSUMSL RETURNS WITH IV(1) = 3 (OR 5). C (SEE THE DESCRIPTION OF V(RELDX) BELOW.) C DEFAULT = MACHEP**0.5, WHERE MACHEP IS THE UNIT ROUNDOFF. C V(XFTOL).... V(34) IS THE FALSE CONVERGENCE TOLERANCE. IF A STEP IS C TRIED THAT GIVES NO MORE THAN V(TUNER1) TIMES THE PREDICT- C ED FUNCTION DECREASE AND THAT HAS V(RELDX) .LE. V(XFTOL), C AND IF DSUMSL DOES NOT RETURN WITH IV(1) = 3, 4, 5, 6, OR C 7, THEN IT RETURNS WITH IV(1) = 8. (SEE THE DESCRIPTION C OF V(RELDX) BELOW.) DEFAULT = 100*MACHEP, WHERE C MACHEP IS THE UNIT ROUNDOFF. C V(*)........ DDEFLT SUPPLIES TO V A NUMBER OF TUNING CONSTANTS, WITH C WHICH IT SHOULD ORDINARILY BE UNNECESSARY TO TINKER. SEE C SECTION 17 OF VERSION 2.2 OF THE NL2SOL USAGE SUMMARY C (I.E., THE APPENDIX TO REF. 1) FOR DETAILS ON V(I), C I = DECFAC, INCFAC, PHMNFC, PHMXFC, RDFCMN, RDFCMX, C TUNER2, TUNER3, TUNER4, TUNER5. C C *** (SELECTED) V OUTPUT VALUES *** C C V(DGNORM)... V(1) IS THE 2-NORM OF (DIAG(D)**-1)*G, WHERE G IS THE C MOST RECENTLY COMPUTED GRADIENT. C V(DSTNRM)... V(2) IS THE 2-NORM OF DIAG(D)*STEP, WHERE STEP IS THE C CURRENT STEP. C V(F)........ V(10) IS THE CURRENT FUNCTION VALUE. C V(F0)....... V(13) IS THE FUNCTION VALUE AT THE START OF THE CURRENT C ITERATION. C V(NREDUC)... V(6), IF POSITIVE, IS THE MAXIMUM FUNCTION REDUCTION C POSSIBLE ACCORDING TO THE CURRENT MODEL, I.E., THE FUNC- C TION REDUCTION PREDICTED FOR A NEWTON STEP (I.E., C STEP = -H**-1 * G, WHERE G IS THE CURRENT GRADIENT AND C H IS THE CURRENT HESSIAN APPROXIMATION). C IF V(NREDUC) IS NEGATIVE, THEN IT IS THE NEGATIVE OF C THE FUNCTION REDUCTION PREDICTED FOR A STEP COMPUTED WITH C A STEP BOUND OF V(LMAXS) FOR USE IN TESTING FOR SINGULAR C CONVERGENCE. C V(PREDUC)... V(7) IS THE FUNCTION REDUCTION PREDICTED (BY THE CURRENT C QUADRATIC MODEL) FOR THE CURRENT STEP. THIS (DIVIDED BY C V(F0)) IS USED IN TESTING FOR RELATIVE FUNCTION C CONVERGENCE. C V(RELDX).... V(17) IS THE SCALED RELATIVE CHANGE IN X CAUSED BY THE C CURRENT STEP, COMPUTED AS C MAX(ABS(D(I)*(X(I)-X0(I)), 1 .LE. I .LE. P) / C MAX(D(I)*(ABS(X(I))+ABS(X0(I))), 1 .LE. I .LE. P), C WHERE X = X0 + STEP. C C------------------------------- NOTES ------------------------------- C C *** ALGORITHM NOTES *** C C THIS ROUTINE USES A HESSIAN APPROXIMATION COMPUTED FROM THE C BFGS UPDATE (SEE REF 3). ONLY A CHOLESKY FACTOR OF THE HESSIAN C APPROXIMATION IS STORED, AND THIS IS UPDATED USING IDEAS FROM C REF. 4. STEPS ARE COMPUTED BY THE DOUBLE DOGLEG SCHEME DESCRIBED C IN REF. 2. THE STEPS ARE ASSESSED AS IN REF. 1. C C *** USAGE NOTES *** C C AFTER A RETURN WITH IV(1) .LE. 11, IT IS POSSIBLE TO RESTART, C I.E., TO CHANGE SOME OF THE IV AND V INPUT VALUES DESCRIBED ABOVE C AND CONTINUE THE ALGORITHM FROM THE POINT WHERE IT WAS INTERRUPT- C ED. IV(1) SHOULD NOT BE CHANGED, NOR SHOULD ANY ENTRIES OF IV C AND V OTHER THAN THE INPUT VALUES (THOSE SUPPLIED BY DDEFLT). C THOSE WHO DO NOT WISH TO WRITE A CALCG WHICH COMPUTES THE C GRADIENT ANALYTICALLY SHOULD CALL DSMSNO RATHER THAN DSUMSL. C DSMSNO USES FINITE DIFFERENCES TO COMPUTE AN APPROXIMATE GRADIENT. C THOSE WHO WOULD PREFER TO PROVIDE F AND G (THE FUNCTION AND C GRADIENT) BY REVERSE COMMUNICATION RATHER THAN BY WRITING SUBROU- C TINES CALCF AND CALCG MAY CALL ON DSUMIT DIRECTLY. SEE THE COM- C MENTS AT THE BEGINNING OF DSUMIT. C THOSE WHO USE DSUMSL INTERACTIVELY MAY WISH TO SUPPLY THEIR C OWN DSTOPX FUNCTION, WHICH SHOULD RETURN .TRUE. IF THE BREAK KEY C HAS BEEN PRESSED SINCE DSTOPX WAS LAST INVOKED. THIS MAKES IT C POSSIBLE TO EXTERNALLY INTERRUPT DSUMSL (WHICH WILL RETURN WITH C IV(1) = 11 IF DSTOPX RETURNS .TRUE.). C STORAGE FOR G IS ALLOCATED AT THE END OF V. THUS THE CALLER C MAY MAKE V LONGER THAN SPECIFIED ABOVE AND MAY ALLOW CALCG TO USE C ELEMENTS OF G BEYOND THE FIRST N AS SCRATCH STORAGE. C C *** PORTABILITY NOTES *** C C THE DSUMSL DISTRIBUTION TAPE CONTAINS BOTH SINGLE- AND DOUBLE- C PRECISION VERSIONS OF THE DSUMSL SOURCE CODE, SO IT SHOULD BE UN- C NECESSARY TO CHANGE PRECISIONS. C INTRINSIC FUNCTIONS ARE EXPLICITLY DECLARED. ON CERTAIN COM- C PUTERS (E.G. UNIVAC), IT MAY BE NECESSARY TO COMMENT OUT THESE C DECLARATIONS. SO THAT THIS MAY BE DONE AUTOMATICALLY BY A SIMPLE C PROGRAM, SUCH DECLARATIONS ARE PRECEDED BY A COMMENT HAVING C/+ C IN COLUMNS 1-3 AND BLANKS IN COLUMNS 4-72 AND ARE FOLLOWED BY C A COMMENT HAVING C/ IN COLUMNS 1 AND 2 AND BLANKS IN COLUMNS 3-72. C THE DSUMSL SOURCE CODE IS EXPRESSED IN 1966 ANSI STANDARD C FORTRAN. IT MAY BE CONVERTED TO FORTRAN 77 BY COMMENTING OUT ALL C LINES THAT FALL BETWEEN A LINE HAVING C/6 IN COLUMNS 1-3 AND A C LINE HAVING C/7 IN COLUMNS 1-3 AND BY REMOVING (I.E., REPLACING C BY A BLANK) THE C IN COLUMN 1 OF THE LINES THAT FOLLOW THE C/7 C LINE AND PRECEDE A LINE HAVING C/ IN COLUMNS 1-2 AND BLANKS IN C COLUMNS 3-72. THESE CHANGES CONVERT SOME DATA STATEMENTS INTO C PARAMETER STATEMENTS, CONVERT SOME VARIABLES FROM REAL TO C CHARACTER*4, AND MAKE THE DATA STATEMENTS THAT INITIALIZE THESE C VARIABLES USE CHARACTER STRINGS DELIMITED BY PRIMES INSTEAD C OF HOLLERITH CONSTANTS. (SUCH VARIABLES AND DATA STATEMENTS C APPEAR ONLY IN MODULES DITSUM AND DPARCK. PARAMETER STATEMENTS C APPEAR NEARLY EVERYWHERE.) C C *** REFERENCES *** C C 1. DENNIS, J.E., GAY, D.M., AND WELSCH, R.E. (1981), ALGORITHM 573 -- C AN ADAPTIVE NONLINEAR LEAST-SQUARES ALGORITHM, ACM TRANS. C MATH. SOFTWARE 7, PP. 369-383. C C 2. DENNIS, J.E., AND MEI, H.H.W. (1979), TWO NEW UNCONSTRAINED OPTI- C MIZATION ALGORITHMS WHICH USE FUNCTION AND GRADIENT C VALUES, J. OPTIM. THEORY APPLIC. 28, PP. 453-482. C C 3. DENNIS, J.E., AND MORE, J.J. (1977), QUASI-NEWTON METHODS, MOTIVA- C TION AND THEORY, SIAM REV. 19, PP. 46-89. C C 4. GOLDFARB, D. (1976), FACTORIZED VARIABLE METRIC METHODS FOR UNCON- C STRAINED OPTIMIZATION, MATH. COMPUT. 30, PP. 796-811. C C *** GENERAL *** C C CODED BY DAVID M. GAY (WINTER 1980). REVISED SUMMER 1982. C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH C SUPPORTED IN PART BY THE NATIONAL SCIENCE FOUNDATION UNDER C GRANTS MCS-7600324, DCR75-10143, 76-14311DSS, MCS76-11989, C AND MCS-7906671. C C. C---------------------------- DECLARATIONS --------------------------- C EXTERNAL DDEFLT, DSUMIT C C DDEFLT.... SUPPLIES DEFAULT IV AND V INPUT COMPONENTS. C DSUMIT... REVERSE-COMMUNICATION ROUTINE THAT CARRIES OUT DSUMSL ALGO- C RITHM. C INTEGER G1, IV1, NF DOUBLE PRECISION F C C *** SUBSCRIPTS FOR IV *** C INTEGER NEXTV, NFCALL, NFGCAL, G, TOOBIG, VNEED C C/6 C DATA NEXTV/47/, NFCALL/6/, NFGCAL/7/, G/28/, TOOBIG/2/, VNEED/4/ C/7 PARAMETER (NEXTV=47, NFCALL=6, NFGCAL=7, G=28, TOOBIG=2, VNEED=4) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C IF (IV(1) .EQ. 0) CALL DDEFLT(2, IV, LIV, LV, V) IV(VNEED) = IV(VNEED) + N IV1 = IV(1) IF (IV1 .EQ. 14) GO TO 10 IF (IV1 .GT. 2 .AND. IV1 .LT. 12) GO TO 10 G1 = 1 IF (IV1 .EQ. 12) IV(1) = 13 GO TO 20 C 10 G1 = IV(G) C 20 CALL DSUMIT(D, F, V(G1), IV, LIV, LV, N, V, X) c IF (IV(1) - 2) 30, 40, 50 IF (IV(1) .EQ. 2) GO TO 40 IF (IV(1) .GT. 2) GO TO 50 C NF = IV(NFCALL) CALL CALCF(N, X, NF, F, UIPARM, URPARM, UFPARM) IF (NF .LE. 0) IV(TOOBIG) = 1 GO TO 20 C 40 CALL CALCG(N, X, IV(NFGCAL), V(G1), UIPARM, URPARM, UFPARM) GO TO 20 C 50 IF (IV(1) .NE. 14) RETURN C C *** STORAGE ALLOCATION C IV(G) = IV(NEXTV) IV(NEXTV) = IV(G) + N IF (IV1 .NE. 13) GO TO 10 C RETURN C *** LAST CARD OF DSUMSL FOLLOWS *** END SUBROUTINE DDEFLT(ALG, IV, LIV, LV, V) save C C *** SUPPLY ***SOL (VERSION 2.3) DEFAULT VALUES TO IV AND V *** C C *** ALG = 1 MEANS REGRESSION CONSTANTS. C *** ALG = 2 MEANS GENERAL UNCONSTRAINED OPTIMIZATION CONSTANTS. C INTEGER LIV, LV INTEGER ALG, IV(LIV) DOUBLE PRECISION V(LV) C EXTERNAL DVDFLT C DVDFLT.... PROVIDES DEFAULT VALUES TO V. C INTEGER MIV, MV INTEGER MINIV(2), MINV(2) C C *** SUBSCRIPTS FOR IV *** C INTEGER ALGSAV, COVPRT, COVREQ, DTYPE, HC, IERR, INITH, INITS, 1 IPIVOT, IVNEED, LASTIV, LASTV, LMAT, MXFCAL, MXITER, 2 NFCOV, NGCOV, NVDFLT, OUTLEV, PARPRT, PARSAV, PERM, 3 PRUNIT, QRTYP, RDREQ, RMAT, SOLPRT, STATPR, VNEED, 4 VSAVE, X0PRT C C *** IV SUBSCRIPT VALUES *** C C/6 C DATA ALGSAV/51/, COVPRT/14/, COVREQ/15/, DTYPE/16/, HC/71/, C 1 IERR/75/, INITH/25/, INITS/25/, IPIVOT/76/, IVNEED/3/, C 2 LASTIV/44/, LASTV/45/, LMAT/42/, MXFCAL/17/, MXITER/18/, C 3 NFCOV/52/, NGCOV/53/, NVDFLT/50/, OUTLEV/19/, PARPRT/20/, C 4 PARSAV/49/, PERM/58/, PRUNIT/21/, QRTYP/80/, RDREQ/57/, C 5 RMAT/78/, SOLPRT/22/, STATPR/23/, VNEED/4/, VSAVE/60/, C 6 X0PRT/24/ C/7 PARAMETER (ALGSAV=51, COVPRT=14, COVREQ=15, DTYPE=16, HC=71, 1 IERR=75, INITH=25, INITS=25, IPIVOT=76, IVNEED=3, 2 LASTIV=44, LASTV=45, LMAT=42, MXFCAL=17, MXITER=18, 3 NFCOV=52, NGCOV=53, NVDFLT=50, OUTLEV=19, PARPRT=20, 4 PARSAV=49, PERM=58, PRUNIT=21, QRTYP=80, RDREQ=57, 5 RMAT=78, SOLPRT=22, STATPR=23, VNEED=4, VSAVE=60, 6 X0PRT=24) C/ DATA MINIV(1)/80/, MINIV(2)/59/, MINV(1)/98/, MINV(2)/71/ C C------------------------------- BODY -------------------------------- C IF (ALG .LT. 1 .OR. ALG .GT. 2) GO TO 40 MIV = MINIV(ALG) IF (LIV .LT. MIV) GO TO 20 MV = MINV(ALG) IF (LV .LT. MV) GO TO 30 CALL DVDFLT(ALG, LV, V) IV(1) = 12 IV(ALGSAV) = ALG IV(IVNEED) = 0 IV(LASTIV) = MIV IV(LASTV) = MV IV(LMAT) = MV + 1 IV(MXFCAL) = 200 IV(MXITER) = 150 IV(OUTLEV) = 1 IV(PARPRT) = 1 IV(PERM) = MIV + 1 c standard output unit: unused IV(PRUNIT) = 6 IV(SOLPRT) = 1 IV(STATPR) = 1 IV(VNEED) = 0 IV(X0PRT) = 1 C IF (ALG .GE. 2) GO TO 10 C C *** REGRESSION VALUES C IV(COVPRT) = 3 IV(COVREQ) = 1 IV(DTYPE) = 1 IV(HC) = 0 IV(IERR) = 0 IV(INITS) = 0 IV(IPIVOT) = 0 IV(NVDFLT) = 32 IV(PARSAV) = 67 IV(QRTYP) = 1 IV(RDREQ) = 3 IV(RMAT) = 0 IV(VSAVE) = 58 RETURN C C *** GENERAL OPTIMIZATION VALUES C 10 IV(DTYPE) = 0 IV(INITH) = 1 IV(NFCOV) = 0 IV(NGCOV) = 0 IV(NVDFLT) = 25 IV(PARSAV) = 47 RETURN C 20 IV(1) = 15 RETURN C 30 IV(1) = 16 RETURN C 40 IV(1) = 67 C RETURN C *** LAST CARD OF DDEFLT FOLLOWS *** END SUBROUTINE DSUMIT(D, FX, G, IV, LIV, LV, N, V, X) save C C *** CARRY OUT DSUMSL (UNCONSTRAINED MINIMIZATION) ITERATIONS, USING C *** DOUBLE-DOGLEG/BFGS STEPS. C C *** PARAMETER DECLARATIONS *** C INTEGER LIV, LV, N INTEGER IV(LIV) DOUBLE PRECISION D(N), FX, G(N), V(LV), X(N) C C-------------------------- PARAMETER USAGE -------------------------- C C D.... SCALE VECTOR. C FX... FUNCTION VALUE. C G.... GRADIENT VECTOR. C IV... INTEGER VALUE ARRAY. C LIV.. LENGTH OF IV (AT LEAST 60). C LV... LENGTH OF V (AT LEAST 71 + N*(N+13)/2). C N.... NUMBER OF VARIABLES (COMPONENTS IN X AND G). C V.... FLOATING-POINT VALUE ARRAY. C X.... VECTOR OF PARAMETERS TO BE OPTIMIZED. C C *** DISCUSSION *** C C PARAMETERS IV, N, V, AND X ARE THE SAME AS THE CORRESPONDING C ONES TO DSUMSL (WHICH SEE), EXCEPT THAT V CAN BE SHORTER (SINCE C THE PART OF V THAT DSUMSL USES FOR STORING G IS NOT NEEDED). C MOREOVER, COMPARED WITH DSUMSL, IV(1) MAY HAVE THE TWO ADDITIONAL C OUTPUT VALUES 1 AND 2, WHICH ARE EXPLAINED BELOW, AS IS THE USE C OF IV(TOOBIG) AND IV(NFGCAL). THE VALUE IV(G), WHICH IS AN C OUTPUT VALUE FROM DSUMSL (AND DSMSNO), IS NOT REFERENCED BY C DSUMIT OR THE SUBROUTINES IT CALLS. C FX AND G NEED NOT HAVE BEEN INITIALIZED WHEN DSUMIT IS CALLED C WITH IV(1) = 12, 13, OR 14. C C IV(1) = 1 MEANS THE CALLER SHOULD SET FX TO F(X), THE FUNCTION VALUE C AT X, AND CALL DSUMIT AGAIN, HAVING CHANGED NONE OF THE C OTHER PARAMETERS. AN EXCEPTION OCCURS IF F(X) CANNOT BE C (E.G. IF OVERFLOW WOULD OCCUR), WHICH MAY HAPPEN BECAUSE C OF AN OVERSIZED STEP. IN THIS CASE THE CALLER SHOULD SET C IV(TOOBIG) = IV(2) TO 1, WHICH WILL CAUSE DSUMIT TO IG- C NORE FX AND TRY A SMALLER STEP. THE PARAMETER NF THAT C DSUMSL PASSES TO CALCF (FOR POSSIBLE USE BY CALCG) IS A C COPY OF IV(NFCALL) = IV(6). C IV(1) = 2 MEANS THE CALLER SHOULD SET G TO G(X), THE GRADIENT VECTOR C OF F AT X, AND CALL DSUMIT AGAIN, HAVING CHANGED NONE OF C THE OTHER PARAMETERS EXCEPT POSSIBLY THE SCALE VECTOR D C WHEN IV(DTYPE) = 0. THE PARAMETER NF THAT DSUMSL PASSES C TO CALCG IS IV(NFGCAL) = IV(7). IF G(X) CANNOT BE C EVALUATED, THEN THE CALLER MAY SET IV(NFGCAL) TO 0, IN C WHICH CASE DSUMIT WILL RETURN WITH IV(1) = 65. C. C *** GENERAL *** C C CODED BY DAVID M. GAY (DECEMBER 1979). REVISED SEPT. 1982. C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH SUPPORTED C IN PART BY THE NATIONAL SCIENCE FOUNDATION UNDER GRANTS C MCS-7600324 AND MCS-7906671. C C (SEE DSUMSL FOR REFERENCES.) C C+++++++++++++++++++++++++++ DECLARATIONS ++++++++++++++++++++++++++++ C C *** LOCAL VARIABLES *** C INTEGER DG1, G01, I, K, L, LSTGST, NN1O2, NWTST1, STEP1, 1 TEMP1, W, X01, Z DOUBLE PRECISION T C C *** CONSTANTS *** C DOUBLE PRECISION NEGONE, ONE, ZERO C C *** NO INTRINSIC FUNCTIONS *** C C *** EXTERNAL FUNCTIONS AND SUBROUTINES *** C EXTERNAL DASSST, DDBDOG, DDEFLT, DITSUM, DLITVM, DLIVMU, 1 DLTVMU, DLUPDT, DLVMUL, DPARCK, DSTOPX, DVAXPY, 2 DVSCPY, DVVMUP, DWZBFG LOGICAL DSTOPX DOUBLE PRECISION DDOT, DNRM2 C C DASSST.... ASSESSES CANDIDATE STEP. C DDBDOG.... COMPUTES DOUBLE-DOGLEG (CANDIDATE) STEP. C DDEFLT.... SUPPLIES DEFAULT IV AND V INPUT COMPONENTS. C DITSUM.... PRINTS ITERATION SUMMARY AND INFO ON INITIAL AND FINAL X. C DLITVM... MULTIPLIES INVERSE TRANSPOSE OF LOWER TRIANGLE TIMES VECTOR. C DLIVMU... MULTIPLIES INVERSE OF LOWER TRIANGLE TIMES VECTOR. C DLTVMU... MULTIPLIES TRANSPOSE OF LOWER TRIANGLE TIMES VECTOR. C LUPDT.... UPDATES CHOLESKY FACTOR OF HESSIAN APPROXIMATION. C DLVMUL.... MULTIPLIES LOWER TRIANGLE TIMES VECTOR. C DPARCK.... CHECKS VALIDITY OF INPUT IV AND V VALUES. C DSTOPX.... RETURNS .TRUE. IF THE BREAK KEY HAS BEEN PRESSED. C DVAXPY.... COMPUTES SCALAR TIMES ONE VECTOR PLUS ANOTHER. C DVSCPY... SETS ALL ELEMENTS OF A VECTOR TO A SCALAR. C DVVMUP... MULTIPLIES VECTOR BY VECTOR RAISED TO POWER (COMPONENTWISE). C DWZBFG... COMPUTES W AND Z FOR DLUPDT CORRESPONDING TO BFGS UPDATE. C C *** SUBSCRIPTS FOR IV AND V *** C INTEGER CNVCOD, DG, DGNORM, DINIT, DSTNRM, DST0, F, F0, 1 GTHG, GTSTEP, G0, INCFAC, INITH, IRC, KAGQT, LMAT, 2 LMAX0, MODE, MODEL, MXFCAL, MXITER, NEXTV, NFCALL, NFGCAL, 3 NGCALL, NITER, NWTSTP, RADFAC, RADINC, RADIUS, RAD0, STEP, 4 STGLIM, STLSTG, TOOBIG, TUNER4, TUNER5, VNEED, XIRC, X0 C C *** IV SUBSCRIPT VALUES *** C C/6 C DATA CNVCOD/55/, DG/37/, G0/48/, INITH/25/, IRC/29/, KAGQT/33/, C 1 MODE/35/, MODEL/5/, MXFCAL/17/, MXITER/18/, NFCALL/6/, C 2 NFGCAL/7/, NGCALL/30/, NITER/31/, NWTSTP/34/, RADINC/8/, C 3 STEP/40/, STGLIM/11/, STLSTG/41/, TOOBIG/2/, XIRC/13/, X0/43/ C/7 PARAMETER (CNVCOD=55, DG=37, G0=48, INITH=25, IRC=29, KAGQT=33, 1 MODE=35, MODEL=5, MXFCAL=17, MXITER=18, NFCALL=6, 2 NFGCAL=7, NGCALL=30, NITER=31, NWTSTP=34, RADINC=8, 3 STEP=40, STGLIM=11, STLSTG=41, TOOBIG=2, XIRC=13, 4 X0=43) C/ C C *** V SUBSCRIPT VALUES *** C C/6 C DATA DGNORM/1/, DINIT/38/, DSTNRM/2/, DST0/3/, F/10/, F0/13/, C 1 GTHG/44/, GTSTEP/4/, INCFAC/23/, LMAT/42/, LMAX0/35/, C 2 NEXTV/47/, RADFAC/16/, RADIUS/8/, RAD0/9/, TUNER4/29/, C 3 TUNER5/30/, VNEED/4/ C/7 PARAMETER (DGNORM=1, DINIT=38, DSTNRM=2, DST0=3, F=10, F0=13, 1 GTHG=44, GTSTEP=4, INCFAC=23, LMAT=42, LMAX0=35, 2 NEXTV=47, RADFAC=16, RADIUS=8, RAD0=9, TUNER4=29, 3 TUNER5=30, VNEED=4) C/ C C/6 C DATA NEGONE/-1.D+0/, ONE/1.D+0/, ZERO/0.D+0/ C/7 PARAMETER (NEGONE=-1.D+0, ONE=1.D+0, ZERO=0.D+0) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C I = IV(1) IF (I .EQ. 1) GO TO 40 IF (I .EQ. 2) GO TO 50 C C *** CHECK VALIDITY OF IV AND V INPUT VALUES *** C IF (IV(1) .EQ. 0) CALL DDEFLT(2, IV, LIV, LV, V) IV(VNEED) = IV(VNEED) + N*(N+13)/2 CALL DPARCK(2, D, IV, LIV, LV, N, V) I = IV(1) - 2 IF (I .GT. 12) RETURN c GO TO (160, 160, 160, 160, 160, 160, 110, 80, 110, 10, 10, 20), I IF (I .LT. 7) GO TO 160 IF (I .EQ. 7) GO TO 110 IF (I .EQ. 8) GO TO 80 IF (I .EQ. 9) GO TO 110 IF (I .EQ. 9) GO TO 110 IF (I .EQ. 9) GO TO 110 C 10 and 11 drop through IF (I .EQ. 12) GO TO 20 C C *** STORAGE ALLOCATION *** C NN1O2 = N * (N + 1) / 2 L = IV(LMAT) IV(X0) = L + NN1O2 IV(STEP) = IV(X0) + N IV(STLSTG) = IV(STEP) + N IV(G0) = IV(STLSTG) + N IV(NWTSTP) = IV(G0) + N IV(DG) = IV(NWTSTP) + N IV(NEXTV) = IV(DG) + N IF (IV(1) .NE. 13) GO TO 20 IV(1) = 14 RETURN C C *** INITIALIZATION *** C 20 IV(NITER) = 0 IV(NFCALL) = 1 IV(NGCALL) = 1 IV(NFGCAL) = 1 IV(MODE) = -1 IV(MODEL) = 1 IV(STGLIM) = 1 IV(TOOBIG) = 0 IV(CNVCOD) = 0 IV(RADINC) = 0 V(RAD0) = ZERO IF (V(DINIT) .GE. ZERO) CALL DVSCPY(N, D, V(DINIT)) IV(1) = 1 IF (IV(INITH) .NE. 1) RETURN C C *** SET THE INITIAL HESSIAN APPROXIMATION TO DIAG(D)**-2 *** C CALL DVSCPY(NN1O2, V(L), ZERO) K = L - 1 DO I = 1, N K = K + I T = D(I) IF (T .LE. ZERO) T = ONE V(K) = T END DO RETURN C 40 V(F) = FX IF (IV(MODE) .GE. 0) GO TO 160 IV(1) = 2 IF (IV(TOOBIG) .EQ. 0) RETURN IV(1) = 63 GO TO 270 C C *** MAKE SURE GRADIENT COULD BE COMPUTED *** C 50 IF (IV(NFGCAL) .NE. 0) GO TO 60 IV(1) = 65 GO TO 270 C 60 DG1 = IV(DG) CALL DVVMUP(N, V(DG1), G, D, -1) V(DGNORM) = DNRM2(N, V(DG1),1) C IF (IV(CNVCOD) .NE. 0) GO TO 260 IF (IV(MODE) .EQ. 0) GO TO 220 C C *** ALLOW FIRST STEP TO HAVE SCALED 2-NORM AT MOST V(LMAX0) *** C V(RADFAC) = V(LMAX0) V(DSTNRM) = ONE C IV(MODE) = 0 C C C----------------------------- MAIN LOOP ----------------------------- C C C *** PRINT ITERATION SUMMARY, CHECK ITERATION LIMIT *** C 70 CALL DITSUM(D, G, IV, LIV, LV, N, V, X) 80 K = IV(NITER) IF (K .LT. IV(MXITER)) GO TO 90 IV(1) = 10 GO TO 270 C C *** UPDATE RADIUS *** C 90 IV(NITER) = K + 1 V(RADIUS) = V(RADFAC) * V(DSTNRM) C C *** INITIALIZE FOR START OF NEXT ITERATION *** C G01 = IV(G0) X01 = IV(X0) V(F0) = V(F) IV(IRC) = 4 IV(KAGQT) = -1 C C *** COPY X TO X0, G TO G0 *** C CALL DCOPY(N, X,1,V(X01),1) CALL DCOPY(N, G,1,V(G01),1) C C *** CHECK DSTOPX AND FUNCTION EVALUATION LIMIT *** C 100 IF (.NOT. DSTOPX()) GO TO 120 IV(1) = 11 GO TO 130 C C *** COME HERE WHEN RESTARTING AFTER FUNC. EVAL. LIMIT OR DSTOPX. C 110 IF (V(F) .GE. V(F0)) GO TO 120 V(RADFAC) = ONE K = IV(NITER) GO TO 90 C 120 IF (IV(NFCALL) .LT. IV(MXFCAL)) GO TO 140 IV(1) = 9 130 IF (V(F) .GE. V(F0)) GO TO 270 C C *** IN CASE OF DSTOPX OR FUNCTION EVALUATION LIMIT WITH C *** IMPROVED V(F), EVALUATE THE GRADIENT AT X. C IV(CNVCOD) = IV(1) GO TO 210 C C. . . . . . . . . . . . . COMPUTE CANDIDATE STEP . . . . . . . . . . C 140 STEP1 = IV(STEP) DG1 = IV(DG) NWTST1 = IV(NWTSTP) IF (IV(KAGQT) .GE. 0) GO TO 150 L = IV(LMAT) CALL DLIVMU(N, V(NWTST1), V(L), G) CALL DLITVM(N, V(NWTST1), V(L), V(NWTST1)) CALL DVVMUP(N, V(STEP1), V(NWTST1), D, 1) V(DST0) = DNRM2(N, V(STEP1),1) CALL DVVMUP(N, V(DG1), V(DG1), D, -1) CALL DLTVMU(N, V(STEP1), V(L), V(DG1)) V(GTHG) = DNRM2(N, V(STEP1),1) IV(KAGQT) = 0 150 CALL DDBDOG(V(DG1), G, LV, N, V(NWTST1), V(STEP1), V) IF (IV(IRC) .EQ. 6) GO TO 160 C C *** COMPUTE F(X0 + STEP) *** C X01 = IV(X0) STEP1 = IV(STEP) CALL DVAXPY(N, X, ONE, V(STEP1), V(X01)) IV(NFCALL) = IV(NFCALL) + 1 IV(1) = 1 IV(TOOBIG) = 0 RETURN C C. . . . . . . . . . . . . ASSESS CANDIDATE STEP . . . . . . . . . . . C 160 STEP1 = IV(STEP) LSTGST = IV(STLSTG) X01 = IV(X0) CALL DASSST(D, IV, N, V(STEP1), V(LSTGST), V, X, V(X01)) C K = IV(IRC) c GO TO (170,200,200,200,170,180,190,190,190,190,190,190,250,220), K IF (K .EQ. 1) GO TO 170 IF (K .EQ. 2) GO TO 200 IF (K .EQ. 3) GO TO 200 IF (K .EQ. 4) GO TO 200 IF (K .EQ. 5) GO TO 170 IF (K .EQ. 6) GO TO 180 IF (K .EQ. 7) GO TO 190 IF (K .EQ. 8) GO TO 190 IF (K .EQ. 9) GO TO 190 IF (K .EQ. 10) GO TO 190 IF (K .EQ. 11) GO TO 190 IF (K .EQ. 12) GO TO 190 IF (K .EQ. 13) GO TO 250 IF (K .EQ. 14) GO TO 220 C C *** RECOMPUTE STEP WITH CHANGED RADIUS *** C 170 V(RADIUS) = V(RADFAC) * V(DSTNRM) GO TO 100 C C *** COMPUTE STEP OF LENGTH V(LMAX0) FOR SINGULAR CONVERGENCE TEST. C 180 V(RADIUS) = V(LMAX0) GO TO 140 C C *** CONVERGENCE OR FALSE CONVERGENCE *** C 190 IV(CNVCOD) = K - 4 IF (V(F) .GE. V(F0)) GO TO 260 IF (IV(XIRC) .EQ. 14) GO TO 260 IV(XIRC) = 14 C C. . . . . . . . . . . . PROCESS ACCEPTABLE STEP . . . . . . . . . . . C 200 IF (IV(IRC) .NE. 3) GO TO 210 STEP1 = IV(STEP) TEMP1 = IV(STLSTG) C C *** SET TEMP1 = HESSIAN * STEP FOR USE IN GRADIENT TESTS *** C L = IV(LMAT) CALL DLTVMU(N, V(TEMP1), V(L), V(STEP1)) CALL DLVMUL(N, V(TEMP1), V(L), V(TEMP1)) C C *** COMPUTE GRADIENT *** C 210 IV(NGCALL) = IV(NGCALL) + 1 IV(1) = 2 RETURN C C *** INITIALIZATIONS -- G0 = G - G0, ETC. *** C 220 G01 = IV(G0) CALL DVAXPY(N, V(G01), NEGONE, V(G01), G) STEP1 = IV(STEP) TEMP1 = IV(STLSTG) IF (IV(IRC) .NE. 3) GO TO 240 C C *** SET V(RADFAC) BY GRADIENT TESTS *** C C *** SET TEMP1 = DIAG(D)**-1 * (HESSIAN*STEP + (G(X0)-G(X))) *** C CALL DVAXPY(N, V(TEMP1), NEGONE, V(G01), V(TEMP1)) CALL DVVMUP(N, V(TEMP1), V(TEMP1), D, -1) C C *** DO GRADIENT TESTS *** C IF (DNRM2(N, V(TEMP1),1) .LE. V(DGNORM) * V(TUNER4)) 1 GO TO 230 IF (DDOT(N, G,1,V(STEP1),1) 1 .GE. V(GTSTEP) * V(TUNER5)) GO TO 240 230 V(RADFAC) = V(INCFAC) C C *** UPDATE H, LOOP *** C 240 W = IV(NWTSTP) Z = IV(X0) L = IV(LMAT) CALL DWZBFG(V(L), N, V(STEP1), V(W), V(G01), V(Z)) C C ** USE THE N-VECTORS STARTING AT V(STEP1) AND V(G01) FOR SCRATCH.. CALL DLUPDT(V(TEMP1), V(STEP1), V(L), V(G01), V(L), N, V(W), V(Z)) IV(1) = 2 GO TO 70 C C. . . . . . . . . . . . . . MISC. DETAILS . . . . . . . . . . . . . . C C *** BAD PARAMETERS TO ASSESS *** C 250 IV(1) = 64 C C *** PRINT SUMMARY OF FINAL ITERATION AND OTHER REQUESTED ITEMS *** C 260 IV(1) = IV(CNVCOD) IV(CNVCOD) = 0 270 CALL DITSUM(D, G, IV, LIV, LV, N, V, X) C RETURN C C *** LAST CARD OF DSUMIT FOLLOWS *** END SUBROUTINE DVAXPY(P, W, A, X, Y) save C C *** SET W = A*X + Y -- W, X, Y = P-VECTORS, A = SCALAR *** C INTEGER P DOUBLE PRECISION A, W(P), X(P), Y(P) C INTEGER I C DO I = 1, P W(I) = A*X(I) + Y(I) END DO RETURN END SUBROUTINE DVDFLT(ALG, LV, V) save C C *** SUPPLY ***SOL (VERSION 2.3) DEFAULT VALUES TO V *** C C *** ALG = 1 MEANS REGRESSION CONSTANTS. C *** ALG = 2 MEANS GENERAL UNCONSTRAINED OPTIMIZATION CONSTANTS. C INTEGER ALG, LV DOUBLE PRECISION V(LV) C/+ DOUBLE PRECISION DMAX1 C/ DOUBLE PRECISION D1MACH C DOUBLE PRECISION MACHEP, MEPCRT, ONE, SQTEPS, THREE C C *** SUBSCRIPTS FOR V *** C INTEGER AFCTOL, BIAS, COSMIN, DECFAC, DELTA0, DFAC, DINIT, DLTFDC, 1 DLTFDJ, DTINIT, D0INIT, EPSLON, ETA0, FUZZ, HUBERC, 2 INCFAC, LMAX0, LMAXS, PHMNFC, PHMXFC, RDFCMN, RDFCMX, 3 RFCTOL, RLIMIT, RSPTOL, SCTOL, SIGMIN, TUNER1, TUNER2, 4 TUNER3, TUNER4, TUNER5, XCTOL, XFTOL C C/6 C DATA ONE/1.D+0/, THREE/3.D+0/ C/7 PARAMETER (ONE=1.D+0, THREE=3.D+0) C/ C C *** V SUBSCRIPT VALUES *** C C/6 C DATA AFCTOL/31/, BIAS/43/, COSMIN/47/, DECFAC/22/, DELTA0/44/, C 1 DFAC/41/, DINIT/38/, DLTFDC/42/, DLTFDJ/43/, DTINIT/39/, C 2 D0INIT/40/, EPSLON/19/, ETA0/42/, FUZZ/45/, HUBERC/48/, C 3 INCFAC/23/, LMAX0/35/, LMAXS/36/, PHMNFC/20/, PHMXFC/21/, C 4 RDFCMN/24/, RDFCMX/25/, RFCTOL/32/, RLIMIT/46/, RSPTOL/49/, C 5 SCTOL/37/, SIGMIN/50/, TUNER1/26/, TUNER2/27/, TUNER3/28/, C 6 TUNER4/29/, TUNER5/30/, XCTOL/33/, XFTOL/34/ C/7 PARAMETER (AFCTOL=31, BIAS=43, COSMIN=47, DECFAC=22, DELTA0=44, 1 DFAC=41, DINIT=38, DLTFDC=42, DLTFDJ=43, DTINIT=39, 2 D0INIT=40, EPSLON=19, ETA0=42, FUZZ=45, HUBERC=48, 3 INCFAC=23, LMAX0=35, LMAXS=36, PHMNFC=20, PHMXFC=21, 4 RDFCMN=24, RDFCMX=25, RFCTOL=32, RLIMIT=46, RSPTOL=49, 5 SCTOL=37, SIGMIN=50, TUNER1=26, TUNER2=27, TUNER3=28, 6 TUNER4=29, TUNER5=30, XCTOL=33, XFTOL=34) C/ C C------------------------------- BODY -------------------------------- C MACHEP = D1MACH(4) V(AFCTOL) = 1.D-20 IF (MACHEP .GT. 1.D-10) V(AFCTOL) = MACHEP**2 V(DECFAC) = 0.5D+0 SQTEPS = DSQRT(D1MACH(4)) V(DFAC) = 0.6D+0 V(DELTA0) = SQTEPS V(DTINIT) = 1.D-6 MEPCRT = MACHEP ** (ONE/THREE) V(D0INIT) = 1.D+0 V(EPSLON) = 0.1D+0 V(INCFAC) = 2.D+0 V(LMAX0) = 1.D+0 V(LMAXS) = 1.D+0 V(PHMNFC) = -0.1D+0 V(PHMXFC) = 0.1D+0 V(RDFCMN) = 0.1D+0 V(RDFCMX) = 4.D+0 V(RFCTOL) = DMAX1(1.D-10, MEPCRT**2) V(SCTOL) = V(RFCTOL) V(TUNER1) = 0.1D+0 V(TUNER2) = 1.D-4 V(TUNER3) = 0.75D+0 V(TUNER4) = 0.5D+0 V(TUNER5) = 0.75D+0 V(XCTOL) = SQTEPS V(XFTOL) = 1.D+2 * MACHEP C IF (ALG .GE. 2) GO TO 10 C C *** REGRESSION VALUES C V(COSMIN) = DMAX1(1.D-6, 1.D+2 * MACHEP) V(DINIT) = 0.D+0 V(DLTFDC) = MEPCRT V(DLTFDJ) = SQTEPS V(FUZZ) = 1.5D+0 V(HUBERC) = 0.7D+0 V(RLIMIT) = DSQRT(D1MACH(2))*16. V(RSPTOL) = 1.D-2 V(SIGMIN) = 1.D-4 RETURN C C *** GENERAL OPTIMIZATION VALUES C 10 V(BIAS) = 0.8D+0 V(DINIT) = -1.0D+0 V(ETA0) = 1.0D+3 * MACHEP C RETURN C *** LAST CARD OF DVDFLT FOLLOWS *** END SUBROUTINE DVSCPY(P, Y, S) save C C *** SET P-VECTOR Y TO SCALAR S *** C INTEGER P DOUBLE PRECISION S, Y(P) C INTEGER I C DO I = 1, P Y(I) = S END DO RETURN END SUBROUTINE DVVMUP(N, X, Y, Z, K) save C C *** SET X(I) = Y(I) * Z(I)**K, 1 .LE. I .LE. N (FOR K = 1 OR -1) *** C INTEGER N, K DOUBLE PRECISION X(N), Y(N), Z(N) INTEGER I C IF (K .GE. 0) GO TO 20 DO I = 1, N X(I) = Y(I) / Z(I) END DO RETURN C 20 DO I = 1, N X(I) = Y(I) * Z(I) END DO RETURN C *** LAST CARD OF DVVMUP FOLLOWS *** END SUBROUTINE DWZBFG (L, N, S, W, Y, Z) save C C *** COMPUTE Y AND Z FOR DLUPDT CORRESPONDING TO BFGS UPDATE. C INTEGER N DOUBLE PRECISION L, S(N), W(N), Y(N), Z(N) DIMENSION L(N*(N+1)/2) C C-------------------------- PARAMETER USAGE -------------------------- C C L (I/O) CHOLESKY FACTOR OF HESSIAN, A LOWER TRIANG. MATRIX STORED C COMPACTLY BY ROWS. C N (INPUT) ORDER OF L AND LENGTH OF S, W, Y, Z. C S (INPUT) THE STEP JUST TAKEN. C W (OUTPUT) RIGHT SINGULAR VECTOR OF RANK 1 CORRECTION TO L. C Y (INPUT) CHANGE IN GRADIENTS CORRESPONDING TO S. C Z (OUTPUT) LEFT SINGULAR VECTOR OF RANK 1 CORRECTION TO L. C C------------------------------- NOTES ------------------------------- C C *** ALGORITHM NOTES *** C C WHEN S IS COMPUTED IN CERTAIN WAYS, E.G. BY GQTSTP OR C DBLDOG, IT IS POSSIBLE TO SAVE N**2/2 OPERATIONS SINCE (L**T)*S C OR L*(L**T)*S IS THEN KNOWN. C IF THE BFGS UPDATE TO L*(L**T) WOULD REDUCE ITS DETERMINANT TO C LESS THAN EPS TIMES ITS OLD VALUE, THEN THIS ROUTINE IN EFFECT C REPLACES Y BY THETA*Y + (1 - THETA)*L*(L**T)*S, WHERE THETA C (BETWEEN 0 AND 1) IS CHOSEN TO MAKE THE REDUCTION FACTOR = EPS. C C *** GENERAL *** C C CODED BY DAVID M. GAY (FALL 1979). C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH SUPPORTED C BY THE NATIONAL SCIENCE FOUNDATION UNDER GRANTS MCS-7600324 AND C MCS-7906671. C C------------------------ EXTERNAL QUANTITIES ------------------------ C C *** FUNCTIONS AND SUBROUTINES CALLED *** C EXTERNAL DLIVMU, DLTVMU DOUBLE PRECISION DDOT C DLIVMU MULTIPLIES L**-1 TIMES A VECTOR. C DLTVMU MULTIPLIES L**T TIMES A VECTOR. C C *** INTRINSIC FUNCTIONS *** C/+ DOUBLE PRECISION DSQRT C/ C-------------------------- LOCAL VARIABLES -------------------------- C INTEGER I DOUBLE PRECISION CS, CY, EPS, EPSRT, ONE, SHS, YS, THETA C C *** DATA INITIALIZATIONS *** C C/6 C DATA EPS/0.1D+0/, ONE/1.D+0/ C/7 PARAMETER (EPS=0.1D+0, ONE=1.D+0) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C CALL DLTVMU(N, W, L, S) SHS = DDOT(N, W,1,W,1) YS = DDOT(N, Y,1,S,1) IF (YS .GE. EPS*SHS) GO TO 10 THETA = (ONE - EPS) * SHS / (SHS - YS) EPSRT = DSQRT(EPS) CY = THETA / (SHS * EPSRT) CS = (ONE + (THETA-ONE)/EPSRT) / SHS GO TO 20 10 CY = ONE / (DSQRT(YS) * DSQRT(SHS)) CS = ONE / SHS 20 CALL DLIVMU(N, Z, L, Y) DO I = 1, N Z(I) = CY * Z(I) - CS * W(I) END DO C RETURN C *** LAST CARD OF DWZBFG FOLLOWS *** END SUBROUTINE DASSST(D, IV, P, STEP, STLSTG, V, X, X0) save C C *** ASSESS CANDIDATE STEP (***SOL VERSION 2.3) *** C INTEGER P, IV(32) DOUBLE PRECISION D(P), STEP(P), STLSTG(P), V(37), X(P), X0(P) C C *** PURPOSE *** C C THIS SUBROUTINE IS CALLED BY AN UNCONSTRAINED MINIMIZATION C ROUTINE TO ASSESS THE NEXT CANDIDATE STEP. IT MAY RECOMMEND ONE C OF SEVERAL COURSES OF ACTION, SUCH AS ACCEPTING THE STEP, RECOM- C PUTING IT USING THE SAME OR A NEW QUADRATIC MODEL, OR HALTING DUE C TO CONVERGENCE OR FALSE CONVERGENCE. SEE THE RETURN CODE LISTING C BELOW. C C-------------------------- PARAMETER USAGE -------------------------- C C IV (I/O) INTEGER PARAMETER AND SCRATCH VECTOR -- SEE DESCRIPTION C BELOW OF IV VALUES REFERENCED. C D (IN) SCALE VECTOR USED IN COMPUTING V(RELDX) -- SEE BELOW. C P (IN) NUMBER OF PARAMETERS BEING OPTIMIZED. C STEP (I/O) ON INPUT, STEP IS THE STEP TO BE ASSESSED. IT IS UN- C CHANGED ON OUTPUT UNLESS A PREVIOUS STEP ACHIEVED A C BETTER OBJECTIVE FUNCTION REDUCTION, IN WHICH CASE STLSTG C WILL HAVE BEEN COPIED TO STEP. C STLSTG (I/O) WHEN ASSESS RECOMMENDS RECOMPUTING STEP EVEN THOUGH THE C CURRENT (OR A PREVIOUS) STEP YIELDS AN OBJECTIVE FUNC- C TION DECREASE, IT SAVES IN STLSTG THE STEP THAT GAVE THE C BEST FUNCTION REDUCTION SEEN SO FAR (IN THE CURRENT ITERA- C TION). IF THE RECOMPUTED STEP YIELDS A LARGER FUNCTION C VALUE, THEN STEP IS RESTORED FROM STLSTG AND C X = X0 + STEP IS RECOMPUTED. C V (I/O) REAL PARAMETER AND SCRATCH VECTOR -- SEE DESCRIPTION C BELOW OF V VALUES REFERENCED. C X (I/O) ON INPUT, X = X0 + STEP IS THE POINT AT WHICH THE OBJEC- C TIVE FUNCTION HAS JUST BEEN EVALUATED. IF AN EARLIER C STEP YIELDED A BIGGER FUNCTION DECREASE, THEN X IS C RESTORED TO THE CORRESPONDING EARLIER VALUE. OTHERWISE, C IF THE CURRENT STEP DOES NOT GIVE ANY FUNCTION DECREASE, C THEN X IS RESTORED TO X0. C X0 (IN) INITIAL OBJECTIVE FUNCTION PARAMETER VECTOR (AT THE C START OF THE CURRENT ITERATION). C C *** IV VALUES REFERENCED *** C C IV(IRC) (I/O) ON INPUT FOR THE FIRST STEP TRIED IN A NEW ITERATION, C IV(IRC) SHOULD BE SET TO 3 OR 4 (THE VALUE TO WHICH IT IS C SET WHEN STEP IS DEFINITELY TO BE ACCEPTED). ON INPUT C AFTER STEP HAS BEEN RECOMPUTED, IV(IRC) SHOULD BE C UNCHANGED SINCE THE PREVIOUS RETURN OF ASSESS. C ON OUTPUT, IV(IRC) IS A RETURN CODE HAVING ONE OF THE C FOLLOWING VALUES... C 1 = SWITCH MODELS OR TRY SMALLER STEP. C 2 = SWITCH MODELS OR ACCEPT STEP. C 3 = ACCEPT STEP AND DETERMINE V(RADFAC) BY GRADIENT C TESTS. C 4 = ACCEPT STEP, V(RADFAC) HAS BEEN DETERMINED. C 5 = RECOMPUTE STEP (USING THE SAME MODEL). C 6 = RECOMPUTE STEP WITH RADIUS = V(LMAXS) BUT DO NOT C EVAULATE THE OBJECTIVE FUNCTION. C 7 = X-CONVERGENCE (SEE V(XCTOL)). C 8 = RELATIVE FUNCTION CONVERGENCE (SEE V(RFCTOL)). C 9 = BOTH X- AND RELATIVE FUNCTION CONVERGENCE. C 10 = ABSOLUTE FUNCTION CONVERGENCE (SEE V(AFCTOL)). C 11 = SINGULAR CONVERGENCE (SEE V(LMAXS)). C 12 = FALSE CONVERGENCE (SEE V(XFTOL)). C 13 = IV(IRC) WAS OUT OF RANGE ON INPUT. C RETURN CODE I HAS PRECDENCE OVER I+1 FOR I = 9, 10, 11. C IV(MLSTGD) (I/O) SAVED VALUE OF IV(MODEL). C IV(MODEL) (I/O) ON INPUT, IV(MODEL) SHOULD BE AN INTEGER IDENTIFYING C THE CURRENT QUADRATIC MODEL OF THE OBJECTIVE FUNCTION. C IF A PREVIOUS STEP YIELDED A BETTER FUNCTION REDUCTION, C THEN IV(MODEL) WILL BE SET TO IV(MLSTGD) ON OUTPUT. C IV(NFCALL) (IN) INVOCATION COUNT FOR THE OBJECTIVE FUNCTION. C IV(NFGCAL) (I/O) VALUE OF IV(NFCALL) AT STEP THAT GAVE THE BIGGEST C FUNCTION REDUCTION THIS ITERATION. IV(NFGCAL) REMAINS C UNCHANGED UNTIL A FUNCTION REDUCTION IS OBTAINED. C IV(RADINC) (I/O) THE NUMBER OF RADIUS INCREASES (OR MINUS THE NUMBER C OF DECREASES) SO FAR THIS ITERATION. C IV(RESTOR) (OUT) SET TO 0 UNLESS X AND V(F) HAVE BEEN RESTORED, IN C WHICH CASE ASSESS SETS IV(RESTOR) = 1. C IV(STAGE) (I/O) COUNT OF THE NUMBER OF MODELS TRIED SO FAR IN THE C CURRENT ITERATION. C IV(STGLIM) (IN) MAXIMUM NUMBER OF MODELS TO CONSIDER. C IV(SWITCH) (OUT) SET TO 0 UNLESS A NEW MODEL IS BEING TRIED AND IT C GIVES A SMALLER FUNCTION VALUE THAN THE PREVIOUS MODEL, C IN WHICH CASE ASSESS SETS IV(SWITCH) = 1. C IV(TOOBIG) (IN) IS NONZERO IF STEP WAS TOO BIG (E.G. IF IT CAUSED C OVERFLOW). C IV(XIRC) (I/O) VALUE THAT IV(IRC) WOULD HAVE IN THE ABSENCE OF C CONVERGENCE, FALSE CONVERGENCE, AND OVERSIZED STEPS. C C *** V VALUES REFERENCED *** C C V(AFCTOL) (IN) ABSOLUTE FUNCTION CONVERGENCE TOLERANCE. IF THE C ABSOLUTE VALUE OF THE CURRENT FUNCTION VALUE V(F) IS LESS C THAN V(AFCTOL), THEN ASSESS RETURNS WITH IV(IRC) = 10. C V(DECFAC) (IN) FACTOR BY WHICH TO DECREASE RADIUS WHEN IV(TOOBIG) IS C NONZERO. C V(DSTNRM) (IN) THE 2-NORM OF D*STEP. C V(DSTSAV) (I/O) VALUE OF V(DSTNRM) ON SAVED STEP. C V(DST0) (IN) THE 2-NORM OF D TIMES THE NEWTON STEP (WHEN DEFINED, C I.E., FOR V(NREDUC) .GE. 0). C V(F) (I/O) ON BOTH INPUT AND OUTPUT, V(F) IS THE OBJECTIVE FUNC- C TION VALUE AT X. IF X IS RESTORED TO A PREVIOUS VALUE, C THEN V(F) IS RESTORED TO THE CORRESPONDING VALUE. C V(FDIF) (OUT) THE FUNCTION REDUCTION V(F0) - V(F) (FOR THE OUTPUT C VALUE OF V(F) IF AN EARLIER STEP GAVE A BIGGER FUNCTION C DECREASE, AND FOR THE INPUT VALUE OF V(F) OTHERWISE). C V(FLSTGD) (I/O) SAVED VALUE OF V(F). C V(F0) (IN) OBJECTIVE FUNCTION VALUE AT START OF ITERATION. C V(GTSLST) (I/O) VALUE OF V(GTSTEP) ON SAVED STEP. C V(GTSTEP) (IN) INNER PRODUCT BETWEEN STEP AND GRADIENT. C V(INCFAC) (IN) MINIMUM FACTOR BY WHICH TO INCREASE RADIUS. C V(LMAXS) (IN) MAXIMUM REASONABLE STEP SIZE (AND INITIAL STEP BOUND). C IF THE ACTUAL FUNCTION DECREASE IS NO MORE THAN TWICE C WHAT WAS PREDICTED, IF A RETURN WITH IV(IRC) = 7, 8, 9, C OR 10 DOES NOT OCCUR, IF V(DSTNRM) .GT. V(LMAXS), AND IF C V(PREDUC) .LE. V(SCTOL) * ABS(V(F0)), THEN ASSESS RE- C TURNS WITH IV(IRC) = 11. IF SO DOING APPEARS WORTHWHILE, C THEN ASSESS REPEATS THIS TEST WITH V(PREDUC) COMPUTED FOR C A STEP OF LENGTH V(LMAXS) (BY A RETURN WITH IV(IRC) = 6). C V(NREDUC) (I/O) FUNCTION REDUCTION PREDICTED BY QUADRATIC MODEL FOR C NEWTON STEP. IF ASSESS IS CALLED WITH IV(IRC) = 6, I.E., C IF V(PREDUC) HAS BEEN COMPUTED WITH RADIUS = V(LMAXS) FOR C USE IN THE SINGULAR CONVERVENCE TEST, THEN V(NREDUC) IS C SET TO -V(PREDUC) BEFORE THE LATTER IS RESTORED. C V(PLSTGD) (I/O) VALUE OF V(PREDUC) ON SAVED STEP. C V(PREDUC) (I/O) FUNCTION REDUCTION PREDICTED BY QUADRATIC MODEL FOR C CURRENT STEP. C V(RADFAC) (OUT) FACTOR TO BE USED IN DETERMINING THE NEW RADIUS, C WHICH SHOULD BE V(RADFAC)*DST, WHERE DST IS EITHER THE C OUTPUT VALUE OF V(DSTNRM) OR THE 2-NORM OF C DIAG(NEWD)*STEP FOR THE OUTPUT VALUE OF STEP AND THE C UPDATED VERSION, NEWD, OF THE SCALE VECTOR D. FOR C IV(IRC) = 3, V(RADFAC) = 1.0 IS RETURNED. C V(RDFCMN) (IN) MINIMUM VALUE FOR V(RADFAC) IN TERMS OF THE INPUT C VALUE OF V(DSTNRM) -- SUGGESTED VALUE = 0.1. C V(RDFCMX) (IN) MAXIMUM VALUE FOR V(RADFAC) -- SUGGESTED VALUE = 4.0. C V(RELDX) (OUT) SCALED RELATIVE CHANGE IN X CAUSED BY STEP, COMPUTED C BY FUNCTION DRELST AS C MAX (D(I)*ABS(X(I)-X0(I)), 1 .LE. I .LE. P) / C MAX (D(I)*(ABS(X(I))+ABS(X0(I))), 1 .LE. I .LE. P). C IF AN ACCEPTABLE STEP IS RETURNED, THEN V(RELDX) IS COM- C PUTED USING THE OUTPUT (POSSIBLY RESTORED) VALUES OF X C AND STEP. OTHERWISE IT IS COMPUTED USING THE INPUT C VALUES. C V(RFCTOL) (IN) RELATIVE FUNCTION CONVERGENCE TOLERANCE. IF THE C ACTUAL FUNCTION REDUCTION IS AT MOST TWICE WHAT WAS PRE- C DICTED AND V(NREDUC) .LE. V(RFCTOL)*ABS(V(F0)), THEN C ASSESS RETURNS WITH IV(IRC) = 8 OR 9. C V(STPPAR) (IN) MARQUARDT PARAMETER -- 0 MEANS FULL NEWTON STEP. C V(TUNER1) (IN) TUNING CONSTANT USED TO DECIDE IF THE FUNCTION C REDUCTION WAS MUCH LESS THAN EXPECTED. SUGGESTED C VALUE = 0.1. C V(TUNER2) (IN) TUNING CONSTANT USED TO DECIDE IF THE FUNCTION C REDUCTION WAS LARGE ENOUGH TO ACCEPT STEP. SUGGESTED C VALUE = 10**-4. C V(TUNER3) (IN) TUNING CONSTANT USED TO DECIDE IF THE RADIUS C SHOULD BE INCREASED. SUGGESTED VALUE = 0.75. C V(XCTOL) (IN) X-CONVERGENCE CRITERION. IF STEP IS A NEWTON STEP C (V(STPPAR) = 0) HAVING V(RELDX) .LE. V(XCTOL) AND GIVING C AT MOST TWICE THE PREDICTED FUNCTION DECREASE, THEN C ASSESS RETURNS IV(IRC) = 7 OR 9. C V(XFTOL) (IN) FALSE CONVERGENCE TOLERANCE. IF STEP GAVE NO OR ONLY C A SMALL FUNCTION DECREASE AND V(RELDX) .LE. V(XFTOL), C THEN ASSESS RETURNS WITH IV(IRC) = 12. C C------------------------------- NOTES ------------------------------- C C *** APPLICATION AND USAGE RESTRICTIONS *** C C THIS ROUTINE IS CALLED AS PART OF THE NL2SOL (NONLINEAR C LEAST-SQUARES) PACKAGE. IT MAY BE USED IN ANY UNCONSTRAINED C MINIMIZATION SOLVER THAT USES DOGLEG, GOLDFELD-QUANDT-TROTTER, C OR LEVENBERG-MARQUARDT STEPS. C C *** ALGORITHM NOTES *** C C SEE (1) FOR FURTHER DISCUSSION OF THE ASSESSING AND MODEL C SWITCHING STRATEGIES. WHILE NL2SOL CONSIDERS ONLY TWO MODELS, C ASSESS IS DESIGNED TO HANDLE ANY NUMBER OF MODELS. C C *** USAGE NOTES *** C C ON THE FIRST CALL OF AN ITERATION, ONLY THE I/O VARIABLES C STEP, X, IV(IRC), IV(MODEL), V(F), V(DSTNRM), V(GTSTEP), AND C V(PREDUC) NEED HAVE BEEN INITIALIZED. BETWEEN CALLS, NO I/O C VALUES EXECPT STEP, X, IV(MODEL), V(F) AND THE STOPPING TOLER- C ANCES SHOULD BE CHANGED. C AFTER A RETURN FOR CONVERGENCE OR FALSE CONVERGENCE, ONE CAN C CHANGE THE STOPPING TOLERANCES AND CALL ASSESS AGAIN, IN WHICH C CASE THE STOPPING TESTS WILL BE REPEATED. C C *** REFERENCES *** C C (1) DENNIS, J.E., JR., GAY, D.M., AND WELSCH, R.E. (1981), C AN ADAPTIVE NONLINEAR LEAST-SQUARES ALGORITHM, C ACM TRANS. MATH. SOFTWARE, VOL. 7, NO. 3. C C (2) POWELL, M.J.D. (1970) A FORTRAN SUBROUTINE FOR SOLVING C SYSTEMS OF NONLINEAR ALGEBRAIC EQUATIONS, IN NUMERICAL C METHODS FOR NONLINEAR ALGEBRAIC EQUATIONS, EDITED BY C P. RABINOWITZ, GORDON AND BREACH, LONDON. C C *** HISTORY *** C C JOHN DENNIS DESIGNED MUCH OF THIS ROUTINE, STARTING WITH C IDEAS IN (2). ROY WELSCH SUGGESTED THE MODEL SWITCHING STRATEGY. C DAVID GAY AND STEPHEN PETERS CAST THIS SUBROUTINE INTO A MORE C PORTABLE FORM (WINTER 1977), AND DAVID GAY CAST IT INTO ITS C PRESENT FORM (FALL 1978). C C *** GENERAL *** C C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH C SUPPORTED BY THE NATIONAL SCIENCE FOUNDATION UNDER GRANTS C MCS-7600324, DCR75-10143, 76-14311DSS, MCS76-11989, AND C MCS-7906671. C C------------------------ EXTERNAL QUANTITIES ------------------------ C C *** EXTERNAL FUNCTIONS AND SUBROUTINES *** C EXTERNAL DRELST DOUBLE PRECISION DRELST C C DRELST... COMPUTES V(RELDX) = RELATIVE STEP SIZE. C C *** INTRINSIC FUNCTIONS *** C/+ DOUBLE PRECISION DABS, DMAX1 C/ C *** NO COMMON BLOCKS *** C C-------------------------- LOCAL VARIABLES -------------------------- C LOGICAL GOODX INTEGER I, NFC DOUBLE PRECISION EMAX, EMAXS, GTS, HALF, ONE, RELDX1, RFAC1, TWO, 1 XMAX, ZERO C C *** SUBSCRIPTS FOR IV AND V *** C INTEGER AFCTOL, DECFAC, DSTNRM, DSTSAV, DST0, F, FDIF, FLSTGD, F0, 1 GTSLST, GTSTEP, INCFAC, IRC, LMAXS, MLSTGD, MODEL, NFCALL, 2 NFGCAL, NREDUC, PLSTGD, PREDUC, RADFAC, RADINC, RDFCMN, 3 RDFCMX, RELDX, RESTOR, RFCTOL, SCTOL, STAGE, STGLIM, 4 STPPAR, SWITCH, TOOBIG, TUNER1, TUNER2, TUNER3, XCTOL, 5 XFTOL, XIRC C C *** DATA INITIALIZATIONS *** C C/6 C DATA HALF/0.5D+0/, ONE/1.D+0/, TWO/2.D+0/, ZERO/0.D+0/ C/7 PARAMETER (HALF=0.5D+0, ONE=1.D+0, TWO=2.D+0, ZERO=0.D+0) C/ C C/6 C DATA IRC/29/, MLSTGD/32/, MODEL/5/, NFCALL/6/, NFGCAL/7/, C 1 RADINC/8/, RESTOR/9/, STAGE/10/, STGLIM/11/, SWITCH/12/, C 2 TOOBIG/2/, XIRC/13/ C/7 PARAMETER (IRC=29, MLSTGD=32, MODEL=5, NFCALL=6, NFGCAL=7, 1 RADINC=8, RESTOR=9, STAGE=10, STGLIM=11, SWITCH=12, 2 TOOBIG=2, XIRC=13) C/ C/6 C DATA AFCTOL/31/, DECFAC/22/, DSTNRM/2/, DST0/3/, DSTSAV/18/, C 1 F/10/, FDIF/11/, FLSTGD/12/, F0/13/, GTSLST/14/, GTSTEP/4/, C 2 INCFAC/23/, LMAXS/36/, NREDUC/6/, PLSTGD/15/, PREDUC/7/, C 3 RADFAC/16/, RDFCMN/24/, RDFCMX/25/, RELDX/17/, RFCTOL/32/, C 4 SCTOL/37/, STPPAR/5/, TUNER1/26/, TUNER2/27/, TUNER3/28/, C 5 XCTOL/33/, XFTOL/34/ C/7 PARAMETER (AFCTOL=31, DECFAC=22, DSTNRM=2, DST0=3, DSTSAV=18, 1 F=10, FDIF=11, FLSTGD=12, F0=13, GTSLST=14, GTSTEP=4, 2 INCFAC=23, LMAXS=36, NREDUC=6, PLSTGD=15, PREDUC=7, 3 RADFAC=16, RDFCMN=24, RDFCMX=25, RELDX=17, RFCTOL=32, 4 SCTOL=37, STPPAR=5, TUNER1=26, TUNER2=27, TUNER3=28, 5 XCTOL=33, XFTOL=34) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C NFC = IV(NFCALL) IV(SWITCH) = 0 IV(RESTOR) = 0 RFAC1 = ONE GOODX = .TRUE. I = IV(IRC) IF (I .GE. 1 .AND. I .LE. 12) THEN c GO TO (20,30,10,10,40,280,220,220,220,220,220,170), I IF (I .EQ. 1) GO TO 20 IF (I .EQ. 2) GO TO 30 IF (I .EQ. 3) GO TO 10 IF (I .EQ. 4) GO TO 10 IF (I .EQ. 5) GO TO 40 IF (I .EQ. 6) GO TO 280 IF (I .EQ. 7) GO TO 220 IF (I .EQ. 8) GO TO 220 IF (I .EQ. 9) GO TO 220 IF (I .EQ. 10) GO TO 220 IF (I .EQ. 11) GO TO 220 IF (I .EQ. 12) GO TO 170 END IF IV(IRC) = 13 RETURN C C *** INITIALIZE FOR NEW ITERATION *** C 10 IV(STAGE) = 1 IV(RADINC) = 0 V(FLSTGD) = V(F0) IF (IV(TOOBIG) .EQ. 0) GO TO 90 IV(STAGE) = -1 IV(XIRC) = I GO TO 60 C C *** STEP WAS RECOMPUTED WITH NEW MODEL OR SMALLER RADIUS *** C *** FIRST DECIDE WHICH *** C 20 IF (IV(MODEL) .NE. IV(MLSTGD)) GO TO 30 C *** OLD MODEL RETAINED, SMALLER RADIUS TRIED *** C *** DO NOT CONSIDER ANY MORE NEW MODELS THIS ITERATION *** IV(STAGE) = IV(STGLIM) IV(RADINC) = -1 GO TO 90 C C *** A NEW MODEL IS BEING TRIED. DECIDE WHETHER TO KEEP IT. *** C 30 IV(STAGE) = IV(STAGE) + 1 C C *** NOW WE ADD THE POSSIBILTIY THAT STEP WAS RECOMPUTED WITH *** C *** THE SAME MODEL, PERHAPS BECAUSE OF AN OVERSIZED STEP. *** C 40 IF (IV(STAGE) .GT. 0) GO TO 50 C C *** STEP WAS RECOMPUTED BECAUSE IT WAS TOO BIG. *** C IF (IV(TOOBIG) .NE. 0) GO TO 60 C C *** RESTORE IV(STAGE) AND PICK UP WHERE WE LEFT OFF. *** C IV(STAGE) = -IV(STAGE) I = IV(XIRC) c GO TO (20, 30, 90, 90, 70), I IF (I .EQ. 1) GO TO 20 IF (I .EQ. 2) GO TO 30 IF (I .EQ. 3) GO TO 90 IF (I .EQ. 4) GO TO 90 IF (I .EQ. 5) GO TO 70 C 50 IF (IV(TOOBIG) .EQ. 0) GO TO 70 C C *** HANDLE OVERSIZE STEP *** C IF (IV(RADINC) .GT. 0) GO TO 80 IV(STAGE) = -IV(STAGE) IV(XIRC) = IV(IRC) C 60 V(RADFAC) = V(DECFAC) IV(RADINC) = IV(RADINC) - 1 IV(IRC) = 5 RETURN C 70 IF (V(F) .LT. V(FLSTGD)) GO TO 90 C C *** THE NEW STEP IS A LOSER. RESTORE OLD MODEL. *** C IF (IV(MODEL) .EQ. IV(MLSTGD)) GO TO 80 IV(MODEL) = IV(MLSTGD) IV(SWITCH) = 1 C C *** RESTORE STEP, ETC. ONLY IF A PREVIOUS STEP DECREASED V(F). C 80 IF (V(FLSTGD) .GE. V(F0)) GO TO 90 IV(RESTOR) = 1 V(F) = V(FLSTGD) V(PREDUC) = V(PLSTGD) V(GTSTEP) = V(GTSLST) IF (IV(SWITCH) .EQ. 0) RFAC1 = V(DSTNRM) / V(DSTSAV) V(DSTNRM) = V(DSTSAV) NFC = IV(NFGCAL) GOODX = .FALSE. C C C *** COMPUTE RELATIVE CHANGE IN X BY CURRENT STEP *** C 90 RELDX1 = DRELST(P, D, X, X0) C C *** RESTORE X AND STEP IF NECESSARY *** C IF (GOODX) GO TO 110 DO I = 1, P STEP(I) = STLSTG(I) X(I) = X0(I) + STLSTG(I) END DO C 110 V(FDIF) = V(F0) - V(F) IF (V(FDIF) .GT. V(TUNER2) * V(PREDUC)) GO TO 140 C C *** NO (OR ONLY A TRIVIAL) FUNCTION DECREASE C *** -- SO TRY NEW MODEL OR SMALLER RADIUS C V(RELDX) = RELDX1 IF (V(F) .LT. V(F0)) GO TO 120 IV(MLSTGD) = IV(MODEL) V(FLSTGD) = V(F) V(F) = V(F0) CALL DCOPY(P,X0,1,X,1) IV(RESTOR) = 1 GO TO 130 120 IV(NFGCAL) = NFC 130 IV(IRC) = 1 IF (IV(STAGE) .LT. IV(STGLIM)) GO TO 160 IV(IRC) = 5 IV(RADINC) = IV(RADINC) - 1 GO TO 160 C C *** NONTRIVIAL FUNCTION DECREASE ACHIEVED *** C 140 IV(NFGCAL) = NFC RFAC1 = ONE IF (GOODX) V(RELDX) = RELDX1 V(DSTSAV) = V(DSTNRM) IF (V(FDIF) .GT. V(PREDUC)*V(TUNER1)) GO TO 190 C C *** DECREASE WAS MUCH LESS THAN PREDICTED -- EITHER CHANGE MODELS C *** OR ACCEPT STEP WITH DECREASED RADIUS. C IF (IV(STAGE) .GE. IV(STGLIM)) GO TO 150 C *** CONSIDER SWITCHING MODELS *** IV(IRC) = 2 GO TO 160 C C *** ACCEPT STEP WITH DECREASED RADIUS *** C 150 IV(IRC) = 4 C C *** SET V(RADFAC) TO FLETCHER*S DECREASE FACTOR *** C 160 IV(XIRC) = IV(IRC) EMAX = V(GTSTEP) + V(FDIF) V(RADFAC) = HALF * RFAC1 IF (EMAX .LT. V(GTSTEP)) V(RADFAC) = RFAC1 * DMAX1(V(RDFCMN), 1 HALF * V(GTSTEP)/EMAX) C C *** DO FALSE CONVERGENCE TEST *** C 170 IF (V(RELDX) .LE. V(XFTOL)) GO TO 180 IV(IRC) = IV(XIRC) IF (V(F) .LT. V(F0)) GO TO 200 GO TO 230 C 180 IV(IRC) = 12 GO TO 240 C C *** HANDLE GOOD FUNCTION DECREASE *** C 190 IF (V(FDIF) .LT. (-V(TUNER3) * V(GTSTEP))) GO TO 210 C C *** INCREASING RADIUS LOOKS WORTHWHILE. SEE IF WE JUST C *** RECOMPUTED STEP WITH A DECREASED RADIUS OR RESTORED STEP C *** AFTER RECOMPUTING IT WITH A LARGER RADIUS. C IF (IV(RADINC) .LT. 0) GO TO 210 IF (IV(RESTOR) .EQ. 1) GO TO 210 C C *** WE DID NOT. TRY A LONGER STEP UNLESS THIS WAS A NEWTON C *** STEP. C V(RADFAC) = V(RDFCMX) GTS = V(GTSTEP) IF (V(FDIF) .LT. (HALF/V(RADFAC) - ONE) * GTS) 1 V(RADFAC) = DMAX1(V(INCFAC), HALF*GTS/(GTS + V(FDIF))) IV(IRC) = 4 IF (V(STPPAR) .EQ. ZERO) GO TO 230 C *** STEP WAS NOT A NEWTON STEP. RECOMPUTE IT WITH C *** A LARGER RADIUS. IV(IRC) = 5 IV(RADINC) = IV(RADINC) + 1 C C *** SAVE VALUES CORRESPONDING TO GOOD STEP *** C 200 V(FLSTGD) = V(F) IV(MLSTGD) = IV(MODEL) CALL DCOPY(P, STEP,1,STLSTG,1) V(DSTSAV) = V(DSTNRM) IV(NFGCAL) = NFC V(PLSTGD) = V(PREDUC) V(GTSLST) = V(GTSTEP) GO TO 230 C C *** ACCEPT STEP WITH RADIUS UNCHANGED *** C 210 V(RADFAC) = ONE IV(IRC) = 3 GO TO 230 C C *** COME HERE FOR A RESTART AFTER CONVERGENCE *** C 220 IV(IRC) = IV(XIRC) IF (V(DSTSAV) .GE. ZERO) GO TO 240 IV(IRC) = 12 GO TO 240 C C *** PERFORM CONVERGENCE TESTS *** C 230 IV(XIRC) = IV(IRC) 240 IF (DABS(V(F)) .LT. V(AFCTOL)) IV(IRC) = 10 IF (HALF * V(FDIF) .GT. V(PREDUC)) RETURN EMAX = V(RFCTOL) * DABS(V(F0)) EMAXS = V(SCTOL) * DABS(V(F0)) IF (V(DSTNRM) .GT. V(LMAXS) .AND. V(PREDUC) .LE. EMAXS) 1 IV(IRC) = 11 IF (V(DST0) .LT. ZERO) GO TO 250 I = 0 IF ((V(NREDUC) .GT. ZERO .AND. V(NREDUC) .LE. EMAX) .OR. 1 (V(NREDUC) .EQ. ZERO. AND. V(PREDUC) .EQ. ZERO)) I = 2 IF (V(STPPAR) .EQ. ZERO .AND. V(RELDX) .LE. V(XCTOL) 1 .AND. GOODX) I = I + 1 IF (I .GT. 0) IV(IRC) = I + 6 C C *** CONSIDER RECOMPUTING STEP OF LENGTH V(LMAXS) FOR SINGULAR C *** CONVERGENCE TEST. C 250 IF (IV(IRC) .GT. 5 .AND. IV(IRC) .NE. 12) RETURN IF (V(DSTNRM) .GT. V(LMAXS)) GO TO 260 IF (V(PREDUC) .GE. EMAXS) RETURN IF (V(DST0) .LE. ZERO) GO TO 270 IF (HALF * V(DST0) .LE. V(LMAXS)) RETURN GO TO 270 260 IF (HALF * V(DSTNRM) .LE. V(LMAXS)) RETURN XMAX = V(LMAXS) / V(DSTNRM) IF (XMAX * (TWO - XMAX) * V(PREDUC) .GE. EMAXS) RETURN 270 IF (V(NREDUC) .LT. ZERO) GO TO 290 C C *** RECOMPUTE V(PREDUC) FOR USE IN SINGULAR CONVERGENCE TEST *** C V(GTSLST) = V(GTSTEP) V(DSTSAV) = V(DSTNRM) IF (IV(IRC) .EQ. 12) V(DSTSAV) = -V(DSTSAV) V(PLSTGD) = V(PREDUC) IV(IRC) = 6 CALL DCOPY(P, STEP,1,STLSTG,1) RETURN C C *** PERFORM SINGULAR CONVERGENCE TEST WITH RECOMPUTED V(PREDUC) *** C 280 V(GTSTEP) = V(GTSLST) V(DSTNRM) = DABS(V(DSTSAV)) CALL DCOPY(P, STLSTG,1,STEP,1) IV(IRC) = IV(XIRC) IF (V(DSTSAV) .LE. ZERO) IV(IRC) = 12 V(NREDUC) = -V(PREDUC) V(PREDUC) = V(PLSTGD) 290 IF (-V(NREDUC) .LE. V(RFCTOL) * DABS(V(F0))) IV(IRC) = 11 C RETURN C C *** LAST CARD OF ASSESS FOLLOWS *** END SUBROUTINE DDBDOG(DIG, G, LV, N, NWTSTP, STEP, V) save C C *** COMPUTE DOUBLE DOGLEG STEP *** C C *** PARAMETER DECLARATIONS *** C INTEGER LV, N DOUBLE PRECISION DIG(N), G(N), NWTSTP(N), STEP(N), V(LV) C C *** PURPOSE *** C C THIS SUBROUTINE COMPUTES A CANDIDATE STEP (FOR USE IN AN UNCON- C STRAINED MINIMIZATION CODE) BY THE DOUBLE DOGLEG ALGORITHM OF C DENNIS AND MEI (REF. 1), WHICH IS A VARIATION ON POWELL*S DOGLEG C SCHEME (REF. 2, P. 95). C C-------------------------- PARAMETER USAGE -------------------------- C C DIG (INPUT) DIAG(D)**-2 * G -- SEE ALGORITHM NOTES. C G (INPUT) THE CURRENT GRADIENT VECTOR. C LV (INPUT) LENGTH OF V. C N (INPUT) NUMBER OF COMPONENTS IN DIG, G, NWTSTP, AND STEP. C NWTSTP (INPUT) NEGATIVE NEWTON STEP -- SEE ALGORITHM NOTES. C STEP (OUTPUT) THE COMPUTED STEP. C V (I/O) VALUES ARRAY, THE FOLLOWING COMPONENTS OF WHICH ARE C USED HERE... C V(BIAS) (INPUT) BIAS FOR RELAXED NEWTON STEP, WHICH IS V(BIAS) OF C THE WAY FROM THE FULL NEWTON TO THE FULLY RELAXED NEWTON C STEP. RECOMMENDED VALUE = 0.8 . C V(DGNORM) (INPUT) 2-NORM OF DIAG(D)**-1 * G -- SEE ALGORITHM NOTES. C V(DSTNRM) (OUTPUT) 2-NORM OF DIAG(D) * STEP, WHICH IS V(RADIUS) C UNLESS V(STPPAR) = 0 -- SEE ALGORITHM NOTES. C V(DST0) (INPUT) 2-NORM OF DIAG(D) * NWTSTP -- SEE ALGORITHM NOTES. C V(GRDFAC) (OUTPUT) THE COEFFICIENT OF DIG IN THE STEP RETURNED -- C STEP(I) = V(GRDFAC)*DIG(I) + V(NWTFAC)*NWTSTP(I). C V(GTHG) (INPUT) SQUARE-ROOT OF (DIG**T) * (HESSIAN) * DIG -- SEE C ALGORITHM NOTES. C V(GTSTEP) (OUTPUT) INNER PRODUCT BETWEEN G AND STEP. C V(NREDUC) (OUTPUT) FUNCTION REDUCTION PREDICTED FOR THE FULL NEWTON C STEP. C V(NWTFAC) (OUTPUT) THE COEFFICIENT OF NWTSTP IN THE STEP RETURNED -- C SEE V(GRDFAC) ABOVE. C V(PREDUC) (OUTPUT) FUNCTION REDUCTION PREDICTED FOR THE STEP RETURNED. C V(RADIUS) (INPUT) THE TRUST REGION RADIUS. D TIMES THE STEP RETURNED C HAS 2-NORM V(RADIUS) UNLESS V(STPPAR) = 0. C V(STPPAR) (OUTPUT) CODE TELLING HOW STEP WAS COMPUTED... 0 MEANS A C FULL NEWTON STEP. BETWEEN 0 AND 1 MEANS V(STPPAR) OF THE C WAY FROM THE NEWTON TO THE RELAXED NEWTON STEP. BETWEEN C 1 AND 2 MEANS A TRUE DOUBLE DOGLEG STEP, V(STPPAR) - 1 OF C THE WAY FROM THE RELAXED NEWTON TO THE CAUCHY STEP. C GREATER THAN 2 MEANS 1 / (V(STPPAR) - 1) TIMES THE CAUCHY C STEP. C C------------------------------- NOTES ------------------------------- C C *** ALGORITHM NOTES *** C C LET G AND H BE THE CURRENT GRADIENT AND HESSIAN APPROXIMA- C TION RESPECTIVELY AND LET D BE THE CURRENT SCALE VECTOR. THIS C ROUTINE ASSUMES DIG = DIAG(D)**-2 * G AND NWTSTP = H**-1 * G. C THE STEP COMPUTED IS THE SAME ONE WOULD GET BY REPLACING G AND H C BY DIAG(D)**-1 * G AND DIAG(D)**-1 * H * DIAG(D)**-1, C COMPUTING STEP, AND TRANSLATING STEP BACK TO THE ORIGINAL C VARIABLES, I.E., PREMULTIPLYING IT BY DIAG(D)**-1. C C *** REFERENCES *** C C 1. DENNIS, J.E., AND MEI, H.H.W. (1979), TWO NEW UNCONSTRAINED OPTI- C MIZATION ALGORITHMS WHICH USE FUNCTION AND GRADIENT C VALUES, J. OPTIM. THEORY APPLIC. 28, PP. 453-482. C 2. POWELL, M.J.D. (1970), A HYBRID METHOD FOR NON-LINEAR EQUATIONS, C IN NUMERICAL METHODS FOR NON-LINEAR EQUATIONS, EDITED BY C P. RABINOWITZ, GORDON AND BREACH, LONDON. C C *** GENERAL *** C C CODED BY DAVID M. GAY. C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH SUPPORTED C BY THE NATIONAL SCIENCE FOUNDATION UNDER GRANTS MCS-7600324 AND C MCS-7906671. C C------------------------ EXTERNAL QUANTITIES ------------------------ C C *** FUNCTIONS AND SUBROUTINES CALLED *** C DOUBLE PRECISION DDOT C C C *** INTRINSIC FUNCTIONS *** C/+ DOUBLE PRECISION DSQRT C/ C-------------------------- LOCAL VARIABLES -------------------------- C INTEGER I DOUBLE PRECISION CFACT, CNORM, CTRNWT, GHINVG, FEMNSQ, GNORM, 1 NWTNRM, RELAX, RLAMBD, T, T1, T2 DOUBLE PRECISION HALF, ONE, TWO, ZERO C C *** V SUBSCRIPTS *** C INTEGER BIAS, DGNORM, DSTNRM, DST0, GRDFAC, GTHG, GTSTEP, 1 NREDUC, NWTFAC, PREDUC, RADIUS, STPPAR C C *** DATA INITIALIZATIONS *** C C/6 C DATA HALF/0.5D+0/, ONE/1.D+0/, TWO/2.D+0/, ZERO/0.D+0/ C/7 PARAMETER (HALF=0.5D+0, ONE=1.D+0, TWO=2.D+0, ZERO=0.D+0) C/ C C/6 C DATA BIAS/43/, DGNORM/1/, DSTNRM/2/, DST0/3/, GRDFAC/45/, C 1 GTHG/44/, GTSTEP/4/, NREDUC/6/, NWTFAC/46/, PREDUC/7/, C 2 RADIUS/8/, STPPAR/5/ C/7 PARAMETER (BIAS=43, DGNORM=1, DSTNRM=2, DST0=3, GRDFAC=45, 1 GTHG=44, GTSTEP=4, NREDUC=6, NWTFAC=46, PREDUC=7, 2 RADIUS=8, STPPAR=5) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C NWTNRM = V(DST0) RLAMBD = ONE IF (NWTNRM .GT. ZERO) RLAMBD = V(RADIUS) / NWTNRM GNORM = V(DGNORM) DO I = 1, N STEP(I) = G(I) / GNORM END DO GHINVG = DDOT(N, STEP,1,NWTSTP,1) V(NREDUC) = HALF * GHINVG * GNORM V(GRDFAC) = ZERO V(NWTFAC) = ZERO IF (RLAMBD .LT. ONE) GO TO 30 C C *** THE NEWTON STEP IS INSIDE THE TRUST REGION *** C V(STPPAR) = ZERO V(DSTNRM) = NWTNRM V(GTSTEP) = -GHINVG * GNORM V(PREDUC) = V(NREDUC) V(NWTFAC) = -ONE DO I = 1, N STEP(I) = -NWTSTP(I) END DO RETURN C 30 V(DSTNRM) = V(RADIUS) CFACT = (GNORM / V(GTHG))**2 C *** CAUCHY STEP = -CFACT * G. CNORM = GNORM * CFACT RELAX = ONE - V(BIAS) * (ONE - CNORM/GHINVG) IF (RLAMBD .LT. RELAX) GO TO 50 C C *** STEP IS BETWEEN RELAXED NEWTON AND FULL NEWTON STEPS *** C V(STPPAR) = ONE - (RLAMBD - RELAX) / (ONE - RELAX) T = -RLAMBD V(GTSTEP) = T * GHINVG * GNORM V(PREDUC) = RLAMBD * (ONE - HALF*RLAMBD) * GHINVG * GNORM V(NWTFAC) = T DO I = 1, N STEP(I) = T * NWTSTP(I) END DO RETURN C 50 IF (CNORM .LT. V(RADIUS)) GO TO 70 C C *** THE CAUCHY STEP LIES OUTSIDE THE TRUST REGION -- C *** STEP = SCALED CAUCHY STEP *** C T = -V(RADIUS) / GNORM V(GRDFAC) = T V(STPPAR) = ONE + CNORM / V(RADIUS) V(GTSTEP) = -V(RADIUS) * GNORM V(PREDUC) = V(RADIUS)*(GNORM - HALF*V(RADIUS)*(V(GTHG)/GNORM)**2) DO I = 1, N STEP(I) = T * DIG(I) END DO RETURN C C *** COMPUTE DOGLEG STEP BETWEEN CAUCHY AND RELAXED NEWTON *** C *** FEMUR = RELAXED NEWTON STEP MINUS CAUCHY STEP *** C 70 CTRNWT = CFACT * RELAX * GHINVG / GNORM C *** CTRNWT = INNER PROD. OF CAUCHY AND RELAXED NEWTON STEPS, C *** SCALED BY GNORM**-2. T1 = CTRNWT - CFACT**2 C *** T1 = INNER PROD. OF FEMUR AND CAUCHY STEP, SCALED BY C *** GNORM**-2. T2 = (V(RADIUS)/GNORM)**2 - CFACT**2 FEMNSQ = (RELAX*NWTNRM/GNORM)**2 - CTRNWT - T1 C *** FEMNSQ = SQUARE OF 2-NORM OF FEMUR, SCALED BY GNORM**-2. T = T2 / (T1 + DSQRT(T1**2 + FEMNSQ*T2)) C *** DOGLEG STEP = CAUCHY STEP + T * FEMUR. T1 = (T - ONE) * CFACT V(GRDFAC) = T1 T2 = -T * RELAX V(NWTFAC) = T2 V(STPPAR) = TWO - T V(GTSTEP) = GNORM * (T1*GNORM + T2*GHINVG) V(PREDUC) = -(T1*GNORM) * ((T2 + ONE)*GNORM) 1 - (T2*GNORM) * (ONE + HALF*T2)*GHINVG 2 - HALF * (V(GTHG)*T1)**2 DO I = 1, N STEP(I) = T1*DIG(I) + T2*NWTSTP(I) END DO C RETURN C *** LAST CARD OF DDBDOG FOLLOWS *** END SUBROUTINE DITSUM(D, G, IV, LIV, LV, P, V, X) use cfuncs save C C *** PRINT ITERATION SUMMARY FOR ***SOL (VERSION 2.3) *** C C *** PARAMETER DECLARATIONS *** C INTEGER LIV, LV, P INTEGER IV(LIV) DOUBLE PRECISION D(P), G(P), V(LV), X(P) C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C *** LOCAL VARIABLES *** C INTEGER ALG, IV1, M, NF, NG, OL, PU C/6 C REAL MODEL1(6), MODEL2(6) C/7 CHARACTER(4) MODEL1(6), MODEL2(6) C/ DOUBLE PRECISION NRELDF, OLDF, PRELDF, RELDF, ZERO C C *** INTRINSIC FUNCTIONS *** C/+ INTEGER IABS DOUBLE PRECISION DABS, DMAX1 C/ C *** NO EXTERNAL FUNCTIONS OR SUBROUTINES *** C C *** SUBSCRIPTS FOR IV AND V *** C INTEGER ALGSAV, DSTNRM, F, FDIF, F0, NEEDHD, NFCALL, NFCOV, NGCOV, 1 NGCALL, NITER, NREDUC, OUTLEV, PREDUC, PRNTIT, PRUNIT, 2 RELDX, SOLPRT, STATPR, STPPAR, SUSED, X0PRT C C *** IV SUBSCRIPT VALUES *** C C/6 C DATA ALGSAV/51/, NEEDHD/36/, NFCALL/6/, NFCOV/52/, NGCALL/30/, C 1 NGCOV/53/, NITER/31/, OUTLEV/19/, PRNTIT/39/, PRUNIT/21/, C 2 SOLPRT/22/, STATPR/23/, SUSED/64/, X0PRT/24/ C/7 PARAMETER (ALGSAV=51, NEEDHD=36, NFCALL=6, NFCOV=52, NGCALL=30, 1 NGCOV=53, NITER=31, OUTLEV=19, PRNTIT=39, PRUNIT=21, 2 SOLPRT=22, STATPR=23, SUSED=64, X0PRT=24) C/ C C *** V SUBSCRIPT VALUES *** C C/6 C DATA DSTNRM/2/, F/10/, F0/13/, FDIF/11/, NREDUC/6/, PREDUC/7/, C 1 RELDX/17/, STPPAR/5/ C/7 PARAMETER (DSTNRM=2, F=10, F0=13, FDIF=11, NREDUC=6, PREDUC=7, 1 RELDX=17, STPPAR=5) C/ C C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ZERO=0.D+0) C/ C/6 C DATA MODEL1(1)/4H /, MODEL1(2)/4H /, MODEL1(3)/4H /, C 1 MODEL1(4)/4H /, MODEL1(5)/4H G /, MODEL1(6)/4H S /, C 2 MODEL2(1)/4H G /, MODEL2(2)/4H S /, MODEL2(3)/4HG-S /, C 3 MODEL2(4)/4HS-G /, MODEL2(5)/4H-S-G/, MODEL2(6)/4H-G-S/ C/7 DATA MODEL1/' ',' ',' ',' ',' G ',' S '/, 1 MODEL2/' G ',' S ','G-S ','S-G ','-S-G','-G-S'/ C/ C C------------------------------- BODY -------------------------------- C PU = IV(PRUNIT) IF (PU .EQ. 0) RETURN IV1 = IV(1) IF (IV1 .GT. 62) IV1 = IV1 - 51 OL = IV(OUTLEV) ALG = IV(ALGSAV) IF (IV1 .LT. 2 .OR. IV1 .GT. 15) GO TO 370 IF (OL .EQ. 0) GO TO 120 IF (IV1 .GE. 12) GO TO 120 IF (IV1 .EQ. 2 .AND. IV(NITER) .EQ. 0) GO TO 390 IF (IV1 .GE. 10 .AND. IV(PRNTIT) .EQ. 0) GO TO 120 IF (IV1 .GT. 2) GO TO 10 IV(PRNTIT) = IV(PRNTIT) + 1 IF (IV(PRNTIT) .LT. IABS(OL)) RETURN 10 NF = IV(NFCALL) - IABS(IV(NFCOV)) IV(PRNTIT) = 0 RELDF = ZERO PRELDF = ZERO OLDF = DMAX1(DABS(V(F0)), DABS(V(F))) IF (OLDF .LE. ZERO) GO TO 20 RELDF = V(FDIF) / OLDF PRELDF = V(PREDUC) / OLDF 20 IF (OL .GT. 0) GO TO 60 C C *** PRINT SHORT SUMMARY LINE *** C IF (IV(NEEDHD) .EQ. 1 .AND. ALG .EQ. 1) call h30() IF (IV(NEEDHD) .EQ. 1 .AND. ALG .EQ. 2) call h40() IV(NEEDHD) = 0 IF (ALG .EQ. 2) GO TO 50 M = IV(SUSED) call h100s(IV(NITER), NF, V(F), RELDF, PRELDF, V(RELDX), 1 MODEL1(M), MODEL2(M), V(STPPAR)) GO TO 120 C 50 call h110s(IV(NITER), NF, V(F), RELDF, PRELDF, V(RELDX), 1 V(STPPAR)) GO TO 120 C C *** PRINT LONG SUMMARY LINE *** C 60 IF (IV(NEEDHD) .EQ. 1 .AND. ALG .EQ. 1) call h70() IF (IV(NEEDHD) .EQ. 1 .AND. ALG .EQ. 2) call h80() IV(NEEDHD) = 0 NRELDF = ZERO IF (OLDF .GT. ZERO) NRELDF = V(NREDUC) / OLDF IF (ALG .EQ. 2) GO TO 90 M = IV(SUSED) call h100l(IV(NITER), NF, V(F), RELDF, PRELDF, V(RELDX), 1 MODEL1(M), MODEL2(M), V(STPPAR), V(DSTNRM), NRELDF) GO TO 120 C 90 call h110l(IV(NITER), NF, V(F), RELDF, PRELDF, 1 V(RELDX), V(STPPAR), V(DSTNRM), NRELDF) C 120 IF (IV(STATPR) .LT. 0) GO TO 430 c GO TO (999, 999, 130, 150, 170, 190, 210, 230, 250, 270, 290, 310, c 1 330, 350, 520), IV1 IF (IV1 .EQ. 1) RETURN IF (IV1 .EQ. 2) RETURN IF (IV1 .EQ. 3) GOTO 130 IF (IV1 .EQ. 4) GOTO 150 IF (IV1 .EQ. 5) GOTO 170 IF (IV1 .EQ. 6) GOTO 190 IF (IV1 .EQ. 7) GOTO 210 IF (IV1 .EQ. 8) GOTO 230 IF (IV1 .EQ. 9) GOTO 250 IF (IV1 .EQ. 10) GOTO 270 IF (IV1 .EQ. 11) GOTO 290 IF (IV1 .EQ. 12) GOTO 310 IF (IV1 .EQ. 13) GOTO 330 IF (IV1 .EQ. 14) GOTO 350 IF (IV1 .EQ. 15) GOTO 520 C 130 call cnlprt(' ***** X-CONVERGENCE *****', 26) GO TO 430 C 150 call cnlprt(' ***** RELATIVE FUNCTION CONVERGENCE *****', 42) GO TO 430 C 170 call cnlprt 1(' ***** X- AND RELATIVE FUNCTION CONVERGENCE *****', 49) GO TO 430 C 190 call cnlprt(' ***** ABSOLUTE FUNCTION CONVERGENCE *****', 42) GO TO 430 C 210 call cnlprt(' ***** SINGULAR CONVERGENCE *****', 33) GO TO 430 C 230 call cnlprt(' ***** FALSE CONVERGENCE *****', 30) GO TO 430 C 250 call cnlprt(' ***** FUNCTION EVALUATION LIMIT *****', 38) GO TO 430 C 270 call cnlprt(' ***** ITERATION LIMIT *****', 28) GO TO 430 C 290 call cnlprt(' ***** STOPX *****', 18) GO TO 430 C 310 call cnlprt(' ***** INITIAL F(X) CANNOT BE COMPUTED *****', 44) GO TO 390 C 330 call cnlprt(' ***** BAD PARAMETERS TO ASSESS *****', 37) RETURN C 350 call cnlprt(' ***** GRADIENT COULD NOT BE COMPUTED *****', 43) IF (IV(NITER) .GT. 0) GO TO 480 GO TO 390 C 370 call h380(IV(1)) RETURN C C *** INITIAL CALL ON DITSUM *** C 390 call h400(P, X, D) IF (IV1 .GE. 12) RETURN IV(NEEDHD) = 0 IV(PRNTIT) = 0 IF (OL .EQ. 0) RETURN IF (OL .LT. 0 .AND. ALG .EQ. 1) call h30() IF (OL .LT. 0 .AND. ALG .EQ. 2) call h40() IF (OL .GT. 0 .AND. ALG .EQ. 1) call h70() IF (OL .GT. 0 .AND. ALG .EQ. 2) call h80() IF (ALG .EQ. 1) call h410(V(F)) IF (ALG .EQ. 2) call h420(V(F)) RETURN C C *** PRINT VARIOUS INFORMATION REQUESTED ON SOLUTION *** C 430 IV(NEEDHD) = 1 IF (IV(STATPR) .EQ. 0) GO TO 480 OLDF = DMAX1(DABS(V(F0)), DABS(V(F))) PRELDF = ZERO NRELDF = ZERO IF (OLDF .LE. ZERO) GO TO 440 PRELDF = V(PREDUC) / OLDF NRELDF = V(NREDUC) / OLDF 440 NF = IV(NFCALL) - IV(NFCOV) NG = IV(NGCALL) - IV(NGCOV) call h450(V(F), V(RELDX), NF, NG, PRELDF, NRELDF) C IF (IV(NFCOV) .GT. 0) call h460(IV(NFCOV)) IF (IV(NGCOV) .GT. 0) call h470(IV(NGCOV)) C 480 IF (IV(SOLPRT) .EQ. 0) RETURN IV(NEEDHD) = 1 call cnlprt(' I FINAL X(I) D(I) G(I)', 1 48) call h500(P, X, D, G) RETURN C 520 call cnlprt(' INCONSISTENT DIMENSIONS', 24) RETURN C *** LAST CARD OF DITSUM FOLLOWS *** END SUBROUTINE DLITVM(N, X, L, Y) save C C *** SOLVE (L**T)*X = Y, WHERE L IS AN N X N LOWER TRIANGULAR C *** MATRIX STORED COMPACTLY BY ROWS. X AND Y MAY OCCUPY THE SAME C *** STORAGE. *** C INTEGER N DOUBLE PRECISION X(N), L, Y(N) DIMENSION L(N*(N+1)/2) INTEGER I, II, IJ, IM1, I0, J, NP1 DOUBLE PRECISION XI, ZERO C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ZERO=0.D+0) C/ C DO I = 1, N X(I) = Y(I) END DO NP1 = N + 1 I0 = N*(N+1)/2 DO II = 1, N I = NP1 - II XI = X(I)/L(I0) X(I) = XI IF (I .LE. 1) RETURN I0 = I0 - I IF (XI .EQ. ZERO) EXIT IM1 = I - 1 DO J = 1, IM1 IJ = I0 + J X(J) = X(J) - XI*L(IJ) END DO END DO RETURN C *** LAST CARD OF DLITVM FOLLOWS *** END SUBROUTINE DLIVMU(N, X, L, Y) save C C *** SOLVE L*X = Y, WHERE L IS AN N X N LOWER TRIANGULAR C *** MATRIX STORED COMPACTLY BY ROWS. X AND Y MAY OCCUPY THE SAME C *** STORAGE. *** C INTEGER N DOUBLE PRECISION X(N), L, Y(N) DIMENSION L(N*(N+1)/2) DOUBLE PRECISION DDOT INTEGER I, J, K DOUBLE PRECISION T, ZERO C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ZERO=0.D+0) C/ C DO K = 1, N IF (Y(K) .NE. ZERO) GO TO 20 X(K) = ZERO END DO RETURN 20 J = K*(K+1)/2 X(K) = Y(K) / L(J) IF (K .GE. N) RETURN K = K + 1 DO I = K, N T = DDOT(I-1, L(J+1),1,X,1) J = J + I X(I) = (Y(I) - T)/L(J) END DO RETURN C *** LAST CARD OF DLIVMU FOLLOWS *** END SUBROUTINE DLTVMU(N, X, L, Y) save C C *** COMPUTE X = (L**T)*Y, WHERE L IS AN N X N LOWER C *** TRIANGULAR MATRIX STORED COMPACTLY BY ROWS. X AND Y MAY C *** OCCUPY THE SAME STORAGE. *** C INTEGER N DOUBLE PRECISION X(N), L, Y(N) DIMENSION L(N*(N+1)/2) INTEGER I, IJ, I0, J DOUBLE PRECISION YI, ZERO C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ZERO=0.D+0) C/ C I0 = 0 DO I = 1, N YI = Y(I) X(I) = ZERO DO J = 1, I IJ = I0 + J X(J) = X(J) + YI*L(IJ) END DO I0 = I0 + I END DO RETURN C *** LAST CARD OF DLTVMU FOLLOWS *** END SUBROUTINE DLUPDT(BETA, GAMMA, L, LAMBDA, LPLUS, N, W, Z) save C C *** COMPUTE LPLUS = SECANT UPDATE OF L *** C C *** PARAMETER DECLARATIONS *** C INTEGER N DOUBLE PRECISION BETA(N), GAMMA(N), L, LAMBDA(N), LPLUS, 1 W(N), Z(N) DIMENSION L(N*(N+1)/2), LPLUS(N*(N+1)/2) C C-------------------------- PARAMETER USAGE -------------------------- C C BETA = SCRATCH VECTOR. C GAMMA = SCRATCH VECTOR. C L (INPUT) LOWER TRIANGULAR MATRIX, STORED ROWWISE. C LAMBDA = SCRATCH VECTOR. C LPLUS (OUTPUT) LOWER TRIANGULAR MATRIX, STORED ROWWISE, WHICH MAY C OCCUPY THE SAME STORAGE AS L. C N (INPUT) LENGTH OF VECTOR PARAMETERS AND ORDER OF MATRICES. C W (INPUT, DESTROYED ON OUTPUT) RIGHT SINGULAR VECTOR OF RANK 1 C CORRECTION TO L. C Z (INPUT, DESTROYED ON OUTPUT) LEFT SINGULAR VECTOR OF RANK 1 C CORRECTION TO L. C C------------------------------- NOTES ------------------------------- C C *** APPLICATION AND USAGE RESTRICTIONS *** C C THIS ROUTINE UPDATES THE CHOLESKY FACTOR L OF A SYMMETRIC C POSITIVE DEFINITE MATRIX TO WHICH A SECANT UPDATE IS BEING C APPLIED -- IT COMPUTES A CHOLESKY FACTOR LPLUS OF C L * (I + Z*W**T) * (I + W*Z**T) * L**T. IT IS ASSUMED THAT W C AND Z HAVE BEEN CHOSEN SO THAT THE UPDATED MATRIX IS STRICTLY C POSITIVE DEFINITE. C C *** ALGORITHM NOTES *** C C THIS CODE USES RECURRENCE 3 OF REF. 1 (WITH D(J) = 1 FOR ALL J) C TO COMPUTE LPLUS OF THE FORM L * (I + Z*W**T) * Q, WHERE Q C IS AN ORTHOGONAL MATRIX THAT MAKES THE RESULT LOWER TRIANGULAR. C LPLUS MAY HAVE SOME NEGATIVE DIAGONAL ELEMENTS. C C *** REFERENCES *** C C 1. GOLDFARB, D. (1976), FACTORIZED VARIABLE METRIC METHODS FOR UNCON- C STRAINED OPTIMIZATION, MATH. COMPUT. 30, PP. 796-811. C C *** GENERAL *** C C CODED BY DAVID M. GAY (FALL 1979). C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH SUPPORTED C BY THE NATIONAL SCIENCE FOUNDATION UNDER GRANTS MCS-7600324 AND C MCS-7906671. C C------------------------ EXTERNAL QUANTITIES ------------------------ C C *** INTRINSIC FUNCTIONS *** C/+ DOUBLE PRECISION DSQRT C/ C-------------------------- LOCAL VARIABLES -------------------------- C INTEGER I, IJ, J, JJ, JP1, K, NM1, NP1 DOUBLE PRECISION A, B, BJ, ETA, GJ, LJ, LIJ, LJJ, NU, S, THETA, 1 WJ, ZJ DOUBLE PRECISION ONE, ZERO C C *** DATA INITIALIZATIONS *** C C/6 C DATA ONE/1.D+0/, ZERO/0.D+0/ C/7 PARAMETER (ONE=1.D+0, ZERO=0.D+0) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C NU = ONE ETA = ZERO IF (N .LE. 1) GO TO 30 NM1 = N - 1 C C *** TEMPORARILY STORE S(J) = SUM OVER K = J+1 TO N OF W(K)**2 IN C *** LAMBDA(J). C S = ZERO DO I = 1, NM1 J = N - I S = S + W(J+1)**2 LAMBDA(J) = S END DO C C *** COMPUTE LAMBDA, GAMMA, AND BETA BY GOLDFARB*S RECURRENCE 3. C DO J = 1, NM1 WJ = W(J) A = NU*Z(J) - ETA*WJ THETA = ONE + A*WJ S = A*LAMBDA(J) LJ = DSQRT(THETA**2 + A*S) IF (THETA .GT. ZERO) LJ = -LJ LAMBDA(J) = LJ B = THETA*WJ + S GAMMA(J) = B * NU / LJ BETA(J) = (A - B*ETA) / LJ NU = -NU / LJ ETA = -(ETA + (A**2)/(THETA - LJ)) / LJ END DO 30 LAMBDA(N) = ONE + (NU*Z(N) - ETA*W(N))*W(N) C C *** UPDATE L, GRADUALLY OVERWRITING W AND Z WITH L*W AND L*Z. C NP1 = N + 1 JJ = N * (N + 1) / 2 DO K = 1, N J = NP1 - K LJ = LAMBDA(J) LJJ = L(JJ) LPLUS(JJ) = LJ * LJJ WJ = W(J) W(J) = LJJ * WJ ZJ = Z(J) Z(J) = LJJ * ZJ IF (K .EQ. 1) GO TO 50 BJ = BETA(J) GJ = GAMMA(J) IJ = JJ + J JP1 = J + 1 DO I = JP1, N LIJ = L(IJ) LPLUS(IJ) = LJ*LIJ + BJ*W(I) + GJ*Z(I) W(I) = W(I) + LIJ*WJ Z(I) = Z(I) + LIJ*ZJ IJ = IJ + I END DO 50 JJ = JJ - J END DO C RETURN C *** LAST CARD OF DLUPDT FOLLOWS *** END SUBROUTINE DLVMUL(N, X, L, Y) save C C *** COMPUTE X = L*Y, WHERE L IS AN N X N LOWER TRIANGULAR C *** MATRIX STORED COMPACTLY BY ROWS. X AND Y MAY OCCUPY THE SAME C *** STORAGE. *** C INTEGER N DOUBLE PRECISION X(N), L, Y(N) DIMENSION L(N*(N+1)/2) INTEGER I, II, IJ, I0, J, NP1 DOUBLE PRECISION T, ZERO C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ZERO=0.D+0) C/ C NP1 = N + 1 I0 = N*(N+1)/2 DO II = 1, N I = NP1 - II I0 = I0 - I T = ZERO DO J = 1, I IJ = I0 + J T = T + L(IJ)*Y(J) END DO X(I) = T END DO RETURN C *** LAST CARD OF DLVMUL FOLLOWS *** END SUBROUTINE DPARCK(ALG, D, IV, LIV, LV, N, V) save C C *** CHECK ***SOL (VERSION 2.3) PARAMETERS, PRINT CHANGED VALUES *** C C *** ALG = 1 FOR REGRESSION, ALG = 2 FOR GENERAL UNCONSTRAINED OPT. C INTEGER ALG, LIV, LV, N INTEGER IV(LIV) DOUBLE PRECISION D(N), V(LV) C EXTERNAL DVDFLT DOUBLE PRECISION D1MACH C DVDFLT -- SUPPLIES DEFAULT PARAMETER VALUES TO V ALONE. C/+ INTEGER MAX0 C/ C C *** LOCAL VARIABLES *** C INTEGER I, II, IV1, J, K, L, M, MIV1, MIV2, NDFALT, PARSV1, PU INTEGER IJMP, JLIM(2), MINIV(2), NDFLT(2) C/6 C INTEGER VARNM(2), SH(2) C REAL CNGD(3), DFLT(3), VN(2,34), WHICH(3) C/7 CHARACTER(1) VARNM(2), SH(2) CHARACTER(4) CNGD(3), DFLT(3), VN(2,34), WHICH(3) C/ DOUBLE PRECISION BIG, MACHEP, TINY, VK, VM(34), VX(34), ZERO C C *** IV AND V SUBSCRIPTS *** C INTEGER ALGSAV, DINIT, DTYPE, DTYPE0, EPSLON, INITS, IVNEED, 1 LASTIV, LASTV, LMAT, NEXTIV, NEXTV, NVDFLT, OLDN, 2 PARPRT, PARSAV, PERM, PRUNIT, VNEED C C C/6 C DATA ALGSAV/51/, DINIT/38/, DTYPE/16/, DTYPE0/54/, EPSLON/19/, C 1 INITS/25/, IVNEED/3/, LASTIV/44/, LASTV/45/, LMAT/42/, C 2 NEXTIV/46/, NEXTV/47/, NVDFLT/50/, OLDN/38/, PARPRT/20/, C 3 PARSAV/49/, PERM/58/, PRUNIT/21/, VNEED/4/ C/7 PARAMETER (ALGSAV=51, DINIT=38, DTYPE=16, DTYPE0=54, EPSLON=19, 1 INITS=25, IVNEED=3, LASTIV=44, LASTV=45, LMAT=42, 2 NEXTIV=46, NEXTV=47, NVDFLT=50, OLDN=38, PARPRT=20, 3 PARSAV=49, PERM=58, PRUNIT=21, VNEED=4) C SAVE BIG, MACHEP, TINY C/ C DATA BIG/0.D+0/, MACHEP/-1.D+0/, TINY/1.D+0/, ZERO/0.D+0/ C/6 C DATA VN(1,1),VN(2,1)/4HEPSL,4HON../ C DATA VN(1,2),VN(2,2)/4HPHMN,4HFC../ C DATA VN(1,3),VN(2,3)/4HPHMX,4HFC../ C DATA VN(1,4),VN(2,4)/4HDECF,4HAC../ C DATA VN(1,5),VN(2,5)/4HINCF,4HAC../ C DATA VN(1,6),VN(2,6)/4HRDFC,4HMN../ C DATA VN(1,7),VN(2,7)/4HRDFC,4HMX../ C DATA VN(1,8),VN(2,8)/4HTUNE,4HR1../ C DATA VN(1,9),VN(2,9)/4HTUNE,4HR2../ C DATA VN(1,10),VN(2,10)/4HTUNE,4HR3../ C DATA VN(1,11),VN(2,11)/4HTUNE,4HR4../ C DATA VN(1,12),VN(2,12)/4HTUNE,4HR5../ C DATA VN(1,13),VN(2,13)/4HAFCT,4HOL../ C DATA VN(1,14),VN(2,14)/4HRFCT,4HOL../ C DATA VN(1,15),VN(2,15)/4HXCTO,4HL.../ C DATA VN(1,16),VN(2,16)/4HXFTO,4HL.../ C DATA VN(1,17),VN(2,17)/4HLMAX,4H0.../ C DATA VN(1,18),VN(2,18)/4HLMAX,4HS.../ C DATA VN(1,19),VN(2,19)/4HSCTO,4HL.../ C DATA VN(1,20),VN(2,20)/4HDINI,4HT.../ C DATA VN(1,21),VN(2,21)/4HDTIN,4HIT../ C DATA VN(1,22),VN(2,22)/4HD0IN,4HIT../ C DATA VN(1,23),VN(2,23)/4HDFAC,4H..../ C DATA VN(1,24),VN(2,24)/4HDLTF,4HDC../ C DATA VN(1,25),VN(2,25)/4HDLTF,4HDJ../ C DATA VN(1,26),VN(2,26)/4HDELT,4HA0../ C DATA VN(1,27),VN(2,27)/4HFUZZ,4H..../ C DATA VN(1,28),VN(2,28)/4HRLIM,4HIT../ C DATA VN(1,29),VN(2,29)/4HCOSM,4HIN../ C DATA VN(1,30),VN(2,30)/4HHUBE,4HRC../ C DATA VN(1,31),VN(2,31)/4HRSPT,4HOL../ C DATA VN(1,32),VN(2,32)/4HSIGM,4HIN../ C DATA VN(1,33),VN(2,33)/4HETA0,4H..../ C DATA VN(1,34),VN(2,34)/4HBIAS,4H..../ C/7 DATA VN(1,1),VN(2,1)/'EPSL','ON..'/ DATA VN(1,2),VN(2,2)/'PHMN','FC..'/ DATA VN(1,3),VN(2,3)/'PHMX','FC..'/ DATA VN(1,4),VN(2,4)/'DECF','AC..'/ DATA VN(1,5),VN(2,5)/'INCF','AC..'/ DATA VN(1,6),VN(2,6)/'RDFC','MN..'/ DATA VN(1,7),VN(2,7)/'RDFC','MX..'/ DATA VN(1,8),VN(2,8)/'TUNE','R1..'/ DATA VN(1,9),VN(2,9)/'TUNE','R2..'/ DATA VN(1,10),VN(2,10)/'TUNE','R3..'/ DATA VN(1,11),VN(2,11)/'TUNE','R4..'/ DATA VN(1,12),VN(2,12)/'TUNE','R5..'/ DATA VN(1,13),VN(2,13)/'AFCT','OL..'/ DATA VN(1,14),VN(2,14)/'RFCT','OL..'/ DATA VN(1,15),VN(2,15)/'XCTO','L...'/ DATA VN(1,16),VN(2,16)/'XFTO','L...'/ DATA VN(1,17),VN(2,17)/'LMAX','0...'/ DATA VN(1,18),VN(2,18)/'LMAX','S...'/ DATA VN(1,19),VN(2,19)/'SCTO','L...'/ DATA VN(1,20),VN(2,20)/'DINI','T...'/ DATA VN(1,21),VN(2,21)/'DTIN','IT..'/ DATA VN(1,22),VN(2,22)/'D0IN','IT..'/ DATA VN(1,23),VN(2,23)/'DFAC','....'/ DATA VN(1,24),VN(2,24)/'DLTF','DC..'/ DATA VN(1,25),VN(2,25)/'DLTF','DJ..'/ DATA VN(1,26),VN(2,26)/'DELT','A0..'/ DATA VN(1,27),VN(2,27)/'FUZZ','....'/ DATA VN(1,28),VN(2,28)/'RLIM','IT..'/ DATA VN(1,29),VN(2,29)/'COSM','IN..'/ DATA VN(1,30),VN(2,30)/'HUBE','RC..'/ DATA VN(1,31),VN(2,31)/'RSPT','OL..'/ DATA VN(1,32),VN(2,32)/'SIGM','IN..'/ DATA VN(1,33),VN(2,33)/'ETA0','....'/ DATA VN(1,34),VN(2,34)/'BIAS','....'/ C/ C DATA VM(1)/1.0D-3/, VM(2)/-0.99D+0/, VM(3)/1.0D-3/, VM(4)/1.0D-2/, 1 VM(5)/1.2D+0/, VM(6)/1.D-2/, VM(7)/1.2D+0/, VM(8)/0.D+0/, 2 VM(9)/0.D+0/, VM(10)/1.D-3/, VM(11)/-1.D+0/, VM(15)/0.D+0/, 3 VM(16)/0.D+0/, VM(19)/0.D+0/, VM(20)/-10.D+0/, VM(21)/0.D+0/, 4 VM(22)/0.D+0/, VM(23)/0.D+0/, VM(27)/1.01D+0/, 5 VM(28)/1.D+10/, VM(30)/0.D+0/, VM(31)/0.D+0/, VM(32)/0.D+0/, 6 VM(34)/0.D+0/ DATA VX(1)/0.9D+0/, VX(2)/-1.D-3/, VX(3)/1.D+1/, VX(4)/0.8D+0/, 1 VX(5)/1.D+2/, VX(6)/0.8D+0/, VX(7)/1.D+2/, VX(8)/0.5D+0/, 2 VX(9)/0.5D+0/, VX(10)/1.D+0/, VX(11)/1.D+0/, VX(14)/0.1D+0/, 3 VX(15)/1.D+0/, VX(16)/1.D+0/, VX(19)/1.D+0/, VX(23)/1.D+0/, 4 VX(24)/1.D+0/, VX(25)/1.D+0/, VX(26)/1.D+0/, VX(27)/1.D+10/, 5 VX(29)/1.D+0/, VX(31)/1.D+0/, VX(32)/1.D+0/, VX(33)/1.D+0/, 6 VX(34)/1.D+0/ C C/6 C DATA VARNM(1)/1HP/, VARNM(2)/1HN/, SH(1)/1HS/, SH(2)/1HH/ C DATA CNGD(1),CNGD(2),CNGD(3)/4H---C,4HHANG,4HED V/, C 1 DFLT(1),DFLT(2),DFLT(3)/4HNOND,4HEFAU,4HLT V/ C/7 DATA VARNM(1)/'P'/, VARNM(2)/'N'/, SH(1)/'S'/, SH(2)/'H'/ DATA CNGD(1),CNGD(2),CNGD(3)/'---C','HANG','ED V'/, 1 DFLT(1),DFLT(2),DFLT(3)/'NOND','EFAU','LT V'/ C/ DATA IJMP/33/, JLIM(1)/0/, JLIM(2)/24/, NDFLT(1)/32/, NDFLT(2)/25/ DATA MINIV(1)/80/, MINIV(2)/59/ C C............................... BODY ................................ C IF (ALG .LT. 1 .OR. ALG .GT. 2) GO TO 330 IF (IV(1) .EQ. 0) CALL DDEFLT(ALG, IV, LIV, LV, V) PU = IV(PRUNIT) MIV1 = MINIV(ALG) IF (PERM .LE. LIV) MIV1 = MAX0(MIV1, IV(PERM) - 1) IF (IVNEED .LE. LIV) MIV2 = MIV1 + MAX0(IV(IVNEED), 0) IF (LASTIV .LE. LIV) IV(LASTIV) = MIV2 IF (LIV .LT. MIV1) GO TO 290 IV(IVNEED) = 0 IV(LASTV) = MAX0(IV(VNEED), 0) + IV(LMAT) - 1 IF (LIV .LT. MIV2) GO TO 290 IF (LV .LT. IV(LASTV)) GO TO 310 IV(VNEED) = 0 IF (ALG .EQ. IV(ALGSAV)) GO TO 20 c IF (PU .NE. 0) WRITE(PU,10) ALG, IV(ALGSAV) c 10 FORMAT(/' THE FIRST PARAMETER TO DDEFLT SHOULD BE',I3, c 1 12H RATHER THAN,I3) IV(1) = 82 RETURN 20 IV1 = IV(1) IF (IV1 .LT. 12 .OR. IV1 .GT. 14) GO TO 50 IF (N .GE. 1) GO TO 40 IV(1) = 81 IF (PU .EQ. 0) RETURN c WRITE(PU,30) VARNM(ALG), N c 30 FORMAT(/8H /// BAD,A1,2H =,I5) RETURN 40 IF (IV1 .NE. 14) IV(NEXTIV) = IV(PERM) IF (IV1 .NE. 14) IV(NEXTV) = IV(LMAT) IF (IV1 .EQ. 13) RETURN K = IV(PARSAV) - EPSLON CALL DVDFLT(ALG, LV-K, V(K+1)) IV(DTYPE0) = 2 - ALG IV(OLDN) = N WHICH(1) = DFLT(1) WHICH(2) = DFLT(2) WHICH(3) = DFLT(3) GO TO 100 50 IF (N .EQ. IV(OLDN)) GO TO 70 IV(1) = 17 IF (PU .EQ. 0) RETURN c WRITE(PU,60) VARNM(ALG), IV(OLDN), N c 60 FORMAT(/5H /// ,1A1,14H CHANGED FROM ,I5,4H TO ,I5) RETURN C 70 IF (IV1 .LE. 11 .AND. IV1 .GE. 1) GO TO 90 IV(1) = 80 c IF (PU .NE. 0) WRITE(PU,80) IV1 c 80 FORMAT(/13H /// IV(1) =,I5,28H SHOULD BE BETWEEN 0 AND 14.) RETURN C 90 WHICH(1) = CNGD(1) WHICH(2) = CNGD(2) WHICH(3) = CNGD(3) C 100 IF (IV1 .EQ. 14) IV1 = 12 IF (BIG .GT. TINY) GO TO 110 TINY = D1MACH(1) MACHEP = D1MACH(4) BIG = D1MACH(2) VM(12) = MACHEP VX(12) = BIG VM(13) = TINY VX(13) = BIG VM(14) = MACHEP VM(17) = TINY VX(17) = BIG VM(18) = TINY VX(18) = BIG VX(20) = BIG VX(21) = BIG VX(22) = BIG VM(24) = MACHEP VM(25) = MACHEP VM(26) = MACHEP VX(28) = DSQRT(D1MACH(2))*16. VM(29) = MACHEP VX(30) = BIG VM(33) = MACHEP 110 M = 0 I = 1 J = JLIM(ALG) K = EPSLON NDFALT = NDFLT(ALG) DO L = 1, NDFALT VK = V(K) IF (VK .GE. VM(I) .AND. VK .LE. VX(I)) GO TO 130 M = K c IF (PU .NE. 0) WRITE(PU,120) VN(1,I), VN(2,I), K, VK, c 1 VM(I), VX(I) c 120 FORMAT(/6H /// ,2A4,5H.. V(,I2,3H) =,D11.3,7H SHOULD, c 1 11H BE BETWEEN,D11.3,4H AND,D11.3) 130 K = K + 1 I = I + 1 IF (I .EQ. J) I = IJMP END DO C IF (IV(NVDFLT) .EQ. NDFALT) GO TO 160 IV(1) = 51 IF (PU .EQ. 0) RETURN c WRITE(PU,150) IV(NVDFLT), NDFALT c 150 FORMAT(/13H IV(NVDFLT) =,I5,13H RATHER THAN ,I5) RETURN 160 IF ((IV(DTYPE) .GT. 0 .OR. V(DINIT) .GT. ZERO) .AND. IV1 .EQ. 12) 1 GO TO 190 DO I = 1, N IF (D(I) .GT. ZERO) EXIT M = 18 c IF (PU .NE. 0) WRITE(PU,170) I, D(I) c 170 FORMAT(/8H /// D(,I3,3H) =,D11.3,19H SHOULD BE POSITIVE) END DO 190 IF (M .EQ. 0) GO TO 200 IV(1) = M RETURN C 200 IF (PU .EQ. 0 .OR. IV(PARPRT) .EQ. 0) RETURN IF (IV1 .NE. 12 .OR. IV(INITS) .EQ. ALG-1) GO TO 220 M = 1 c WRITE(PU,210) SH(ALG), IV(INITS) c 210 FORMAT(/22H NONDEFAULT VALUES..../5H INIT,A1,14H..... IV(25) =, c 1 I3) 220 IF (IV(DTYPE) .EQ. IV(DTYPE0)) GO TO 240 c IF (M .EQ. 0) WRITE(PU,250) WHICH M = 1 c WRITE(PU,230) IV(DTYPE) c 230 FORMAT(20H DTYPE..... IV(16) =,I3) 240 I = 1 J = JLIM(ALG) K = EPSLON L = IV(PARSAV) NDFALT = NDFLT(ALG) DO II = 1, NDFALT IF (V(K) .EQ. V(L)) GO TO 270 c IF (M .EQ. 0) WRITE(PU,250) WHICH c 250 FORMAT(/1H ,3A4,9HALUES..../) M = 1 c WRITE(PU,260) VN(1,I), VN(2,I), K, V(K) c 260 FORMAT(1X,2A4,5H.. V(,I2,3H) =,D15.7) 270 K = K + 1 L = L + 1 I = I + 1 IF (I .EQ. J) I = IJMP END DO C IV(DTYPE0) = IV(DTYPE) PARSV1 = IV(PARSAV) CALL DCOPY(IV(NVDFLT), V(EPSLON),1,V(PARSV1),1) RETURN C 290 IV(1) = 15 IF (PU .EQ. 0) RETURN c WRITE(PU,300) LIV, MIV2 c 300 FORMAT(/10H /// LIV =,I5,17H MUST BE AT LEAST,I5) IF (LIV .LT. MIV1) RETURN IF (LV .LT. IV(LASTV)) GO TO 310 RETURN C 310 IV(1) = 16 IF (PU .EQ. 0) RETURN c WRITE(PU,320) LV, IV(LASTV) c 320 FORMAT(/9H /// LV =,I5,17H MUST BE AT LEAST,I5) RETURN C 330 IV(1) = 67 C RETURN C *** LAST CARD OF DPARCK FOLLOWS *** END DOUBLE PRECISION FUNCTION DRELST(P, D, X, X0) save C C *** COMPUTE AND RETURN RELATIVE DIFFERENCE BETWEEN X AND X0 *** C *** NL2SOL VERSION 2.2 *** C INTEGER P DOUBLE PRECISION D(P), X(P), X0(P) C/+ DOUBLE PRECISION DABS C/ INTEGER I DOUBLE PRECISION EMAX, T, XMAX, ZERO C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ZERO=0.D+0) C/ C EMAX = ZERO XMAX = ZERO DO I = 1, P T = DABS(D(I) * (X(I) - X0(I))) IF (EMAX .LT. T) EMAX = T T = D(I) * (DABS(X(I)) + DABS(X0(I))) IF (XMAX .LT. T) XMAX = T END DO DRELST = ZERO IF (XMAX .GT. ZERO) DRELST = EMAX / XMAX RETURN C *** LAST CARD OF DRELST FOLLOWS *** END LOGICAL FUNCTION DSTOPX() save C *****PARAMETERS... c INTEGER IDUMMY C C .................................................................. C C *****PURPOSE... C THIS FUNCTION MAY SERVE AS THE DSTOPX (ASYNCHRONOUS INTERRUPTION) C FUNCTION FOR THE NL2SOL (NONLINEAR LEAST-SQUARES) PACKAGE AT C THOSE INSTALLATIONS WHICH DO NOT WISH TO IMPLEMENT A C DYNAMIC DSTOPX. C C *****ALGORITHM NOTES... C AT INSTALLATIONS WHERE THE NL2SOL SYSTEM IS USED C INTERACTIVELY, THIS DUMMY DSTOPX SHOULD BE REPLACED BY A C FUNCTION THAT RETURNS .TRUE. IF AND ONLY IF THE INTERRUPT C (BREAK) KEY HAS BEEN PRESSED SINCE THE LAST CALL ON DSTOPX. C C .................................................................. C DSTOPX = .FALSE. RETURN END SUBROUTINE DSMSNO(N, D, X, CALCF, IV, LIV, LV, V, 1 UIPARM, URPARM, UFPARM) save C C *** MINIMIZE GENERAL UNCONSTRAINED OBJECTIVE FUNCTION USING C *** FINITE-DIFFERENCE GRADIENTS AND SECANT HESSIAN APPROXIMATIONS. C INTEGER N, LIV, LV INTEGER IV(LIV), UIPARM(*) DOUBLE PRECISION D(N), X(N), V(LV), URPARM(*) C DIMENSION V(77 + N*(N+17)/2), UIPARM(*), URPARM(*) EXTERNAL CALCF, UFPARM C C *** PURPOSE *** C C THIS ROUTINE INTERACTS WITH SUBROUTINE DSNOIT IN AN ATTEMPT C TO FIND AN N-VECTOR X* THAT MINIMIZES THE (UNCONSTRAINED) C OBJECTIVE FUNCTION COMPUTED BY CALCF. (OFTEN THE X* FOUND IS C A LOCAL MINIMIZER RATHER THAN A GLOBAL ONE.) C C *** PARAMETERS *** C C THE PARAMETERS FOR DSMSNO ARE THE SAME AS THOSE FOR DSUMSL C (WHICH SEE), EXCEPT THAT CALCG IS OMITTED. INSTEAD OF CALLING C CALCG TO OBTAIN THE GRADIENT OF THE OBJECTIVE FUNCTION AT X, C DSMSNO CALLS DSGRD2, WHICH COMPUTES AN APPROXIMATION TO THE C GRADIENT BY FINITE (FORWARD AND CENTRAL) DIFFERENCES USING THE C METHOD OF REF. 1. THE FOLLOWING INPUT COMPONENT IS OF INTEREST C IN THIS REGARD (AND IS NOT DESCRIBED IN DSUMSL). C C V(ETA0)..... V(42) IS AN ESTIMATED BOUND ON THE RELATIVE ERROR IN THE C OBJECTIVE FUNCTION VALUE COMPUTED BY CALCF... C (TRUE VALUE) = (COMPUTED VALUE) * (1 + E), C WHERE ABS(E) .LE. V(ETA0). DEFAULT = MACHEP * 10**3, C WHERE MACHEP IS THE UNIT ROUNDOFF. C C THE OUTPUT VALUES IV(NFCALL) AND IV(NGCALL) HAVE DIFFERENT C MEANINGS FOR DSMSNO THAN FOR DSUMSL... C C IV(NFCALL)... IV(6) IS THE NUMBER OF CALLS SO FAR MADE ON CALCF (I.E., C FUNCTION EVALUATIONS) EXCLUDING THOSE MADE ONLY FOR C COMPUTING GRADIENTS. THE INPUT VALUE IV(MXFCAL) IS A C LIMIT ON IV(NFCALL). C IV(NGCALL)... IV(30) IS THE NUMBER OF FUNCTION EVALUATIONS MADE ONLY C FOR COMPUTING GRADIENTS. THE TOTAL NUMBER OF FUNCTION C EVALUATIONS IS THUS IV(NFCALL) + IV(NGCALL). C C *** REFERENCES *** C C 1. STEWART, G.W. (1967), A MODIFICATION OF DAVIDON*S MINIMIZATION C METHOD TO ACCEPT DIFFERENCE APPROXIMATIONS OF DERIVATIVES, C J. ASSOC. COMPUT. MACH. 14, PP. 72-83. C. C *** GENERAL *** C C CODED BY DAVID M. GAY (WINTER 1980). REVISED SEPT. 1982. C THIS SUBROUTINE WAS WRITTEN IN CONNECTION WITH RESEARCH C SUPPORTED IN PART BY THE NATIONAL SCIENCE FOUNDATION UNDER C GRANTS MCS-7600324, DCR75-10143, 76-14311DSS, MCS76-11989, C AND MCS-7906671. C C C---------------------------- DECLARATIONS --------------------------- C EXTERNAL DSNOIT C C DSNOIT.... OVERSEES COMPUTATION OF FINITE-DIFFERENCE GRADIENT AND C CALLS DSUMIT TO CARRY OUT DSUMSL ALGORITHM. C INTEGER NF DOUBLE PRECISION FX C C *** SUBSCRIPTS FOR IV *** C INTEGER NFCALL, TOOBIG C C/6 C DATA NFCALL/6/, TOOBIG/2/ C/7 PARAMETER (NFCALL=6, TOOBIG=2) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C 10 CALL DSNOIT(D, FX, IV, LIV, LV, N, V, X) IF (IV(1) .GT. 2) RETURN C C *** COMPUTE FUNCTION *** C NF = IV(NFCALL) CALL CALCF(N, X, NF, FX, UIPARM, URPARM, UFPARM) IF (NF .LE. 0) IV(TOOBIG) = 1 GO TO 10 C C RETURN C *** LAST CARD OF DSMSNO FOLLOWS *** END SUBROUTINE DSNOIT(D, FX, IV, LIV, LV, N, V, X) save C C *** ITERATION DRIVER FOR DSMSNO... C *** MINIMIZE GENERAL UNCONSTRAINED OBJECTIVE FUNCTION USING C *** FINITE-DIFFERENCE GRADIENTS AND SECANT HESSIAN APPROXIMATIONS. C INTEGER LIV, LV, N INTEGER IV(LIV) DOUBLE PRECISION D(N), FX, X(N), V(LV) C DIMENSION V(77 + N*(N+17)/2) C C *** PURPOSE *** C C THIS ROUTINE INTERACTS WITH SUBROUTINE DSUMIT IN AN ATTEMPT C TO FIND AN N-VECTOR X* THAT MINIMIZES THE (UNCONSTRAINED) C OBJECTIVE FUNCTION FX = F(X) COMPUTED BY THE CALLER. (OFTEN C THE X* FOUND IS A LOCAL MINIMIZER RATHER THAN A GLOBAL ONE.) C C *** PARAMETERS *** C C THE PARAMETERS FOR DSNOIT ARE THE SAME AS THOSE FOR DSUMSL C (WHICH SEE), EXCEPT THAT CALCF, CALCG, UIPARM, URPARM, AND UFPARM C ARE OMITTED, AND A PARAMETER FX FOR THE OBJECTIVE FUNCTION C VALUE AT X IS ADDED. INSTEAD OF CALLING CALCG TO OBTAIN THE C GRADIENT OF THE OBJECTIVE FUNCTION AT X, DSNOIT CALLS DSGRD2, C WHICH COMPUTES AN APPROXIMATION TO THE GRADIENT BY FINITE C (FORWARD AND CENTRAL) DIFFERENCES USING THE METHOD OF REF. 1. C THE FOLLOWING INPUT COMPONENT IS OF INTEREST IN THIS REGARD C (AND IS NOT DESCRIBED IN DSUMSL). C C V(ETA0)..... V(42) IS AN ESTIMATED BOUND ON THE RELATIVE ERROR IN THE C OBJECTIVE FUNCTION VALUE COMPUTED BY CALCF... C (TRUE VALUE) = (COMPUTED VALUE) * (1 + E), C WHERE ABS(E) .LE. V(ETA0). DEFAULT = MACHEP * 10**3, C WHERE MACHEP IS THE UNIT ROUNDOFF. C C THE OUTPUT VALUES IV(NFCALL) AND IV(NGCALL) HAVE DIFFERENT C MEANINGS FOR DSMSNO THAN FOR DSUMSL... C C IV(NFCALL)... IV(6) IS THE NUMBER OF CALLS SO FAR MADE ON CALCF (I.E., C FUNCTION EVALUATIONS) EXCLUDING THOSE MADE ONLY FOR C COMPUTING GRADIENTS. THE INPUT VALUE IV(MXFCAL) IS A C LIMIT ON IV(NFCALL). C IV(NGCALL)... IV(30) IS THE NUMBER OF FUNCTION EVALUATIONS MADE ONLY C FOR COMPUTING GRADIENTS. THE TOTAL NUMBER OF FUNCTION C EVALUATIONS IS THUS IV(NFCALL) + IV(NGCALL). C C *** REFERENCES *** C C 1. STEWART, G.W. (1967), A MODIFICATION OF DAVIDON*S MINIMIZATION C METHOD TO ACCEPT DIFFERENCE APPROXIMATIONS OF DERIVATIVES, C J. ASSOC. COMPUT. MACH. 14, PP. 72-83. C. C *** GENERAL *** C C CODED BY DAVID M. GAY (AUGUST 1982). C C---------------------------- DECLARATIONS --------------------------- C EXTERNAL DDEFLT, DSGRD2, DSUMIT, DVSCPY DOUBLE PRECISION DDOT C C DDEFLT.... SUPPLIES DEFAULT PARAMETER VALUES. C DSGRD2... COMPUTES FINITE-DIFFERENCE GRADIENT APPROXIMATION. C DSUMIT.... REVERSE-COMMUNICATION ROUTINE THAT DOES DSUMSL ALGORITHM. C DVSCPY... SETS ALL ELEMENTS OF A VECTOR TO A SCALAR. C INTEGER ALPHA, G1, I, IV1, J, K, W DOUBLE PRECISION ZERO C C *** SUBSCRIPTS FOR IV *** C INTEGER ETA0, F, G, LMAT, NEXTV, NFGCAL, NGCALL, 1 NITER, SGIRC, TOOBIG, VNEED C C/6 C DATA ETA0/42/, F/10/, G/28/, LMAT/42/, NEXTV/47/, C 1 NFGCAL/7/, NGCALL/30/, NITER/31/, SGIRC/57/, C 2 TOOBIG/2/, VNEED/4/ C/7 PARAMETER (DTYPE=16, ETA0=42, F=10, G=28, LMAT=42, NEXTV=47, 1 NFCALL=6, NFGCAL=7, NGCALL=30, NITER=31, SGIRC=57, 2 TOOBIG=2, VNEED=4) C/ C/6 C DATA ZERO/0.D+0/ C/7 PARAMETER (ONE=1.D+0, ZERO=0.D+0) C/ C C+++++++++++++++++++++++++++++++ BODY ++++++++++++++++++++++++++++++++ C IV1 = IV(1) IF (IV1 .EQ. 1) GO TO 10 IF (IV1 .EQ. 2) GO TO 50 IF (IV(1) .EQ. 0) CALL DDEFLT(2, IV, LIV, LV, V) IV(VNEED) = IV(VNEED) + 2*N + 6 IV1 = IV(1) IF (IV1 .EQ. 14) GO TO 10 IF (IV1 .GT. 2 .AND. IV1 .LT. 12) GO TO 10 G1 = 1 IF (IV1 .EQ. 12) IV(1) = 13 GO TO 20 C 10 G1 = IV(G) C 20 CALL DSUMIT(D, FX, V(G1), IV, LIV, LV, N, V, X) c IF (IV(1) - 2) , 30, 70 IF (IV(1) .LT. 2) RETURN IF (IV(1) .GT. 2) GO TO 70 C C *** COMPUTE GRADIENT *** C IF (IV(NITER) .EQ. 0) CALL DVSCPY(N, V(G1), ZERO) J = IV(LMAT) K = G1 - N DO I = 1, N V(K) = DDOT(I, V(J),1,V(J),1) K = K + 1 J = J + I END DO C *** UNDO INCREMENT OF IV(NGCALL) DONE BY DSUMIT *** IV(NGCALL) = IV(NGCALL) - 1 C *** STORE RETURN CODE FROM DSGRD2 IN IV(SGIRC) *** IV(SGIRC) = 0 C *** X MAY HAVE BEEN RESTORED, SO COPY BACK FX... *** FX = V(F) GO TO 60 C C *** GRADIENT LOOP *** C 50 IF (IV(TOOBIG) .EQ. 0) GO TO 60 IV(NFGCAL) = 0 GO TO 10 C 60 G1 = IV(G) ALPHA = G1 - N W = ALPHA - 6 CALL DSGRD2(V(ALPHA), D, V(ETA0), FX, V(G1), IV(SGIRC), N, V(W),X) IF (IV(SGIRC) .EQ. 0) GO TO 10 IV(NGCALL) = IV(NGCALL) + 1 RETURN C 70 IF (IV(1) .NE. 14) RETURN C C *** STORAGE ALLOCATION *** C IV(G) = IV(NEXTV) + N + 6 IV(NEXTV) = IV(G) + N IF (IV1 .NE. 13) GO TO 10 C RETURN C *** LAST CARD OF DSNOIT FOLLOWS *** END SUBROUTINE DSGRD2 (ALPHA, D, ETA0, FX, G, IRC, N, W, X) save C C *** COMPUTE FINITE DIFFERENCE GRADIENT BY STWEART*S SCHEME *** C C *** PARAMETERS *** C INTEGER IRC, N DOUBLE PRECISION ALPHA(N), D(N), ETA0, FX, G(N), W(6), X(N) C C....................................................................... C C *** PURPOSE *** C C THIS SUBROUTINE USES AN EMBELLISHED FORM OF THE FINITE-DIFFER- C ENCE SCHEME PROPOSED BY STEWART (REF. 1) TO APPROXIMATE THE C GRADIENT OF THE FUNCTION F(X), WHOSE VALUES ARE SUPPLIED BY C REVERSE COMMUNICATION. C C *** PARAMETER DESCRIPTION *** C C ALPHA IN (APPROXIMATE) DIAGONAL ELEMENTS OF THE HESSIAN OF F(X). C D IN SCALE VECTOR SUCH THAT D(I)*X(I), I = 1,...,N, ARE IN C COMPARABLE UNITS. C ETA0 IN ESTIMATED BOUND ON RELATIVE ERROR IN THE FUNCTION VALUE... C (TRUE VALUE) = (COMPUTED VALUE)*(1+E), WHERE C ABS(E) .LE. ETA0. C FX I/O ON INPUT, FX MUST BE THE COMPUTED VALUE OF F(X). ON C OUTPUT WITH IRC = 0, FX HAS BEEN RESTORED TO ITS ORIGINAL C VALUE, THE ONE IT HAD WHEN DSGRD2 WAS LAST CALLED WITH C IRC = 0. C G I/O ON INPUT WITH IRC = 0, G SHOULD CONTAIN AN APPROXIMATION C TO THE GRADIENT OF F NEAR X, E.G., THE GRADIENT AT THE C PREVIOUS ITERATE. WHEN DSGRD2 RETURNS WITH IRC = 0, G IS C THE DESIRED FINITE-DIFFERENCE APPROXIMATION TO THE C GRADIENT AT X. C IRC I/O INPUT/RETURN CODE... BEFORE THE VERY FIRST CALL ON DSGRD2, C THE CALLER MUST SET IRC TO 0. WHENEVER DSGRD2 RETURNS A C NONZERO VALUE FOR IRC, IT HAS PERTURBED SOME COMPONENT OF C X... THE CALLER SHOULD EVALUATE F(X) AND CALL DSGRD2 C AGAIN WITH FX = F(X). C N IN THE NUMBER OF VARIABLES (COMPONENTS OF X) ON WHICH F C DEPENDS. C X I/O ON INPUT WITH IRC = 0, X IS THE POINT AT WHICH THE C GRADIENT OF F IS DESIRED. ON OUTPUT WITH IRC NONZERO, X C IS THE POINT AT WHICH F SHOULD BE EVALUATED. ON OUTPUT C WITH IRC = 0, X HAS BEEN RESTORED TO ITS ORIGINAL VALUE C (THE ONE IT HAD WHEN DSGRD2 WAS LAST CALLED WITH IRC = 0) C AND G CONTAINS THE DESIRED GRADIENT APPROXIMATION. C W I/O WORK VECTOR OF LENGTH 6 IN WHICH DSGRD2 SAVES CERTAIN C QUANTITIES WHILE THE CALLER IS EVALUATING F(X) AT A C PERTURBED X. C C *** APPLICATION AND USAGE RESTRICTIONS *** C C THIS ROUTINE IS INTENDED FOR USE WITH QUASI-NEWTON ROUTINES C FOR UNCONSTRAINED MINIMIZATION (IN WHICH CASE ALPHA COMES FROM C THE DIAGONAL OF THE QUASI-NEWTON HESSIAN APPROXIMATION). C C *** ALGORITHM NOTES *** C C THIS CODE DEPARTS FROM THE SCHEME PROPOSED BY STEWART (REF. 1) C IN ITS GUARDING AGAINST OVERLY LARGE OR SMALL STEP SIZES AND ITS C HANDLING OF SPECIAL CASES (SUCH AS ZERO COMPONENTS OF ALPHA OR G). C C *** REFERENCES *** C C 1. STEWART, G.W. (1967), A MODIFICATION OF DAVIDON*S MINIMIZATION C METHOD TO ACCEPT DIFFERENCE APPROXIMATIONS OF DERIVATIVES, C J. ASSOC. COMPUT. MACH. 14, PP. 72-83. C C *** HISTORY *** C C DESIGNED AND CODED BY DAVID M. GAY (SUMMER 1977/SUMMER 1980). C C *** GENERAL *** C C THIS ROUTINE WAS PREPARED IN CONNECTION WITH WORK SUPPORTED BY C THE NATIONAL SCIENCE FOUNDATION UNDER GRANTS MCS76-00324 AND C MCS-7906671. C C....................................................................... C C ***** EXTERNAL FUNCTION ***** C DOUBLE PRECISION D1MACH C C ***** INTRINSIC FUNCTIONS ***** C/+ INTEGER IABS DOUBLE PRECISION DABS, DMAX1, DSQRT C/ C ***** LOCAL VARIABLES ***** C INTEGER FH, FX0, HSAVE, I, XISAVE DOUBLE PRECISION AAI, AFX, AFXETA, AGI, ALPHAI, AXI, AXIBAR, 1 DISCON, ETA, GI, H, HMIN DOUBLE PRECISION C2000, FOUR, HMAX0, HMIN0, H0, MACHEP, ONE, P002, 1 THREE, TWO, ZERO C C/6 C DATA C2000/2.0D+3/, FOUR/4.0D+0/, HMAX0/0.02D+0/, HMIN0/5.0D+1/, C 1 ONE/1.0D+0/, P002/0.002D+0/, THREE/3.0D+0/, C 2 TWO/2.0D+0/, ZERO/0.0D+0/ C/7 PARAMETER (C2000=2.0D+3, FOUR=4.0D+0, HMAX0=0.02D+0, HMIN0=5.0D+1, 1 ONE=1.0D+0, P002=0.002D+0, THREE=3.0D+0, 2 TWO=2.0D+0, ZERO=0.0D+0) C/ C/6 C DATA FH/3/, FX0/4/, HSAVE/5/, XISAVE/6/ C/7 PARAMETER (FH=3, FX0=4, HSAVE=5, XISAVE=6) C/ C C--------------------------------- BODY ------------------------------ C c IF (IRC) 140, 100, 210 IF (IRC .LT. 0) GO TO 140 IF (IRC .GT. 0) GO TO 210 C C *** FRESH START -- GET MACHINE-DEPENDENT CONSTANTS *** C C STORE MACHEP IN W(1) AND H0 IN W(2), WHERE MACHEP IS THE UNIT C ROUNDOFF (THE SMALLEST POSITIVE NUMBER SUCH THAT C 1 + MACHEP .GT. 1 AND 1 - MACHEP .LT. 1), AND H0 IS THE C SQUARE-ROOT OF MACHEP. C W(1) = D1MACH(4) W(2) = DSQRT(W(1)) C W(FX0) = FX C C *** INCREMENT I AND START COMPUTING G(I) *** C 110 I = IABS(IRC) + 1 IF (I .GT. N) GO TO 300 IRC = I AFX = DABS(W(FX0)) MACHEP = W(1) H0 = W(2) HMIN = HMIN0 * MACHEP W(XISAVE) = X(I) AXI = DABS(X(I)) AXIBAR = DMAX1(AXI, ONE/D(I)) GI = G(I) AGI = DABS(GI) ETA = DABS(ETA0) IF (AFX .GT. ZERO) ETA = DMAX1(ETA, AGI*AXI*MACHEP/AFX) ALPHAI = ALPHA(I) IF (ALPHAI .EQ. ZERO) GO TO 170 IF (GI .EQ. ZERO .OR. FX .EQ. ZERO) GO TO 180 AFXETA = AFX*ETA AAI = DABS(ALPHAI) C C *** COMPUTE H = STEWART*S FORWARD-DIFFERENCE STEP SIZE. C IF (GI**2 .LE. AFXETA*AAI) GO TO 120 H = TWO*DSQRT(AFXETA/AAI) H = H*(ONE - AAI*H/(THREE*AAI*H + FOUR*AGI)) GO TO 130 120 H = TWO*(AFXETA*AGI/(AAI**2))**(ONE/THREE) H = H*(ONE - TWO*AGI/(THREE*AAI*H + FOUR*AGI)) C C *** ENSURE THAT H IS NOT INSIGNIFICANTLY SMALL *** C 130 H = DMAX1(H, HMIN*AXIBAR) C C *** USE FORWARD DIFFERENCE IF BOUND ON TRUNCATION ERROR IS AT C *** MOST 10**-3. C IF (AAI*H .LE. P002*AGI) GO TO 160 C C *** COMPUTE H = STEWART*S STEP FOR CENTRAL DIFFERENCE. C DISCON = C2000*AFXETA H = DISCON/(AGI + DSQRT(GI**2 + AAI*DISCON)) C C *** ENSURE THAT H IS NEITHER TOO SMALL NOR TOO BIG *** C H = DMAX1(H, HMIN*AXIBAR) IF (H .GE. HMAX0*AXIBAR) H = AXIBAR * H0**(TWO/THREE) C C *** COMPUTE CENTRAL DIFFERENCE *** C IRC = -I GO TO 200 C 140 H = -W(HSAVE) I = IABS(IRC) IF (H .GT. ZERO) GO TO 150 W(FH) = FX GO TO 200 C 150 G(I) = (W(FH) - FX) / (TWO * H) X(I) = W(XISAVE) GO TO 110 C C *** COMPUTE FORWARD DIFFERENCES IN VARIOUS CASES *** C 160 IF (H .GE. HMAX0*AXIBAR) H = H0 * AXIBAR IF (ALPHAI*GI .LT. ZERO) H = -H GO TO 200 170 H = AXIBAR GO TO 200 180 H = H0 * AXIBAR C 200 X(I) = W(XISAVE) + H W(HSAVE) = H RETURN C C *** COMPUTE ACTUAL FORWARD DIFFERENCE *** C 210 G(IRC) = (FX - W(FX0)) / W(HSAVE) X(IRC) = W(XISAVE) GO TO 110 C C *** RESTORE FX AND INDICATE THAT G HAS BEEN COMPUTED *** C 300 FX = W(FX0) IRC = 0 C RETURN C *** LAST CARD OF DSGRD2 FOLLOWS *** END tseries/src/formats.c0000755000175100001440000000644613475670275014411 0ustar hornikusers#include #include void cnlprt_C(char *msg, int *plen) { char buf[1000]; int len = *plen; memmove(buf, msg, len); buf[len] = '\0'; Rprintf("\n%s\n", buf); } /* 30 FORMAT(/10H IT NF,6X,1HF,7X,5HRELDF,3X,6HPRELDF,3X,5HRELDX, 1 2X,13HMODEL STPPAR) */ void F77_SUB(h30)(void) { Rprintf("\n IT NF F RELDF PRELDF RELDX MODEL STPPAR\n"); } /* 40 FORMAT(/11H IT NF,7X,1HF,8X,5HRELDF,4X,6HPRELDF,4X,5HRELDX, 1 3X,6HSTPPAR) */ void F77_SUB(h40)(void) { Rprintf("\n IT NF F RELDF PRELDF RELDX STPPAR"); } /* 70 FORMAT(/11H IT NF,6X,1HF,7X,5HRELDF,3X,6HPRELDF,3X,5HRELDX, 1 2X,13HMODEL STPPAR,2X,6HD*STEP,2X,7HNPRELDF) */ void F77_SUB(h70)(void) { Rprintf("\n IT NF F RELDF PRELDF RELDX MODEL STPPAR"); Rprintf(" D*STEP NPRELDF\n"); } /* 80 FORMAT(/11H IT NF,7X,1HF,8X,5HRELDF,4X,6HPRELDF,4X,5HRELDX, 1 3X,6HSTPPAR,3X,6HD*STEP,3X,7HNPRELDF) */ void F77_SUB(h80)(void) { Rprintf("\n IT NF F RELDF PRELDF RELDX STPPAR"); Rprintf(" D*STEP NPRELDF\n"); } /* 100 FORMAT(I6,I5,D10.3,2D9.2,D8.1,A3,A4,2D8.1,D9.2) */ void h100s_C(int *i1, int *i2, double *d1, double *d2, double *d3, double *d4, char *a1, char *a2, double *d5) { Rprintf("%6d%5d%10.3e%9.2e%9.2e%8.1e%3s%4s%8.1e\n", *i1, *i2, *d1, *d2, *d3, *d4, a1, a2, *d5); } void h100l_C(int *i1, int *i2, double *d1, double *d2, double *d3, double *d4, char *a1, char *a2, double *d5, double *d6, double *d7) { Rprintf("%6d%5d%10.3e%9.2e%9.2e%8.1e%3s%4s%8.1e%8.1e%e9.2\n", *i1, *i2, *d1, *d2, *d3, *d4, a1, a2, *d5, *d6, *d7); } /* 110 FORMAT(I6,I5,D11.3,2D10.2,3D9.1,D10.2) */ void F77_SUB(h110s)(int *i1, int *i2, double *d1, double *d2, double *d3, double *d4, double *d5) { Rprintf("%6d%5d%11.3e%10.2e%10.2e%9.1e%9.1e\n", *i1, *i2, *d1, *d2, *d3, *d4, *d5); } void F77_SUB(h110l)(int *i1, int *i2, double *d1, double *d2, double *d3, double *d4, double *d5, double *d6, double *d7) { Rprintf("%6d%5d%11.3e%10.2e%10.2e%9.1e%9.1e%9.1e%10.2e\n", *i1, *i2, *d1, *d2, *d3, *d4, *d5, *d6, *d7); } void F77_SUB(h380)(int *i) { Rprintf(" ***** IV(1) =%i5 *****\n", *i); } void F77_SUB(h400)(int *p, double *x, double *d) { int i; Rprintf("\n I INITIAL X(I) D(I)\n\n"); for (i = 0; i < *p; i++) Rprintf(" %5i%17.6e%14.3e\n", i+1, x[i], d[i]); } void F77_SUB(h410)(double *x) { Rprintf(" 0 1%10.3e\n", *x); } void F77_SUB(h420)(double *x) { Rprintf(" 0 1%11.3e\n", *x); } void F77_SUB(h450)(double *d1, double *d2, int *i1, int *i2, double *d3, double *d4) { Rprintf("\n FUNCTION%17.6e RELDX%17.3e\n", *d1, *d2); Rprintf(" FUNC. EVALS%8i GRAD. EVALS%8u\n", *i1, *i2); Rprintf(" PRELDF%16.3e NPRELDF%15.3e\n", *d3, *d4); } void F77_SUB(h460)(int *i) { Rprintf("\n %4d EXTRA FUNC. EVALS FOR COVARIANCE AND DIAGNOSTICS\n", *i); } void F77_SUB(h470)(int *i) { Rprintf("\n %4d EXTRA GRAD. EVALS FOR COVARIANCE AND DIAGNOSTICS\n", *i); } void F77_SUB(h500)(int *p, double *x, double *d, double *g) { int i; Rprintf("\n"); for (i = 0; i < *p; i++) Rprintf(" %5i%16.6e%14.3e%14.3e\n", i+1, x[i], d[i], g[i]); } tseries/ChangeLog0000644000175100001440000005434014674232201013527 0ustar hornikusers2024-09-23 Kurt Hornik * DESCRIPTION: New version is 0.10-58. * src/dsumsl.f: * src/garch.c: Silence compilation warnings. By Brian Ripley. 2024-08-13 Kurt Hornik * DESCRIPTION: New version is 0.10-57. * src/bdstest.c: * src/garch.c: Use R_Calloc/R_Free instead of the long deprecated Calloc/Free. 2024-05-14 Kurt Hornik * DESCRIPTION: New version is 0.10-56. * src/dsumsl.f: Stop using Fortran 2018 deleted features. 2023-12-16 Kurt Hornik * DESCRIPTION (License): Change to GPL-2 or GPL-3. Suggestion by Arne Babenhauserheide. 2023-12-06 Kurt Hornik * DESCRIPTION: New version is 0.10-55. * R/test.R (kpss.test): Warn for essentially perfect linear fit. 2023-05-02 Kurt Hornik * DESCRIPTION: New version is 0.10-54. 2023-04-05 Kurt Hornik * R/arma.R: * R/test.R: Avoid partial argument matches. 2023-01-31 Kurt Hornik * DESCRIPTION: New version is 0.10-53. * inst/CITATION: Drop. 2022-10-07 Kurt Hornik * DESCRIPTION: New version is 0.10-52. * src/bdstest.c: * src/garch.c: Add missing prototypes. 2022-05-01 Kurt Hornik * DESCRIPTION: New version is 0.10-51. * man/get.hist.quote.Rd: Safeguard against problems accessing the Yahoo Finance web service. 2022-03-28 Kurt Hornik * DESCRIPTION: New version is 0.10-50. * R/finance.R (get.hist.quote): Safeguard against non-unique index entries. 2021-11-16 Kurt Hornik * DESCRIPTION: New version is 0.10-49. 2021-11-15 Kurt Hornik * R/garch.R: Tweaks. 2021-03-08 Kurt Hornik * R/finance.R: * R/test.R: * man/bds.test.Rd: * man/irts-functions.Rd: Avoid partial matching. 2020-12-04 Kurt Hornik * DESCRIPTION: New version is 0.10-48. * man/NelPlo.Rd: Update source info. 2020-03-09 Kurt Hornik * src/cfuncs.f90: Renamed from cfuncs.f95. 2019-06-05 Kurt Hornik * DESCRIPTION: New version is 0.10-47. * src/formats.c: * src/dsumsl.f: Use bind(C) for correctly passing character strings from Fortran to C. * src/cfuncs.f95: Added. 2018-11-18 Adrian Trapletti * DESCRIPTION (Version): New version is 0.10-46. * README: Update contributers. * R/test.R (kpss.test): * man/kpss.test.Rd: Change the truncation lag parameter formulas to the original formulas of KPSS. Spotted by M. Bruns and K. Nieradko. 2018-06-04 Kurt Hornik * DESCRIPTION: Improve Imports for cran2deb (spotted by DE). New version is 0.10-45. 2017-02-20 Kurt Hornik * DESCRIPTION: New version is 0.10-38. * R/*.R: * src/*c: Improve registration of native routines. 2017-01-17 Kurt Hornik * DESCRIPTION: New version is 0.10-37. * R/*.R: * src/*c: Register native routines. 2016-12-15 Kurt Hornik * DESCRIPTION: New version is 0.10-36. * R/finance.R (get.hist.quote): * man/get.hist.quote.Rd: Drop support for archived 'its' package. 2016-12-08 Kurt Hornik * inst/CITATION: Canonicalize CRAN URLs. 2016-05-02 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-35. * R/test.R: Data frames are not univariate time series. Spotted by szolaryb . 2016-04-28 Kurt Hornik * R/finance.R (get.hist.quote): * man/get.hist.quote.Rd: OANDA now needs https at least for URL connections. Spotted by Paul Gilbert . 2016-01-06 Kurt Hornik * inst/CITATION: Avoid personList(). 2015-02-20 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-34. * R/finance.R (get.hist.quote): Fix problems with new oanda format reported by Bert Tijhuis . 2015-02-10 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-33. * R/finance.R: Change get.hist.quote() to use new oanda URL and file format. 2013-05-07 Adrian Trapletti * DESCRIPTION (Version): New version is 0.10-32. * README: Update contributers. * R/test.R (adf.test, pp.test, kpss.test): Convert time series argument in order to correctly handle xts inputs as pointed out by Matthieu Stigler. 2013-04-16 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-31. * src/dsumsl.f: Fix array bounds declarations. 2012-11-13 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-30. * DESCRIPTION (Depends, Imports): * NAMESPACE: * man/get.hist.quote.Rd: * man/portfolio.optim.Rd: Improve imports, and remove package depends. 2012-07-07 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-29. * R/finance.R (get.hist.quote): Protect against duplicated entries as suggested by AZ. 2012-02-21 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-28. * R/finance.R (get.hist.quote): Try yahoo 5 times before giving up. 2012-02-20 Kurt Hornik * man/get.hist.quote.Rd: Make example more robust re availability of web services. 2011-10-23 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-27. * R/finance.R (portfolio.optim.default): Portfolio returns should be a vector (not a matrix). 2011-08-09 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-26. * R/zzz.R (.onAttach): Improvements. * R/arma.R (arma.init): * R/finance.R (portfolio.optim.default: * R/irts.R (irts, read.irts, plot.irts): * R/tsutils.R (quadmap): Use '&&' and '||' in if() conditions. Suggested by Tim Hesterberg . 2011-02-07 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-25. (Depends): Require R >= 2.10.0. * data: Replace *.R files by *.rda files. 2010-12-07 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-24. * R/finance.R (plotOHLC): Cosmetics. 2010-11-14 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-23. * R/tsutils.R (quadmap): Fix typo spotted by Breno Neri . 2009-11-22 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-22. * R/finance.R (portfolio.optim.default, get.hist.quote): Simplify/improve run-time depends. 2009-10-04 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-21. * man/portfolio.optim.Rd: Enhance example (suggestion by Dirk Eddelbuettel ). 2009-09-10 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-20. * inst/CITATION: Improve. 2009-08-31 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-19. * man/get.hist.quote.Rd: Rd fixes. 2009-02-05 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-18. * inst/CITATION: Improve. 2009-01-11 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-17. * man/get.hist.quote.Rd: OANDA now allows for time periods of at most 500 days. 2008-07-18 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-16. * R/finance.R (get.hist.quote): Apparently OANDA has switched to using years without centuries (spotted by Martin Becker ). 2008-05-08 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-15. * R/finance.R (get.hist.quote): Improve determining when OANDA provides no data (spotted by Ajay Shah ). 2008-02-26 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-14. 2008-02-09 Achim Zeileis * R/garch.R: changed handling of control arguments for garch(), new garch.control() function, added new vcov() method. * src/garch.c: de-coupled single eps tolerance into four different tolerance parameters. * man/garch.Rd: all control arguments now collected in garch.control(), re-named (similar to optim arguments), de-coupled tolerance parameters, return value has vcov instead of asy.se.coef. * man/garch-methods.Rd: new vcov method. * R/arma.R: new vcov() method * man/arma.Rd: return value has vcov instead of asy.se.coef. * man/arma-methods.Rd: new vcov method. * NAMESPACE: new vcov() methods 2007-12-13 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-13. * src/dsumsl.f: * src/formats.c: Fixes for FORTRAN I/O problems, contributed by Brian Ripley. * data/00Index: * man/tseries-internal.Rd: Removed. 2007-11-04 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-12. * R/finance.R (get.hist.quote): OANDA enhancements. 2007-02-20 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-11. * data/ice.river.R: Update by kindly provided by Rob Hyndman . 2007-02-11 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-10. * R/finance.R (get.hist.quote): Adjust for Yahoo's change its CSV files to use standard %Y-%m-%d dates. 2007-02-01 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-8. * inst/CITATION: Get date/year and version from the package metadata. 2006-10-04 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-7. (License): Standardize. * COPYING: Removed. 2006-09-10 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-6. (Imports): Add graphics and utils. 2006-09-09 Kurt Hornik * NAMESPACE: Import graphics and utils. 2006-09-07 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-5. (Imports): Add utils. * NAMESPACE: Add some imports from utils. * R/zzz.R: .First.lib needs to be .onAttach. 2006-08-11 Achim Zeileis * DESCRIPTION: added "stats" dependency, new version is 0.10-4. * NAMESPACE: added import("stats") 2006-06-27 G. Grothendieck * R/finance.R (get.hist.quote) * man/get.hist.quote.Rd: added 'drop=' argument to get.hist.quote. Defaults to FALSE (i.e., previous behavior). 2006-06-26 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-2. * inst/CITATION: New file. 2006-05-10 Achim Zeileis * DESCRIPTION (Version): New version is 0.10-1. 2006-05-09 Achim Zeileis * R/finance.R (get.hist.quote) * man/get.hist.quote.Rd: handled 'method' argument as in download.file(), so that it can be set via options(download.file.method = "...") 2006-04-07 Achim Zeileis * R/finance.R (get.hist.quote) * man/get.hist.quote.Rd: added quiet argument passed on to download.file(), defaults to FALSE (i.e., previous behaviour) 2005-10-24 Kurt Hornik * DESCRIPTION (Version): New version is 0.10-0. (Depends): Require R >= 2.2.0. * NAMESPACE: Added. * man/irts-methods.Rd: Use \method markup for [ usage entries. 2005-09-07 Achim Zeileis * DESCRIPTION (Version): New version is 0.9-30, Depends on zoo, suggests its. * R/finance.R (get.hist.quote): can return now "zoo", "ts" and "its" series. * man/get.hist.quote.Rd: added retclass argument. * man/plotOHLC.Rd: adapted to get.hist.quote(). 2005-09-06 Adrian Trapletti * README: Update contributers. * R/finance.R (get.hist.quote): * man/get.hist.quote.Rd: Improved error messages and documentation. 2005-09-03 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-29. * R/finance.R (get.hist.quote): * man/get.hist.quote.Rd: New provider 'oanda' to get.hist.quote() [by A Trapletti]. 2005-08-29 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-28. 2005-08-28 Kurt Hornik * man/irts-methods.Rd: Link to plot.ts rather than the defunct plot.mts (spotted by BDR). 2005-04-20 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-26. * src/Makevars: New file. * src/dsumsl.f: Convert from FORTRAN 66 to FORTRAN 77 as per instructions. Remove code for D1MACH/I1MACH (in R) and the BLAS subroutines DCOPY and DDOT. 2005-04-01 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-25. * R/finance.R (get.hist.quote): Use Date rather than POSIXct, suggested by Gabor Grothendieck . 2004-11-12 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-24. * R/finance.R (get.hist.quote): * man/get.hist.quote.Rd: Add argument 'compression' to get.hist.quote(), provided by BBands . 2004-08-05 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-23. * data/*.R: Remove explicit calls to require() for package stats, and instead use stats::ts() to ensure that stats gets attached. 2004-07-20 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-22. * man/get.hist.quote.Rd: * man/plotOHLC.Rd: Change symbol for S&P 500 from ^spc to ^gspc, argh. Try wrapping examples inside a suitable test for connectivity to quote.yahoo.com rather than \dontrun{}, so that we can figure out when examples fail more easily. 2004-03-23 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-20. * R/finance.R (portfolio.optim.default): * R/test.R (white.test.default, white.test.ts): * R/zzz.R (.First.lib): Adjust for changes in R 1.9.0. 2004-01-31 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-19. * INDEX: Removed. 2003-12-15 Dirk Eddelbuettel * DESCRIPTION (Version): New version is 0.9-18. * R/finance.R (plotOHLC): Use segments() with vector arguments. 2003-11-06 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-17. * man/summary.garch.Rd: * man/summary.arma.Rd: Fix codoc default value problem/typo. 2003-10-10 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-16. * R/arma.R (print.summary.arma): * R/garch.R (print.summary.garch): * man/arma-methods.Rd: * man/garch-methods.Rd: * man/summary.arma.Rd: * man/summary.garch.Rd: print.coefmat() is deprecated and replaced by printCoefmat() in R 1.8. 2003-08-27 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-15. * README: Cosmetic change. * R/finance.R (get.hist.quote): Treat the case when the submitted data from Yahoo contains information concerning dividends (problem and solution reported by Achmim Zeileis ). 2003-07-09 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-14. * R/finance.R (plotOHLC): Correct bug when setting the ylim argument (reported by Dirk Eddelbuettel). * R/irts.R: * man/irts-functions.Rd: rename function interpolate to approx.irts. 2003-07-08 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-13. * man/arma-methods.Rd: * man/garch-methods.Rd: Remove over-documented argument 'signif.stars' from \arguments. 2003-06-06 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-12. * R/finance.R (get.hist.quote): Work around addressed in 0.9-11 was not good enough. 2003-04-22 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-11. * R/finance.R (get.hist.quote): Work around a problem in 1.7.0 (PR#2815 and also reported by Lars W. Hansen ). 2003-03-04 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-10. * R/finance.R: change check for the case of an unknown quote. * man/arma-methods.Rd * man/garch-methods.Rd * man/plotOHLC.Rd * man/portfolio.optim.Rd * man/read.ts.Rd * man/seqplot.ts.Rd * man/surrogate.Rd * man/terasvirta.test.Rd * man/white.test.Rd: cosmetic changes. * R/irts.R: * man/irts-functions.Rd: * man/irts-methods.Rd: * man/irts.Rd: add new class for irregularly spaced time-series. 2003-02-19 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-9. * README: update. * R/finance.R: * man/plotOHLC.Rd: add new argument origin such that it works smoothly together with get.hist.quote() (problem spotted by Michael Parzen ). 2003-02-05 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-8. * README: cleanup. * R/finance.R * man/get.hist.quote.Rd: add new argument origin and change YAHOO query (it seems that YAHOO has slightly changed the query syntax to access historical data). * R/garch.R * man/garch-methods.Rd: add new method logLik.garch. * man/garch.Rd: cosmetic change. 2003-01-22 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-7. * R/tsutils.R (print.resample.statistic): Call print with named 'digits' argument [S4 method dispatch]. 2002-11-22 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-6. * R/garch.R (garch): Also had .C("pred_garch") without 'genuine'. Guess to use FALSE here. 2002-11-21 Kurt Hornik * DESCRIPTION (Version): New version is 0.9-5. * R/garch.R (predict.garch): .C("pred_garch") needs to pass 'genuine' as well (spotted by Fan and Duncan Murdoch ). 2002-09-09 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-3. * INDEX: * README: cleanup and update. * man/garch.Rd * man/bds.test.Rd: correct bugs in documentation. * man/tsbootstrap.Rd: improve documentation. * man/runs.test.Rd: * R/test.R: new implementation of runs.test which was wrong for versions <= 0.9-2. 2002-06-28 Kurt Hornik * DESCRIPTION: New version is 0.9-2. * R/garch.R (garch): Replace Machine() by .Machine as the former is deprecated in R 1.6. 2002-06-19 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-1. * INDEX: * TITLE: * R/zzz.R: Cleanup and cosmetic changes. * man/maxdrawdown.Rd: * man/sharpe.Rd: * man/sterling.Rd: * R/finance.R: Improved version of maxdrawdown and new functions sharpe and sterling. 2002-04-26 Adrian Trapletti * DESCRIPTION (Version): New version is 0.9-0. * man/amif.Rd: * man/plot.amif.Rd: * R/cor.R: * misc/README: * misc/mutinfo-1.21b.tar.gz * src/tsutils.c: Removed non-GPL code. * man/bootstrap.Rd: * man/surrogate.Rd: * man/tsbootstrap.Rd: * R/tsutils.R: Improved version of time series bootstrap which allows a block of blocks bootstrap. The function bootstrap is renamed to tsbootstrap. * DESCRIPTION: * README: Cleanup. * man/arma.Rd: Cosmetic change. 2001-11-30 Adrian Trapletti * DESCRIPTION (Version): New version is 0.8-4. * man/plotOHLC.Rd: Improve documentation. * R/zzz.R: Cosmetic change. 2001-11-08 Adrian Trapletti * DESCRIPTION (Version): New version is 0.8-3. * man/bootstrap.Rd: * R/tsutils.R: * src/boot.c: Improve documentation, error messages, and code. 2001-10-29 Adrian Trapletti * DESCRIPTION (Version): New version is 0.8-2. * man/get.hist.quote.Rd: * R/finance.R: Change default value for argument 'quote' of 'get.hist.quote()'. * man/maxdrawdown.Rd: * R/finance.R: * src/tsutils.c: Simpler and more informative implementation of max drawdown statistic. * man/plotOHLC.Rd: * R/finance.R: New function which plots open-high-low-close bar charts. 2001-10-18 Adrian Trapletti * DESCRIPTION: Cleanup. New version is 0.8-1. * README: Cleanup. 2001-10-12 Adrian Trapletti * DESCRIPTION (Version): New version is 0.8-0. * R/tsutils.R: Call .C with 'mode = "double"' everywhere. * man/maxdrawdown.Rd: * R/finance.R: * src/tsutils.c: Fast implementation of max drawdown statistic. 2001-08-27 Adrian Trapletti * DESCRIPTION (Version): New version is 0.7-6. * src/arma.c: Correct nasty bug concerning accessing the parameter intercept. * man/portfolio.optim.Rd: * R/finance.R: Integration of a patch of Dirk Eddelbuettel for 'portfolio.optim()' that allows inequality restrictions on the portfolio weights and a specification of the covariance matrix. 2001-08-20 Kurt Hornik * DESCRIPTION (Version): New version is 0.7-5. * man/tseries.internal.Rd: Renamed to tseries-internal.Rd. * man/arma-methods.Rd: * man/garch-methods.Rd: * man/plot.amif.Rd: * man/summary.arma.Rd: * man/summary.garch.Rd: New files. * R/*.R: * man/*.Rd: Fix generic/method inconsistencies. 2001-08-19 Kurt Hornik * man/tseries.internal.Rd: Change keyword 'misc' to 'internal'. * R/tsutils.R: TnF fix. 2001-07-15 Kurt Hornik * DESCRIPTION (Version): New version is 0.7-4. * R/test.R: * man/terasvirta.test.Rd: * man/white.test.Rd: Use 'Chisq' instead of 'chisq' for argument 'type'. 2001-07-06 Kurt Hornik * DESCRIPTION (Depends): No longer depends on chron. * R/finance.R: Rewrite get.hist.quote() to use R internal POSIX date/time classes and allow for retrieval of several quotes and volume at once. * man/get.hist.quote.Rd: Changed accordingly. 2001-06-18 Kurt Hornik * DESCRIPTION (Version): New version is 0.7-2. (Depends): Redo according to R-exts. Detailed info now in 'README'. * man/na.remove.Rd: Sync code and documented usage. * ChangeLog: finally started. tseries/NAMESPACE0000644000175100001440000000352013112737631013171 0ustar hornikusersuseDynLib("tseries", .registration = TRUE) import("graphics", "stats", "utils") importFrom("quadprog", "solve.QP") importFrom("zoo", "zoo", "index", "index<-") importFrom("quantmod", "getSymbols") export("adf.test", "approx.irts", "arma", "as.irts", "bds.test", "daysecond", "garch", "garch.control", "get.hist.quote", "irts", "is.businessday", "is.irts", "is.weekend", "jarque.bera.test", "kpss.test", "maxdrawdown", "na.remove", "plotOHLC", "po.test", "portfolio.optim", "pp.test", "quadmap", "read.irts", "read.matrix", "read.ts", "runs.test", "seqplot.ts", "sharpe", "sterling", "surrogate", "terasvirta.test", "tsbootstrap", "value", "weekday", "white.test", "write.irts") S3method("[", "irts") S3method("as.irts", "default") S3method("as.irts", "zoo") S3method("coef", "arma") S3method("coef", "garch") S3method("fitted", "arma") S3method("fitted", "garch") S3method("lines", "irts") S3method("logLik", "garch") S3method("na.remove", "default") S3method("na.remove", "ts") S3method("plot", "arma") S3method("plot", "garch") S3method("plot", "irts") S3method("points", "irts") S3method("portfolio.optim", "default") S3method("portfolio.optim", "ts") S3method("predict", "garch") S3method("print", "arma") S3method("print", "bdstest") S3method("print", "garch") S3method("print", "irts") S3method("print", "resample.statistic") S3method("print", "summary.arma") S3method("print", "summary.garch") S3method("residuals", "arma") S3method("residuals", "garch") S3method("summary", "arma") S3method("summary", "garch") S3method("terasvirta.test", "default") S3method("terasvirta.test", "ts") S3method("time", "irts") S3method("value", "irts") S3method("vcov", "arma") S3method("vcov", "garch") S3method("white.test", "default") S3method("white.test", "ts") tseries/build/0000755000175100001440000000000014674232237013057 5ustar hornikuserstseries/build/partial.rdb0000644000175100001440000000007514674232237015206 0ustar hornikusers‹‹àb```b`aad`b1…À€… H02°0piÖ¼ÄÜÔb C"Éðh¿eÍ7tseries/man/0000755000175100001440000000000013762377126012537 5ustar hornikuserstseries/man/po.test.Rd0000644000175100001440000000422511304021310014370 0ustar hornikusers\name{po.test} \alias{po.test} \title{Phillips--Ouliaris Cointegration Test} \description{ Computes the Phillips-Ouliaris test for the null hypothesis that \code{x} is not cointegrated. } \usage{ po.test(x, demean = TRUE, lshort = TRUE) } \arguments{ \item{x}{a matrix or multivariate time series.} \item{demean}{a logical indicating whether an intercept is included in the cointegration regression or not.} \item{lshort}{a logical indicating whether the short or long version of the truncation lag parameter is used.} } \details{ The Phillips-Perron Z(alpha) statistic for a unit root in the residuals of the cointegration regression is computed, see also \code{\link{pp.test}}. The unit root is estimated from a regression of the first variable (column) of \code{x} on the remaining variables of \code{x} without a constant and a linear trend. To estimate \code{sigma^2} the Newey-West estimator is used. If \code{lshort} is \code{TRUE}, then the truncation lag parameter is set to \code{trunc(n/100)}, otherwise \code{trunc(n/30)} is used. The p-values are interpolated from Table Ia and Ib, p. 189 of Phillips and Ouliaris (1990). If the computed statistic is outside the table of critical values, then a warning message is generated. The dimension of \code{x} is restricted to six variables. Missing values are not handled. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{parameter}{the truncation lag parameter.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{data.name}{a character string giving the name of the data.} } \references{ P. C. B. Phillips and S. Ouliaris (1990): Asymptotic Properties of Residual Based Tests for Cointegration. \emph{Econometrica} \bold{58}, 165--193. } \author{A. Trapletti} \seealso{ \code{\link{pp.test}} } \examples{ x <- ts(diffinv(matrix(rnorm(2000),1000,2))) # no cointegration po.test(x) x <- diffinv(rnorm(1000)) y <- 2.0-3.0*x+rnorm(x,sd=5) z <- ts(cbind(x,y)) # cointegrated po.test(z) } \keyword{ts} tseries/man/arma-methods.Rd0000644000175100001440000000223211304021310015351 0ustar hornikusers\name{arma-methods} \alias{arma-methods} \alias{coef.arma} \alias{vcov.arma} \alias{residuals.arma} \alias{fitted.arma} \alias{print.arma} \alias{plot.arma} \title{Methods for Fitted ARMA Models} \description{ Methods for fitted ARMA model objects. } \usage{ \method{coef}{arma}(object, \dots) \method{vcov}{arma}(object, \dots) \method{residuals}{arma}(object, \dots) \method{fitted}{arma}(object, \dots) \method{print}{arma}(x, digits = max(3, getOption("digits") - 3), \dots) \method{plot}{arma}(x, ask = interactive(), \dots) } \arguments{ \item{object, x}{an object of class \code{"arma"}; usually, a result of a call to \code{\link{arma}}.} \item{digits}{see \code{\link{printCoefmat}}.} \item{ask}{Should the \code{plot} method work interactively? See \code{\link{interactive}}.} \item{\dots}{further arguments passed to or from other methods.} } \value{ For \code{coef}, a numeric vector; for \code{vcov}, a numeric matrix; for \code{residuals} and \code{fitted} a univariate time series; for \code{plot} and \code{print}, the fitted ARMA model object. } \author{ A. Trapletti } \seealso{ \code{\link{arma}} } \keyword{models} \keyword{ts} tseries/man/garch-methods.Rd0000644000175100001440000000522411304021310015521 0ustar hornikusers\name{garch-methods} \alias{garch-methods} \alias{predict.garch} \alias{coef.garch} \alias{vcov.garch} \alias{residuals.garch} \alias{fitted.garch} \alias{print.garch} \alias{plot.garch} \alias{logLik.garch} \title{Methods for Fitted GARCH Models} \description{ Methods for fitted GARCH model objects. } \usage{ \method{predict}{garch}(object, newdata, genuine = FALSE, \dots) \method{coef}{garch}(object, \dots) \method{vcov}{garch}(object, \dots) \method{residuals}{garch}(object, \dots) \method{fitted}{garch}(object, \dots) \method{print}{garch}(x, digits = max(3, getOption("digits") - 3), \dots) \method{plot}{garch}(x, ask = interactive(), \dots) \method{logLik}{garch}(object, \dots) } \arguments{ \item{object, x}{an object of class \code{"garch"}; usually, a result of a call to \code{\link{garch}}.} \item{newdata}{a numeric vector or time series to compute GARCH predictions. Defaults to \code{eval(parse(text=object$series))}.} \item{genuine}{a logical indicating whether a genuine prediction should be made, i.e., a prediction for which there is no target observation available.} \item{digits}{see \code{\link{printCoefmat}}.} \item{ask}{Should the \code{plot} method work interactively? See \code{\link{interactive}}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ \code{predict} returns +/- the conditional standard deviation predictions from a fitted GARCH model. \code{coef} returns the coefficient estimates. \code{vcov} the associated covariance matrix estimate (outer product of gradients estimator). \code{residuals} returns the GARCH residuals, i.e., the time series used to fit the model divided by the computed conditional standard deviation predictions for this series. Under the assumption of conditional normality the residual series should be i.i.d. standard normal. \code{fitted} returns +/- the conditional standard deviation predictions for the series which has been used to fit the model. \code{plot} graphically investigates normality and remaining ARCH effects for the residuals. \code{logLik} returns the log-likelihood value of the GARCH(p, q) model represented by \code{object} evaluated at the estimated coefficients. It is assumed that first max(p, q) values are fixed. } \value{ For \code{predict} a bivariate time series (two-column matrix) of predictions. For \code{coef}, a numeric vector, for \code{residuals} and \code{fitted} a univariate (vector) and a bivariate time series (two-column matrix), respectively. For \code{plot} and \code{print}, the fitted GARCH model object. } \author{ A. Trapletti } \keyword{models} \keyword{ts} tseries/man/quadmap.Rd0000644000175100001440000000071211304021310014421 0ustar hornikusers\name{quadmap} \alias{quadmap} \title{Quadratic Map (Logistic Equation)} \description{ Computes the quadratic map simulation. } \usage{ quadmap(xi = 0.2, a = 4.0, n = 1000) } \arguments{ \item{xi}{the initial value for the iteration.} \item{a}{the quadratic map parameter.} \item{n}{the length of the simulated series.} } \value{ A vector containing the simulated series. } \author{A. Trapletti} \examples{ x <- quadmap() acf(x, 10) } \keyword{ts} tseries/man/read.ts.Rd0000644000175100001440000000224111304021310014330 0ustar hornikusers\name{read.ts} \alias{read.ts} \title{Read Time Series Data} \description{ Reads a time series file. } \usage{ read.ts(file, header = FALSE, sep = "", skip = 0, \dots) } \arguments{ \item{file}{the name of the file which the data are to be read from. Each line of the file contains one observation of the variables.} \item{header}{a logical value indicating whether the file contains the names of the variables as its first line.} \item{sep}{the field separator character. Values on each line of the file are separated by this character.} \item{skip}{the number of lines of the data file to skip before beginning to read data.} \item{\dots}{Additional arguments for \code{\link{ts}} such as, e.g., \code{start}.} } \details{ Each row of the file represents an observation and each column contains a variable. The first row possibly contains the names of the variables. } \author{A. Trapletti} \seealso{ \code{\link{ts}}. } \examples{ data(sunspots) st <- start(sunspots) fr <- frequency(sunspots) write(sunspots, "sunspots", ncolumns=1) x <- read.ts("sunspots", start=st, frequency=fr) plot(x) unlink("sunspots") } \keyword{file} \keyword{ts} tseries/man/garch.Rd0000644000175100001440000001251011304021310014054 0ustar hornikusers\name{garch} \alias{garch} \alias{garch.control} \title{Fit GARCH Models to Time Series} \description{ Fit a Generalized Autoregressive Conditional Heteroscedastic GARCH(p, q) time series model to the data by computing the maximum-likelihood estimates of the conditionally normal model. } \usage{ garch(x, order = c(1, 1), series = NULL, control = garch.control(\dots), \dots) garch.control(maxiter = 200, trace = TRUE, start = NULL, grad = c("analytical","numerical"), abstol = max(1e-20, .Machine$double.eps^2), reltol = max(1e-10, .Machine$double.eps^(2/3)), xtol = sqrt(.Machine$double.eps), falsetol = 1e2 * .Machine$double.eps, \dots) } \arguments{ \item{x}{a numeric vector or time series.} \item{order}{a two dimensional integer vector giving the orders of the model to fit. \code{order[2]} corresponds to the ARCH part and \code{order[1]} to the GARCH part.} \item{series}{name for the series. Defaults to \code{deparse(substitute(x))}.} \item{control}{a list of control parameters as set up by \code{garch.control}.} \item{maxiter}{gives the maximum number of log-likelihood function evaluations \code{maxiter} and the maximum number of iterations \code{2*maxiter} the optimizer is allowed to compute.} \item{trace}{logical. Trace optimizer output?} \item{start}{If given this numeric vector is used as the initial estimate of the GARCH coefficients. Default initialization is to set the GARCH parameters to slightly positive values and to initialize the intercept such that the unconditional variance of the initial GARCH is equal to the variance of \code{x}.} \item{grad}{character indicating whether analytical gradients or a numerical approximation is used for the optimization.} \item{abstol}{absolute function convergence tolerance.} \item{reltol}{relative function convergence tolerance.} \item{xtol}{coefficient-convergence tolerance.} \item{falsetol}{false convergence tolerance.} \item{\dots}{additional arguments for \code{\link{qr}} when computing the asymptotic covariance matrix.} } \details{ \code{garch} uses a Quasi-Newton optimizer to find the maximum likelihood estimates of the conditionally normal model. The first max(p, q) values are assumed to be fixed. The optimizer uses a hessian approximation computed from the BFGS update. Only a Cholesky factor of the Hessian approximation is stored. For more details see Dennis et al. (1981), Dennis and Mei (1979), Dennis and More (1977), and Goldfarb (1976). The gradient is either computed analytically or using a numerical approximation. } \value{ A list of class \code{"garch"} with the following elements: \item{order}{the order of the fitted model.} \item{coef}{estimated GARCH coefficients for the fitted model.} \item{n.likeli}{the negative log-likelihood function evaluated at the coefficient estimates (apart from some constant).} \item{n.used}{the number of observations of \code{x}.} \item{residuals}{the series of residuals.} \item{fitted.values}{the bivariate series of conditional standard deviation predictions for \code{x}.} \item{series}{the name of the series \code{x}.} \item{frequency}{the frequency of the series \code{x}.} \item{call}{the call of the \code{garch} function.} \item{vcov}{outer product of gradient estimate of the asymptotic-theory covariance matrix for the coefficient estimates.} } \references{ A. K. Bera and M. L. Higgins (1993): ARCH Models: Properties, Estimation and Testing. \emph{J. Economic Surveys} \bold{7} 305--362. T. Bollerslev (1986): Generalized Autoregressive Conditional Heteroscedasticity. \emph{Journal of Econometrics} \bold{31}, 307--327. R. F. Engle (1982): Autoregressive Conditional Heteroscedasticity with Estimates of the Variance of United Kingdom Inflation. \emph{Econometrica} \bold{50}, 987--1008. J. E. Dennis, D. M. Gay, and R. E. Welsch (1981): Algorithm 573 --- An Adaptive Nonlinear Least-Squares Algorithm. \emph{ACM Transactions on Mathematical Software} \bold{7}, 369--383. J. E. Dennis and H. H. W. Mei (1979): Two New Unconstrained Optimization Algorithms which use Function and Gradient Values. \emph{J. Optim. Theory Applic.} \bold{28}, 453--482. J. E. Dennis and J. J. More (1977): Quasi-Newton Methods, Motivation and Theory. \emph{SIAM Rev.} \bold{19}, 46--89. D. Goldfarb (1976): Factorized Variable Metric Methods for Unconstrained Optimization. \emph{Math. Comput.} \bold{30}, 796--811. } \author{ A. Trapletti, the whole GARCH part; D. M. Gay, the FORTRAN optimizer } \seealso{ \code{\link{summary.garch}} for summarizing GARCH model fits; \code{\link{garch-methods}} for further methods. } \examples{ n <- 1100 a <- c(0.1, 0.5, 0.2) # ARCH(2) coefficients e <- rnorm(n) x <- double(n) x[1:2] <- rnorm(2, sd = sqrt(a[1]/(1.0-a[2]-a[3]))) for(i in 3:n) # Generate ARCH(2) process { x[i] <- e[i]*sqrt(a[1]+a[2]*x[i-1]^2+a[3]*x[i-2]^2) } x <- ts(x[101:1100]) x.arch <- garch(x, order = c(0,2)) # Fit ARCH(2) summary(x.arch) # Diagnostic tests plot(x.arch) data(EuStockMarkets) dax <- diff(log(EuStockMarkets))[,"DAX"] dax.garch <- garch(dax) # Fit a GARCH(1,1) to DAX returns summary(dax.garch) # ARCH effects are filtered. However, plot(dax.garch) # conditional normality seems to be violated } \keyword{ts} tseries/man/bds.test.Rd0000644000175100001440000000426614021343243014542 0ustar hornikusers\name{bds.test} \alias{bds.test} \alias{print.bdstest} \title{BDS Test} \description{ Computes and prints the BDS test statistic for the null that \code{x} is a series of i.i.d. random variables. } \usage{ bds.test(x, m = 3, eps = seq(0.5 * sd(x), 2 * sd(x), length.out = 4), trace = FALSE) } \arguments{ \item{x}{a numeric vector or time series.} \item{m}{an integer indicating that the BDS test statistic is computed for embedding dimensions \code{2}, \dots, \code{m}.} \item{eps}{a numeric vector of epsilon values for close points. The BDS test is computed for each element of \code{eps}. It should be set in terms of the standard deviation of \code{x}.} \item{trace}{a logical indicating whether some informational output is traced.} } \details{ This test examines the ``spatial dependence'' of the observed series. To do this, the series is embedded in \code{m}-space and the dependence of \code{x} is examined by counting ``near'' points. Points for which the distance is less than \code{eps} are called ``near''. The BDS test statistic is asymptotically standard Normal. Missing values are not allowed. There is a special print method for objects of class \code{"bdstest"} which by default uses 4 digits to format real numbers. } \value{ A list with class \code{"bdstest"} containing the following components: \item{statistic}{the values of the test statistic.} \item{p.value}{the p-values of the test.} \item{method}{a character string indicating what type of test was performed.} \item{parameter}{a list with the components \code{m} and \code{eps} containing the embedding dimensions and epsilon values for which the statistic is computed.} \item{data.name}{a character string giving the name of the data.} } \references{ J. B. Cromwell, W. C. Labys and M. Terraza (1994): \emph{Univariate Tests for Time Series Models}, Sage, Thousand Oaks, CA, pages 32--36. } \author{B. LeBaron, Ported to R by A. Trapletti} \examples{ x <- rnorm(100) bds.test(x) # i.i.d. example x <- c(rnorm(50), runif(50)) bds.test(x) # not identically distributed x <- quadmap(xi = 0.2, a = 4.0, n = 100) bds.test(x) # not independent } \keyword{ts} tseries/man/tcmd.Rd0000644000175100001440000000142513762355306013753 0ustar hornikusers\name{tcmd} \alias{tcmd} \alias{tcm1yd} \alias{tcm3yd} \alias{tcm5yd} \alias{tcm10yd} \title{ Daily Yields on Treasury Securities } \description{ This data set contains daily 1 year, 3 year, 5 year, and 10 year yields on treasury securities at constant, fixed maturity. } \usage{ data(tcmd) } \format{ 4 univariate time series \code{tcm1yd}, \code{tcm3yd}, \code{tcm5yd}, and \code{tcm10yd} and the joint series \code{tcmd}. } \details{ The yields at constant fixed maturity have been constructed by the Treasury Department, based on the most actively traded marketable treasury securities. Daily refers to business days, i.e., weekends and holidays are eliminated. } \source{ U.S. Fed \url{https://www.federalreserve.gov/Releases/H15/data.htm} } \keyword{datasets} tseries/man/read.matrix.Rd0000644000175100001440000000205511304021310015211 0ustar hornikusers\name{read.matrix} \alias{read.matrix} \title{Read Matrix Data} \description{ Reads a matrix data file. } \usage{ read.matrix(file, header = FALSE, sep = "", skip = 0) } \arguments{ \item{file}{the name of the file which the data are to be read from.} \item{header}{a logical value indicating whether the file contains the names of the columns as its first line.} \item{sep}{the field separator character. Values on each line of the file are separated by this character.} \item{skip}{the number of lines of the data file to skip before beginning to read data.} } \details{ Usually each row of the file represents an observation and each column contains a variable. The first row possibly contains the names of the variables (columns). \code{read.matrix} might be more efficient than \code{\link{read.table}} for very large data sets. } \author{A. Trapletti} \seealso{ \code{\link{read.table}}. } \examples{ x <- matrix(0, 10, 10) write(x, "test", ncolumns=10) x <- read.matrix("test") x unlink("test") } \keyword{file} \keyword{ts} tseries/man/runs.test.Rd0000644000175100001440000000341211304021310014736 0ustar hornikusers\name{runs.test} \alias{runs.test} \title{Runs Test} \description{ Computes the runs test for randomness of the dichotomous (binary) data series \code{x}. } \usage{ runs.test(x, alternative = c("two.sided", "less", "greater")) } \arguments{ \item{x}{a dichotomous factor.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"two.sided"} (default), \code{"less"}, or \code{"greater"}. You can specify just the initial letter.} } \details{ This test searches for randomness in the observed data series \code{x} by examining the frequency of runs. A "run" is defined as a series of similar responses. Note, that by using the alternative \code{"less"} the null of randomness is tested against some kind of "under-mixing" ("trend"). By using the alternative \code{"greater"} the null of randomness is tested against some kind of "over-mixing" ("mean-reversion"). Missing values are not allowed. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{data.name}{a character string giving the name of the data.} \item{alternative}{a character string describing the alternative hypothesis.} } \references{ S. Siegel (1956): \emph{Nonparametric Statistics for the Behavioural Sciences}, McGraw-Hill, New York. S. Siegel and N. J. Castellan (1988): \emph{Nonparametric Statistics for the Behavioural Sciences}, 2nd edn, McGraw-Hill, New York. } \author{A. Trapletti} \examples{ x <- factor(sign(rnorm(100))) # randomness runs.test(x) x <- factor(rep(c(-1,1),50)) # over-mixing runs.test(x) } \keyword{ts} tseries/man/irts-functions.Rd0000644000175100001440000000663714021343312016004 0ustar hornikusers\name{irts-functions} \alias{irts-functions} \alias{approx.irts} \alias{daysecond} \alias{is.businessday} \alias{is.weekend} \alias{read.irts} \alias{weekday} \alias{write.irts} \title{Basic Functions for Irregular Time-Series Objects} \description{ Basic functions related to irregular time-series objects. } \usage{ daysecond(object, tz = "GMT") approx.irts(object, time, \dots) is.businessday(object, tz = "GMT") is.weekend(object, tz = "GMT") read.irts(file, format = "\%Y-\%m-\%d \%H:\%M:\%S", tz = "GMT", \dots) weekday(object, tz = "GMT") write.irts(object, file = "", append = FALSE, quote = FALSE, sep = " ", eol = "\n", na = "NA", dec = ".", row.names = FALSE, col.names = FALSE, qmethod = "escape", format = "\%Y-\%m-\%d \%H:\%M:\%S", tz = "GMT", usetz = FALSE, format.value = NULL, \dots) } \arguments{ \item{object}{an object of class \code{"irts"}; usually, a result of a call to \code{\link{irts}}.} \item{format, tz, usetz}{formatting related arguments, see \code{\link{format.POSIXct}}.} \item{time}{an object of class \code{"POSIXct"} specifying the times at which to interpolate the irregularly spaced time-series.} \item{file, append, quote, sep, eol, na, dec, row.names, col.names, qmethod}{reading and writing related arguments, see \code{\link{read.table}} and \code{\link{write.table}}.} \item{format.value}{a string which specifies the formatting of the values when writing an irregular time-series object to a file. \code{format.value} is passed unchanged as argument \code{format} to the function \code{\link{formatC}}.} \item{\dots}{further arguments passed to or from other methods: for \code{approx.irts} passed to \code{\link{approx}}; for \code{read.irts} passed to \code{\link{read.table}}; for \code{write.irts} passed to \code{\link{data.frame}}.} } \details{ \code{daysecond} and \code{weekday} return the number of seconds since midnight (the same day) and the weekday as a decimal number (0-6, Sunday is 0), respectively. \code{is.businessday} and \code{is.weekend} test which entries of an irregular time-series object are recorded on business days and weekends, respectively. \code{approx.irts} interpolates an irregularly spaced time-series at prespecified times. \code{read.irts} is the function to read irregular time-series objects from a file. \code{write.irts} is the function to write irregular time-series objects to a file. } \value{ For \code{daysecond} and \code{weekday} a vector of decimal numbers representing the number of seconds and the weekday, respectively. For \code{is.businessday} and \code{is.weekend} a vector of \code{"logical"} representing the test results for each time. For \code{approx.irts}, \code{read.irts} and \code{write.irts} an object of class \code{"irts"}. } \author{ A. Trapletti } \seealso{ \code{\link{irts}}, \code{\link{irts-methods}} } \examples{ n <- 10 t <- cumsum(rexp(n, rate = 0.1)) v <- rnorm(n) x <- irts(t, v) daysecond(x) weekday(x) is.businessday(x) is.weekend(x) x approx.irts(x, seq(ISOdatetime(1970, 1, 1, 0, 0, 0, tz = "GMT"), by = "10 secs", length.out = 7), rule = 2) \dontrun{ file <- tempfile() # To write an irregular time-series object to a file one might use write.irts(x, file = file) # To read an irregular time-series object from a file one might use read.irts(file = file) unlink(file) } } \keyword{ts} tseries/man/ice.river.Rd0000644000175100001440000000237513112744016014704 0ustar hornikusers\name{ice.river} \alias{ice.river} \alias{flow.vat} \alias{flow.jok} \alias{prec} \alias{temp} \title{ Icelandic River Data } \description{ Contains the Icelandic river data as presented in Tong (1990), pages 432--440. } \usage{ data(ice.river) } \format{ 4 univariate time series \code{flow.vat}, \code{flow.jok}, \code{prec}, and \code{temp}, each with 1095 observations and the joint series \code{ice.river}. } \details{ The series are daily observations from Jan. 1, 1972 to Dec. 31, 1974 on 4 variables: \code{flow.vat}, mean daily flow of Vatnsdalsa river (cms), \code{flow.jok}, mean daily flow of Jokulsa Eystri river (cms), \code{prec}, daily precipitation in Hveravellir (mm), and mean daily temperature in Hveravellir (deg C). These datasets were introduced into the literature in a paper by Tong, Thanoon, and Gudmundsson (1985). } \source{ Time Series Data Library: \url{https://robjhyndman.com/TSDL/} } \references{ H. Tong (1990): \emph{Non-Linear Time Series, A Dynamical System Approach}. Oxford University Press, Oxford. H. Tong, B. Thanoon, and G. Gudmundsson (1985): Threshold time series modelling of two Icelandic riverflow systems. \emph{Water Resources Bulletin}, \bold{21}, 651--661. } \keyword{datasets} tseries/man/jarque.bera.test.Rd0000644000175100001440000000205311304021310016146 0ustar hornikusers\name{jarque.bera.test} \alias{jarque.bera.test} \title{Jarque--Bera Test} \description{ Tests the null of normality for \code{x} using the Jarque-Bera test statistic. } \usage{ jarque.bera.test(x) } \arguments{ \item{x}{a numeric vector or time series.} } \details{ This test is a joint statistic using skewness and kurtosis coefficients. Missing values are not allowed. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{parameter}{the degrees of freedom.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{data.name}{a character string giving the name of the data.} } \references{ J. B. Cromwell, W. C. Labys and M. Terraza (1994): \emph{Univariate Tests for Time Series Models}, Sage, Thousand Oaks, CA, pages 20--22. } \author{A. Trapletti} \examples{ x <- rnorm(100) # null jarque.bera.test(x) x <- runif(100) # alternative jarque.bera.test(x) } \keyword{ts} tseries/man/adf.test.Rd0000644000175100001440000000454211304021310014506 0ustar hornikusers\name{adf.test} \alias{adf.test} \title{Augmented Dickey--Fuller Test} \description{ Computes the Augmented Dickey-Fuller test for the null that \code{x} has a unit root. } \usage{ adf.test(x, alternative = c("stationary", "explosive"), k = trunc((length(x)-1)^(1/3))) } \arguments{ \item{x}{a numeric vector or time series.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"stationary"} (default) or \code{"explosive"}. You can specify just the initial letter.} \item{k}{the lag order to calculate the test statistic.} } \details{ The general regression equation which incorporates a constant and a linear trend is used and the t-statistic for a first order autoregressive coefficient equals one is computed. The number of lags used in the regression is \code{k}. The default value of \code{trunc((length(x)-1)^(1/3))} corresponds to the suggested upper bound on the rate at which the number of lags, \code{k}, should be made to grow with the sample size for the general \code{ARMA(p,q)} setup. Note that for \code{k} equals zero the standard Dickey-Fuller test is computed. The p-values are interpolated from Table 4.2, p. 103 of Banerjee et al. (1993). If the computed statistic is outside the table of critical values, then a warning message is generated. Missing values are not allowed. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{parameter}{the lag order.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{data.name}{a character string giving the name of the data.} \item{alternative}{a character string describing the alternative hypothesis.} } \references{ A. Banerjee, J. J. Dolado, J. W. Galbraith, and D. F. Hendry (1993): \emph{Cointegration, Error Correction, and the Econometric Analysis of Non-Stationary Data}, Oxford University Press, Oxford. S. E. Said and D. A. Dickey (1984): Testing for Unit Roots in Autoregressive-Moving Average Models of Unknown Order. \emph{Biometrika} \bold{71}, 599--607. } \author{A. Trapletti} \seealso{ \code{\link{pp.test}} } \examples{ x <- rnorm(1000) # no unit-root adf.test(x) y <- diffinv(x) # contains a unit-root adf.test(y) } \keyword{ts} tseries/man/sterling.Rd0000644000175100001440000000151411304021310014621 0ustar hornikusers\name{sterling} \alias{sterling} \title{Sterling Ratio} \description{ This function computes the Sterling ratio of the univariate time series (or vector) \code{x}. } \usage{ sterling(x) } \arguments{ \item{x}{a numeric vector or univariate time series corresponding to a portfolio's cumulated returns.} } \details{ The Sterling ratio is defined as a portfolio's overall return divided by the portfolio's \code{\link{maxdrawdown}} statistic. In finance the Sterling Ratio represents a measure of the portfolio's risk-adjusted return. } \value{ a double representing the Sterling ratio. } \author{A. Trapletti} \seealso{ \code{\link{maxdrawdown}}, \code{\link{sharpe}} } \examples{ data(EuStockMarkets) dax <- log(EuStockMarkets[,"DAX"]) ftse <- log(EuStockMarkets[,"FTSE"]) sterling(dax) sterling(ftse) } \keyword{ts} tseries/man/terasvirta.test.Rd0000644000175100001440000000511311304021310016133 0ustar hornikusers\name{terasvirta.test} \title{Teraesvirta Neural Network Test for Nonlinearity} \alias{terasvirta.test} \alias{terasvirta.test.ts} \alias{terasvirta.test.default} \description{ Generically computes Teraesvirta's neural network test for neglected nonlinearity either for the time series \code{x} or the regression \code{y~x}. } \usage{ \method{terasvirta.test}{ts}(x, lag = 1, type = c("Chisq","F"), scale = TRUE, \dots) \method{terasvirta.test}{default}(x, y, type = c("Chisq","F"), scale = TRUE, \dots) } \arguments{ \item{x}{a numeric vector, matrix, or time series.} \item{y}{a numeric vector.} \item{lag}{an integer which specifies the model order in terms of lags.} \item{type}{a string indicating whether the Chi-Squared test or the F-test is computed. Valid types are \code{"Chisq"} and \code{"F"}.} \item{scale}{a logical indicating whether the data should be scaled before computing the test statistic. The default arguments to \code{\link{scale}} are used.} \item{\dots}{further arguments to be passed from or to methods.} } \details{ The null is the hypotheses of linearity in ``mean''. This test uses a Taylor series expansion of the activation function to arrive at a suitable test statistic. If \code{type} equals \code{"F"}, then the F-statistic instead of the Chi-Squared statistic is used in analogy to the classical linear regression. Missing values are not allowed. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{parameter}{a list containing the additional parameters used to compute the test statistic.} \item{data.name}{a character string giving the name of the data.} \item{arguments}{additional arguments used to compute the test statistic.} } \references{ T. Teraesvirta, C. F. Lin, and C. W. J. Granger (1993): Power of the Neural Network Linearity Test. \emph{Journal of Time Series Analysis} 14, 209-220. } \author{A. Trapletti} \seealso{ \code{\link{white.test}} } \examples{ n <- 1000 x <- runif(1000, -1, 1) # Non-linear in ``mean'' regression y <- x^2 - x^3 + 0.1*rnorm(x) terasvirta.test(x, y) ## Is the polynomial of order 2 misspecified? terasvirta.test(cbind(x,x^2,x^3), y) ## Generate time series which is nonlinear in ``mean'' x[1] <- 0.0 for(i in (2:n)) { x[i] <- 0.4*x[i-1] + tanh(x[i-1]) + rnorm(1, sd=0.5) } x <- as.ts(x) plot(x) terasvirta.test(x) } \keyword{ts} tseries/man/USeconomic.Rd0000644000175100001440000000142311304021310015035 0ustar hornikusers\name{USeconomic} \alias{USeconomic} \alias{M1} \alias{GNP} \alias{rs} \alias{rl} \title{ U.S. Economic Variables } \description{ This is the E.3 example data set of Luetkepohl (1991). } \usage{ data(USeconomic) } \format{ 4 univariate time series \code{M1}, \code{GNP}, \code{rs}, and \code{rl} and the joint series \code{USeconomic} containing the logarithm of \code{M1}, the logarithm of \code{GNP}, \code{rs}, and \code{rl}. } \details{ It contains seasonally adjusted real U.S. money \code{M1} and GNP in 1982 Dollars; discount rate on 91-Day treasury bills \code{rs} and yield on long-term treasury bonds \code{rl}. } \source{ Luetkepohl, H. (1991): \emph{Introduction to Multiple Time Series Analysis}. Springer Verlag, NY, 500--503. } \keyword{datasets} tseries/man/nino.Rd0000644000175100001440000000121513762355331013762 0ustar hornikusers\name{nino} \alias{nino} \alias{nino3} \alias{nino3.4} \title{ Sea Surface Temperature (SST) Nino 3 and Nino 3.4 Indices } \description{ These data constitutes of Nino Region 3 and Nino Region 3.4 SST indices. } \usage{ data(nino) } \format{ Two univariate time series \code{nino3} and \code{nino3.4} with 598 observations and the joint series \code{nino}. } \details{ The measurements are given in degrees Celsius. The Nino 3 Region is bounded by 90W-150W and 5S-5N. The Nino 3.4 Region is bounded by 120W-170W and 5S-5N. } \source{ Climate Prediction Center: \url{https://www.cpc.ncep.noaa.gov/data/indices/} } \keyword{datasets} tseries/man/maxdrawdown.Rd0000644000175100001440000000325711304021310015333 0ustar hornikusers\name{maxdrawdown} \alias{maxdrawdown} \title{Maximum Drawdown or Maximum Loss} \description{ This function computes the maximum drawdown or maximum loss of the univariate time series (or vector) \code{x}. } \usage{ maxdrawdown(x) } \arguments{ \item{x}{a numeric vector or univariate time series.} } \details{ The max drawdown or max loss statistic is defined as the maximum value drop after one of the peaks of \code{x}. For financial instruments the max drawdown represents the worst investment loss for a buy-and-hold strategy invested in \code{x}. } \value{ A list containing the following three components: \item{maxdrawdown}{double representing the max drawdown or max loss statistic.} \item{from}{the index (or vector of indices) where the max drawdown period starts.} \item{to}{the index (or vector of indices) where the max drawdown period ends.} } \author{A. Trapletti} \seealso{ \code{\link{sterling}} } \examples{ # Toy example x <- c(1:10, 9:7, 8:14, 13:8, 9:20) mdd <- maxdrawdown(x) mdd plot(x) segments(mdd$from, x[mdd$from], mdd$to, x[mdd$from], col="grey") segments(mdd$from, x[mdd$to], mdd$to, x[mdd$to], col="grey") mid <- (mdd$from + mdd$to)/2 arrows(mid, x[mdd$from], mid, x[mdd$to], col="red", length = 0.16) # Realistic example data(EuStockMarkets) dax <- log(EuStockMarkets[,"DAX"]) mdd <- maxdrawdown(dax) mdd plot(dax) segments(time(dax)[mdd$from], dax[mdd$from], time(dax)[mdd$to], dax[mdd$from], col="grey") segments(time(dax)[mdd$from], dax[mdd$to], time(dax)[mdd$to], dax[mdd$to], col="grey") mid <- time(dax)[(mdd$from + mdd$to)/2] arrows(mid, dax[mdd$from], mid, dax[mdd$to], col="red", length = 0.16) } \keyword{ts} tseries/man/bev.Rd0000644000175100001440000000150113112743771013567 0ustar hornikusers\name{bev} \alias{bev} \title{ Beveridge Wheat Price Index, 1500--1869. } \description{ Contains the well-known Beveridge Wheat Price Index which gives annual price data from 1500 to 1869, averaged over many locations in western and central Europe. } \usage{ data(bev) } \format{ A univariate time series with 370 observations. The object is of class \code{"ts"}. } \details{ This data provides an example of long memory time series which has the appearance of being nonstationary in levels and yet also appears overdifferenced. See, e.g., Baillie (1996). } \source{ Time Series Data Library: \url{https://robjhyndman.com/TSDL/} } \references{ R. T. Baillie (1996): Long Memory Processes and Fractional Integration in Econometrics. \emph{Journal of Econometrics}, \bold{73}, 5--59. } \keyword{datasets} tseries/man/portfolio.optim.Rd0000644000175100001440000000520212050426753016157 0ustar hornikusers\name{portfolio.optim} \alias{portfolio.optim} \alias{portfolio.optim.ts} \alias{portfolio.optim.default} \title{Portfolio Optimization} \description{ Computes an efficient portfolio from the given return series \code{x} in the mean-variance sense. } \usage{ \method{portfolio.optim}{default}(x, pm = mean(x), riskless = FALSE, shorts = FALSE, rf = 0.0, reslow = NULL, reshigh = NULL, covmat = cov(x), \dots) } \arguments{ \item{x}{a numeric matrix or multivariate time series consisting of a series of returns.} \item{pm}{the desired mean portfolio return.} \item{riskless}{a logical indicating whether there is a riskless lending and borrowing rate.} \item{shorts}{a logical indicating whether shortsales on the risky securities are allowed.} \item{rf}{the riskfree interest rate.} \item{reslow}{a vector specifying the (optional) lower bound on allowed portfolio weights.} \item{reshigh}{a vector specifying the (optional) upper bound on allowed portfolio weights.} \item{covmat}{the covariance matrix of asset returns.} \item{\dots}{further arguments to be passed from or to methods.} } \details{ The computed portfolio has the desired expected return \code{pm} and no other portfolio exists, which has the same mean return, but a smaller variance. Inequality restrictions of the form \eqn{w_l \le w \le w_h}{w_l <= w <= w_h} can be imposed using the \code{reslow} and \code{reshigh} vectors. An alternative covariance matrix estimate can be supplied via the \code{covmat} argument. To solve the quadratic program, \code{\link[quadprog]{solve.QP}} is used. \code{portfolio.optim} is a generic function with methods for multivariate \code{"ts"} and \code{default} for matrix. Missing values are not allowed. } \value{ A list containing the following components: \item{pw}{the portfolio weights.} \item{px}{the returns of the overall portfolio.} \item{pm}{the expected portfolio return.} \item{ps}{the standard deviation of the portfolio returns.} } \references{ E. J. Elton and M. J. Gruber (1991): \emph{Modern Portfolio Theory and Investment Analysis}, 4th Edition, Wiley, NY, pp. 65-93. C. Huang and R. H. Litzenberger (1988): \emph{Foundations for Financial Economics}, Elsevier, NY, pp. 59-82. } \author{A. Trapletti} \seealso{ \code{\link[quadprog]{solve.QP}} } \examples{ x <- rnorm(1000) dim(x) <- c(500,2) res <- portfolio.optim(x) res$pw require("zoo") # For diff() method. X <- diff(log(as.zoo(EuStockMarkets))) res <- portfolio.optim(X) ## Long only res$pw res <- portfolio.optim(X, shorts=TRUE) ## Long/Short res$pw } \keyword{ts} tseries/man/plotOHLC.Rd0000644000175100001440000000475213075614234014451 0ustar hornikusers\name{plotOHLC} \alias{plotOHLC} \title{Plot Open-High-Low-Close Bar Chart} \description{ Plots open-high-low-close bar chart of a (financial) time series. } \usage{ plotOHLC(x, xlim = NULL, ylim = NULL, xlab = "Time", ylab, col = par("col"), bg = par("bg"), axes = TRUE, frame.plot = axes, ann = par("ann"), main = NULL, date = c("calendar", "julian"), format = "\%Y-\%m-\%d", origin = "1899-12-30", \dots) } \arguments{ \item{x}{a multivariate time series object of class \code{"mts"}.} \item{xlim, ylim, xlab, ylab, col, bg, axes, frame.plot, ann, main}{graphical arguments, see \code{\link{plot}}, \code{\link{plot.default}} and \code{\link{par}}.} \item{date}{a string indicating the type of x axis annotation. Default is calendar dates.} \item{format}{a string indicating the format of the x axis annotation if \code{date == "calendar"}. For details see \code{\link{format.POSIXct}}.} \item{origin}{an R object specifying the origin of the Julian dates if \code{date == "calendar"}. Defaults to 1899-12-30 (Popular spreadsheet programs internally also use Julian dates with this origin).} \item{\dots}{further graphical arguments passed to \code{\link{plot.window}}, \code{\link{title}}, \code{\link{axis}}, and \code{\link{box}}.} } \details{ Within an open-high-low-close bar chart, each bar represents price information for the time interval between the open and the close price. The left tick for each bar indicates the open price for the time interval. The right tick indicates the closing price for the time interval. The vertical length of the bar represents the price range for the time interval. The time scale of \code{x} must be in Julian dates (days since the \code{origin}). } \author{A. Trapletti} \seealso{ \code{\link{plot.default}}, \code{\link{format.POSIXct}}, \code{\link{get.hist.quote}} } \examples{ con <- url("https://finance.yahoo.com") if(!inherits(try(open(con), silent = TRUE), "try-error")) { close(con) ## Plot OHLC bar chart for the last 'nDays' days of the instrument ## 'instrument' nDays <- 50 instrument <- "^gspc" start <- strftime(as.POSIXlt(Sys.time() - nDays * 24 * 3600), format="\%Y-\%m-\%d") end <- strftime(as.POSIXlt(Sys.time()), format = "\%Y-\%m-\%d") x <- get.hist.quote(instrument = instrument, start = start, end = end, retclass = "ts") plotOHLC(x, ylab = "price", main = instrument) } } \keyword{hplot} \keyword{ts} tseries/man/tsbootstrap.Rd0000644000175100001440000001303314656603417015410 0ustar hornikusers\name{tsbootstrap} \alias{tsbootstrap} \alias{print.resample.statistic} \title{Bootstrap for General Stationary Data} \description{ \code{tsbootstrap} generates bootstrap samples for general stationary data and computes the bootstrap estimate of standard error and bias if a statistic is given. } \usage{ tsbootstrap(x, nb = 1, statistic = NULL, m = 1, b = NULL, type = c("stationary","block"), \dots) } \arguments{ \item{x}{a numeric vector or time series giving the original data.} \item{nb}{the number of bootstrap series to compute.} \item{statistic}{a function which when applied to a time series returns a vector containing the statistic(s) of interest.} \item{m}{the length of the basic blocks in the block of blocks bootstrap.} \item{b}{if \code{type} is \code{"stationary"}, then \code{b} is the mean block length. If \code{type} is \code{"block"}, then \code{b} is the fixed block length.} \item{type}{the type of bootstrap to generate the simulated time series. The possible input values are \code{"stationary"} (stationary bootstrap with mean block length \code{b}) and \code{"block"} (blockwise bootstrap with block length \code{b}). Default to \code{"stationary"}.} \item{\dots}{additional arguments for \code{statistic} which are passed unchanged each time \code{statistic} is called.} } \details{ If \code{type} is \code{"stationary"}, then the stationary bootstrap scheme with mean block length \code{b} according to Politis and Romano (1994) is computed. For \code{type} equals \code{"block"}, the blockwise bootstrap with block length \code{b} according to Kuensch (1989) is used. If \code{m > 1}, then the block of blocks bootstrap is computed (see Kuensch, 1989). The basic sampling scheme is the same as for the case \code{m = 1}, except that the bootstrap is applied to a series \code{y} containing blocks of length \code{m}, where each block of \code{y} is defined as \eqn{y[t] = (x[t], \dots, x[t-m+1])}. Therefore, for the block of blocks bootstrap the first argument of \code{statistic} is given by a \code{n x m} matrix \code{yb}, where each row of \code{yb} contains one bootstrapped basic block observation \eqn{y[t]} (\code{n} is the number of observations in \code{x}). Note, that for statistics which are functions of the empirical \code{m}-dimensional marginal (\code{m > 1}) only this procedure yields asymptotically valid bootstrap estimates. The case \code{m = 1} may only be used for symmetric statistics (i.e., for statistics which are invariant under permutations of \code{x}). \code{\link[boot]{tsboot}} does not implement the block of blocks bootstrap, and, therefore, the first example in \code{\link[boot]{tsboot}} yields inconsistent estimates. For consistency, the (mean) block length \code{b} should grow with \code{n} at an appropriate rate. If \code{b} is not given, then a default growth rate of \code{const * n^(1/3)} is used. This rate is "optimal" under certain conditions (see the references for more details). However, in general the growth rate depends on the specific properties of the data generation process. A default value for \code{const} has been determined by a Monte Carlo simulation using a Gaussian AR(1) process (AR(1)-parameter of 0.5, 500 observations). \code{const} has been chosen such that the mean square error for the bootstrap estimate of the variance of the empirical mean is minimized. Note, that the computationally intensive parts are fully implemented in \code{C} which makes \code{tsbootstrap} about 10 to 30 times faster than \code{\link[boot]{tsboot}}. Missing values are not allowed. There is a special print method for objects of class \code{"resample.statistic"} which by default uses \code{max(3, getOption("digits") - 3)} digits to format real numbers. } \value{ If \code{statistic} is \code{NULL}, then it returns a matrix or time series with \code{nb} columns and \code{length(x)} rows containing the bootstrap data. Each column contains one bootstrap sample. If \code{statistic} is given, then a list of class \code{"resample.statistic"} with the following elements is returned: \item{statistic}{the results of applying \code{statistic} to each of the simulated time series.} \item{orig.statistic}{the results of applying \code{statistic} to the original series.} \item{bias}{the bootstrap estimate of the bias of \code{statistic}.} \item{se}{the bootstrap estimate of the standard error of \code{statistic}.} \item{call}{the original call of \code{tsbootstrap}.} } \references{ H. R. Kuensch (1989): The Jackknife and the Bootstrap for General Stationary Observations. \emph{The Annals of Statistics} \bold{17}, 1217--1241. D. N. Politis and J. P. Romano (1994): The Stationary Bootstrap. \emph{Journal of the American Statistical Association} \bold{89}, 1303--1313. } \author{A. Trapletti} \seealso{ \code{\link{sample}}, \code{\link{surrogate}}, \code{\link[boot]{tsboot}} } \examples{ n <- 500 # Generate AR(1) process a <- 0.6 e <- rnorm(n+100) x <- double(n+100) x[1] <- rnorm(1) for(i in 2:(n+100)) { x[i] <- a * x[i-1] + e[i] } x <- ts(x[-(1:100)]) tsbootstrap(x, nb=500, statistic=mean) # Asymptotic formula for the std. error of the mean sqrt(1/(n*(1-a)^2)) acflag1 <- function(x) { xo <- c(x[,1], x[1,2]) xm <- mean(xo) return(mean((x[,1]-xm)*(x[,2]-xm))/mean((xo-xm)^2)) } tsbootstrap(x, nb=500, statistic=acflag1, m=2) # Asymptotic formula for the std. error of the acf at lag one sqrt(((1+a^2)-2*a^2)/n) } \keyword{ts} tseries/man/na.remove.Rd0000644000175100001440000000222511304021310014664 0ustar hornikusers\name{na.remove} \alias{na.remove} \alias{na.remove.ts} \alias{na.remove.default} \title{NA Handling Routines for Time Series} \description{ Observations with missing values in some of the variables are removed. } \usage{ na.remove(object, \dots) } \arguments{ \item{object}{a numeric matrix, vector, univariate, or multivariate time series.} \item{\dots}{further arguments to be passed to or from methods.} } \details{ For \code{na.remove.ts} this changes the ``intrinsic'' time scale. It is assumed that both, the new and the old time scale are synchronized at the first and the last valid observation. In between, the new series is equally spaced in the new time scale. } \value{ An object without missing values. The attribute \code{"na.removed"} contains the indices of the removed missing values in \code{object}. } \author{A. Trapletti} \seealso{ \code{\link{na.omit}}, \code{\link{na.fail}} } \examples{ x<-ts(c(5453.08,5409.24,5315.57,5270.53, # one and a half week stock index 5211.66,NA,NA,5160.80,5172.37)) # data including a weekend na.remove(x) # eliminate weekend and introduce ``business'' time scale } \keyword{ts} tseries/man/seqplot.ts.Rd0000644000175100001440000000341311304021310015106 0ustar hornikusers\name{seqplot.ts} \alias{seqplot.ts} \title{Plot Two Time Series} \description{ Plot two time series on the same plot frame. } \usage{ seqplot.ts(x, y, colx = "black", coly = "red", typex = "l", typey = "l", pchx = 1, pchy = 1, ltyx = "solid", ltyy = "solid", oma = c(6, 0, 5, 0), ann = par("ann"), xlab = "Time", ylab = deparse(substitute(x)), main = NULL) } \arguments{ \item{x, y}{the time series.} \item{colx, coly}{color code or name for the \code{x} and \code{y} series, see \code{\link{colors}}, \code{\link{palette}}.} \item{typex, typey}{what type of plot should be drawn for the \code{x} and \code{y} series, see \code{\link{plot}}.} \item{pchx, pchy}{character or integer code for kind of points/lines for the \code{x} and \code{y} series.} \item{ltyx, ltyy}{line type code for the \code{x} and \code{y} series, see \code{\link{lines}}.} \item{oma}{a vector giving the size of the outer margins in lines of text, see \code{\link{par}}.} \item{ann}{annotate the plots? See \code{\link{par}}.} \item{xlab, ylab}{titles for the x and y axis.} \item{main}{an overall title for the plot.} } \details{ Unlike \code{\link{plot.ts}} the series can have different time bases, but they should have the same frequency. Unlike \code{\link{ts.plot}} the series can be plotted in different styles and for multivariate \code{x} and \code{y} the common variables are plotted together in a separate array element. } \value{ None. } \author{A. Trapletti} \seealso{ \code{\link{ts}}, \code{\link{plot.ts}} } \examples{ data(USeconomic) x <- ts.union(log(M1), log(GNP), rs, rl) m.ar <- ar(x, method = "ols", order.max = 5) y <- predict(m.ar, x, n.ahead = 200, se.fit = FALSE) seqplot.ts(x, y) } \keyword{hplot} \keyword{ts} tseries/man/surrogate.Rd0000644000175100001440000000621711304021310015012 0ustar hornikusers\name{surrogate} \alias{surrogate} \title{Generate Surrogate Data and Statistics} \description{ Generates \code{ns} surrogate samples from the original data \code{x} and computes the standard error and the bias of \code{statistic} as in a bootstrap setup, if \code{statistic} is given. } \usage{ surrogate(x, ns = 1, fft = FALSE, amplitude = FALSE, statistic = NULL, \dots) } \arguments{ \item{x}{a numeric vector or time series.} \item{ns}{the number of surrogate series to compute.} \item{fft}{a logical indicating whether phase randomized surrogate data is generated.} \item{amplitude}{a logical indicating whether amplitude-adjusted surrogate data is computed.} \item{statistic}{a function which when applied to a time series returns a vector containing the statistic(s) of interest.} \item{\dots}{Additional arguments for \code{statistic} which are passed unchanged each time it is called.} } \details{ If \code{fft} is \code{FALSE}, then \code{x} is mixed in temporal order, so that all temporal dependencies are eliminated, but the histogram of the original data is preserved. If \code{fft} is \code{TRUE}, then surrogate data with the same spectrum as \code{x} is computed by randomizing the phases of the Fourier coefficients of \code{x}. If in addition \code{amplitude} is \code{TRUE}, then also the amplitude distribution of the original series is preserved. Note, that the interpretation of the computed standard error and bias is different than in a bootstrap setup. To compute the phase randomized surrogate and the amplitude adjusted data algorithm 1 and 2 from Theiler et al. (1992), pp. 183, 184 are used. Missing values are not allowed. } \value{ If \code{statistic} is \code{NULL}, then it returns a matrix or time series with \code{ns} columns and \code{length(x)} rows containing the surrogate data. Each column contains one surrogate sample. If \code{statistic} is given, then a list of class \code{"resample.statistic"} with the following elements is returned: \item{statistic}{the results of applying \code{statistic} to each of the simulated time series.} \item{orig.statistic}{the results of applying \code{statistic} to the original series.} \item{bias}{the bias of the statistics computed as in a bootstrap setup.} \item{se}{the standard error of the statistics computed as in a bootstrap setup.} \item{call}{the original call of \code{surrogate}.} } \references{ J. Theiler, B. Galdrikian, A. Longtin, S. Eubank, and J. D. Farmer (1992): Using Surrogate Data to Detect Nonlinearity in Time Series, in \emph{Nonlinear Modelling and Forecasting}, Eds. M. Casdagli and S. Eubank, Santa Fe Institute, Addison Wesley, 163--188. } \author{A. Trapletti} \seealso{ \code{\link{sample}}, \code{\link{tsbootstrap}} } \examples{ x <- 1:10 # Simple example surrogate(x) n <- 500 # Generate AR(1) process e <- rnorm(n) x <- double(n) x[1] <- rnorm(1) for(i in 2:n) { x[i] <- 0.4 * x[i-1] + e[i] } x <- ts(x) theta <- function(x) # Autocorrelations up to lag 10 return(acf(x, plot=FALSE)$acf[2:11]) surrogate(x, ns=50, fft=TRUE, statistic=theta) } \keyword{ts} tseries/man/sharpe.Rd0000644000175100001440000000211111304021310014246 0ustar hornikusers\name{sharpe} \alias{sharpe} \title{Sharpe Ratio} \description{ This function computes the Sharpe ratio of the univariate time series (or vector) \code{x}. } \usage{ sharpe(x, r = 0, scale = sqrt(250)) } \arguments{ \item{x}{a numeric vector or univariate time series corresponding to a portfolio's cumulated returns.} \item{r}{the risk free rate. Default corresponds to using portfolio returns not in excess of the riskless return.} \item{scale}{a scale factor. Default corresponds to an annualization when working with daily financial time series data.} } \details{ The Sharpe ratio is defined as a portfolio's mean return in excess of the riskless return divided by the portfolio's standard deviation. In finance the Sharpe Ratio represents a measure of the portfolio's risk-adjusted (excess) return. } \value{ a double representing the Sharpe ratio. } \author{A. Trapletti} \seealso{ \code{\link{sterling}} } \examples{ data(EuStockMarkets) dax <- log(EuStockMarkets[,"DAX"]) ftse <- log(EuStockMarkets[,"FTSE"]) sharpe(dax) sharpe(ftse) } \keyword{ts} tseries/man/pp.test.Rd0000644000175100001440000000472011304021310014371 0ustar hornikusers\name{pp.test} \alias{pp.test} \title{Phillips--Perron Unit Root Test} \description{ Computes the Phillips-Perron test for the null hypothesis that \code{x} has a unit root. } \usage{ pp.test(x, alternative = c("stationary", "explosive"), type = c("Z(alpha)", "Z(t_alpha)"), lshort = TRUE) } \arguments{ \item{x}{a numeric vector or univariate time series.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"stationary"} (default) or \code{"explosive"}. You can specify just the initial letter.} \item{type}{indicates which variant of the test is computed and must be one of \code{"Z(alpha)"} (default) or \code{"Z(t_alpha)"}.} \item{lshort}{a logical indicating whether the short or long version of the truncation lag parameter is used.} } \details{ The general regression equation which incorporates a constant and a linear trend is used and the \code{Z(alpha)} or \code{Z(t_alpha)} statistic for a first order autoregressive coefficient equals one are computed. To estimate \code{sigma^2} the Newey-West estimator is used. If \code{lshort} is \code{TRUE}, then the truncation lag parameter is set to \code{trunc(4*(n/100)^0.25)}, otherwise \code{trunc(12*(n/100)^0.25)} is used. The p-values are interpolated from Table 4.1 and 4.2, p. 103 of Banerjee et al. (1993). If the computed statistic is outside the table of critical values, then a warning message is generated. Missing values are not handled. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{parameter}{the truncation lag parameter.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{data.name}{a character string giving the name of the data.} \item{alternative}{a character string describing the alternative hypothesis.} } \references{ A. Banerjee, J. J. Dolado, J. W. Galbraith, and D. F. Hendry (1993): \emph{Cointegration, Error Correction, and the Econometric Analysis of Non-Stationary Data}, Oxford University Press, Oxford. P. Perron (1988): Trends and Random Walks in Macroeconomic Time Series. \emph{Journal of Economic Dynamics and Control} \bold{12}, 297--332. } \author{A. Trapletti} \seealso{ \code{\link{adf.test}} } \examples{ x <- rnorm(1000) # no unit-root pp.test(x) y <- cumsum(x) # has unit root pp.test(y) } \keyword{ts} tseries/man/arma.Rd0000644000175100001440000001004711304021310013713 0ustar hornikusers\name{arma} \alias{arma} \title{Fit ARMA Models to Time Series} \description{ Fit an ARMA model to a univariate time series by conditional least squares. For exact maximum likelihood estimation see \code{\link{arima0}}. } \usage{ arma(x, order = c(1, 1), lag = NULL, coef = NULL, include.intercept = TRUE, series = NULL, qr.tol = 1e-07, \dots) } \arguments{ \item{x}{a numeric vector or time series.} \item{order}{a two dimensional integer vector giving the orders of the model to fit. \code{order[1]} corresponds to the AR part and \code{order[2]} to the MA part.} \item{lag}{a list with components \code{ar} and \code{ma}. Each component is an integer vector, specifying the AR and MA lags that are included in the model. If both, \code{order} and \code{lag}, are given, only the specification from \code{lag} is used.} \item{coef}{If given this numeric vector is used as the initial estimate of the ARMA coefficients. The preliminary estimator suggested in Hannan and Rissanen (1982) is used for the default initialization.} \item{include.intercept}{Should the model contain an intercept?} \item{series}{name for the series. Defaults to \code{deparse(substitute(x))}.} \item{qr.tol}{the \code{tol} argument for \code{\link{qr}} when computing the asymptotic standard errors of \code{coef}.} \item{\dots}{additional arguments for \code{\link{optim}} when fitting the model.} } \details{ The following parametrization is used for the ARMA(p,q) model: \deqn{y[t] = a[0] + a[1]y[t-1] + \dots + a[p]y[t-p] + b[1]e[t-1] + \dots + b[q]e[t-q] + e[t],} where \eqn{a[0]} is set to zero if no intercept is included. By using the argument \code{lag}, it is possible to fit a parsimonious submodel by setting arbitrary \eqn{a[i]} and \eqn{b[i]} to zero. \code{arma} uses \code{\link{optim}} to minimize the conditional sum-of-squared errors. The gradient is computed, if it is needed, by a finite-difference approximation. Default initialization is done by fitting a pure high-order AR model (see \code{\link{ar.ols}}). The estimated residuals are then used for computing a least squares estimator of the full ARMA model. See Hannan and Rissanen (1982) for details. } \value{ A list of class \code{"arma"} with the following elements: \item{lag}{the lag specification of the fitted model.} \item{coef}{estimated ARMA coefficients for the fitted model.} \item{css}{the conditional sum-of-squared errors.} \item{n.used}{the number of observations of \code{x}.} \item{residuals}{the series of residuals.} \item{fitted.values}{the fitted series.} \item{series}{the name of the series \code{x}.} \item{frequency}{the frequency of the series \code{x}.} \item{call}{the call of the \code{arma} function.} \item{vcov}{estimate of the asymptotic-theory covariance matrix for the coefficient estimates.} \item{convergence}{The \code{convergence} integer code from \code{\link{optim}}.} \item{include.intercept}{Does the model contain an intercept?} } \references{ E. J. Hannan and J. Rissanen (1982): Recursive Estimation of Mixed Autoregressive-Moving Average Order. \emph{Biometrika} \bold{69}, 81--94. } \author{ A. Trapletti } \seealso{ \code{\link{summary.arma}} for summarizing ARMA model fits; \code{\link{arma-methods}} for further methods; \code{\link{arima0}}, \code{\link{ar}}. } \examples{ data(tcm) r <- diff(tcm10y) summary(r.arma <- arma(r, order = c(1, 0))) summary(r.arma <- arma(r, order = c(2, 0))) summary(r.arma <- arma(r, order = c(0, 1))) summary(r.arma <- arma(r, order = c(0, 2))) summary(r.arma <- arma(r, order = c(1, 1))) plot(r.arma) data(nino) s <- nino3.4 summary(s.arma <- arma(s, order=c(20,0))) summary(s.arma <- arma(s, lag=list(ar=c(1,3,7,10,12,13,16,17,19),ma=NULL))) acf(residuals(s.arma), na.action=na.remove) pacf(residuals(s.arma), na.action=na.remove) summary(s.arma <- arma(s, lag=list(ar=c(1,3,7,10,12,13,16,17,19),ma=12))) summary(s.arma <- arma(s, lag=list(ar=c(1,3,7,10,12,13,16,17),ma=12))) plot(s.arma) } \keyword{ts} tseries/man/NelPlo.Rd0000644000175100001440000000323313762377436014224 0ustar hornikusers\name{NelPlo} \alias{NelPlo} \alias{cpi} \alias{ip} \alias{gnp.nom} \alias{vel} \alias{emp} \alias{int.rate} \alias{nom.wages} \alias{gnp.def} \alias{money.stock} \alias{gnp.real} \alias{stock.prices} \alias{gnp.capita} \alias{real.wages} \alias{unemp} \title{ Nelson--Plosser Macroeconomic Time Series } \description{ These are the extended Nelson-Plosser Data. } \usage{ data(NelPlo) } \format{ 14 macroeconomic time series: \code{cpi}, \code{ip}, \code{gnp.nom}, \code{vel}, \code{emp}, \code{int.rate}, \code{nom.wages}, \code{gnp.def}, \code{money.stock}, \code{gnp.real}, \code{stock.prices}, \code{gnp.capita}, \code{real.wages}, and \code{unemp} and the joint series \code{NelPlo}. } \details{ The series are of various lengths but all end in 1988. The data set contains the following series: consumer price index, industrial production, nominal GNP, velocity, employment, interest rate, nominal wages, GNP deflator, money stock, real GNP, stock prices (S&P500), GNP per capita, real wages, unemployment. } \source{ C. R. Nelson and C. I. Plosser (1982), Trends and Random Walks in Macroeconomic Time Series. \emph{Journal of Monetary Economics}, \bold{10}, 139--162. \doi{10.1016/0304-3932(82)90012-5}. Formerly in the Journal of Business and Economic Statistics data archive, currently at \url{http://korora.econ.yale.edu/phillips/data/np&enp.dat}. } \references{ G. Koop and M. F. J. Steel (1994), A Decision-Theoretic Analysis of the Unit-Root Hypothesis using Mixtures of Elliptical Models. \emph{Journal of Business and Economic Statistics}, \bold{12}, 95--107. \doi{10.1080/07350015.1994.10509993}. } \keyword{datasets} tseries/man/camp.Rd0000644000175100001440000000114413112744004013724 0ustar hornikusers\name{camp} \alias{camp} \title{ Mount Campito Yearly Treering Data, -3435--1969. } \description{ Contains annual tree-ring measurements from Mount Campito from 3426 BC through 1969 AD. } \usage{ data(camp) } \format{ A univariate time series with 5405 observations. The object is of class \code{"ts"}. } \details{ This series is a standard example for the concept of long memory time series. The data was produced and assembled at the Tree Ring Laboratory at the University of Arizona, Tuscon. } \source{ Time Series Data Library: \url{https://robjhyndman.com/TSDL/} } \keyword{datasets} tseries/man/tcm.Rd0000644000175100001440000000127513762355300013604 0ustar hornikusers\name{tcm} \alias{tcm} \alias{tcm1y} \alias{tcm3y} \alias{tcm5y} \alias{tcm10y} \title{ Monthly Yields on Treasury Securities } \description{ This data set contains monthly 1 year, 3 year, 5 year, and 10 year yields on treasury securities at constant, fixed maturity. } \usage{ data(tcm) } \format{ 4 univariate time series \code{tcm1y}, \code{tcm3y}, \code{tcm5y}, and \code{tcm10y} and the joint series \code{tcm}. } \details{ The yields at constant fixed maturity have been constructed by the Treasury Department, based on the most actively traded marketable treasury securities. } \source{ U.S. Fed \url{https://www.federalreserve.gov/Releases/H15/data.htm} } \keyword{datasets} tseries/man/irts-methods.Rd0000644000175100001440000000651311304021310015420 0ustar hornikusers\name{irts-methods} \alias{irts-methods} \alias{lines.irts} \alias{plot.irts} \alias{points.irts} \alias{print.irts} \alias{time.irts} \alias{value} \alias{value.irts} \alias{[.irts} \title{Methods for Irregular Time-Series Objects} \description{ Methods for irregular time-series objects. } \usage{ \method{lines}{irts}(x, type = "l", \dots) \method{plot}{irts}(x, type = "l", plot.type = c("multiple", "single"), xlab = "Time", ylab = NULL, main = NULL, ylim = NULL, oma = c(6, 0, 5, 0), \dots) \method{points}{irts}(x, type = "p", \dots) \method{print}{irts}(x, format = "\%Y-\%m-\%d \%H:\%M:\%S", tz = "GMT", usetz = TRUE, format.value = NULL, \dots) \method{time}{irts}(x, \dots) \method{value}{irts}(x, \dots) \method{[}{irts}(x, i, j, \dots) } \arguments{ \item{x}{an object of class \code{"irts"}; usually, a result of a call to \code{\link{irts}}.} \item{type, plot.type, xlab, ylab, main, ylim, oma}{graphical arguments, see \code{\link{plot}}, \code{\link{points}}, \code{\link{lines}}, \code{\link{par}}, and \code{\link{plot.ts}}.} \item{format, tz, usetz}{formatting related arguments, see \code{\link{format.POSIXct}}.} \item{format.value}{a string which specifies the formatting of the values when printing an irregular time-series object. \code{format.value} is passed unchanged as argument \code{format} to the function \code{\link{formatC}}.} \item{i, j}{indices specifying the parts to extract from an irregular time-series object.} \item{\dots}{further arguments passed to or from other methods: for \code{lines} passed to \code{\link{lines}}; for \code{plot} passed to \code{\link{plot}}, \code{\link{plot.default}}, and \code{\link{mtext}}; for \code{points} passed to \code{\link{points}}; for \code{print} passed to \code{\link{formatC}}; for \code{time}, \code{value}, and \code{[.irts} unused.} } \details{ \code{plot} is the method for plotting irregular time-series objects. \code{points} and \code{lines} are the methods for drawing a sequence of points as given by an irregular time-series object and joining the corresponding points with line segments, respectively. \code{print} is the method for printing irregular time-series objects. \code{time} and \code{value} are the methods for extracting the sequence of times and the sequence of values of an irregular time-series object. \code{[.irts} is the method for extracting parts of irregular time-series objects. } \value{ For \code{time} an object of class \code{"POSIXct"} representing the sequence of times. For \code{value} a vector or matrix representing the sequence of values. For \code{[.irts} an object of class \code{"irts"} representing the extracted part. For \code{plot}, \code{points}, \code{lines}, and \code{print} the irregular time-series object. } \author{ A. Trapletti } \seealso{ \code{\link{irts}}, \code{\link{irts-functions}} } \examples{ n <- 10 t <- cumsum(rexp(n, rate = 0.1)) v <- rnorm(n) x <- irts(t, v) x time(x) value(x) plot(x) points(x) t <- cumsum(c(t[1], rexp(n-1, rate = 0.2))) v <- rnorm(n, sd = 0.1) x <- irts(t, v) lines(x, col = "red") points(x, col = "red") # Multivariate t <- cumsum(rexp(n, rate = 0.1)) u <- rnorm(n) v <- rnorm(n) x <- irts(t, cbind(u, v)) x x[,1] x[1:3,] x[1:3,1] plot(x) } \keyword{ts} tseries/man/summary.garch.Rd0000644000175100001440000000256311304021310015557 0ustar hornikusers\name{summary.garch} \alias{summary.garch} \alias{print.summary.garch} \title{Summarizing GARCH Model Fits} \description{ Methods for creating and printing summaries of GARCH model fits. } \usage{ \method{summary}{garch}(object, \dots) \method{print}{summary.garch}(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), \dots) } \arguments{ \item{object}{an object of class \code{"garch"}; usually, a result of a call to \code{\link{garch}}.} \item{x}{an object of class \code{"summary.garch"}; usually, a result of a call to the summary method for objects of class \code{"garch"}.} \item{digits, signif.stars}{see \code{\link{printCoefmat}}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ \code{summary} computes the asymptotic standard errors of the coefficient estimates from an outer-product approximation of the Hessian evaluated at the estimates, see Bollerslev (1986). It furthermore tests the residuals for normality and remaining ARCH effects, see \code{\link{jarque.bera.test}} and \code{\link{Box.test}}. } \value{ A list of class \code{"summary.garch"}. } \references{ T. Bollerslev (1986): Generalized Autoregressive Conditional Heteroscedasticity. \emph{Journal of Econometrics} \bold{31}, 307--327. } \seealso{ \code{\link{garch}} } \keyword{models} \keyword{ts} tseries/man/get.hist.quote.Rd0000644000175100001440000000764014233523253015702 0ustar hornikusers\name{get.hist.quote} \alias{get.hist.quote} \title{Download Historical Finance Data} \description{ Download historical financial data from a given data provider over the WWW. } \usage{ get.hist.quote(instrument = "^gdax", start, end, quote = c("Open", "High", "Low", "Close"), provider = c("yahoo"), method = NULL, origin = "1899-12-30", compression = "d", retclass = c("zoo", "ts"), quiet = FALSE, drop = FALSE) } \arguments{ \item{instrument}{a character string giving the name of the quote symbol to download. See the web page of the data provider for information about the available quote symbols.} \item{start}{an R object specifying the date of the start of the period to download. This must be in a form which is recognized by \code{\link{as.POSIXct}}, which includes R POSIX date/time objects, objects of class \code{"date"} (from package \code{date}) and \code{"chron"} and \code{"dates"} (from package \code{chron}), and character strings representing dates in ISO 8601 format. Defaults to 1992-01-02.} \item{end}{an R object specifying the end of the download period, see above. Defaults to yesterday.} \item{quote}{a character string or vector indicating whether to download opening, high, low, or closing quotes, or volume. For the default provider, this can be specified as \code{"Open"}, \code{"High"}, \code{"Low"}, \code{"Close"}, \code{"Adjusted"}, and \code{"Volume"}, respectively. Abbreviations are allowed.} \item{provider}{a character string with the name of the data provider. Currently, only \code{"yahoo"} is supported via \code{\link[quantmod:getSymbols.yahoo]{getSymbols}} from package \pkg{quantmod} for the Yahoo Finance source. Provider \code{"oanda"} is no longer available.} \item{method}{No longer used.} \item{origin}{an R object specifying the origin of the Julian dates, see above. Defaults to 1899-12-30 (Popular spreadsheet programs internally also use Julian dates with this origin).} \item{compression}{Governs the granularity of the retrieved data; \code{"d"} for daily, \code{"w"} for weekly or \code{"m"} for monthly. Defaults to \code{"d"}. For the provider \code{"oanda"}, this argument is ignored.} \item{retclass}{character specifying which class the return value should have: can be either \code{"zoo"} (with \code{"Date"} index), or \code{"ts"} (with numeric index corresponding to days since \code{origin}).} \item{quiet}{logical. Should status messages (if any) be suppressed?} \item{drop}{logical. If \code{TRUE} the result is coerced to the lowest possible dimension. Default is \code{FALSE}.} } \value{ A time series containing the data either as a \code{"zoo"} series (default) or a \code{"ts"} series. The \code{"zoo"} series is created with \code{\link[zoo]{zoo}} and has an index of class \code{"Date"}. If a \code{"ts"} series is returned, the index is in physical time, i.e., weekends, holidays, and missing days are filled with \code{NA}s if not available. The time scale is given in Julian dates (days since the \code{origin}). } \author{A. Trapletti} \seealso{ \code{\link[quantmod]{getSymbols}} for downloads from various providers; \code{\link[zoo]{zoo}}, \code{\link{ts}}, \code{\link{as.Date}}, \code{\link{as.POSIXct}}, } \examples{ tryCatch({ x <- get.hist.quote(instrument = "^gspc", start = "1998-01-01", quote = "Close") plot(x) x <- get.hist.quote(instrument = "ibm", quote = c("Cl", "Vol")) plot(x, main = "International Business Machines Corp") spc <- get.hist.quote(instrument = "^gspc", start = "1998-01-01", quote = "Close") ibm <- get.hist.quote(instrument = "ibm", start = "1998-01-01", quote = "Adj") require("zoo") # For merge() method. x <- merge(spc, ibm) plot(x, main = "IBM vs S&P 500") }, error = identity) } \keyword{ts} tseries/man/summary.arma.Rd0000644000175100001440000000225011304021310015404 0ustar hornikusers\name{summary.arma} \alias{summary.arma} \alias{print.summary.arma} \title{Summarizing ARMA Model Fits} \description{ Methods for creating and printing summaries of ARMA model fits. } \usage{ \method{summary}{arma}(object, \dots) \method{print}{summary.arma}(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), \dots) } \arguments{ \item{object}{an object of class \code{"arma"}; usually, a result of a call to \code{\link{arma}}.} \item{x}{an object of class \code{"summary.arma"}; usually, a result of a call to the summary method for objects of class \code{"arma"}.} \item{digits, signif.stars}{see \code{\link{printCoefmat}}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ The summary method computes the asymptotic standard errors of the coefficient estimates from the numerically differentiated Hessian matrix approximation. The AIC is computed from the conditional sum-of-squared errors and not from the true maximum likelihood function. That may be problematic. } \value{ A list of class \code{"summary.arma"}. } \seealso{ \code{\link{arma}} } \keyword{models} \keyword{ts} tseries/man/irts.Rd0000644000175100001440000000342611304021310013757 0ustar hornikusers\name{irts} \alias{irts} \alias{is.irts} \alias{as.irts} \alias{as.irts.default} \alias{as.irts.zoo} \title{Irregularly Spaced Time-Series} \description{ The function \code{irts} is used to create irregular time-series objects. \code{as.irts} coerces an object to an irregularly spaced time-series. \code{is.irts} tests whether an object is an irregularly spaced time series. } \usage{ irts(time, value) as.irts(object) is.irts(object) } \arguments{ \item{time}{a numeric vector or a vector of class \code{"POSIXct"} representing the time-stamps of the irregular time-series object. The elements of the numeric vector are construed as the (signed) number of seconds since the beginning of 1970, see \code{\link{POSIXct}}.} \item{value}{a numeric vector or matrix representing the values of the irregular time-series object.} \item{object}{an R object to be coerced to an irregular time-series object or an R object to be tested whether it is an irregular time-series object.} } \details{ The function \code{irts} is used to create irregular time-series objects. These are scalar or vector valued time series indexed by a time-stamp of class \code{"POSIXct"}. Unlike objects of class \code{"ts"}, they can be used to represent irregularly spaced time-series. } \value{ A list of class \code{"irts"} with the following elements: \item{time}{a vector of class \code{"POSIXct"}.} \item{value}{a numeric vector or matrix.} } \author{ A. Trapletti } \seealso{ \code{\link{ts}}, \code{\link{POSIXct}}, \code{\link{irts-methods}}, \code{\link{irts-functions}} } \examples{ n <- 10 t <- cumsum(rexp(n, rate = 0.1)) v <- rnorm(n) x <- irts(t, v) x as.irts(cbind(t, v)) is.irts(x) # Multivariate u <- rnorm(n) irts(t, cbind(u, v)) } \keyword{ts} tseries/man/white.test.Rd0000644000175100001440000000612011304021310015066 0ustar hornikusers\name{white.test} \title{White Neural Network Test for Nonlinearity} \alias{white.test} \alias{white.test.ts} \alias{white.test.default} \description{ Generically computes the White neural network test for neglected nonlinearity either for the time series \code{x} or the regression \code{y~x}. } \usage{ \method{white.test}{ts}(x, lag = 1, qstar = 2, q = 10, range = 4, type = c("Chisq","F"), scale = TRUE, \dots) \method{white.test}{default}(x, y, qstar = 2, q = 10, range = 4, type = c("Chisq","F"), scale = TRUE, \dots) } \arguments{ \item{x}{a numeric vector, matrix, or time series.} \item{y}{a numeric vector.} \item{lag}{an integer which specifies the model order in terms of lags.} \item{q}{an integer representing the number of phantom hidden units used to compute the test statistic.} \item{qstar}{the test is conducted using \code{qstar} principal components of the phantom hidden units. The first principal component is omitted since in most cases it appears to be collinear with the input vector of lagged variables. This strategy preserves power while still conserving degrees of freedom.} \item{range}{the input to hidden unit weights are initialized uniformly over [-range/2, range/2].} \item{type}{a string indicating whether the Chi-Squared test or the F-test is computed. Valid types are \code{"Chisq"} and \code{"F"}.} \item{scale}{a logical indicating whether the data should be scaled before computing the test statistic. The default arguments to \code{\link{scale}} are used.} \item{\dots}{further arguments to be passed from or to methods.} } \details{ The null is the hypotheses of linearity in ``mean''. This type of test is consistent against arbitrary nonlinearity in mean. If \code{type} equals \code{"F"}, then the F-statistic instead of the Chi-Squared statistic is used in analogy to the classical linear regression. Missing values are not allowed. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{parameter}{a list containing the additional parameters used to compute the test statistic.} \item{data.name}{a character string giving the name of the data.} \item{arguments}{additional arguments used to compute the test statistic.} } \references{ T. H. Lee, H. White, and C. W. J. Granger (1993): Testing for neglected nonlinearity in time series models. \emph{Journal of Econometrics} \bold{56}, 269-290. } \author{A. Trapletti} \seealso{ \code{\link{terasvirta.test}} } \examples{ n <- 1000 x <- runif(1000, -1, 1) # Non-linear in ``mean'' regression y <- x^2 - x^3 + 0.1*rnorm(x) white.test(x, y) ## Is the polynomial of order 2 misspecified? white.test(cbind(x,x^2,x^3), y) ## Generate time series which is nonlinear in ``mean'' x[1] <- 0.0 for(i in (2:n)) { x[i] <- 0.4*x[i-1] + tanh(x[i-1]) + rnorm(1, sd=0.5) } x <- as.ts(x) plot(x) white.test(x) } \keyword{ts} tseries/man/kpss.test.Rd0000644000175100001440000000364713374612630014765 0ustar hornikusers\name{kpss.test} \alias{kpss.test} \title{KPSS Test for Stationarity} \description{ Computes the Kwiatkowski-Phillips-Schmidt-Shin (KPSS) test for the null hypothesis that \code{x} is level or trend stationary. } \usage{ kpss.test(x, null = c("Level", "Trend"), lshort = TRUE) } \arguments{ \item{x}{a numeric vector or univariate time series.} \item{null}{indicates the null hypothesis and must be one of \code{"Level"} (default) or \code{"Trend"}. You can specify just the initial letter.} \item{lshort}{a logical indicating whether the short or long version of the truncation lag parameter is used.} } \details{ To estimate \code{sigma^2} the Newey-West estimator is used. If \code{lshort} is \code{TRUE}, then the truncation lag parameter is set to \code{trunc(4*(n/100)^0.25)}, otherwise \code{trunc(12*(n/100)^0.25)} is used. The p-values are interpolated from Table 1 of Kwiatkowski et al. (1992). If the computed statistic is outside the table of critical values, then a warning message is generated. Missing values are not handled. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the value of the test statistic.} \item{parameter}{the truncation lag parameter.} \item{p.value}{the p-value of the test.} \item{method}{a character string indicating what type of test was performed.} \item{data.name}{a character string giving the name of the data.} } \references{ D. Kwiatkowski, P. C. B. Phillips, P. Schmidt, and Y. Shin (1992): Testing the Null Hypothesis of Stationarity against the Alternative of a Unit Root. \emph{Journal of Econometrics} \bold{54}, 159--178. } \author{A. Trapletti} \seealso{ \code{\link{pp.test}} } \examples{ x <- rnorm(1000) # is level stationary kpss.test(x) y <- cumsum(x) # has unit root kpss.test(y) x <- 0.3*(1:1000)+rnorm(1000) # is trend stationary kpss.test(x, null = "Trend") } \keyword{ts} tseries/DESCRIPTION0000644000175100001440000000171714674236060013472 0ustar hornikusersPackage: tseries Version: 0.10-58 Title: Time Series Analysis and Computational Finance Authors@R: c(person("Adrian", "Trapletti", role = "aut", email = "adrian@trapletti.org"), person("Kurt", "Hornik", role = c("aut", "cre"), email = "Kurt.Hornik@R-project.org", comment = c(ORCID = "0000-0003-4198-9911")), person("Blake", "LeBaron", role = "ctb", comment = "BDS test code")) Description: Time series analysis and computational finance. Depends: R (>= 3.4.0) Imports: graphics, stats, utils, quadprog, zoo, quantmod (>= 0.4-9), jsonlite License: GPL-2 | GPL-3 NeedsCompilation: yes Packaged: 2024-09-23 09:27:59 UTC; hornik Author: Adrian Trapletti [aut], Kurt Hornik [aut, cre] (), Blake LeBaron [ctb] (BDS test code) Maintainer: Kurt Hornik Repository: CRAN Date/Publication: 2024-09-23 10:00:16 UTC