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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
#$Author: sinnwell $
#$Date: 2008/04/04 16:10:18 $
#$Header: /people/biostat3/sinnwell/Haplo/Make/RCS/print.haplo.glm.q,v 1.10 2008/04/04 16:10:18 sinnwell Exp $
#$Locker: $
#$Log: print.haplo.glm.q,v $
#Revision 1.10 2008/04/04 16:10:18 sinnwell
#add show.missing and return coeffDF and hapDF by invisible
#
#Revision 1.9 2005/03/29 14:18:47 sinnwell
#fix call to print within widths, different for R/Splus
#
#
#Revision 1.8 2004/10/22 22:08:27 sinnwell
#do not drop matrix to vector when subsetting to haplo.unique
#when only 1 haplotype
#
#Revision 1.7 2004/03/18 23:30:32 sinnwell
#keep matrix from converting to data.frame, and char vecs to factors
#
#Revision 1.6 2004/02/26 23:05:23 sinnwell
#print.banner to printBanner
#
#Revision 1.5 2004/02/06 16:34:17 sinnwell
#fix 1-sided pval to 2-sided
#
#Revision 1.4 2003/12/08 20:16:49 sinnwell
# changed T,F to TRUE,FALSE
#
#Revision 1.3 2003/11/17 23:28:19 schaid
#made compatible with R
#
#Revision 1.2 2003/10/15 21:13:30 schaid
#got rid of bug caused by use of 'fit' (should have been x)
#
#Revision 1.1 2003/09/16 16:03:15 schaid
#Initial revision
#
print.haplo.glm <- function(x, print.all.haplo=FALSE, show.missing=FALSE, digits = max(options()$digits - 4, 3), ...){
if(exists("is.R") && is.function(is.R) && is.R()) {
x$call <- deparse(x$call, width.cutoff=40)
cat("\n Call: ", x$call, sep="\n")
}
else {
cat("\n Call: \n")
dput(x$call)
}
haplo.df<- function(x){
z <- x$haplo.common
df <- as.matrix(x$haplo.unique[z,,drop=FALSE])
y <- x$haplo.freq[z]
if(x$haplo.rare.term){
df <- rbind(df, rep("*",ncol(df)))
y <- c(y, sum(x$haplo.freq[x$haplo.rare]))
}
# use dimnames to change row names do not convert from matrix to df
dimnames(df)[[1]] <- x$haplo.names
df <- rbind(df,x$haplo.unique[x$haplo.base,])
dimnames(df)[[1]][nrow(df)] <- "haplo.base"
y <- c(y,x$haplo.freq[x$haplo.base])
data.frame(df,hap.freq=y)
}
ncoef <- length(x$coef)
coef <- x$coef
se <- sqrt(x$var.mat[cbind(1:ncoef, 1:ncoef) ])
wt <- x$weights.expanded * x$haplo.post.info$post
df.residual <- sum(wt) - length(x$coef)
t.stat <- coef/se
pval <- 2*(1-pt(abs(t.stat), df.residual))
# printBanner("Regression Coefficients")
cat("\nCoefficients:\n")
coeff.df <- cbind(coef=coef, se=se, t.stat=t.stat, pval=pval)
print(coeff.df, digits=digits)
# cat("\n")
# printBanner("Hapoltypes and their Frequencies")
cat("\nHaplotypes:\n")
hap.df <- haplo.df(x)
print(hap.df, digits=digits)
if(print.all.haplo){
haplo.type <- rep(NA,length(x$haplo.freq))
haplo.type[x$haplo.common] <- "C"
haplo.type[x$haplo.rare] <- "*"
haplo.type[x$haplo.base] <- "B"
df <- data.frame(x$haplo.unique, hap.freq = round(x$haplo.freq, digits), hap.type=haplo.type)
cat("\n")
printBanner("All Haplotypes")
cat("B = base haplotype\n")
cat("C = common haplotype\n")
cat("* = rare haplotype\n\n")
print(df)
}
if(show.missing) {# & (nrow(miss.tbl) > 1)) {
cat("\nSubjects removed by NAs in y or x, or all NA in geno\n")
miss.tbl <- apply(1*x$missing, 2, sum)
print(miss.tbl)
}
invisible(list(coeffDF=coeff.df, hapDF=hap.df))
}
|
