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
|
% file MASS/OME.d
% copyright (C) 1994-9 W. N. Venables and B. D. Ripley
%
\name{OME}
\alias{OME}
\title{
Tests of Auditory Perception in Children with OME
}
\description{
Experiments were performed on children on their ability to
differentiate a signal in broad-band noise. The noise was played from
a pair of speakers and a signal was added to just one channel; the
subject had to turn his/her head to the channel with the added signal.
The signal was either coherent (the amplitude of the noise was
increased for a period) or incoherent (independent noise was added for
the same period to form the same increase in power).
The threshold used in the original analysis was the stimulus loudness
needs to get 75\% correct responses. Some of the children had
suffered from otitis media with effusion (OME).
}
\usage{
OME
}
\format{
The \code{OME} data frame has 1129 rows and 7 columns:
\describe{
\item{\code{ID}}{
Subject ID (1 to 99, with some IDs missing). A few subjects were
measured at different ages.
}
\item{\code{OME}}{
\code{"low"} or \code{"high"} or \code{"N/A"} (at ages other than 30 and 60 months).
}
\item{\code{Age}}{
Age of the subject (months).
}
\item{\code{Loud}}{
Loudness of stimulus, in decibels.
}
\item{\code{Noise}}{
Whether the signal in the stimulus was \code{"coherent"} or \code{"incoherent"}.
}
\item{\code{Correct}}{
Number of correct responses from \code{Trials} trials.
}
\item{\code{Trials}}{
Number of trials performed.
}}}
\source{
Sarah Hogan, Dept of Physiology, University of Oxford, via
Dept of Statistics Consulting Service
}
\section{Background}{
The experiment was to study otitis media with effusion (OME), a very
common childhood condition where the middle ear space, which is
normally air-filled, becomes congested by a fluid. There is a
concomitant fluctuating, conductive hearing loss which can result in
various language, cognitive and social deficits. The term \dQuote{binaural
hearing} is used to describe the listening conditions in which the
brain is processing information from both ears at the same time. The
brain computes differences in the intensity and/or timing of signals
arriving at each ear which contributes to sound localisation and also
to our ability to hear in background noise.
Some years ago, it was found that children of 7-8 years with a history
of significant OME had significantly worse binaural hearing than
children without such a history, despite having equivalent
sensitivity. The question remained as to whether it was the timing,
the duration, or the degree of severity of the otitis media episodes
during critical periods, which affected later binaural hearing. In an
attempt to begin to answer this question, 95 children were monitored for
the presence of effusion every month since birth. On the basis of OME
experience in their first two years, the test population was split
into one group of high OME prevalence and one of low prevalence.
}
\examples{
# Fit logistic curve from p = 0.5 to p = 1.0
fp1 <- deriv(~ 0.5 + 0.5/(1 + exp(-(x-L75)/scal)),
c("L75", "scal"),
function(x,L75,scal)NULL)
nls(Correct/Trials ~ fp1(Loud, L75, scal), data = OME,
start = c(L75=45, scal=3))
nls(Correct/Trials ~ fp1(Loud, L75, scal),
data = OME[OME$Noise == "coherent",],
start=c(L75=45, scal=3))
nls(Correct/Trials ~ fp1(Loud, L75, scal),
data = OME[OME$Noise == "incoherent",],
start = c(L75=45, scal=3))
# individual fits for each experiment
aa <- factor(OME$Age)
ab <- 10*OME$ID + unclass(aa)
ac <- unclass(factor(ab))
OME$UID <- as.vector(ac)
OME$UIDn <- OME$UID + 0.1*(OME$Noise == "incoherent")
rm(aa, ab, ac)
OMEi <- OME
library(nlme)
fp2 <- deriv(~ 0.5 + 0.5/(1 + exp(-(x-L75)/2)),
"L75", function(x,L75) NULL)
options(show.error.messages = FALSE)
OMEi.nls <- nlsList(Correct/Trials ~ fp2(Loud, L75) | UIDn,
data = OMEi, start = list(L75=45), control = list(maxiter=100))
options(show.error.messages = TRUE)
tmp <- sapply(OMEi.nls, function(X)
{if(is.null(X)) NA else as.vector(coef(X))})
OMEif <- data.frame(UID = round(as.numeric((names(tmp)))),
Noise = rep(c("coherent", "incoherent"), 110),
L75 = as.vector(tmp))
OMEif$Age <- OME$Age[match(OMEif$UID, OME$UID)]
OMEif$OME <- OME$OME[match(OMEif$UID, OME$UID)]
OMEif <- OMEif[OMEif$L75 > 30,]
summary(lm(L75 ~ Noise/Age, data = OMEif, na.action = na.omit))
summary(lm(L75 ~ Noise/(Age + OME), data = OMEif,
subset = (Age >= 30 & Age <= 60),
na.action = na.omit), cor = FALSE)
# Or fit by weighted least squares
fpl75 <- deriv(~ sqrt(n)*(r/n - 0.5 - 0.5/(1 + exp(-(x-L75)/scal))),
c("L75", "scal"),
function(r,n,x,L75,scal) NULL)
nls(0 ~ fpl75(Correct, Trials, Loud, L75, scal),
data = OME[OME$Noise == "coherent",],
start = c(L75=45, scal=3))
nls(0 ~ fpl75(Correct, Trials, Loud, L75, scal),
data = OME[OME$Noise == "incoherent",],
start = c(L75=45, scal=3))
# Test to see if the curves shift with age
fpl75age <- deriv(~sqrt(n)*(r/n - 0.5 - 0.5/(1 +
exp(-(x-L75-slope*age)/scal))),
c("L75", "slope", "scal"),
function(r,n,x,age,L75,slope,scal) NULL)
OME.nls1 <-
nls(0 ~ fpl75age(Correct, Trials, Loud, Age, L75, slope, scal),
data = OME[OME$Noise == "coherent",],
start = c(L75=45, slope=0, scal=2))
sqrt(diag(vcov(OME.nls1)))
OME.nls2 <-
nls(0 ~ fpl75age(Correct, Trials, Loud, Age, L75, slope, scal),
data = OME[OME$Noise == "incoherent",],
start = c(L75=45, slope=0, scal=2))
sqrt(diag(vcov(OME.nls2)))
# Now allow random effects by using NLME
OMEf <- OME[rep(1:nrow(OME), OME$Trials),]
attach(OME)
OMEf$Resp <- rep(rep(c(1,0), length(Trials)),
t(cbind(Correct, Trials-Correct)))
OMEf <- OMEf[, -match(c("Correct", "Trials"), names(OMEf))]
detach("OME")
\dontrun{## this fails in R on some platforms
fp2 <- deriv(~ 0.5 + 0.5/(1 + exp(-(x-L75)/exp(lsc))),
c("L75", "lsc"),
function(x, L75, lsc) NULL)
G1.nlme <- nlme(Resp ~ fp2(Loud, L75, lsc),
fixed = list(L75 ~ Age, lsc ~ 1),
random = L75 + lsc ~ 1 | UID,
data = OMEf[OMEf$Noise == "coherent",], method = "ML",
start = list(fixed=c(L75=c(48.7, -0.03), lsc=0.24)), verbose = TRUE)
summary(G1.nlme)
G2.nlme <- nlme(Resp ~ fp2(Loud, L75, lsc),
fixed = list(L75 ~ Age, lsc ~ 1),
random = L75 + lsc ~ 1 | UID,
data = OMEf[OMEf$Noise == "incoherent",], method="ML",
start = list(fixed=c(L75=c(41.5, -0.1), lsc=0)), verbose = TRUE)
summary(G2.nlme)
}}
\keyword{datasets}
|
