Skip to content
Prev 834 / 15274 Next

Using summary function from and armafit with R2HTML

Spencer,

Thank you for you suggestion, but that did not work.  It is in way the 
summary function uses cat to produce the pretty output.  R2HTML does not 
see to be able to reroute the report.  I create my own 
summary.fARMA.html function to produce the report.

I appreciate the help and hope the code below is useful for other 
people.  If Rmetrics would like to include this code please be my 
guest.  I just would like a citation so I can put it in my vita. :-)

Joe

The function is
______________________________________________________________________________
##Created by Joe W. Byers, The University of Tulsa and FinancialSEAL
##This code is available under current GPL Licenses of R and Rmetrics

summary.fARMA.HTML<-function (object, doplot = FALSE, ...)
{
    ans <- NULL
    digits <- max(5, getOption("digits") - 4)
    x <- object
    object <- x at fit
    ans$call <- object$call
    ans$tsmodel <- object$tstitle
    ans$residuals <- as.vector(na.omit(object$residuals))
    if (length(ans$residuals) == 0) {
        ans$var <- 0
    }
    if (length(ans$residuals) > 0) {
        ans$var <- var(ans$residuals)
    }
    ans$sigma2 <- object$sigma2
    tval <- object$coef/object$se.coef
    prob <- 2 * (1 - pnorm(abs(tval)))
    ans$coefmat <- cbind(format(object$coef,digits=digits), 
format(object$se.coef,digits=digits),
        format(tval,digits=digits), prob=format.pval(prob,digits=digits))
    dimnames(ans$coefmat) <- list(names(object$coef), c(" Estimate",
        " Std. Error", " t value", "Pr(>|t|)"))
    row.names(ans$coefmat)<-toupper(row.names(ans$coefmat))
    if (object$tsmodel == "ar") {
        ans$aic <- (object$n.used * (1 + log(2 * pi)) + object$n.used *
            log(ans$var) + 2 * length(object$coef))
    }
    if (object$tsmodel == "arma") {
        ans$aic <- (object$n.used * (1 + log(2 * pi)) + object$n.used *
            log(ans$var) + 2 * length(object$coef))
        ans$css <- object$css
    }
    if (object$tsmodel == "arima") {
        ans$aic <- object$aic
        ans$loglik <- object$loglik
    }
    if (object$tsmodel == "fracdiff") {
        doplot <- FALSE
    }
    HTML("Title: ")
    HTML(x at title)
    HTML("Call: ")
    HTML(object$call)
    HTML(c("Model: ", object$tstitle))#, "", sep = "")
    HTML("Coefficient(s):")
    digits <- max(5, getOption("digits") - 4)
    t1<-data.frame(object$coef)#copy to dataframe
    t1<-data.frame(t(t1)) #traspose for reporting
    names(t1)<-toupper(names(t1))
    row.names(t1)<-" " # rename row name
    HTML(t1,digits=digits)
    #HTML(print.default(format(object$coef, digits = digits), print.gap 
= 2, quote = FALSE))
    digits <- max(5, getOption("digits") - 4)
    if (length(object$residuals) > 2) {
        HTML("Residuals:")
        rq <- as.data.frame(t(structure(quantile(ans$residuals), names = 
c("Min",
            "1Q", "Median", "3Q", "Max"))))
        row.names(rq)<-' '
        HTML(rq,digits=digits)
        HTML("Moments: ")
        skewness <- sum((ans$residuals - 
mean(ans$residuals))^3/sqrt(var(ans$residuals))^3)/length(ans$residuals)
        kurtosis <- sum((ans$residuals - 
mean(ans$residuals))^4/var(ans$residuals)^2)/length(ans$residuals) -
            3
        stats <- as.data.frame(t(structure(c(skewness, kurtosis), names 
= c("Skewness",
            "Kurtosis"))))
        row.names(stats)<-" "
        HTML(stats,digits=digits)
    }
    HTML("Coefficient(s):")
    signif.stars <- getOption("show.signif.stars")
    #HTML(printCoefmat(ans$coefmat, digits=digits, signif.stars = 
signif.stars,    ...))
    HTML(ans$coefmat, digits=digits, signif.stars = signif.stars)
    if (x at fit$tsmodel == "ar") {
        t1<-data.frame(c(format(object$sigma2, digits = 
digits),format(round(object$aic, digits))),
            row.names=c("sigma^2 estimated as:       ","AIC 
Criterion:              "))
        names(t1)<-" "
        HTML(t1)
    }
    if (x at fit$tsmodel == "arma") {
        t1<-data.frame(c(format(object$sigma2, digits = 
digits),format(round(object$css, digits = digits))),
            row.names=c("sigma^2 estimated as:       ", "Conditional 
Sum-of-Squares: "))
            names(t1)<-" "
        HTML(t1)
    }
    if (x at fit$tsmodel == "arima") {
        cm <- object$call$method
        if (is.null(cm) || cm != "CSS") {
            t1<-data.frame(c(format(object$sigma2, digits = digits), 
format(round(object$loglik, digits)),
                format(round(object$aic, digits))),
                row.names=c("sigma^2 estimated as:       ", "log 
likelihood:       ",
                "AIC Criterion:        ",))
            names(t1)<-" "
            HTML(t1)
        }
        else {
            t1<-data.frame(c(format(object$sigma2, digits = digits), 
format(round(object$loglik, digits))),
                row.names=c("sigma^2 estimated as:       ", "log 
likelihood:       "))
            names(t1)<-" "
            HTML(t1)
        }
    }
    if (doplot)
        plot.fARMA(x, ...)
    HTML(c("Description: ",x at description))
    invisible()
}
_____________________________________________________________________________________
Spencer Graves wrote:
-------------- next part --------------
A non-text attachment was scrubbed...
Name: joe-byers.vcf
Type: text/x-vcard
Size: 295 bytes
Desc: not available
Url : https://stat.ethz.ch/pipermail/r-sig-finance/attachments/20060522/8a9961f8/attachment.vcf