En este ejemplo se ilustra la creación y los resultados de un experimento usando el cuadrado greco-latino y aplicado a un caso de Investigación de Mercados.

Caso de estudio: Decisión sobre la política de precios adecuada y el acompañamiento o no de un display en el punto de venta.

Una compañía desea comprobar a través de un experimento el impacto de distintas políticas de precios y distintos tipos de display de punto de venta, a lo largo de distintios días de la semana y en distintas zonas geográficas, en sus ventas. En un estudio previo los resultados de las distintas combinaciones de precios, ni del uso de los distintos displays no tuvieron impacto significativo en las ventas y se decidio repetir el experimento cambiando la poltíca de precio pero usando los mismos 5 tipos de display propuestos por la agencia de publicidad. El objetivo es decidir si elimina los displays y el encontrar la estrategia de precios adecuada.

library(gridExtra)
library(ggplot2)

# Tenemos 5 precios distintos
# Tenemos 5 tipos de display
# Tenemos 5 días de la semana de lunes a viernes
# Tenemos 5 zonas distintas

Zona <-factor( c(rep("Norte",1), rep("Sur",1), rep("Este",1), rep("Oeste",1), rep("Centro",1)))
Dia <- factor(c(rep("Lunes",5), rep("Martes",5), rep("Miercoles",5), rep("Jueves",5), rep("Viernes",5)),
              levels = c('Lunes','Martes','Miercoles','Jueves','Viernes'))
Precio <- factor(c("A","E","C","B","D", "C","B","A","D","E", "B","C","D","E","A", "D","A","E","C","B", "E","D","B","A","C"))
Display <- factor(c("a","b","c","d","e",  "c","d","e","a","b",
                    "e","a","b","c","d",  "b","c","d","e","a",
                    "d","e","a","b","c"))
Ventas <- c(17,26,19,16,13, 18,21,18,16,28, 20,12,16,35,13, 15,15,22,14,17, 41,34,27,27,24)*33
mydata <- data.frame(Zona, Dia, Precio,Display, Ventas)

di <- ggplot(mydata, aes(x = Dia, y = Ventas, fill=Dia)) +
  geom_boxplot() + theme(legend.position = "none")
pre <- ggplot(mydata, aes(x = Precio, y = Ventas, fill=Precio)) +
  geom_boxplot() + theme(legend.position = "none")
dis <- ggplot(mydata, aes(x = Display, y = Ventas, fill=Display)) +
  geom_boxplot() + theme(legend.position = "none")
zon <- ggplot(mydata, aes(x = Zona, y = Ventas, fill=Zona)) +
  geom_boxplot() + theme(legend.position = "none")

grid.arrange(pre,dis,di,zon, nrow=2,ncol=2)

# Gráficos de interacción
in_pre <- ggplot(data = mydata,
                 aes(x = Dia, y = Ventas, colour = Precio, group=Precio)) +
  stat_summary(fun.y=mean, geom="point")+
  stat_summary(fun.y=mean, geom="line")+
  ylab('Ventas Medias')
in_dis <- ggplot(data = mydata,
                 aes(x = Dia, y = Ventas, colour = Display, group=Display)) +
  stat_summary(fun.y=mean, geom="point")+
  stat_summary(fun.y=mean, geom="line")+
  ylab('Ventas Medias')
in_pre_zo <- ggplot(data = mydata,
                    aes(x = Zona, y = Ventas, colour = Precio, group=Precio)) +
  stat_summary(fun.y=mean, geom="point")+
  stat_summary(fun.y=mean, geom="line")+
  ylab('Ventas Medias')
in_dis_zo <- ggplot(data = mydata,
                    aes(x = Zona, y = Ventas, colour = Display, group=Display)) +
  stat_summary(fun.y=mean, geom="point")+
  stat_summary(fun.y=mean, geom="line")+
  ylab('Ventas Medias')

grid.arrange(in_pre,in_dis,in_pre_zo,in_dis_zo, nrow=2,ncol=2)

grid.arrange(in_pre,in_dis,nrow=1,ncol=2)

grid.arrange(in_pre_zo,in_dis_zo,nrow=1,ncol=2)

myfit <- lm(Ventas ~ Precio+Display+Dia+Zona, mydata)
summary(myfit)
## 
## Call:
## lm(formula = Ventas ~ Precio + Display + Dia + Zona, data = mydata)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -84.23 -56.84   2.64  32.13 122.28 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   398.970     92.860   4.296 0.002628 ** 
## PrecioB       105.018     73.720   1.425 0.192109    
## PrecioC       -80.753     76.138  -1.061 0.319835    
## PrecioD        34.068     73.720   0.462 0.656304    
## PrecioE       430.068     73.720   5.834 0.000390 ***
## Displayb       -1.184     78.666  -0.015 0.988359    
## Displayc      140.308     79.217   1.771 0.114477    
## Displayd      -22.964     75.469  -0.304 0.768675    
## Displaye       80.190     71.929   1.115 0.297286    
## DiaMartes      66.000     70.196   0.940 0.374620    
## DiaMiercoles   33.000     70.196   0.470 0.650824    
## DiaJueves     -52.800     70.196  -0.752 0.473490    
## DiaViernes    409.200     70.196   5.829 0.000392 ***
## ZonaEste       46.200     70.196   0.658 0.528918    
## ZonaNorte     105.600     70.196   1.504 0.170901    
## ZonaOeste      85.800     70.196   1.222 0.256384    
## ZonaSur        85.800     70.196   1.222 0.256384    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 111 on 8 degrees of freedom
## Multiple R-squared:  0.9345, Adjusted R-squared:  0.8034 
## F-statistic:  7.13 on 16 and 8 DF,  p-value: 0.004186
anova(myfit)
## Analysis of Variance Table
## 
## Response: Ventas
##           Df Sum Sq Mean Sq F value   Pr(>F)   
## Precio     4 630487  157622 12.7954 0.001489 **
## Display    4  68373   17093  1.3876 0.320559   
## Dia        4 670998  167750 13.6175 0.001207 **
## Zona       4  35458    8864  0.7196 0.602046   
## Residuals  8  98549   12319                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Special thanks to: http://www.real-statistics.com/design-of-experiments/ and https://www.r-bloggers.com/latin-squares-design-in-r/