

   TTeessttss ooff AAuuddiittoorryy PPeerrcceeppttiioonn iinn CChhiillddrreenn wwiitthh OOMMEE

   AArrgguummeennttss::

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

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

        Age: Age of the subject (months).

       Loud: Loudness of stimulus, in decibels.

      Noise: Whether the signal in the stimulus was `"coher-
             ent"' or "`incoherent"'.

    Correct: Number of correct responses from `Trials' trials.

     Trials: Number of trials performed.

   SSUUMMMMAARRYY::

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

        The `Hogan' data frame has 1129 rows and 7 columns.

   DDAATTAA DDEESSCCRRIIPPTTIIOONN::

        This data frame contains the following columns:

   SSOOUURRCCEE::

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

   BBAACCKKGGRROOUUNNDD::

        The experiment was to study otitis media with effusion
        (OME), a very common childhood condition where the mid-
        dle ear space, which is normally air-filled, becomes
        congested by a fluid.  There is a concomitant fluctuat-
        ing, conductive hearing loss which can result in vari-
        ous 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 locali-
        sation 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 pres-
        ence 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 preva-
        lence and one of low prevalence.

   EExxaammpplleess::

        ### Not usable in R

        # Fit logistic curve from p=0.5 to p=1.0
        fp1 <- deriv(~ 0.5 + 0.5/(1 + exp(-(x-ld75)/scal)),
                     c("ld75", "scal"),
                     function(x,ld75,scal)NULL)
        nls(Correct/Trials ~ fp1(Loud, ld75, scal), data=OME,
            start=c(ld75=45, scal=3))
        nls(Correct/Trials ~ fp1(Loud, ld75, scal),
            data=OME[OME$Noise=="coherent",],
            start=c(ld75=45, scal=3))
        nls(Correct/Trials ~ fp1(Loud, ld75, scal),
            data=OME[OME$Noise=="incoherent",],
            start=c(ld75=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
        parameters(OMEi) <- list(L75=45)
        fp2 <- deriv(~ 0.5 + 0.5/(1 + exp(-(x-L75)/2)),
                    "L75", function(x,L75) NULL)
        OMEi.nls <- nlsList(Correct/Trials ~ fp2(Loud, L75),
           data = OMEi, cluster = ~UIDn, control = list(maxiter=100))
        tmp <- sapply(OMEi.nls, function(X)
                      {if(is.null(X)) NA else as.vector(X$param)})
        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)]

        # Or fit by weighted least squares
        fpl75 <- deriv(~sqrt(n)*(r/n - 0.5 - 0.5/(1 + exp(-(x-ld75)/scal))),
                       c("ld75", "scal"),
                       function(r,n,x,ld75,scal)NULL)
        nls(0 ~ fpl75(Correct, Trials, Loud, ld75, scal),
            data=OME[OME$Noise=="coherent",],
            start=c(ld75=45, scal=2))
        nls(0 ~ fpl75(Correct, Trials, Loud, ld75, scal),
            data=OME[OME$Noise=="incoherent",],
            start=c(ld75=45, scal=2))

        # Test to see if the curves shift with age
        fpl75age <- deriv(~sqrt(n)*(r/n -  0.5 - 0.5/(1 +
                          exp(-(x-ld75-slope*age)/scal))),
                          c("ld75", "slope", "scal"),
                          function(r,n,x,age,ld75,slope,scal )NULL)
        library(MASS)
        OME.nls1 <-
        nls(0 ~ fpl75age(Correct, Trials, Loud, Age, ld75, slope, scal),
            data=OME[OME$Noise=="coherent",],
            start=c(ld75=45, slope=0, scal=2))
        sqrt(diag(vcov(OME.nls1)))

        OME.nls2 <-
        nls(0 ~ fpl75age(Correct, Trials, Loud, Age, ld75, slope, scal),
            data=OME[OME$Noise=="incoherent",],
            start=c(ld75=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()

        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 ~ .),
             random = list(L75 ~ ., lsc ~ .),
             cluster=~UID, data=OMEf[OMEf$Noise=="coherent",],
             start = list(fixed=c(L75=c(48, -0.03), lsc=0)), verbose=T)
        summary(G1.nlme)$fixed

        G2.nlme <- nlme(Resp ~ fp2(Loud, L75, lsc),
             fixed = list(L75 ~ Age, lsc ~ .),
             random = list(L75 ~ ., lsc ~ .),
             cluster=~UID, data=OMEf[OMEf$Noise=="incoherent",],
             start = list(fixed=c(L75=c(41, -0.1), lsc=0)), verbose=T)
        summary(G2.nlme)$fixed

