Estamos interesados en conocer si hay colores más atractivos para los insectos. Para ello se diseñaron trampas con los siguientes colores: amarillo, azul, blanco y verde. Se cuantificó el número de insectos que quedaban atrapados:

1. Organización de los datos

Generamos dos variables: insectos es la variable respuesta y colores es la variable factor (establece los grupos de interés):

insectos <- c(16,11,20,21,14,7,37,32,15,25,39,41,21,12,14,17,13,17,45,59,48,46,38,47)
colores <- as.factor(c(rep(c("azul", "verde", "blanco", "amarillo"), each =6)))

Exploramos los datos de la muestra:

boxplot(insectos ~ colores, col = c("yellow", "blue", "white","green"), ylab = "Número de insectos atrapados")

tapply(insectos, colores, mean)
amarillo     azul   blanco    verde 
47.16667 14.83333 15.66667 31.50000 

2. Supuestos

Los supuestos que se deben cumplir son tres: independencia, homocedasticidad y normalidad.

2.1. Independencia

fm = aov( lm(insectos ~ colores) )
plot(fm$residuals)

2.2. Normalidad

Los gráficos y descriptivos nos informan si se verifica la igualdad de varianzas en los grupos descritos.

summary(fm$residuals)
    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
-16.5000  -2.9167   0.1667   0.0000   5.2083  11.8333 
boxplot(fm$residuals)

hist(fm$residuals)

qqnorm(fm$residuals)
qqline(fm$residuals)

El test de Shapiro-Wilk indica que no tenemos evidencia suficiente para rechazar la hipótesis nula (normalidad de los residuos).

shapiro.test(fm$residuals)

    Shapiro-Wilk normality test

data:  fm$residuals
W = 0.97337, p-value = 0.75

2.3.homocedasticidad

Los gráficos y descriptivos nos informan si se verifica la igualdad de varianzas en los grupos descritos:

boxplot(fm$residuals~colores, col = c("yellow", "blue", "white","green"))

desviaciones <- tapply(fm$residuals, colores, sd)

Comparando la desviación máxima con la mínima obtenemos una orientación sobre la falta de homocedasticidad (>2 aproximadamente).

max(desviaciones) / min(desviaciones)    
[1] 2.980357

El test de Bartlett indica que no tenemos evidencia suficiente para rechazar la hipótesis nula (las varianzas son iguales).

bartlett.test(fm$residuals ~ colores)

    Bartlett test of homogeneity of variances

data:  fm$residuals by colores
Bartlett's K-squared = 5.2628, df = 3, p-value = 0.1535

3. ANOVA

Esta es la forma de pedir un ANOVA en R:

fm = aov( lm(insectos ~ colores) )

Pedimos un resumen de la tabla del ANOVA.

summary(fm)
            Df Sum Sq Mean Sq F value   Pr(>F)    
colores      3   4218    1406   30.55 1.15e-07 ***
Residuals   20    921      46                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Elementos generados en el ANOVA:

names(fm)
 [1] "coefficients"  "residuals"     "effects"       "rank"          "fitted.values" "assign"       
 [7] "qr"            "df.residual"   "contrasts"     "xlevels"       "call"          "terms"        
[13] "model"        

Bajo la Ho el estadístico de contraste F se distribuye como una F de grados de libertad (I-1), (n-I) donde I es el número de grupos que disponemos y n el tamaño total de la muestral. Así obtenemos el cuantil buscado.

qf(0.05, 3-1, 18-3, lower.tail = F)
[1] 3.68232

Valores del estadístico > 3.68232 estarán incluidos en la región de rechazo. En nuetro caso 30.55 es mucho mayor que el valor crítico obtenido.

Este sería el intervalo de confianza de la media de los insectos capturados para las trampas amarillas, con un nivel de confianza del 95%:

media <- mean(insectos[colores =="amarillo"]) 
valor_t <- pt(0.05/2, 18 - 3) 
sp <- sqrt(46)  #desviación típica de la varianza muestral común
ee  <- valor_t * (sp/ sqrt(6))  #error de estimación 
media
[1] 47.16667

Límite superior del intervalo de confianza de la media de insectos capturados para las trampas amarillas.

media + ee 
[1] 48.57826

