Jak narysować wykres interakcji z przedziałami ufności?


11

Moje próby:

  1. Nie mogłem uzyskać przedziałów ufności interaction.plot()

  2. z drugiej strony plotmeans()z pakietu „gplot” nie wyświetlałby dwóch wykresów. Co więcej, nie mogłem nałożyć dwóch plotmeans()wykresów jeden na drugim, ponieważ domyślnie oś jest inna.

  3. Miałem pewne sukcesy, używając plotCI()pakietu gplot i nakładając dwa wykresy, ale dopasowanie osi nie było idealne.

Wszelkie porady dotyczące tworzenia wykresu interakcji z przedziałami ufności? Albo za pomocą jednej funkcji, albo porady dotyczące nakładania się plotmeans()lub plotCI()wykresów.

próbka kodu

br=structure(list(tangle = c(140L, 50L, 40L, 140L, 90L, 70L, 110L, 
150L, 150L, 110L, 110L, 50L, 90L, 140L, 110L, 50L, 60L, 40L, 
40L, 130L, 120L, 140L, 70L, 50L, 140L, 120L, 130L, 50L, 40L, 
80L, 140L, 100L, 60L, 70L, 50L, 60L, 60L, 130L, 40L, 130L, 100L, 
70L, 110L, 80L, 120L, 110L, 40L, 100L, 40L, 60L, 120L, 120L, 
70L, 80L, 130L, 60L, 100L, 100L, 60L, 70L, 90L, 100L, 140L, 70L, 
100L, 90L, 130L, 70L, 130L, 40L, 80L, 130L, 150L, 110L, 120L, 
140L, 90L, 60L, 90L, 80L, 120L, 150L, 90L, 150L, 50L, 50L, 100L, 
150L, 80L, 90L, 110L, 150L, 150L, 120L, 80L, 80L), gtangles = c(141L, 
58L, 44L, 154L, 120L, 90L, 128L, 147L, 147L, 120L, 127L, 66L, 
118L, 141L, 111L, 59L, 72L, 45L, 52L, 144L, 139L, 143L, 73L,  
59L, 148L, 141L, 135L, 63L, 51L, 88L, 147L, 110L, 68L, 78L, 63L, 
64L, 70L, 133L, 49L, 129L, 100L, 78L, 128L, 91L, 121L, 109L, 
48L, 113L, 50L, 68L, 135L, 120L, 85L, 97L, 136L, 59L, 112L, 103L, 
62L, 87L, 92L, 116L, 141L, 70L, 121L, 92L, 137L, 85L, 117L, 51L, 
84L, 128L, 162L, 102L, 127L, 151L, 115L, 57L, 93L, 92L, 117L, 
140L, 95L, 159L, 57L, 65L, 130L, 152L, 90L, 117L, 116L, 147L, 
140L, 116L, 98L, 95L), up = c(-1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
-1L, -1L, 1L, 1L, 1L, 1L, -1L, -1L, -1L, -1L, 1L, 1L, -1L, -1L, 
1L, 1L, -1L, 1L, 1L, -1L, 1L, 1L, 1L, 1L, 1L, -1L, -1L, 1L, 1L, 
1L, 1L, -1L, -1L, 1L, 1L, -1L, -1L, -1L, -1L, -1L, -1L, -1L, 
1L, -1L, -1L, -1L, -1L, -1L, 1L, -1L, 1L, 1L, -1L, -1L, -1L, 
-1L, 1L, -1L, 1L, -1L, -1L, -1L, 1L, -1L, 1L, -1L, 1L, 1L, 1L, 
-1L, -1L, -1L, -1L, -1L, -1L, 1L, -1L, 1L, 1L, -1L, -1L, 1L, 
1L, 1L, -1L, 1L, 1L, 1L)), .Names = c("tangle", "gtangles", "up"
), class = "data.frame", row.names = c(NA, -96L))

plotmeans2 <- function(br, alph) {
dt=br;   tmp   <- split(br$gtangles, br$tangle);   
means <- sapply(tmp, mean);  stdev <- sqrt(sapply(tmp, var));  
n <- sapply(tmp,length);  
ciw   <- qt(alph, n) * stdev / sqrt(n)
plotCI(x=means, uiw=ciw, col="black", barcol="blue", lwd=1,ylim=c(40,150),  xlim=c(1,12)); 
par(new=TRUE) dt= subset(br,up==1);   
tmp   <- split(dt$gtangles, dt$tangle);  
means <- sapply(tmp, mean);  
stdev <- sqrt(sapply(tmp, var));  
n <- sapply(tmp,length); 
ciw  <- qt(0.95, n) * stdev / sqrt(n)
plotCI(x=means, uiw=ciw, type='l',col="black", barcol="red", lwd=1,ylim=c(40,150), xlim=c(1,12),pch='+');
abline(v=6);abline(h=90);abline(30,10); par(new=TRUE);
dt=subset(br,up==-1);   
tmp <- split(dt$gtangles, dt$tangle);  
means <- sapply(tmp, mean);  
stdev <- sqrt(sapply(tmp, var));  
n <- sapply(tmp,length); 
ciw <- qt(0.95, n) * stdev / sqrt(n)
plotCI(x=means, uiw=ciw, type='l', col="black", barcol="blue",   lwd=1,ylim=c(40,150), xlim=c(1,12),pch='-');abline(v=6);abline(h=90);
abline(30,10);
}

