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
|
#$Author: sinnwell $
#$Date: 2008/04/04 15:56:23 $
#$Header: /people/biostat3/sinnwell/Haplo/Make/RCS/haplo.glm.control.q,v 1.7 2008/04/04 15:56:23 sinnwell Exp $
#$Locker: $
#$Log: haplo.glm.control.q,v $
#Revision 1.7 2008/04/04 15:56:23 sinnwell
#fix typo of haplo.min.count
#
#Revision 1.6 2008/04/04 15:48:18 sinnwell
#enforce haplo.freq.min as .01, and override haplo.min.count
#
#Revision 1.5 2008/04/01 21:23:40 sinnwell
#manage haplo.freq.min, which is overriden by haplo.min.count
#
#Revision 1.4 2005/01/04 17:36:47 sinnwell
#use haplo.min.count as more important than haplo.freq.min
#
#Revision 1.3 2004/03/02 16:34:07 sinnwell
#change T to TRUE
#
#Revision 1.2 2003/12/08 19:37:28 sinnwell
# changed F,T to FALSE,TRUE
#
#Revision 1.1 2003/09/16 16:01:29 schaid
#Initial revision
#
haplo.glm.control <- function(haplo.effect="add",
haplo.base = NULL,
haplo.min.count=NA,
haplo.freq.min=.01,
sum.rare.min=0.001,
haplo.min.info=0.001,
keep.rare.haplo=TRUE,
glm.c=glm.control(maxit=500),
em.c=haplo.em.control()){
chk <- charmatch(haplo.effect, c("additive", "dominant", "recessive"))
if(is.na(chk)) stop("Invalid haplo.effect")
if(haplo.min.info < 0 | haplo.min.info > .9) {
warning("The value of haplo.min.info is out of range, the default value of 0.001 is used instead")
haplo.min.info <- 0.001
}
# 1/2005 JPS
# enourage the use of selecting haplotypes to model by a minimum expected count of 5
if(!is.null(match.call()$haplo.freq.min)) {
if(haplo.freq.min < haplo.min.info | haplo.freq.min >= 1) {
warning("invalid value for haplo.freq.min, setting to default of .01")
haplo.freq.min <- .01
}
if(!is.null(match.call()$haplo.min.count)) {
warning("Both control parameters haplo.freq.min and haplo.min.count given; haplo.freq.min will be used")
haplo.min.count <- NA
}
} else {
if(!is.na(haplo.min.count)) {
haplo.freq.min <- NA
if(haplo.min.count <= 1) {
warning("The value of haplo.min.count is too small, the count will default to 5/(2*n.subjects)")
haplo.freq.min <- NA
haplo.min.count <- 5
}
}
}
if(sum.rare.min < 0 | sum.rare.min > .9) {
warning("The value of sum.rare.min is out of range, the default value of 0.001 is used instead")
sum.rare.min <- 0.001
}
if(keep.rare.haplo!=TRUE & keep.rare.haplo!=FALSE){
warning("The value of keep.rare.haplo is invalid, the default value of TRUE is used instead")
keep.rare.haplo=TRUE
}
return(list(haplo.effect=haplo.effect,
haplo.base = haplo.base,
haplo.min.count=haplo.min.count,
haplo.freq.min=haplo.freq.min,
sum.rare.min=sum.rare.min,
haplo.min.info=haplo.min.info,
keep.rare.haplo=keep.rare.haplo,
epsilon=glm.c$epsilon,
maxit=glm.c$maxit,
trace=glm.c$trace,
em.control=em.c))
}
|
