Permutatie test

set.seed(35)
captoprilSamp <- captopril
perm <- sample(c(FALSE, TRUE), 15, replace = TRUE)
captoprilSamp$SBPa[perm] <- captopril$SBPb[perm]
captoprilSamp$SBPb[perm] <- captopril$SBPa[perm]
captoprilSamp$deltaSBP <- captoprilSamp$SBPa-captoprilSamp$SBPb
captoprilSamp %>%
  gather(type, bp, -id) %>%
  filter(type %in% c("SBPa","SBPb")) %>%
  mutate(type = factor(type, levels = c("SBPb", "SBPa")))%>%
  ggplot(aes(x = type,y = bp)) +
  geom_line(aes(group = id)) +
  geom_point()

data.frame(
  deltaSBP = c(captopril$deltaSBP,captoprilSamp$deltaSBP),
  shuffled=rep(c(FALSE,TRUE),each=15)
  ) %>%
  ggplot(aes(x = shuffled, y = deltaSBP)) +
  geom_boxplot(outlier.shape = NA) +
  geom_point(position = "jitter")+
  stat_summary(
    fun.y = mean,
    geom = "point",
    shape = 19,
    size = 3,
    color = "red",
    fill = "red") +
  ylab("Difference (mm mercury)")

We permuteren opnieuw

captoprilSamp <- captopril
perm <- sample(c(FALSE,TRUE), 15, replace = TRUE)
captoprilSamp$SBPa[perm] <- captopril$SBPb[perm]
captoprilSamp$SBPb[perm] <- captopril$SBPa[perm]
captoprilSamp$deltaSBP <- captoprilSamp$SBPa-captoprilSamp$SBPb
captoprilSamp %>%
  gather(type, bp, -id) %>%
  filter(type %in% c("SBPa","SBPb")) %>%
  mutate(type = factor(type, levels = c("SBPb", "SBPa")))%>%
  ggplot(aes(x = type,y = bp)) +
  geom_line(aes(group = id)) +
  geom_point()

data.frame(
  deltaSBP = c(captopril$deltaSBP,captoprilSamp$deltaSBP),
  shuffled=rep(c(FALSE,TRUE),each=15)
  ) %>%
  ggplot(aes(x = shuffled, y = deltaSBP)) +
  geom_boxplot(outlier.shape = NA) +
  geom_point(position = "jitter")+
  stat_summary(
    fun.y = mean,
    geom = "point",
    shape = 19,
    size = 3,
    color = "red",
    fill = "red") +
  ylab("Difference (mm mercury)")

permH <- expand.grid(
  replicate(
    15,
    c(-1,1),
    simplify=FALSE)
  ) %>%
  t

permH[,1:5]
##       [,1] [,2] [,3] [,4] [,5]
## Var1    -1    1   -1    1   -1
## Var2    -1   -1    1    1   -1
## Var3    -1   -1   -1   -1    1
## Var4    -1   -1   -1   -1   -1
## Var5    -1   -1   -1   -1   -1
## Var6    -1   -1   -1   -1   -1
## Var7    -1   -1   -1   -1   -1
## Var8    -1   -1   -1   -1   -1
## Var9    -1   -1   -1   -1   -1
## Var10   -1   -1   -1   -1   -1
## Var11   -1   -1   -1   -1   -1
## Var12   -1   -1   -1   -1   -1
## Var13   -1   -1   -1   -1   -1
## Var14   -1   -1   -1   -1   -1
## Var15   -1   -1   -1   -1   -1
#calculate the means for the permuted data
muPerm <- colMeans(permH*captopril$deltaSBP)
muPerm %>%
  as.data.frame %>%
  ggplot(aes(x=.)) +
  geom_histogram() +
  geom_vline(
    xintercept = mean(captopril$deltaSBP),
    col = "blue")

sum(muPerm <= mean(captopril$deltaSBP))
## [1] 1
mean(muPerm <= mean(captopril$deltaSBP))
## [1] 3.051758e-05

We hebben dus sterk bewijs dat \(H_0\) onjuist is en daarom verwerpen we \(H_0\) en concluderen \(H_1\): het toedienen van captopril heeft een effect op de bloeddruk van patiënten met hypertensie.

Pivot

\[t=\frac{\bar X-\mu_0}{se_{\bar X}}\]

We bepalen nu de nulverdeling van teststatistiek t met permutatie.

deltaPerms <- permH*captopril$deltaSBP
tPerm <- colMeans(deltaPerms)/(apply(deltaPerms,2,sd)/sqrt(15))
tOrig <- mean(captopril$deltaSBP)/sd(captopril$deltaSBP)*sqrt(15)

tPermPlot <- tPerm %>%
  as.data.frame %>%
  ggplot(aes(x = .)) +
  geom_histogram(aes(y = ..density.., fill = ..count..)) +
  geom_vline(xintercept = tOrig,col = "blue")
tPermPlot

Wanneer er geen effect is van captopril, is het bijna onmogelijk om een teststatistiek te verkrijgen die zo extreem is als degene die werd waargenomen in de steekproef (t=-8.12).


Hoe beslissen we?

Wanneer is de p-waarde klein genoeg om te concluderen dat er sterk bewijs is tegen de nulhypothese?


Permutatietests zijn computationeel veeleisend

\[t=\frac{\bar X - \mu}{se_{\bar X}}\]

volgt een t-verdeling (met 14 vrijheidsgraden voor het Captopril voorbeeld).

tPermPlot +
  stat_function(
    fun = dt,
    color = "red",
    args = list(df=14))

We overlopen nu alle componenten van een hypothese test waarbij we gebruik maken van veronderstellingen over de distributie van de gegevens.