plotmeans2(br,.95)

Odpowiedzi:


21

Jeśli chcesz użyć ggplot , możesz wypróbować następujący kod.

Z ciągłym predyktorem

library(ggplot2)
gp <- ggplot(data=br, aes(x=tangle, y=gtangles)) 
gp + geom_point() + stat_smooth(method="lm", fullrange=T) + facet_grid(. ~ up)

dla fasetowego wykresu interakcji

wprowadź opis zdjęcia tutaj

W przypadku standardowego wykresu interakcji (takiego jak ten wyprodukowany przez interaction.plot()) wystarczy usunąć fasetowanie.

gp <- ggplot(data=br, aes(x=tangle, y=gtangles, colour=factor(up))) 
gp + geom_point() + stat_smooth(method="lm")

wprowadź opis zdjęcia tutaj

Z dyskretnym predyktorem

Za pomocą ToothGrowthzestawu danych (patrz help(ToothGrowth))

ToothGrowth$dose.cat <- factor(ToothGrowth$dose, labels=paste("d", 1:3, sep=""))
df <- with(ToothGrowth , aggregate(len, list(supp=supp, dose=dose.cat), mean))
df$se <- with(ToothGrowth , aggregate(len, list(supp=supp, dose=dose.cat), 
              function(x) sd(x)/sqrt(10)))[,3]

opar <- theme_update(panel.grid.major = theme_blank(),
                     panel.grid.minor = theme_blank(),
                     panel.background = theme_rect(colour = "black"))
gp <- ggplot(df, aes(x=dose, y=x, colour=supp, group=supp))
gp + geom_line(aes(linetype=supp), size=.6) + 
     geom_point(aes(shape=supp), size=3) + 
     geom_errorbar(aes(ymax=x+se, ymin=x-se), width=.1)
theme_set(opar)

wprowadź opis zdjęcia tutaj


Dziękuję bardzo za szczegółową odpowiedź. Chciałem zapytać, czy istnieje sposób na ustawienie pionowych przedziałów ufności na każdym poziomie zmiennej niezależnej? Czy istnieje sposób na usunięcie tła i powrót do wykresu „starego stylu”?
Adam SA

1
@Adam Zaktualizowałem moją odpowiedź w przypadku 2 zmiennych kategorialnych + zmiennej odpowiedzi ciągłej - mam nadzieję, że o to ci chodziło. Dodałem również kod pokazujący, jak dostosować ggplotmotyw. Ogólnie rzecz biorąc, możesz powiedzieć, gp + theme_bw()aby po prostu usunąć szare tło; tutaj również usunąłem siatkę.
chl

12

Istnieje również pakiet efektów Foxa i Honga w R. Patrz J. Stat. Miękki. dokumenty tu i tutaj dla przykładów z przedziałami ufności i generowaniem kodu R.

Nie jest tak ładny jak rozwiązanie ggplot, ale jest bardziej ogólny i ratuje życie dla średnio złożonych GLM.


1
(+1) Muszę przyznać, że wolę takie podejście :-)
chl

@chl i / lub Conjugate, czy możesz powiedzieć więcej o tym, dlaczego wolisz takie podejście? Pomógłby takim osobom jak ja zdecydować, w którą metodę zainwestować czas.
Michael Bishop,

1
@MichaelBishop Zasadniczo, ponieważ podsumowuje wiele trudnych rzeczy (spiskowanie na skali link vs. odpowiedź, wyświetlanie 95% CI dla GLMMM, marginalizacja w stosunku do warunków interakcji itp.), Które trudno byłoby obsłużyć w kilku poleceniach R (i osobiście, Bardzo lubię latticegrafikę :)
chl
Korzystając z naszej strony potwierdzasz, że przeczytałeś(-aś) i rozumiesz nasze zasady używania plików cookie i zasady ochrony prywatności.
Licensed under cc by-sa 3.0 with attribution required.