[R] getting/storing the name of an object passed to a function

[Gavin Simpson]

Hi

I have a couple of functions that work on the object created by another R
command and then print out or summarise the results of this work.

The main function is defined as:

hotelling.t <- function(obj)
{
	#internal commands
}

I then have print.hotelling.t() that takes the list returned by hotelling.t
and prints it with some extra significance calculations, formatting, etc.

I want to then use the named object in another calculation in
print.hotelling.t() , that only gets done/printed if you ask for it in the
call to print.hotelling.t()

How do I store the name of the object obj passed to hotelling.t in the
object returned by hotelling.t?

And how do I "paste" the name of that object into a call to another R
function within my print.hotelling.t()?

Perhaps this is not the best way to do things in R?  So any comments would
be most appreciated.

By the way, the object obj is of class lda (Package MASS), if that matters.
Functions appended below.  R 1.6.2 on windows XP.

Many Thanks

Gavin Simpson

Functions:  the commented line in print.hotelling.t (last line) is where I
want to use the name of obj, to replace picea.lda.  The code works if you
known the lda object, I now just want to grab it from the original call to
hotelling.t

hotelling.t <- function(obj)
{
    if (is.null(class(obj))) {
        stop("You must supply an object of class lda from lda()")
    } else {
        if (class(obj) != "lda") {
            stop("You must supply an object of class lda from lda()")
        }
    }
    group <- as.factor(eval(obj$call[[3]]))
    fac.levels <- levels(group)
    x <- eval(obj$call[[2]])
    x1 <- subset(x, group==fac.levels[1])
    x2 <- subset(x, group==fac.levels[2])
    s1 <- cov(x1)
    s2 <- cov(x2)    
    cor1 <- cor(x1)
    cor2 <- cor(x2)
    n1 <- nrow(x1)
    n2 <- nrow(x2)
    n.vars <- ncol(x)
    V <- (1/(n1+n2-2))*(((n1-1)*s1)+((n2-1)*s2))
    Vcor <- (1/(n1+n2-2))*(((n1-1)*cor1)+((n2-1)*cor2))
    mu1 <- obj$means[1,]
    mu2 <- obj$means[2,]
    d2 <- mahalanobis(mu1, mu2, V)
    d <- sqrt(d2)
    t2 <- ((n1*n2)/(n1+n2)) * d2
    F.stat <- ((n1 + n2 - ((n.vars)+1)) / ((n1 + n2 - 2) * (n.vars-1))) * t2
    tmp <- list(s1 = s1, s2 = s2, V = V, Vcor = Vcor, d2 = d2, d = d, t2 =
t2, 	F.stat = F.stat, obj.call = obj$call, n.obs = obj$N, n1 = n1, n2 =
n2,
	mu1 = mu1, mu2 = mu2)
    return(tmp)
}

print.hotelling.t <- function(x, digits = max(3, getOption("digits") - 3),
na.print = "", 
    ...)
{
    ## Do the required calculations
    df1 <- ncol(x$V)
    df2 <- x$n.obs - (df1 + 1)
    p.F.stat <- 1 - pf(x$F.stat, df1 = df1, df2 = df2)
    inv.mat <- solve(x$V)
    means.diff <- x$mu1 - x$mu2
    lambda <- inv.mat %*% means.diff
    colnames(lambda) <- "lambda"
    rownames(lambda) <- colnames(x$V)
    
    ## Print the results
    cat("\nCall: ", deparse(x$call), "\n\n")
    cat("Pooled Variance-Covariance Matrix:", "\n\n")
    print.default(x$V, digits = digits)
    cat("\n")
    cat("Covariance Matrices:", "\n\n")
    cat("Group 1:", "\n")
    print.default(x$s1, digits = digits)
    cat("\n")
    cat("Group 2:", "\n")
    print.default(x$s2, digits = digits)
    cat("\n")
    cat("Pooled correlation matrix:", "\n\n")
    print.default(x$Vcor, digits = digits)
    cat("\n")
    cat("Mahanalobis Generalised distance \(d^2\):", x$d2, "\n")
    cat("Square root of Mahalanobis Distance:", x$d, "\n")
    cat("Hotelling's T^2:", x$t2, "\n")
    cat("F-value:", x$F.stat, "on", df1, "and", df2, "degrees of freedom\n")
    cat("p-value:", p.F.stat, "\n\n")
    cat("Variable means for Group 1:\n")
    print.default(x$mu1, digits = digits)
    cat("\nVariable means for Group 2:\n")
    print.default(x$mu2, digits = digits)
    cat("\n")
    cat("Coefficients of discriminant function:\n")
    print.default(lambda, digits=digits)
    cat("\nClassification success:\n")
    #print(table(predict(picea.lda)$class, picea[,1],
	dnn=c("Actual", "Predicted")))
}