Commit 7219cc1e authored by Dirk Eddelbuettel's avatar Dirk Eddelbuettel

Import Upstream version 0.10-12

parent 99df089c
2007-11-04 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
* DESCRIPTION (Version): New version is 0.10-12.
* R/finance.R (get.hist.quote): OANDA enhancements.
2007-02-20 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
* DESCRIPTION (Version): New version is 0.10-11.
......@@ -70,7 +76,7 @@
* R/finance.R (get.hist.quote)
* man/get.hist.quote.Rd:
handled `method' argument as in download.file(), so
handled 'method' argument as in download.file(), so
that it can be set via options(download.file.method = "...")
2006-04-07 Achim Zeileis <Achim.Zeileis@R-project.org>
......@@ -407,7 +413,7 @@
* man/get.hist.quote.Rd:
* R/finance.R:
Change default value for argument `quote' of `get.hist.quote()'.
Change default value for argument 'quote' of 'get.hist.quote()'.
* man/maxdrawdown.Rd:
* R/finance.R:
......@@ -429,7 +435,7 @@
* DESCRIPTION (Version): New version is 0.8-0.
* R/tsutils.R: Call .C with `mode = "double"' everywhere.
* R/tsutils.R: Call .C with 'mode = "double"' everywhere.
* man/maxdrawdown.Rd:
* R/finance.R:
......@@ -445,7 +451,7 @@
* man/portfolio.optim.Rd:
* R/finance.R:
Integration of a patch of Dirk Eddelbuettel for `portfolio.optim()'
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.
......@@ -468,7 +474,7 @@
2001-08-19 Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
* man/tseries.internal.Rd: Change keyword `misc' to `internal'.
* man/tseries.internal.Rd: Change keyword 'misc' to 'internal'.
* R/tsutils.R: TnF fix.
......@@ -479,7 +485,7 @@
* R/test.R:
* man/terasvirta.test.Rd:
* man/white.test.Rd:
Use `Chisq' instead of `chisq' for argument `type'.
Use 'Chisq' instead of 'chisq' for argument 'type'.
2001-07-06 Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
......@@ -494,7 +500,7 @@
* DESCRIPTION (Version): New version is 0.7-2.
(Depends): Redo according to R-exts. Detailed info now in
`README'.
'README'.
* man/na.remove.Rd: Sync code and documented usage.
......
Package: tseries
Version: 0.10-11
Date: 2007-02-20
Version: 0.10-12
Date: 2007-11-04
Title: Time series analysis and computational finance
Author: Compiled by Adrian Trapletti <a.trapletti@swissonline.ch>
Maintainer: Kurt Hornik <Kurt.Hornik@R-project.org>
Description: Package for time series analysis and computational finance
Depends: R (>= 2.2.0), quadprog, stats, zoo
Depends: R (>= 2.4.0), quadprog, stats, zoo
Suggests: its
Imports: graphics, stats, utils
License: GPL-2
Packaged: Tue Feb 20 10:23:44 2007; hornik
Packaged: Sun Nov 4 18:42:23 2007; hornik
......@@ -125,13 +125,13 @@ function(x, order = c(1, 1), lag = NULL, coef = NULL,
coef <- md$par
rank <- qr(md$hessian, qr.tol)$rank
if(rank != ncoef) {
se <- rep(NA, ncoef)
cat("Warning: singular Hessian\n")
se <- rep.int(NA, ncoef)
warning("singular Hessian")
}
else {
di <- diag(2*md$value/n*solve(md$hessian))
if(any(di < 0))
cat("Warning: Hessian negative-semidefinite\n")
warning("Hessian negative-semidefinite")
se <- sqrt(di)
}
e <- resid(coef)
......
......@@ -51,13 +51,13 @@ function(x, pm = mean(x), riskless = FALSE, shorts = FALSE,
stop("covmat has not the right dimension")
}
Dmat <- covmat
dvec <- rep(0, k)
dvec <- rep.int(0, k)
big <- 1e+100
if(!is.null(reslow) & is.null(reshigh)) {
reshigh <- rep(big, k)
reshigh <- rep.int(big, k)
}
if(is.null(reslow) & !is.null(reshigh)) {
reslow <- -rep(big, k)
reslow <- -rep.int(big, k)
}
if(!is.null(reslow)) {
if(!is.vector(reslow)) {
......@@ -76,7 +76,7 @@ function(x, pm = mean(x), riskless = FALSE, shorts = FALSE,
}
}
if(riskless) {
a1 <- apply(x, 2, mean)-rf
a1 <- colMeans(x) - rf
if(shorts) {
a2 <- NULL
b2 <- NULL
......@@ -84,7 +84,7 @@ function(x, pm = mean(x), riskless = FALSE, shorts = FALSE,
else {
a2 <- matrix(0, k, k)
diag(a2) <- 1
b2 <- rep(0, k)
b2 <- rep.int(0, k)
}
if(!is.null(reslow) & !is.null(reshigh)) {
a3 <- matrix(0, k, k)
......@@ -99,8 +99,8 @@ function(x, pm = mean(x), riskless = FALSE, shorts = FALSE,
res <- solve.QP(Dmat, dvec, Amat, bvec=b0, meq=1)
}
else {
a1 <- rep(1, k)
a2 <- apply(x, 2, mean)
a1 <- rep.int(1, k)
a2 <- colMeans(x)
if(shorts) {
if(!is.null(reslow) & !is.null(reshigh)) {
a3 <- matrix(0, k, k)
......@@ -116,7 +116,7 @@ function(x, pm = mean(x), riskless = FALSE, shorts = FALSE,
else {
a3 <- matrix(0, k, k)
diag(a3) <- 1
b3 <- rep(0, k)
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)
......@@ -220,16 +220,16 @@ function (instrument = "^gdax", start, end,
## We need unclass() because 1.7.0 does not allow adding a
## number to a "difftime" object.
ind <- jdat - jdat[n] + 1
y <- matrix(NA, nr = max(ind), nc = length(nser))
y <- matrix(NA, nrow = max(ind), ncol = length(nser))
y[ind, ] <- as.matrix(x[, nser, drop = FALSE])
colnames(y) <- names(x)[nser]
y <- y[, seq(along = nser), drop = drop]
y <- y[, seq_along(nser), drop = drop]
return(ts(y, start = jdat[n], end = jdat[1]))
} else {
x <- as.matrix(x[, nser, drop = FALSE])
rownames(x) <- NULL
y <- zoo(x, dat)
y <- y[, seq(along = nser), drop = drop]
y <- y[, seq_along(nser), drop = drop]
if(retclass == "its") {
if("package:its" %in% search() || require("its", quietly = TRUE)) {
index(y) <- as.POSIXct(index(y))
......@@ -268,7 +268,7 @@ function (instrument = "^gdax", start, end,
stop(paste("download error, status", status))
}
x <- readLines(destfile)
x <- readLines(destfile, warn = quiet)
unlink(destfile)
if(length(grep("Sorry", x)) > 0) {
......@@ -276,32 +276,38 @@ function (instrument = "^gdax", start, end,
msg <- paste(msg[msg != ""], collapse = " ")
stop("Message from Oanda: ", msg)
}
first <- which(substr(x, 1, 5) == "<PRE>")
last <- which(x == "</PRE>") - 1
if((length(first) == 0) || (length(last) == 0)) {
## This used to have
## first <- which(substr(x, 1, 5) == "<PRE>")
## last <- which(x == "</PRE>") - 1
## but at least on 2007-11-04 we had an instance of <PRE> not
## being at the beginning of a line and </PRE> not being on a
## line of its own ...
first <- grep("<PRE>", x, fixed = TRUE)
last <- grep("</PRE>", x, fixed = TRUE) - 1
if((length(first) != 1) || (length(last) != 1)) {
stop(paste("no data available for", instrument))
}
x[first] <- substr(x[first], 6, nchar(x[first]))
split <- strsplit(x[first:last], split = " ")
x <- cbind(unlist(lapply(split, function(x) { x[1] })), unlist(lapply(split, function(x) { x[length(x)] })))
n <- nrow(x)
x[first] <- sub(".*<PRE>", "", x[first])
con <- textConnection(x[first:last])
on.exit(close(con))
x <- scan(con, what = list(character(), double()), quiet = TRUE)
dat <- as.Date(x[,1], format = "%m/%d/%Y")
dat <- as.Date(x[[1]], format = "%m/%d/%Y")
n <- length(dat)
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)))
jdat <- unclass(julian(dat, origin = as.Date(origin)))
ind <- jdat - jdat[1] + 1
y <- rep(NA, max(ind))
y[ind] <- as.numeric(x[,2])
y <- rep.int(NA, max(ind))
y[ind] <- x[[2]]
return(ts(y, start = jdat[1], end = jdat[n]))
} else {
y <- zoo(as.numeric(x[,2]), dat)
} else {
y <- zoo(x[[2]], dat)
if(retclass == "its") {
if("package:its" %in% search() || require("its", quietly = TRUE)) {
index(y) <- as.POSIXct(index(y))
......
......@@ -44,7 +44,7 @@ function (x, order = c(1, 1), coef = NULL, itmax = 200, eps = NULL,
hess <- matrix(0.0, ncoef, ncoef)
small <- 0.05
if(is.null(coef))
coef <- c(var(x)*(1.0-small*(ncoef-1)),rep(small,ncoef-1))
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")
if(is.null(eps)) eps <- .Machine$double.eps
......@@ -80,13 +80,13 @@ function (x, order = c(1, 1), coef = NULL, itmax = 200, eps = NULL,
PACKAGE="tseries")
rank <- qr(com.hess$hess, ...)$rank
if(rank != ncoef) {
se.garch <- rep(NA, ncoef)
cat("Warning: singular information\n")
se.garch <- rep.int(NA, ncoef)
warning("singular information")
}
else
se.garch <- sqrt(diag(solve(com.hess$hess)))
sigt <- sqrt(pred$e)
sigt[1:max(order[1],order[2])] <- rep(NA, max(order[1],order[2]))
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
......@@ -250,7 +250,7 @@ function(object, newdata, genuine = FALSE, ...)
PACKAGE="tseries")
pred$h <- sqrt(pred$h)
pred$h[1:max(object$order[1],object$order[2])] <-
rep(NA, 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") <-
......
......@@ -286,7 +286,7 @@ function(x, type = "l", plot.type = c("multiple", "single"),
}
}
} else {
stop("Can't plot more than 10 series")
stop("cannot plot more than 10 series")
}
invisible(x)
}
......@@ -302,7 +302,7 @@ function(x, type = "l", ...)
if(nser == 1) {
lines(t, v, type = type, ...)
} else {
stop("Can't plot multivariate irregular time-series object")
stop("cannot plot multivariate irregular time-series object")
}
invisible(x)
}
......@@ -318,7 +318,7 @@ function(x, type = "p", ...)
if(nser == 1) {
points(t, v, type = type, ...)
} else {
stop("Can't plot multivariate irregular time-series object")
stop("cannot plot multivariate irregular time-series object")
}
invisible(x)
}
......
......@@ -227,8 +227,8 @@ function(x, y, qstar = 2, q = 10, range = 4,
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"))
warning(paste("value 'chisq' for 'type' is deprecated,",
"use 'Chisq' instead"))
type <- "Chisq"
}
else
......@@ -244,7 +244,7 @@ function(x, y, qstar = 2, q = 10, range = 4,
ssr0 <- sum(u^2)
max <- range/2
gamma <- matrix(runif((nin+1)*q,-max,max),nin+1,q)
phantom <- (1+exp(-(cbind(rep(1,t),x)%*%gamma)))^(-1)
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="+")
......@@ -294,8 +294,8 @@ function(x, lag = 1, qstar = 2, q = 10, range = 4,
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"))
warning(paste("value 'chisq' for 'type' is deprecated,",
"use 'Chisq' instead"))
type <- "Chisq"
}
else
......@@ -311,7 +311,7 @@ function(x, lag = 1, qstar = 2, q = 10, range = 4,
ssr0 <- sum(u^2)
max <- range/2
gamma <- matrix(runif((lag+1)*q,-max,max),lag+1,q)
phantom <- (1+exp(-(cbind(rep(1,t-lag),y[,2:(lag+1)])%*%gamma)))^(-1)
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="+")
......@@ -370,8 +370,8 @@ function(x, y, type = c("Chisq", "F"), scale = TRUE, ...)
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"))
warning(paste("value 'chisq' for 'type' is deprecated,",
"use 'Chisq' instead"))
type <- "Chisq"
}
else
......@@ -449,8 +449,8 @@ function(x, lag = 1, type = c("Chisq", "F"), scale = TRUE, ...)
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"))
warning(paste("value 'chisq' for 'type' is deprecated,",
"use 'Chisq' instead"))
type <- "Chisq"
}
else
......
......@@ -107,7 +107,7 @@ function(x, ns = 1, fft = FALSE, amplitude = FALSE, statistic = NULL, ...)
for(i in 1:ns)
stat[i,] <- statistic(sample(x, replace=FALSE), ...)
colnames(stat) <- names(orig.statistic)
bias <- apply(stat, 2, mean) - orig.statistic
bias <- colMeans(stat) - orig.statistic
se <- apply(stat, 2, sd)
res <- list(statistic = drop(stat),
orig.statistic = drop(orig.statistic),
......@@ -218,10 +218,10 @@ function(x, y, colx = "black", coly = "red", typex = "l",
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 don't have the same frequency")
stop("x and y do not have the same frequency")
nser <- NCOL(x)
nsery <- NCOL(y)
if(nser != nsery) stop("x and y don't have consistent dimensions")
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)])
......@@ -234,7 +234,7 @@ function(x, y, colx = "black", coly = "red", typex = "l",
}
}
else {
if(nser > 10) stop("Can't plot more than 10 series")
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)
......@@ -314,7 +314,7 @@ tsbootstrap <- function(x, nb = 1, statistic = NULL, m = 1, b = NULL,
}
if(is.null(statistic)) {
if (m > 1)
stop("Can only return bootstrap data for 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)
......@@ -335,7 +335,7 @@ tsbootstrap <- function(x, nb = 1, statistic = NULL, m = 1, b = NULL,
for(i in 1:nb)
stat[i,] <- statistic(y[boot.sample(yi, b, type), , drop=TRUE], ...)
colnames(stat) <- names(orig.statistic)
bias <- apply(stat, 2, mean)-orig.statistic
bias <- colMeans(stat) - orig.statistic
se <- apply(stat, 2, sd)
res <- list(statistic = drop(stat),
orig.statistic = drop(orig.statistic),
......
......@@ -2,7 +2,7 @@
function(lib, pkg)
{
mylib <- dirname(system.file(package = "tseries"))
ver <- packageDescription("tseries", lib = mylib)["Version"]
ver <- packageDescription("tseries", lib.loc = mylib)["Version"]
txt <- c("\n",
paste(sQuote("tseries"), "version:", ver),
"\n",
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment