OME                   package:MASS                   R Documentation

_T_e_s_t_s _o_f _A_u_d_i_t_o_r_y _P_e_r_c_e_p_t_i_o_n _i_n _C_h_i_l_d_r_e_n _w_i_t_h _O_M_E

_D_e_s_c_r_i_p_t_i_o_n:

     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).

_U_s_a_g_e:

     OME

_F_o_r_m_a_t:

     The 'OME' data frame has 1129 rows and 7 columns:

     '_I_D' Subject ID (1 to 99, with some IDs missing). A few subjects
          were measured at different ages.

     '_O_M_E' '"low"' or '"high"' or '"N/A"' (at ages other than 30 and 60
          months).

     '_A_g_e' Age of the subject (months).

     '_L_o_u_d' Loudness of stimulus, in decibels.

     '_N_o_i_s_e' Whether the signal in the stimulus was '"coherent"' or
          '"incoherent"'.

     '_C_o_r_r_e_c_t' Number of correct responses from 'Trials' trials.

     '_T_r_i_a_l_s' Number of trials performed.

_B_a_c_k_g_r_o_u_n_d:

     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
     "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.

_S_o_u_r_c_e:

     Sarah Hogan, Dept of Physiology, University of Oxford, via Dept of
     Statistics Consulting Service

_E_x_a_m_p_l_e_s:

     # 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), stringsAsFactors = TRUE)
     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")

     ## Not run: ## 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)
     ## End(Not run)

