# Tabla de contingencia tridimensonal
# A x S X D con los datos del archivo Berkeley.rda

# Para ejecutar el script en R o RStudio es necesario instalar el paquete Deducer
# También el paquete vcd
install.packages("vcd")
library(vcd)

# Tabla A x S X D con las frecuencias 
A3<-contingency.tables(row.vars=d(A),col.vars=d(S),stratum.var=D,data=Berkeley)
print(A3,prop.r=F,prop.c=F,prop.t=F)

# Tablas A x S y A x D 
A1<-contingency.tables(row.vars=d(A),col.vars=d(S,D),data=Berkeley)
A1<-add.chi.squared(A1)
print(A1,prop.r=T,prop.c=T,prop.t=F,expected.n=T,adj.residuals=T)
ggplot() + geom_bar(aes(y = ..count..,x = S,fill = A),data=Berkeley,position = position_fill())
ggplot() + geom_bar(aes(y = ..count..,x = D,fill = A),data=Berkeley,position = position_fill())
assocstats(table(Berkeley$A, Berkeley$S))
assocstats(table(Berkeley$A, Berkeley$D))

# Tabla S x D 
A2<-contingency.tables(row.vars=d(S),col.vars=d(D),data=Berkeley)
A2<-add.chi.squared(A2)
print(A2,prop.r=T,prop.c=T,prop.t=F,expected.n=T,adj.residuals=T)
ggplot() + geom_bar(aes(y = ..count..,x = D,fill = S),data=Berkeley,position = position_fill())
assocstats(table(Berkeley$S, Berkeley$D))

# Tabla A x S x D 
A3<-add.chi.squared(A3)
print(A3,prop.r=T,prop.c=T,prop.t=F,expected.n=T,adj.residuals=T)
ggplot() + geom_bar(aes(y = ..count..,x = S,fill = A),data=Berkeley,position = position_fill()) +
  facet_wrap(facets = ~D) + ggtitle(label = 'D')
D1=subset(Berkeley,subset=D=="A")
assocstats(table(D1$A, D1$S))
D2=subset(Berkeley,subset=D=="B")
assocstats(table(D2$A, D2$S))
D3=subset(Berkeley,subset=D=="C")
assocstats(table(D3$A, D3$S))
D4=subset(Berkeley,subset=D=="D")
assocstats(table(D4$A, D4$S))
D5=subset(Berkeley,subset=D=="E")
assocstats(table(D5$A, D5$S))
D6=subset(Berkeley,subset=D=="F")
assocstats(table(D6$A, D6$S))

# Instrucciones adicionales
# Introducción de la tabla de contingencia como Data Frame.
A = c("Admitted","Admitted","Admitted","Admitted","Admitted","Admitted","Rejected","Rejected","Rejected","Rejected","Rejected","Rejected","Admitted","Admitted","Admitted","Admitted","Admitted","Admitted","Rejected","Rejected","Rejected","Rejected","Rejected","Rejected")
S = c("Women","Women","Women","Women","Women","Women","Women","Women","Women","Women","Women","Women","Men","Men","Men","Men","Men","Men","Men","Men","Men","Men","Men","Men")
D = c("A","B","C","D","E","F","A","B","C","D","E","F","A","B","C","D","E","F","A","B","C","D","E","F")
Fre = c(89,17,202,131,94,24,19,8,391,244,299,317,512,353,120,138,53,22,314,207,205,279,138,351)
matriz = data.frame(A,S,D,Fre)
matriz

# Función que convierte un "data frame" de frecuencias a un "data frame" de casos.
# 'countcol' es el nombre de la columna que tiene las frecuencias.
CountsToCases <- function(x, countcol = "Fre") {
  # Indice de fila de los datos del data frame x
  idx <- rep.int(seq_len(nrow(x)), x[[countcol]])
  # Extrae la columna de frecuencias
  x[[countcol]] <- NULL
  # Toma las filas del data frame x
  x[idx, ]
}

# Creación de un archivo externo sin formato.
write.table(CountsToCases(matriz),file='D:/Datos/Berkeley.dat')
# Importación a R.
Berkeley <- read.table("D:/Datos/Berkeley.dat",header=T,sep="",quote="\"")
# Se guarda en formato de R.
save(Berkeley,file='D:/Datos/Berkeley.rda')