[R-SIG-Finance] GARCH - Models
Sarbo
cmdr_rogue at hotmail.com
Sat Apr 17 19:11:23 CEST 2010
I can see your problem right away- there's no noise factor. Everything
that comes out of your model is purely deterministic- no stochastic
component to it whatsoever.
See this bit of code?
for(t in 2:length(v2)){
>
> v2[t] <- garch.coefs[1] + garch.coefs[2] * (r[t-1])^2 +
> garch.coefs[3] * v2[t-1]
>
> r[t] <- sqrt(v2[t])*r[t-1]
>
> }
In order for this stochastic process to work, there has to be a driving
white noise factor. It's important to note the the return series itself
is considered to be essentially just a random process, the precise
nature of which depends on the conditional distribution that you
specify.
Try the version in the code I've attached instead. I don't use the
quantmod package, simply because I've never needed it- there are other
ways to get the job done.
Oh, and I made a slight error in the references I provided- you'll need
Hull Ch.19.
I hope that helps.
Regards,
Sarbo
On Sat, 2010-04-17 at 17:29 +0200, Konrad Hoppe wrote:
> Hi,
>
> first of all, thank you for being patient with me,
>
> I’ve now implemented your example, but I simply don’t get any valid
> result, as you can see in the plot-call at the end of the following
> snippet:
>
>
>
> install.packages("quantmod")
>
> library(quantmod)
>
>
>
> from.dat <- as.Date("01/01/91", format="%m/%d/%y")
>
> to.dat <- as.Date(Sys.Date(), format="%m/%d/%y")
>
> getSymbols("^GDAXI", src="yahoo", from = from.dat, to = to.dat)
>
>
>
> daxTs <- ts(Ad(GDAXI))
>
> garch.coefs <- summary(garch(diff(daxTs), order=c(1,1),
> trace=F))$coef[,1]
>
>
>
> v2 <- vector(length=length(diff(daxTs)))
>
> r <- vector(length=length(diff(daxTs)))
>
> v2[1] <- rnorm(1)
>
> r[1] <- rnorm(1)
>
>
>
> for(t in 2:length(v2)){
>
> v2[t] <- garch.coefs[1] + garch.coefs[2] * (r[t-1])^2 +
> garch.coefs[3] * v2[t-1]
>
> r[t] <- sqrt(v2[t])*r[t-1]
>
> }
>
> plot.ts(r)
>
>
>
> I don’t get it what I’m doing wrong, since I’m just simulating the
> estimated model formula… hope you have a clue,
>
>
>
> konrad
>
>
>
>
>
> ______________________________________________________________________
>
> Von: Sarbo [mailto:cmdr_rogue at hotmail.com]
> Gesendet: Samstag, 17. April 2010 14:58
> An: Konrad Hoppe
> Cc: r-sig-finance at stat.math.ethz.ch
> Betreff: Re: AW: [R-SIG-Finance] GARCH - Models
>
>
>
>
>
> Yes, it should be r_t = v_t * r_t-1
>
> You're right about the residuals; however, that's only in the case of
> normalised residuals. The cool thing about the GARCH model is that you
> can apply different kinds of residual schemes; for instance, there is
> literature out there concerning GARCH models with t-distributed or
> even EVT-distributed residuals. As you move farther away from Gaussian
> assumptions the fitting becomes more difficult, but more robust as
> well.
>
> On Sat, 2010-04-17 at 14:36 +0200, Konrad Hoppe wrote:
>
>
>
> Hi Sarbo,
>
> thank you for your help, I was looking for this formal representation
> you gave in your first formula, because I was just unable to conjunct
> the series of conditional variance with the outcome of the process and
> I couldn't found one.
>
> But I think you got a small typing error there, you wrote r_t=v_t*r_t
>
> I guess the the r_t is the sequence of returns and v_t is the
> conditional standard error, but I don't get the r_t on the
> righthandside of the equation. Is that right specified there?
>
> And in addition I thought that the residual series of a garch model is
> the process divided by the estimated conditional variance function.
> And hence I assume a zero mean series, the residuals are standardized
> after that. Am I right?
>
> Thanks for your help,
> Konrad
>
> -----Ursprüngliche Nachricht-----
> Von: r-sig-finance-bounces at stat.math.ethz.ch
> [mailto:r-sig-finance-bounces at stat.math.ethz.ch] Im Auftrag von Sarbo
> Gesendet: Samstag, 17. April 2010 13:07
> An: r-sig-finance at stat.math.ethz.ch
> Betreff: Re: [R-SIG-Finance] GARCH - Models
>
> Hi Konrad- I think you're using the GARCH model for the wrong purpose
> here. It's important to remember that the GARCH model is primarily
> designed to model returns and volatility. The best way to use a GARCH
> model is to take a price series, calculate a return series from
> that ,
> and then generate the GARCH parameters using an R package like
> "fGARCH",
> "tseries", or "mgarch".
>
> Remember above all that a GARCH model is a mean-reverting model, and
> that all you need to simulate (or predict) the future returns from a
> GARCH model are the fitted model parameters. Since a GARCH model
> follows
> the form:
>
> r_t = v_t * r_t
> v_t ^2 = l + a * r_t-1 ^2 + b * v_t-1 ^2 + e_t
>
> it should become clear pretty quickly that once you have the three
> parameters l, a, and b, you can set up the simulations in a
> spreadsheet
> if necessary.
>
> As for literature- I would always go with Hull's book, "Options,
> Futures, & Other Derivatives", 6th edition or later, Ch.18. There's a
> very nice explanation of the basics of the GARCH model in there.
> There's
> also Shumway & Stoffer's "Time Series Analysis & Its Applications:
> With
> R Examples", which is rather more relevant to what you're trying to
> do.
>
> On Fri, 2010-04-16 at 23:02 +0200, Konrad Hoppe wrote:
>
> > Hi list,
> >
> >
> >
> > Im still struggling with garch models. My first approach was doing
> a
> > fourier analysis on the series and then try to explain the residuals
> with an
> > ARIMA/GARCH model, but it turns out that this approach doesnt work
> well
> > since the garch model doesnt add many information to the arima
> model.
> >
> > Ive found that the differenced series of the DAX, corrected for mean
> and
> > slope has nearly the same residuals as the residuals from the
> fourier
> > residuals, hence Ive littered the fourier approach but now Ive got
> a
> > question concerning pure garch models.
> >
> >
> >
> > How can I use them to predict the series? I hope you have some
> pointers to
> > literature, or examples for that. To make my actual approach clear,
> please
> > check the following code snippet:
> >
> >
> >
> > library(quantmod)
> >
> > from.dat <- as.Date("01/01/91", format="%m/%d/%y")
> >
> > to.dat <- as.Date(Sys.Date(), format="%m/%d/%y")
> >
> > getSymbols("^GDAXI", src="yahoo", from = from.dat, to = to.dat)
> >
> >
> >
> > daxTs <- ts(Ad(GDAXI))
> >
> > time <- c(1:length(daxTs))
> >
> > tsData <- daxTs - lm(daxTs ~ time)$fitted.values
> >
> > diffData <- diff(tsData)
> >
> >
> >
> > garch.resids <- garch(diffData, order=c(1,1), trace=F)$residuals
> >
> > garch.resids[which(is.na(garch.resids))] <- 0
> >
> > plot.ts(garch.resids)
> >
> >
> >
> > as you can see in the plot, there is only white noise in the
> standardized
> > residual series, but actually Ive no idea how this information could
> help
> > me to predict the series. So it seems to me that the model works
> quite well,
> > but Ive no clue how this information could help me with the
> prediction.
> >
> >
> >
> > all the best
> >
> > Konrad
> >
> >
> > [[alternative HTML version deleted]]
> >
> > _______________________________________________
> > R-SIG-Finance at stat.math.ethz.ch mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-sig-finance
> > -- Subscriber-posting only. If you want to post, subscribe first.
> > -- Also note that this is not the r-help list where general R
> questions should go.
>
>
>
> [[alternative HTML version deleted]]
>
> _______________________________________________
> R-SIG-Finance at stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-sig-finance
> -- Subscriber-posting only. If you want to post, subscribe first.
> -- Also note that this is not the r-help list where general R
> questions should go.
>
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://stat.ethz.ch/pipermail/r-sig-finance/attachments/20100417/4b40d85b/attachment.html>
-------------- next part --------------
#Load packages:
library(fImport)
library(fGarch)
#Get data:
from <- as.Date('01/01/91', format = '%m/%d/%y')
to <- as.Date(Sys.Date() - 1, format = '%m/%d/%y')
DAX <- yahooSeries('^GDAXI', from = from, to = to)
prices <- rev(DAX[,6])
i <- 2:length(prices)
rets <- log(prices[i] / prices[i-1])
#Plot prices & returns:
par(mfrow = c(1,2))
ts.plot(prices)
ts.plot(rets)
#Fit a GARCH(1,1) model to the returns:
fit <- garchFit(data = rets)
summary(fit)
#If you want a selection of plots for this fit, use the function below:
plot(fit)
#Simulate a GARCH(1,1) model using the fitted parameters:
fitcoef <- fit at fit$par
model <- list(mu = fitcoef[1], omega = fitcoef[2], alpha = fitcoef[3], beta = fitcoef[4])
spec <- garchSpec(model)
sim <- garchSim(spec, n = 500)
#Plot the simulated GARCH(1,1) values:
ts.plot(sim)
More information about the R-SIG-Finance
mailing list