/
association.fit.R
315 lines (295 loc) · 13.6 KB
/
association.fit.R
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
`association.fit` <-
function (var, dep, adj, quantitative, type, level, nIndiv, genotypingRate=0, ...)
{
if (!quantitative) {
if (length(unique(dep))==1)
{
res <- "Genot error"
}
else
{
co<-dom<-co<-dom<-rec<-over<-Ad<-NULL
dep <- as.factor(dep)
controlGeno <- ifelse(is.null(levels(var)),0,(length(var)/nIndiv)*100)
if (genotypingRate >= controlGeno)
{
res <- c(paste("Genot ", round(controlGeno, 1), "\\%", sep = ""))
}
else if (length(table(as.character(var)))==1) {
res <- "Monomorphic"
}
else {
if (length(table(as.character(var))) == 3) {
var.co <- codominant(var)
if (any(type%in%6) | any(type%in%2))
var.dom <- dominant(var)
if (any(type%in%6) | any(type%in%3))
var.rec <- recessive(var)
if (any(type%in%6) | any(type%in%4))
var.over <- overdominant(var)
if (is.null(adj)) {
m.co <- glm(dep ~ var.co, family = binomial, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ NULL, subset = subset, family = binomial, ...)
if (any(type%in%6) | any(type%in%2))
m.dom <- glm(dep ~ var.dom, subset = subset,
family = binomial, ...)
if (any(type%in%6) | any(type%in%3))
m.rec <- glm(dep ~ var.rec, subset = subset,
family = binomial, ...)
if (any(type%in%6) | any(type%in%4))
m.over <- glm(dep ~ var.over, subset = subset,
family = binomial, ...)
if (any(type%in%6) | any(type%in%5))
m.ad <- glm(dep ~ as.numeric(var.co), subset = subset,
family = binomial, ...)
}
else {
m.co <- glm(dep ~ . + var.co, family = binomial,
data = adj, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ ., subset = subset, family = binomial,
data = adj, ...)
if (any(type%in%6) | any(type%in%2))
m.dom <- glm(dep ~ . + var.dom, subset = subset,
family = binomial, data = adj, ...)
if (any(type%in%6) | any(type%in%3))
m.rec <- glm(dep ~ . + var.rec, subset = subset,
family = binomial, data = adj, ...)
if (any(type%in%6) | any(type%in%4))
m.over <- glm(dep ~ . + var.over, subset = subset,
family = binomial, data = adj, ...)
if (any(type%in%6) | any(type%in%5))
m.ad <- glm(dep ~ . + as.numeric(var.co), subset = subset,
family = binomial, data = adj, ...)
}
if (any(type%in%6) | any(type%in%1))
{
temptp<-Table.N.Per(var.co, dep, subset)$tp
co <- cbind(temptp,
intervals.or(m.co, level, m.b, var)$or.ic,
c(round(AIC(m.co), 1), NA, NA))
if (any(temptp == 0) & is.null(adj))
{
pp<-fisher.test(dep,var.co)$p
co[1, 8] <- pp
}
}
if (any(type%in%6) | any(type%in%2))
{
temptp<-Table.N.Per(var.dom, dep, subset)$tp
dom <- cbind(temptp,
intervals.or(m.dom, level, m.b, var.dom)$or.ic,
c(round(AIC(m.dom), 1), NA))
if (any(temptp == 0) & is.null(adj))
{
pp<-fisher.test(dep,var.dom)$p
dom[1, 8] <- pp
}
}
if (any(type%in%6) | any(type%in%3))
{
temptp<-Table.N.Per(var.rec, dep, subset)$tp
rec <- cbind(temptp,
intervals.or(m.rec, level, m.b, var.rec)$or.ic,
c(round(AIC(m.rec), 1), NA))
if (any(temptp == 0) & is.null(adj))
{
pp<-fisher.test(dep,var.rec)$p
rec[1, 8] <- pp
}
}
if (any(type%in%6) | any(type%in%4))
{
temptp<-Table.N.Per(var.over, dep, subset)$tp
over <- cbind(temptp,
intervals.or(m.over, level, m.b, var.over)$or.ic,
c(round(AIC(m.over), 1), NA))
if (any(temptp == 0) & is.null(adj))
{
pp<-fisher.test(dep,var.over)$p
over[1, 8] <- pp
}
}
if (any(type%in%6) | any(type%in%5))
{
temptp<-Table.N.Per(var.co, dep, subset)$tp
totals<-round(table(dep),1)
prop.totals<-round(100*prop.table(totals),1)
ansTot<-c(totals[1],prop.totals[1], totals[2],prop.totals[2])
Ad <- c(ansTot, intervals.or(m.ad,
level, m.b)$or.ic, round(AIC(m.ad), 1))
if (any(temptp == 0) & is.null(adj))
{
pp<-fisher.test(dep,var.co)$p
Ad[8] <- pp
}
}
res<-NULL
if(!is.null(co))
res<-rbind(Codominant=rep(NA,9),co)
if(!is.null(dom))
res<-rbind(res,Dominant=rep(NA,9),dom)
if(!is.null(rec))
res<-rbind(res,Recessive=rep(NA,9),rec)
if(!is.null(over))
res<-rbind(res,Overdominant=rep(NA,9),over)
if(!is.null(Ad))
res<-rbind(res,"log-Additive"=rep(NA,9),"0,1,2"=Ad)
dimnames(res)[[2]][5:9] <- c("OR","lower","upper","p-value","AIC")
}
else if (length(table(as.character(var))) == 2) {
var.co <- codominant(var)
if (is.null(adj)) {
m.co <- glm(dep ~ var.co, family = binomial, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ NULL, subset = subset, family = binomial, ...)
}
else {
m.co <- glm(dep ~ . + var.co, family = binomial,
data = adj, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ ., subset = subset, family = binomial,
data = adj, ...)
}
co <- cbind(Table.N.Per(var.co, dep, subset)$tp,
intervals.or(m.co, level, m.b, var.co)$or.ic,
c(round(AIC(m.co), 1), NA))
# Ad <- c(rep(NA, times = 4), intervals.or(m.ad, level, m.b)$or.ic, round(AIC(m.ad), 1))
totals<-table(dep)
prop.totals<-round(100*prop.table(totals),1)
ansTot<-c(totals[1],prop.totals[1], totals[2],prop.totals[2])
Ad <- c(ansTot, intervals.or(m.co, level, m.b)$or.ic, round(AIC(m.co), 1))
Ad[8]<-NA
if(any(Table.N.Per(var.co, dep, subset)$tp==0) & is.null(adj))
{
pp<-fisher.test(dep,var.co)$p
Ad[8]<-pp
co[1,8]<-pp
}
res <- rbind(Codominant=rep(NA,9),co,"log-Additive"=rep(NA,9), "0,1,2"=Ad)
dimnames(res)[[2]][5:9] <- c("OR","lower","upper","p-value","AIC")
}
}
}
}
else { # quantitative trait
co<-dom<-co<-dom<-rec<-over<-Ad<-NULL
controlGeno <- ifelse(is.null(levels(var)),0,(length(var)/nIndiv)*100)
if (genotypingRate >= controlGeno)
{
res <- c(paste("Genot ", round(controlGeno, 1), "\\%", sep = ""))
}
else if (length(table(as.character(var)))==1) {
res <- "Monomorphic"
}
else {
if (length(table(as.character(var))) == 3) {
var.co <- codominant(var)
if (any(type%in%6) | any(type%in%2))
var.dom <- dominant(var)
if (any(type%in%6) | any(type%in%3))
var.rec <- recessive(var)
if (any(type%in%6) | any(type%in%4))
var.over <- overdominant(var)
if (is.null(adj)) {
m.co <- glm(dep ~ var.co, family = gaussian, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ NULL, subset = subset, family = gaussian, ...)
if (any(type%in%6) | any(type%in%2))
m.dom <- glm(dep ~ var.dom, subset = subset,
family = gaussian, ...)
if (any(type%in%6) | any(type%in%3))
m.rec <- glm(dep ~ var.rec, subset = subset,
family = gaussian, ...)
if (any(type%in%6) | any(type%in%4))
m.over <- glm(dep ~ var.over, subset = subset,
family = gaussian, ...)
if (any(type%in%6) | any(type%in%5))
m.ad <- glm(dep ~ as.numeric(var.co), subset = subset,
family = gaussian, ...)
}
else {
m.co <- glm(dep ~ . + var.co, family = gaussian,
data = adj, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ ., subset = subset, family = gaussian,
data = adj, ...)
if (any(type%in%6) | any(type%in%2))
m.dom <- glm(dep ~ . + var.dom, subset = subset,
family = gaussian, data = adj, ...)
if (any(type%in%6) | any(type%in%3))
m.rec <- glm(dep ~ . + var.rec, subset = subset,
family = gaussian, data = adj, ...)
if (any(type%in%6) | any(type%in%4))
m.over <- glm(dep ~ . + var.over, subset = subset,
family = gaussian, data = adj, ...)
if (any(type%in%6) | any(type%in%5))
m.ad <- glm(dep ~ . + as.numeric(var.co), subset = subset,
family = gaussian, data = adj, ...)
}
if (any(type%in%6) | any(type%in%1))
co <- cbind(Table.mean.se(var.co, dep, subset)$tp,
intervals.dif(m.co, level, m.b, var)$m, AIC = c(round(AIC(m.co),
1), NA, NA))
if (any(type%in%6) | any(type%in%2))
dom <- cbind(Table.mean.se(var.dom, dep, subset)$tp,
intervals.dif(m.dom, level, m.b, var.dom)$m,
AIC = c(round(AIC(m.dom), 1), NA))
if (any(type%in%6) | any(type%in%3))
rec <- cbind(Table.mean.se(var.rec, dep, subset)$tp,
intervals.dif(m.rec, level, m.b, var.rec)$m,
AIC = c(round(AIC(m.rec), 1), NA))
if (any(type%in%6) | any(type%in%4))
over <- cbind(Table.mean.se(var.over, dep, subset)$tp,
intervals.dif(m.over, level, m.b, var.over)$m,
AIC = c(round(AIC(m.over), 1), NA))
if (any(type%in%6) | any(type%in%5))
Ad <- c(rep(NA, 3), intervals.dif(m.ad, level,
m.b)$m, AIC(m.ad))
res<-NULL
if(!is.null(co))
res<-rbind(Codominant=rep(NA,8),co)
if(!is.null(dom))
res<-rbind(res,Dominant=rep(NA,8),dom)
if(!is.null(rec))
res<-rbind(res,Recessive=rep(NA,8),rec)
if(!is.null(over))
res<-rbind(res,Overdominant=rep(NA,8),over)
if(!is.null(Ad))
res<-rbind(res,"log-Additive"=rep(NA,8),"0,1,2"=Ad)
dimnames(res)[[2]][4:8] <- c("dif","lower","upper","p-value","AIC")
}
else if (length(table(as.character(var))) == 2) {
var.co <- codominant(var)
if (is.null(adj)) {
m.co <- glm(dep ~ var.co, family = gaussian, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ NULL, subset = subset, family = gaussian, ...)
}
else {
m.co <- glm(dep ~ . + var.co, family = gaussian,
data = adj, ...)
subset <- 1:length(var) %in% as.numeric(rownames(m.co$model))
m.b <- glm(dep ~ ., subset = subset, family = gaussian,
data = adj, ...)
}
co <- cbind(Table.mean.se(var.co, dep, subset)$tp,
intervals.dif(m.co, level, m.b, var.co)$m, AIC = c(AIC(m.co),
NA))
# Ad <- c(rep(NA, 3), intervals.dif(m.ad, level, m.b)$m, round(AIC(m.ad), 1))
Ad <- c(rep(NA, 3), intervals.dif(m.co, level,m.b)$m, round(AIC(m.co), 1))
Ad[7]<-NA
if(any(Table.mean.se(var.co, dep, subset)$tp==0) & is.null(adj))
{
pp<-fisher.test(dep,var.co)$p
Ad[7]<-pp
co[1,7]<-pp
}
res <- rbind(Codominant=rep(NA,8),co,"log-Additive"=rep(NA,8), "0,1,2"=Ad)
dimnames(res)[[2]][4:8] <- c("dif","lower","upper","p-value","AIC")
}
}
}
res
}