1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
withSE <- function(object, vcov, ...){
if(is.matrix(vcov)) UseMethod("withVCov")
else if(is.function(vcov)) UseMethod("withVCov")
else if(is.character(vcov)){
if(exists(vcov))
vcov <- get(vcov)
else if(exists(vcov2 <- paste0("vcov",vcov)))
vcov <- get(vcov2)
else
stop("neither '",vcov,"' nor '", vcov2, "' is a known function")
withVCov(object, vcov=vcov, ...)
}
else stop("cannot handle 'vcov' argument of type",typeof(vcov))
}
withVCov <- function(object, vcov, ...) UseMethod("withVCov")
withVCov.lm <- function(object, vcov, ...){
if(is.function(vcov))
V <- vcov(object, ...)
else if(is.matrix(vcov))
V <- vcov
else
stop("argument 'vcov' should be a matrix")
cls <- class(object)
cls <- c(paste("withVCov",cls[1],sep="."),
"withVCov",
class(object))
structure(object,
.VCov=V,
class=cls)
}
vcov.withVCov <- function(object, ...) attr(object,".VCov")
summary.withVCov <- function(object, ...){
V <- attr(object,".VCov")
res <- NextMethod()
coefTab <- res$coefficients
est <- coefTab[,1]
se <- sqrt(diag(V))
zval <- est/se
pval <- 2 * pnorm(abs(zval),lower.tail=FALSE)
coefTab[,2] <- se
coefTab[,3] <- zval
coefTab[,4] <- pval
res$coefficients <- coefTab
res
}
summary.withVCov.lm <- function(object, ...){
V <- attr(object,".VCov")
res <- NextMethod()
coefTab <- res$coefficients
rdf <- res$df[2]
est <- coefTab[,1]
se <- sqrt(diag(V))
tval <- est/se
pval <- 2 * pt(abs(tval),df=rdf,lower.tail=FALSE)
coefTab[,2] <- se
coefTab[,3] <- tval
coefTab[,4] <- pval
res$coefficients <- coefTab
res
}
|
