Transit fare (one-tailed)

Recently, the transit system increased their bus fare by $0.10 in an effort to fix their budget without significantly affecting the monthly expense of their passengers. Since most of their passengers take the Metro train, they did not increase the rail fare. Now, the administration wants to determine whether the median amount of fare spent in a month has significantly increased to a value higher than $200. A sample of regular customers revealed the following observed monthly fares.

fares <- c(205, 188, 192, 220, 203, 197, 206, 209, 184, 200, 214, 217)

One way to settle this is via a hypothesis test where \(\mathcal{H}_0\): the 50% quantile is less than 200; versus \(\mathcal{H}_1\): the 50% quantile is greater than 200. I.e., a lower-tailed test.

So in R we have

pstar <- 0.5
xstar <- 200
n <- length(fares)
t1 <- sum(fares <= xstar)

and then \(p\)-value is thus

phi <- pbinom(t1, n, pstar)
phi
## [1] 0.387207

We should not be surprised to find that this is the same as what we get out of the library function binom.test.

binom.test(t1, n, pstar, "less")
## 
##  Exact binomial test
## 
## data:  t1 and n
## number of successes = 5, number of trials = 12, p-value = 0.3872
## alternative hypothesis: true probability of success is less than 0.5
## 95 percent confidence interval:
##  0.0000000 0.6847622
## sample estimates:
## probability of success 
##              0.4166667

Freshmen exam (two-tailed)

Entering college, freshmen must take an exam, and the upper quartile (75th quantile) is established at a score of 193. A particular high school sends 112 of its graduates to college. Suppose 100 students have a score less than or equal to 193, and 98 students have a score strictly less than 193. Conduct the quantile test and determine whether this established quantity holds for this high school.

The hypotheses are \(\mathcal{H}_0\): The 75th quantile is 193, versus \(\mathcal{H}_1\): the 75th quantile is not 193.

So in R we have

pstar <- 0.75
t1 <- 100
t2 <- 98
n <- 112

and then the \(p\)-value is thus

phi <- 2*min(pbinom(t1, n, pstar), 1-pbinom(t2-1, n, pstar))
phi
## [1] 0.001709746

What happens when we use binom.test?

Transistor failure (confidence interval)

Sixteen transistors are selected at random from a large batch of transistors and are tested. The number of hours until failure is recorded for each one. We wish to find an approximately 90% confidence interval for the upper quartile. The data follows.

fail <-  c(67.1, 63.7, 46.9, 56.5, 63.2, 59.9, 47.2, 73.3, 63.3, 49.1, 78.5, 56.8, 63.4, 59.2, 64.1, 67.7)
alpha <- 0.1
n <- length(fail)
pstar <- 0.75
r <- qbinom(alpha/2, n, pstar)
s <- qbinom(1-alpha/2, n, pstar)
c(r,s)
## [1]  9 15
fail.sorted <- sort(fail)
c(fail.sorted[r], fail.sorted[s])
## [1] 63.3 73.3

So our CI is [63.3, 73.3], but it doesn’t have cover exactly 90%. To figure out the exact confidence level requires inverting the quantile calculations.

alpha1 <- pbinom(r-1, n, pstar)
alpha2 <- 1-pbinom(s-1, n, pstar)
1 - alpha1 - alpha2
## [1] 0.9093936

Transit fare revisited (CI)

Lets revisit one of our earlier examples (we can’t do the Metro one because we don’t have the raw observations) and find a 95% confidence interval for the median.

alpha <- 0.05
n <- length(fares)
pstar <- 0.5
r <- qbinom(alpha/2, n, pstar)
s <- qbinom(1-alpha/2, n, pstar)
fares.sorted <- sort(fares)
c(fares.sorted[r], fares.sorted[s])
## [1] 192 209

Lets calculate the actual confidence level.

alpha1 <- pbinom(r-1, n, pstar)
alpha2 <- 1-pbinom(s-1, n, pstar)
1 - alpha1 - alpha2
## [1] 0.9077148

Our own library function

It easy to cut-and-paste to construct a new CI for a new data set, but it would be even easier if we didn’t have to. Lets make our own quantile CI function, with defaults for the median and 95% level.

quantile.confint <- function(x, pstar=0.5, level=0.95)
{
    alpha <- 1-level
    n <- length(x)
    xs <- sort(x)
    r <- qbinom(alpha/2, n, pstar)
    s <- qbinom(1-alpha/2, n, pstar)
    CI <- c(xs[r], xs[s])
    alpha1 <- pbinom(r-1, n, pstar)
    alpha2 <- 1-pbinom(s-1, n, pstar)
    level.act <- 1 - alpha1 - alpha2
    return(list(CI=CI, level.act=level.act))
}

Now lets try it out.

quantile.confint(fail, 0.75, 0.9)
## $CI
## [1] 63.3 73.3
## 
## $level.act
## [1] 0.9093936
quantile.confint(fares)
## $CI
## [1] 192 209
## 
## $level.act
## [1] 0.9077148