Límite inferior del intervalo de confianza de la media de insectos capturados para las trampas amarillas.

media - ee 
[1] 45.75507

Si hemos detectado diferencias significativas entre las medias de las poblaciones.

intervals = TukeyHSD(fm)
intervals
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = lm(insectos ~ colores))

$colores
                       diff        lwr       upr     p adj
azul-amarillo   -32.3333333 -43.296330 -21.37034 0.0000004
blanco-amarillo -31.5000000 -42.462996 -20.53700 0.0000006
verde-amarillo  -15.6666667 -26.629663  -4.70367 0.0036170
blanco-azul       0.8333333 -10.129663  11.79633 0.9964823
verde-azul       16.6666667   5.703670  27.62966 0.0020222
verde-blanco     15.8333333   4.870337  26.79633 0.0032835
LS0tCnRpdGxlOiAiQW7DoWxpc2lzIGRlIHZhcmlhbnphIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpFc3RhbW9zIGludGVyZXNhZG9zIGVuIGNvbm9jZXIgc2kgaGF5IGNvbG9yZXMgbcOhcyBhdHJhY3Rpdm9zIHBhcmEgbG9zIGluc2VjdG9zLiBQYXJhIGVsbG8gc2UgZGlzZcOxYXJvbiB0cmFtcGFzIGNvbiBsb3Mgc2lndWllbnRlcyBjb2xvcmVzOiBhbWFyaWxsbywgYXp1bCwgYmxhbmNvIHkgdmVyZGUuIFNlIGN1YW50aWZpY8OzIGVsIG7Dum1lcm8gZGUgaW5zZWN0b3MgcXVlIHF1ZWRhYmFuIGF0cmFwYWRvczoKCi0gICAqKkF6dWwqKjogMTYgMTEgMjAgMjEgMTQgNwoKLSAgICoqVmVyZGUqKjogMzcgMzIgMTUgMjUgMzkgNDEKCi0gICAqKkJsYW5jbyoqOiAyMSAxMiAxNCAxNyAxMyAxNwoKLSAgICoqQW1hcmlsbG8qKjogNDUgNTkgNDggNDYgMzggNDcKCiMjICoqMS4gT3JnYW5pemFjacOzbiBkZSBsb3MgZGF0b3MqKgoKR2VuZXJhbW9zIGRvcyB2YXJpYWJsZXM6ICoqaW5zZWN0b3MqKiBlcyBsYSB2YXJpYWJsZSByZXNwdWVzdGEgeSAqKmNvbG9yZXMqKiBlcyBsYSB2YXJpYWJsZSBmYWN0b3IgKGVzdGFibGVjZSBsb3MgZ3J1cG9zIGRlIGludGVyw6lzKToKCmBgYHtyfQppbnNlY3RvcyA8LSBjKDE2LDExLDIwLDIxLDE0LDcsMzcsMzIsMTUsMjUsMzksNDEsMjEsMTIsMTQsMTcsMTMsMTcsNDUsNTksNDgsNDYsMzgsNDcpCmNvbG9yZXMgPC0gYXMuZmFjdG9yKGMocmVwKGMoImF6dWwiLCAidmVyZGUiLCAiYmxhbmNvIiwgImFtYXJpbGxvIiksIGVhY2ggPTYpKSkKYGBgCgpFeHBsb3JhbW9zIGxvcyBkYXRvcyBkZSBsYSBtdWVzdHJhOgoKYGBge3J9CmJveHBsb3QoaW5zZWN0b3MgfiBjb2xvcmVzLCBjb2wgPSBjKCJ5ZWxsb3ciLCAiYmx1ZSIsICJ3aGl0ZSIsImdyZWVuIiksIHlsYWIgPSAiTsO6bWVybyBkZSBpbnNlY3RvcyBhdHJhcGFkb3MiKQpgYGAKCmBgYHtyfQp0YXBwbHkoaW5zZWN0b3MsIGNvbG9yZXMsIG1lYW4pCmBgYAoKIyMgMi4gU3VwdWVzdG9zCgpMb3Mgc3VwdWVzdG9zIHF1ZSBzZSBkZWJlbiBjdW1wbGlyIHNvbiB0cmVzOiBpbmRlcGVuZGVuY2lhLCBob21vY2VkYXN0aWNpZGFkIHkgbm9ybWFsaWRhZC4KCiMjIyAyLjEuIEluZGVwZW5kZW5jaWEKCmBgYHtyfQpmbSA9IGFvdiggbG0oaW5zZWN0b3MgfiBjb2xvcmVzKSApCnBsb3QoZm0kcmVzaWR1YWxzKQpgYGAKCiMjIyAyLjIuIE5vcm1hbGlkYWQKCkxvcyBncsOhZmljb3MgeSBkZXNjcmlwdGl2b3Mgbm9zIGluZm9ybWFuIHNpIHNlIHZlcmlmaWNhIGxhIGlndWFsZGFkIGRlIHZhcmlhbnphcyBlbiBsb3MgZ3J1cG9zIGRlc2NyaXRvcy4KCmBgYHtyfQpzdW1tYXJ5KGZtJHJlc2lkdWFscykKYGBgCgpgYGB7cn0KYm94cGxvdChmbSRyZXNpZHVhbHMpCmBgYAoKYGBge3J9Cmhpc3QoZm0kcmVzaWR1YWxzKQpgYGAKCmBgYHtyfQpxcW5vcm0oZm0kcmVzaWR1YWxzKQpxcWxpbmUoZm0kcmVzaWR1YWxzKQpgYGAKCkVsIHRlc3QgZGUgU2hhcGlyby1XaWxrIGluZGljYSBxdWUgbm8gdGVuZW1vcyBldmlkZW5jaWEgc3VmaWNpZW50ZSBwYXJhIHJlY2hhemFyIGxhIGhpcMOzdGVzaXMgbnVsYSAobm9ybWFsaWRhZCBkZSBsb3MgcmVzaWR1b3MpLgoKYGBge3J9CnNoYXBpcm8udGVzdChmbSRyZXNpZHVhbHMpCmBgYAoKIyMjIDIuMy5ob21vY2VkYXN0aWNpZGFkCgpMb3MgZ3LDoWZpY29zIHkgZGVzY3JpcHRpdm9zIG5vcyBpbmZvcm1hbiBzaSBzZSB2ZXJpZmljYSBsYSBpZ3VhbGRhZCBkZSB2YXJpYW56YXMgZW4gbG9zIGdydXBvcyBkZXNjcml0b3M6CgpgYGB7cn0KYm94cGxvdChmbSRyZXNpZHVhbHN+Y29sb3JlcywgY29sID0gYygieWVsbG93IiwgImJsdWUiLCAid2hpdGUiLCJncmVlbiIpKQpgYGAKCmBgYHtyfQpkZXN2aWFjaW9uZXMgPC0gdGFwcGx5KGZtJHJlc2lkdWFscywgY29sb3Jlcywgc2QpCmBgYAoKQ29tcGFyYW5kbyBsYSBkZXN2aWFjacOzbiBtw6F4aW1hIGNvbiBsYSBtw61uaW1hIG9idGVuZW1vcyB1bmEgb3JpZW50YWNpw7NuIHNvYnJlIGxhIGZhbHRhIGRlIGhvbW9jZWRhc3RpY2lkYWQgKFw+MiBhcHJveGltYWRhbWVudGUpLgoKYGBge3J9Cm1heChkZXN2aWFjaW9uZXMpIC8gbWluKGRlc3ZpYWNpb25lcykgICAgCmBgYAoKRWwgdGVzdCBkZSBCYXJ0bGV0dCBpbmRpY2EgcXVlIG5vIHRlbmVtb3MgZXZpZGVuY2lhIHN1ZmljaWVudGUgcGFyYSByZWNoYXphciBsYSBoaXDDs3Rlc2lzIG51bGEgKGxhcyB2YXJpYW56YXMgc29uIGlndWFsZXMpLgoKYGBge3J9CmJhcnRsZXR0LnRlc3QoZm0kcmVzaWR1YWxzIH4gY29sb3JlcykKYGBgCgojIyAzLiBBTk9WQQoKRXN0YSBlcyBsYSBmb3JtYSBkZSBwZWRpciB1biBBTk9WQSBlbiBSOgoKYGBge3J9CmZtID0gYW92KCBsbShpbnNlY3RvcyB+IGNvbG9yZXMpICkKYGBgCgpQZWRpbW9zIHVuIHJlc3VtZW4gZGUgbGEgdGFibGEgZGVsIEFOT1ZBLgoKYGBge3J9CnN1bW1hcnkoZm0pCmBgYAoKRWxlbWVudG9zIGdlbmVyYWRvcyBlbiBlbCBBTk9WQToKCmBgYHtyfQpuYW1lcyhmbSkKYGBgCgpCYWpvIGxhIEhvIGVsIGVzdGFkw61zdGljbyBkZSBjb250cmFzdGUgRiBzZSBkaXN0cmlidXllIGNvbW8gdW5hIEYgZGUgZ3JhZG9zIGRlIGxpYmVydGFkIChJLTEpLCAobi1JKSBkb25kZSBJIGVzIGVsIG7Dum1lcm8gZGUgZ3J1cG9zIHF1ZSBkaXNwb25lbW9zIHkgbiBlbCB0YW1hw7FvIHRvdGFsIGRlIGxhIG11ZXN0cmFsLiBBc8OtIG9idGVuZW1vcyBlbCBjdWFudGlsIGJ1c2NhZG8uCgpgYGB7cn0KcWYoMC4wNSwgMy0xLCAxOC0zLCBsb3dlci50YWlsID0gRikKYGBgCgpWYWxvcmVzIGRlbCBlc3RhZMOtc3RpY28gXD4gMy42ODIzMiBlc3RhcsOhbiBpbmNsdWlkb3MgZW4gbGEgcmVnacOzbiBkZSByZWNoYXpvLiBFbiBudWV0cm8gY2FzbyAzMC41NSBlcyBtdWNobyBtYXlvciBxdWUgZWwgdmFsb3IgY3LDrXRpY28gb2J0ZW5pZG8uCgpFc3RlIHNlcsOtYSBlbCBpbnRlcnZhbG8gZGUgY29uZmlhbnphIGRlIGxhIG1lZGlhIGRlIGxvcyBpbnNlY3RvcyBjYXB0dXJhZG9zIHBhcmEgbGFzIHRyYW1wYXMgYW1hcmlsbGFzLCBjb24gdW4gbml2ZWwgZGUgY29uZmlhbnphIGRlbCA5NSU6CgpgYGB7cn0KbWVkaWEgPC0gbWVhbihpbnNlY3Rvc1tjb2xvcmVzID09ImFtYXJpbGxvIl0pIAp2YWxvcl90IDwtIHB0KDAuMDUvMiwgMTggLSAzKSAKc3AgPC0gc3FydCg0NikgICNkZXN2aWFjacOzbiB0w61waWNhIGRlIGxhIHZhcmlhbnphIG11ZXN0cmFsIGNvbcO6bgplZSAgPC0gdmFsb3JfdCAqIChzcC8gc3FydCg2KSkgICNlcnJvciBkZSBlc3RpbWFjacOzbiAKbWVkaWEKYGBgCgpMw61taXRlIHN1cGVyaW9yIGRlbCBpbnRlcnZhbG8gZGUgY29uZmlhbnphIGRlIGxhIG1lZGlhIGRlIGluc2VjdG9zIGNhcHR1cmFkb3MgcGFyYSBsYXMgdHJhbXBhcyBhbWFyaWxsYXMuCgpgYGB7cn0KbWVkaWEgKyBlZSAKYGBgCgpMw61taXRlIGluZmVyaW9yIGRlbCBpbnRlcnZhbG8gZGUgY29uZmlhbnphIGRlIGxhIG1lZGlhIGRlIGluc2VjdG9zIGNhcHR1cmFkb3MgcGFyYSBsYXMgdHJhbXBhcyBhbWFyaWxsYXMuCgpgYGB7cn0KbWVkaWEgLSBlZSAKYGBgCgpTaSBoZW1vcyBkZXRlY3RhZG8gKipkaWZlcmVuY2lhcyBzaWduaWZpY2F0aXZhcyoqIGVudHJlIGxhcyBtZWRpYXMgZGUgbGFzIHBvYmxhY2lvbmVzLgoKYGBge3J9CmludGVydmFscyA9IFR1a2V5SFNEKGZtKQppbnRlcnZhbHMKYGBgCg==