Nothing
#################################################################################
##
## R package rgarch by Alexios Ghalanos Copyright (C) 2008, 2009, 2010, 2011
## This file is part of the R package rgarch.
##
## The R package rgarch 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 3 of the License, or
## (at your option) any later version.
##
## The R package rgarch 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.
##
#################################################################################
# function to deal with the numerous data formats present
# we want to extract the date from the data
.extractmdata = function(data)
{
tsclass = class(data)[1]
valid.choices = c("timeSeries", "zoo", "zooreg", "data.frame",
"xts", "matrix")
if(!any(valid.choices == tsclass)) stop("\nrdcc-->error: class of data object not recognized")
x = switch(tsclass,
timeSeries = .mseries.timeSeries(data),
zoo = .mseries.zoo(data),
zooreg = .mseries.zoo(data),
xts = .mseries.xts(data),
data.frame = .mseries.dataframe(data),
matrix = .mseries.matrix(data))
return(x)
}
.mseries.timeSeries = function(data){
asset.names = colnames(data)
x = unclass(data)
if(!is.null(dim(data)[2]) && dim(data)[2]==1) stop("only multivariate datasets supported")
xdata = as.matrix(x)
rdates = .makedate(as.character(time(data)))
if(rdates$status){
xdates = rdates$dates
dformat = rdates$dformat
} else{
xdates = 1:length(x)
dformat = "numeric"
}
return(list(data = xdata, pos = xdates, dformat = dformat, asset.names = asset.names))
}
.mseries.zoo = function(data){
asset.names = colnames(data)
if(is.null(asset.names)) asset.names = paste("Asset_", 1:dim(data)[2], sep = "")
x = unclass(data)
if(!is.null(dim(data)[2]) && dim(data)[2]==1) stop("only multivariate datasets supported")
xdata = as.matrix(x)
rdates = .makedate(as.character(index(data)))
if(rdates$status){
xdates = rdates$dates
dformat = rdates$dformat
} else{
xdates = 1:length(x)
dformat = "numeric"
}
return(list(data = xdata, pos = xdates, dformat = dformat, asset.names = asset.names))
}
.mseries.xts = function(data){
asset.names = colnames(data)
x = unclass(data)
if(!is.null(dim(data)[2]) && dim(data)[2]==1) stop("only multivariate datasets supported")
xdata = as.matrix(x)
rdates = .makedate(as.character(index(data)))
if(rdates$status){
xdates = rdates$dates
dformat = rdates$dformat
} else{
xdates = 1:length(x)
dformat = "numeric"
}
return(list(data = xdata, pos = xdates, dformat = dformat, asset.names = asset.names))
}
.mseries.dataframe = function(data){
asset.names = colnames(data)
xdata = as.matrix(data)
if(!is.null(dim(data)[2]) && dim(data)[2]==1) stop("only multivariate datasets supported")
if(!is.null(rownames(data))){
rdates = .makedate(rownames(data))
if(rdates$status){
xdates = rdates$dates
dformat = rdates$dformat
} else{
xdates = 1:length(xdata)
dformat = "numeric"
}
} else{
xdates = 1:length(xdata)
dformat = "numeric"
}
return(list(data = xdata, pos = xdates, dformat = dformat, asset.names = asset.names))
}
.mseries.matrix<-function(data){
asset.names = colnames(data)
if(is.null(asset.names)) asset.names = paste("Asset_", 1:dim(data)[2], sep = "")
xdata = as.matrix(data)
if(!is.null(dim(data)[2]) && dim(data)[2]==1) stop("only multivariate datasets supported")
if(!is.null(rownames(data))){
rdates = .makedate(rownames(data))
if(rdates$status){
xdates = rdates$dates
dformat = rdates$dformat
} else{
xdates = as.character(1:length(xdata))
dformat = "numeric"
}
} else{
xdates = as.character(1:length(xdata))
dformat = "numeric"
}
return(list(data = xdata, pos = xdates, dformat = dformat, asset.names = asset.names))
}
.makedate = function(x)
{
# find the divisor: 4 cases "-", "/", ".", and no divisor
allc = strsplit(x[1], "")
if(any(allc[[1]] == "-")){
dt = "-"
ld = length(which(diff(which(allc[[1]]!="-"))==1))+3
dte = t(apply(as.data.frame(x), 1, FUN=function(z) as.numeric(strsplit(z, dt)[[1]]) ))
} else if(any(allc[[1]] == "/")){
dt = "/"
ld = length(which(diff(which(allc[[1]]!="/"))==1))+3
dte = t(apply(as.data.frame(x), 1, FUN=function(z) as.numeric(strsplit(z, dt)[[1]]) ))
} else if(any(allc[[1]] == ".")){
dt = "."
dte = t(apply(as.data.frame(x), 1, FUN=function(z) as.numeric(strsplit(z, dt)[[1]]) ))
} else{
# this is a little more complicated
ld = length(allc[[1]])
if(ld==6){
dte = t(apply(as.data.frame(x), 1, FUN=function(z)
as.numeric(c(substr(z, 1,2), substr(z, 3,4), substr(z, 5,6)))))
} else if(ld==8){
# 2 cases either the 4 digit year is at the beginning or else at the end
dte.1 = as.vector(t(apply(as.data.frame(x), 1, FUN=function(z)
as.numeric(c(substr(z, 1,2))))))
dte.2 = as.vector(t(apply(as.data.frame(x), 1, FUN=function(z)
as.numeric(c(substr(z, 5,6))))))
if(all(dte.1>18)){
dte = t(apply(as.data.frame(x), 1, FUN=function(z)
as.numeric(c(substr(z, 1,4), substr(z, 5,6), substr(z, 7,8)))))
} else if(all(dte.2>18)){
dte = t(apply(as.data.frame(x), 1, FUN=function(z)
as.numeric(c(substr(z, 1,2), substr(z, 3,4), substr(z, 5,8)))))
} else{
return(list(status=0))
}
} else{
return(list(status=0))
}
}
m = 0
for(i in 1:3){
if(all(dte[,i]<=12)) m = i
}
if(m==0) return(list(status=0))
sq = 1:3
sq = sq[-m]
y = 0
for(i in sq){
if(any(dte[,i]>31)) y = i
}
if(y==0) return(list(status=0))
d = sq[-y]
dmatrix = cbind(dte[,d], dte[,m], dte[,y])
colnames(dmatrix) = c("d","m","y")
if(ld==6){
ddates = as.Date(paste(dmatrix[,3], dmatrix[,2], dmatrix[,1], sep = "-"), format="%y-%m-%d")
dformat = "%y-%m-%d"
} else{
ddates = as.Date(paste(dmatrix[,3], dmatrix[,2], dmatrix[,1], sep = "-"), format="%Y-%m-%d")
dformat = "%Y-%m-%d"
}
return(list(datesmat = dmatrix, dates = ddates, dformat = dformat, status=1))
}
#---------------------------------------------------------------------------------
# lag functions
.embed = function(data, k, by = 1, ascending = FALSE)
{
# n = no of time points, k = number of columns
# by = increment. normally =1 but if =b calc every b-th point
# ascending If TRUE, points passed in ascending order else descending.
# Note that embed(1:n,k) corresponds to embedX(n,k,by=1,rev=TRUE)
# e.g. embedX(10,3)
#if(is.null(dim(data)[1])) n = length(data) else n = dim(data)[1]
data = matrix(data, ncol = 1)
n = dim(data)[1]
s = seq(1, n - k + 1, by)
lens = length(s)
cols = if (ascending) 1:k else k:1
return(matrix(data[s + rep(cols, rep(lens, k)) - 1], lens))
}
.lagx = function(data, n.lag = 1, removeNA = FALSE, pad = NA)
{
# has NAs
data = as.matrix(data)
n = dim(data)[1]
d = dim(data)[2]
if(dim(data)[2] == 1) data = matrix(data, ncol = 1)
z = apply(data, 2, FUN = function(x) .embed(x, n.lag + 1)[, n.lag + 1])
if(!removeNA) z = rbind(matrix(pad, ncol = d, nrow = n.lag), z)
return(z)
}
.lagmatrix = function(data, n.lag = 1, pad = 0)
{
n = length(as.numeric(data))
z = matrix(NA, ncol = n.lag, nrow = n)
for(i in 1:n.lag) z[,i] = .lagx(as.numeric(data), i, removeNA = FALSE, pad = pad)
z = cbind(data, z)
colnames(z) = paste("lag-", 0:n.lag, sep = "")
return(z)
}
repmat = function(a, n, m)
{
kronecker(matrix(1, n, m), a)
}
size = function(x, n = NULL)
{
x = as.matrix(x)
if(missing(n)) sol = c(n = dim(x)[1], m = dim(x)[2]) else sol = dim(x)[n]
return(sol)
}
zeros = function(n = 1, m = 1)
{
if(missing(m)) m = n
sol = matrix(0, nrow = n, ncol = m)
return(sol)
}
ones = function(n = 1, m = 1)
{
if(missing(m)) m = n
sol = matrix(1, nrow = n, ncol = m)
return(sol)
}
newlagmatrix = function(x,nlags,xc)
{
nlags = nlags+1
xt = size(x, 1);
newX = rbind(x, zeros(nlags, 1))
lagmatrix = repmat(newX, nlags, 1)
lagmatrix = matrix(lagmatrix[1:(size(lagmatrix,1)-nlags)], nrow = (xt+nlags-1), ncol = nlags)
lagmatrix = lagmatrix[nlags:xt,]
y = lagmatrix[,1]
x = lagmatrix[,2:nlags]
if(xc == 1) x = cbind(ones(size(x,1), 1), x)
return(data.frame(y = y, x = x))
}
.colorgradient = function(n = 50, low.col = 0.6, high.col=0.7, saturation = 0.8) {
if (n < 2) stop("n must be greater than 2")
n1 = n%/%2
n2 = - n - n1
c(hsv(low.col, saturation, seq(1, 0.5, length = n1)),
hsv(high.col, saturation, seq(0.5, 1, length = n2)))
}
.simlayout = function(m)
{
if(m == 1){
nf = c(1, 1, 2, 2)
nf = layout(matrix(nf, 2, 2, byrow = TRUE), respect = TRUE)
middle.plot = 1
}
if(m == 2){
nf = c(1, 1, 1, 1, 0, 2, 2, 0, 3, 3, 3, 3)
nf = layout(matrix(nf, 3, 4, byrow = TRUE), respect = TRUE)
middle.plot = 2
}
if(m == 3){
nf = c(1, 0, 0, 2, 0, 3, 3, 0, 4, 0, 0, 5)
nf = layout(matrix(nf, 3, 4, byrow = TRUE), respect = TRUE)
middle.plot = 3
}
if(m == 12){
nf = c(1, 2, 3, 4,
5, 6, 6, 7,
8, 6, 6, 9,
10, 11, 12, 13)
nf = layout(matrix(nf, 4, 4, byrow = TRUE), respect = TRUE)
}
}
.sdigit = function(x){
sid = as.numeric(strsplit(format(as.numeric(x), scientific=TRUE), "e")[[1]])[2]
10^(-sid)
}
.stars = function(testvector, levels = c(0.01, 0.05, 0.1))
{
N = length(testvector)
ans = vector(mode="character", length = N)
#recursive replacement
z = which(testvector<levels[3])
ans[z] = c("*")
z = which(testvector<levels[2])
ans[z] = c("**")
z = which(testvector<levels[1])
ans[z] = c("***")
ans
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.