Tarea 4 - Análisis de Datos Categóricos
Kevin Gargate Osorio
2024-10-02
library(readxl)Ejercicio 1
\(H_0\): La proporción de niños con defecto neuronal sin ácido fólico es 3.5%, es decir, \(p_0 = 0.035\)
\(H_1\): La proporción de niños con defecto neuronal es menor con ácido fólico, es decir, \(p < 0.035\).
Usaremos una prueba de proporciones (Z-test) para una cola, dado que comparamos la proporción observada con la esperada.
El estadístico Z para una prueba de proporciones se calcula como:
\[ Z = \frac{\hat{p} - p_0}{\sqrt{\frac{p_0(1 - p_0)}{n}}} \]
p_obs = 6/600 # Proporción observada
p_0 = 0.035 # Proporción bajo la hipotesis nula
n = 600 # tamaño de la muestra
z = (p_obs - p_0)/sqrt(p_0*(1 - p_0)/n)
p_valor = pnorm(z)
alpha = 0.05
ifelse(p_valor<alpha,"Rechazamos la hipótesis nula concluimos que existe evidencia suficiente para afirmar, con un nivel de significancia del 5%, que el ácido fólico ha reducido la proporción de defectos neuronales en recién nacidos. En otras palabras, la disminución observada no se debe al azar","No se rechaza la hipótesis nula, lo que significa que no hay evidencia suficiente para afirmar que el ácido fólico ha reducido significativamente la proporción de defectos neuronales. La diferencia observada podría deberse al azar")## [1] "Rechazamos la hipótesis nula concluimos que existe evidencia suficiente para afirmar, con un nivel de significancia del 5%, que el ácido fólico ha reducido la proporción de defectos neuronales en recién nacidos. En otras palabras, la disminución observada no se debe al azar"Ejercicio 2
\(H_0\):La distribución observada es igual a la distribución esperada
\(H_1\): La distribución observada no es igual a la distribución esperada
Utilizamos la fórmula del test chi-cuadrado:
\[ \chi^2 = \sum \frac{(O_i - E_i)^2}{E_i} \]
donde \(O_i\) son las frecuencias observadas y \(E_i\) las frecuencias esperadas.
# Frecuencias observadas (número de personas)
observado <- c(47 * 800 / 100, 38 * 800 / 100, 12 * 800 / 100, 4 * 800 / 100)
# Frecuencias esperadas (porcentajes esperados por 800 personas)
esperado <- c(46 * 800 / 100, 39 * 800 / 100, 11 * 800 / 100, 4 * 800 / 100)
# Prueba chi-cuadrado
chi_test <- chisq.test(observado, p = esperado/sum(esperado))
# Resultados
cat("Valor chi-cuadrado calculado:", chi_test$statistic, "\n")## Valor chi-cuadrado calculado: 1.016152cat("Valor p asociado:", chi_test$p.value, "\n")## Valor p asociado: 0.7973436# Nivel de significancia
alpha <- 0.05
# Decisión
if (chi_test$p.value < alpha) {
cat("Rechazamos la hipótesis nula. Existe evidencia suficiente para concluir que la distribución observada es significativamente diferente de la esperada.\n")
} else {
cat("No rechazamos la hipótesis nula. No hay evidencia suficiente para concluir que la distribución observada es diferente de la esperada.\n")
}## No rechazamos la hipótesis nula. No hay evidencia suficiente para concluir que la distribución observada es diferente de la esperada.Función Actualizada
stat_tab1 <- function(data) {
res <- list()
# Verificar si el input es una tabla de contingencia o dos factores
if (is.table(data)) {
# Si es una tabla de contingencia, se usa directamente
tdata <- data
} else if (is.data.frame(data) && ncol(data) == 2) {
# Si son dos columnas (factores), creamos la tabla de contingencia
tdata <- table(data[, 1], data[, 2])
} else {
stop("El argumento 'data' debe ser una tabla o un data.frame con dos columnas")
}
# Datos
nr <- dim(tdata)[1] # Número de filas
nc <- dim(tdata)[2] # Número de columnas
n <- sum(tdata) # Total de unidades
# Totales marginales
tr <- margin.table(tdata, 1) # Totales marginales de fila
tc <- margin.table(tdata, 2) # Totales marginales de columna
tcdata <- addmargins(tdata) # Añadiendo los totales
# Ajustar nombres de filas y columnas
colnames(tcdata)[nc+1] <- "Marginal" # Cambiar a "Marginal"
rownames(tcdata)[nr+1] <- "Marginal" # Cambiar a "Marginal"
res$Table <- tcdata
# Tabla de frecuencias
ptdata <- tcdata / n # Tabla de frecuencias
res$Frequencies <- round(ptdata, 3)
# Tabla sin márgenes
pdata <- ptdata[1:nr, 1:nc] # Sin márgenes
pr <- ptdata[1:nr, nc+1] # Margen de filas (Totales por filas)
pc <- ptdata[nr+1, 1:nc] # Margen de columnas (Totales por columnas)
# Perfiles de filas
prdata <- prop.table(tdata, 1) # Perfiles de fila
prfr <- rbind(prdata, pc) # Añadiendo perfil marginal
prfr <- cbind(prfr, apply(prfr, 1, sum))
rownames(prfr)[nr+1] <- "Marginal"
colnames(prfr)[nc+1] <- "Marginal"
res$row.profiles <- round(prfr, 3)
# Perfiles de columnas
pcdata <- prop.table(tdata, 2) # Perfiles de columna
prfc <- cbind(pcdata, pr) # Añadiendo perfil marginal
prfc <- rbind(prfc, apply(prfc, 2, sum))
rownames(prfc)[nr+1] <- "Marginal"
colnames(prfc)[nc+1] <- "Marginal"
res$col.profiles <- round(prfc, 3)
# Desvíos a la independencia
exdata <- pr %*% t(pc) # Tabla de valores esperados
pexdata <- addmargins(exdata) # Totales ajustados
colnames(pexdata)[nc+1] <- "Marginal"
rownames(pexdata)[nr+1] <- "Marginal"
res$exp.frequencies <- round(pexdata, 3)
despdata <- (pdata - exdata) # Desviaciones
res$dev.frequencies <- round(despdata, 3)
dedata <- despdata * n # Desviaciones absolutas
res$dev.values <- round(dedata, 3)
# Entropías
entr <- -sum(pr * log(pr, 2)) # Entropía de filas
entrr <- entr / log(nr, 2) # Entropía relativa filas
entc <- -sum(pc * log(pc, 2)) # Entropía de columnas
entcr <- entc / log(nc, 2) # Entropía relativa columnas
entt <- -sum(pdata * log(pdata, 2)) # Entropía conjunta
enttr <- entt / log(nr * nc, 2) # Entropía relativa conjunta
entexp <- -sum(exdata * log(exdata, 2)) # Entropía esperada
entexpr <- entexp / log(nr * nc, 2) # Entropía relativa esperada
# Información mutua y estadística G²
infm <- entr + entc - entt # Información mutua
G2 <- 2 * n * infm * log(2) # g²
entconr <- entr - infm
entconc <- entc - infm
# Tabla de entropías
entropias <- rbind(c(entr, entrr), c(entc, entcr), c(entt, enttr), c(entexp, entexpr))
rownames(entropias) <- c("filas", "columnas", "conjunta", "esperada")
colnames(entropias) <- c("entropía", "relativa")
res$Entropies <- round(entropias, 5)
# Entropías condicionadas
econ <- c(entconr, entconc)
names(econ) <- c("fila|columnas", "columna|filas")
res$Cond.entropies <- round(econ, 5)
info <- c(infm, G2)
names(info) <- c("mutual_information", "G² statistics")
res$Information <- round(info, 5)
# Estadísticas chi-cuadrado
phi <- sum((pdata - exdata)^2 / exdata) # phi cuadrado
chi <- n * phi # chi cuadrado
df <- (nr - 1) * (nc - 1) # Grados de libertad
pearson <- sqrt(chi / (n + chi)) # Pearson
tchuprow <- sqrt(chi / (n * sqrt(df))) # T de Tchuprow
cramer <- sqrt(phi / (min(nr - 1, nc - 1))) # phi de Cramer
# Tabla de estadísticas chi-cuadrado
chist <- rbind(phi, chi, df, pearson, tchuprow, cramer)
rownames(chist) <- c("phi-cuadrado", "chi-cuadrado", "grados de libertad",
"C de Pearson", "T de Tchuprow", "phi de Cramer")
colnames(chist) <- "estadísticas"
res$Phi_stats <- round(chist, 5)
#####################################
#Riesgos y Odds
## Por Filas:
## Riesgo:
#Frecuencias:
f_f= tr;f_f
#Riesgo/Frecuencia Relativa:
f_r = pr;f_r
# Porcentaje
f_rp = f_r*100
#Sorpresa:
f_s = - log(f_r,2);f_s
#Odds/momio:
f_o = pr/(1-pr);f_o
# Log de Momios
f_lo = -log(f_o,2)
tab_f <- t(cbind(f_f,f_r,f_rp,f_s,f_o,f_lo)) # resultados
rownames(tab_f) <- c("frecuencias","frec.relativas/Riegos","porcentajes","sorpresa","momios/Odds","log momios/Odds") # nombres
res$infor_filas = round(tab_f,3)
## Por Columnas:
#Frecuencias:
f_c= tc;f_c
#Riesgo/Frecuencia Relativa:
f_cr = pc;f_cr
# Porcentaje
f_cp = f_cr*100
#Sorpresa:
f_cs = - log(f_c,2);f_cs
#Odds/momio:
f_co = pc/(1-pc);f_co
# Log de Momios
f_clo = -log(f_co,2)
tab_c <- t(rbind(f_c,f_cr,f_cp,f_cs,f_co,f_clo)) # resultados
colnames(tab_c) <- c("frecuencias","frec.relativas/Riegos","porcentajes","sorpresa","momios/Odds","log momios/Odds") # nombres
res$infor_col = round(tab_c,3)
#####################################
#### TEST DE CHI-CUADRADRO######
### Agregamos el test de hipótesis ###
# Nivel de significancia
alpha <- 0.05
# Chequeamos si el valor del estadístico chi-cuadrado o los grados de libertad son NaN
if (is.nan(chi) || is.nan(df)) {
res$decision_chi2 <- "No se puede realizar el test de chi-cuadrado debido a valores NaN."
res$p_value <- NA
} else {
# Calcular el valor p (probabilidad acumulada del chi-cuadrado)
p_value <- 1 - pchisq(chi, df)
res$p_value <- p_value
# Decisión
if (p_value < alpha) {
res$decision_chi2 <- "Rechazamos la hipótesis nula. La distribución observada es significativamente diferente de la esperada."
} else {
res$decision_chi2 <- "No rechazamos la hipótesis nula. No hay evidencia suficiente para concluir que la distribución observada es diferente de la esperada."
}
}
#### TEST POR G^2######
# Valor crítico de la distribución chi-cuadrado para el G²
# Chequeamos si el valor del estadístico G^2 o los grados de libertad son NaN
if (is.nan(G2) || is.nan(df)) {
res$decision_g2 <- "No se puede realizar el test de G² debido a valores NaN."
} else {
# Valor crítico de la distribución chi-cuadrado para el G²
valor_critico_g2 <- qchisq(1 - alpha, df)
# Decisión basada en G²
if (G2 > valor_critico_g2) {
res$decision_g2 <- paste("Rechazamos la hipótesis nula con G² =", round(G2, 3),
">", round(valor_critico_g2, 3),
". Existe evidencia de que la distribución observada difiere de la esperada.")
} else {
res$decision_g2 <- paste("No rechazamos la hipótesis nula con G² =", round(G2, 3),
"<=", round(valor_critico_g2, 3),
". No hay evidencia suficiente para concluir que la distribución observada difiere de la esperada.")
}
}
### PRIMER GRÁFICO: Filas condicionadas por columnas ###
max_prfr <- max(prfr, na.rm = TRUE)
if (!is.finite(max_prfr)) {
max_prfr <- 1 # Valor por defecto si max(prfr) no es finito
}
plot(1:nc, prfr[nr+1, 1:nc], ylim = c(0, max_prfr + 0.05), type = "n", xaxt = "n",
xlab = "Columna (Condicionada)", ylab = "Frecuencias",
main = "Filas condicionadas por Columnas")
axis(1, at = 1:nc, labels = colnames(prfr)[1:nc])
for (i in 1:nr) {
lines(1:nc, prfr[i, 1:nc], col = i) # Añadir líneas dinámicamente
}
lines(1:nc, prfr[nr+1, 1:nc], col = "red") # Línea marginal
# Leyenda actualizada sin duplicar "Marginal"
legend("topright", legend = rownames(prfr)[1:(nr+1)], lty = 1, cex = 0.6, y.intersp = 0.7, col = c(1:nr, "red"))
### SEGUNDO GRÁFICO: Columnas condicionadas por filas ###
max_prfc <- max(prfc, na.rm = TRUE)
if (!is.finite(max_prfc)) {
max_prfc <- 1 # Valor por defecto si max(prfc) no es finito
}
plot(1:nr, prfc[1:nr,nc+1], ylim = c(0, max_prfc + 0.05), type = "n", xaxt = "n",
xlab = "Fila (Condicionada)", ylab = "Frecuencias",
main = "Columnas condicionadas por Filas")
axis(1, at = 1:nr, labels = rownames(prfc)[1:nr]) # Eje horizontal
for (i in 1:nc) {
lines(1:nr, prfc[1:nr, i], col = i)
}
# Línea marginal de color azul (representa los totales por filas)
lines(1:nr, prfc[1:nr, nc+1], col = "blue")
# Leyenda actualizada sin duplicar "Marginal"
legend("topright", legend = c(colnames(prfc)[1:nc], "Marginal"), lty = 1, col = c(1:nc, "blue"), cex = 0.6, y.intersp = 0.7)
return(res)
}Snee
### **Snee**
snee=read.csv("Snee.csv")snee$Color_Ojos <- factor(snee$Color_Ojos, # factor y etiquetas de la primera variable
levels = c(1,2,3,4),
labels = c("Oscuros","Pardos",
"Verdes","Azules"),ordered=TRUE)
snee$Color_Pelo <- factor(snee$Color_Pelo, # factor y etiquetas de la segunda variable
levels = c(1,2,3,4),
labels = c("Negro","Castano",
"Rojo","Rubio"),ordered=TRUE) stat_tab1(snee)
## $Table
##
## Negro Castano Rojo Rubio Marginal
## Oscuros 68 119 26 7 220
## Pardos 15 54 14 10 93
## Verdes 5 29 14 16 64
## Azules 20 84 17 94 215
## Marginal 108 286 71 127 592
##
## $Frequencies
##
## Negro Castano Rojo Rubio Marginal
## Oscuros 0.115 0.201 0.044 0.012 0.372
## Pardos 0.025 0.091 0.024 0.017 0.157
## Verdes 0.008 0.049 0.024 0.027 0.108
## Azules 0.034 0.142 0.029 0.159 0.363
## Marginal 0.182 0.483 0.120 0.215 1.000
##
## $row.profiles
## Negro Castano Rojo Rubio Marginal
## Oscuros 0.309 0.541 0.118 0.032 1
## Pardos 0.161 0.581 0.151 0.108 1
## Verdes 0.078 0.453 0.219 0.250 1
## Azules 0.093 0.391 0.079 0.437 1
## Marginal 0.182 0.483 0.120 0.215 1
##
## $col.profiles
## Negro Castano Rojo Rubio Marginal
## Oscuros 0.630 0.416 0.366 0.055 0.372
## Pardos 0.139 0.189 0.197 0.079 0.157
## Verdes 0.046 0.101 0.197 0.126 0.108
## Azules 0.185 0.294 0.239 0.740 0.363
## Marginal 1.000 1.000 1.000 1.000 1.000
##
## $exp.frequencies
## Negro Castano Rojo Rubio Marginal
## 0.068 0.180 0.045 0.080 0.372
## 0.029 0.076 0.019 0.034 0.157
## 0.020 0.052 0.013 0.023 0.108
## 0.066 0.175 0.044 0.078 0.363
## Marginal 0.182 0.483 0.120 0.215 1.000
##
## $dev.frequencies
##
## Negro Castano Rojo Rubio
## Oscuros 0.047 0.021 -0.001 -0.068
## Pardos -0.003 0.015 0.005 -0.017
## Verdes -0.011 -0.003 0.011 0.004
## Azules -0.032 -0.034 -0.015 0.081
##
## $dev.values
##
## Negro Castano Rojo Rubio
## Oscuros 27.865 12.716 -0.385 -40.196
## Pardos -1.966 9.071 2.846 -9.951
## Verdes -6.676 -1.919 6.324 2.270
## Azules -19.223 -19.868 -8.785 47.877
##
## $Entropies
## entropía relativa
## filas 1.82786 0.91393
## columnas 1.79823 0.89911
## conjunta 3.44765 0.86191
## esperada 3.62609 0.90652
##
## $Cond.entropies
## fila|columnas columna|filas
## 1.64942 1.61979
##
## $Information
## mutual_information G² statistics
## 0.17844 146.44358
##
## $Phi_stats
## estadísticas
## phi-cuadrado 0.23360
## chi-cuadrado 138.28984
## grados de libertad 9.00000
## C de Pearson 0.43516
## T de Tchuprow 0.27904
## phi de Cramer 0.27904
##
## $infor_filas
## Oscuros Pardos Verdes Azules
## frecuencias 220.000 93.000 64.000 215.000
## frec.relativas/Riegos 0.372 0.157 0.108 0.363
## porcentajes 37.162 15.709 10.811 36.318
## sorpresa 1.428 2.670 3.209 1.461
## momios/Odds 0.591 0.186 0.121 0.570
## log momios/Odds 0.758 2.424 3.044 0.810
##
## $infor_col
## frecuencias frec.relativas/Riegos porcentajes sorpresa momios/Odds
## Negro 108 0.182 18.243 -6.755 0.223
## Castano 286 0.483 48.311 -8.160 0.935
## Rojo 71 0.120 11.993 -6.150 0.136
## Rubio 127 0.215 21.453 -6.989 0.273
## log momios/Odds
## Negro 2.164
## Castano 0.098
## Rojo 2.875
## Rubio 1.872
##
## $p_value
## [1] 0
##
## $decision_chi2
## [1] "Rechazamos la hipótesis nula. La distribución observada es significativamente diferente de la esperada."
##
## $decision_g2
## [1] "Rechazamos la hipótesis nula con G² = 146.444 > 16.919 . Existe evidencia de que la distribución observada difiere de la esperada."Piel Escuero
piel = read.csv("Pielescuero_car.csv")
head(piel)## Exportacion Tamano Financiacion Zona Actividad
## 1 siexp 11-20 nopre NE MeAl
## 2 noexp 11-20 nopre CE Ropa
## 3 siexp 11-20 nopre NE Ropa
## 4 siexp 11-20 nopre NE Ropa
## 5 siexp 11-20 nopre NO Ropa
## 6 siexp 11-20 nopre CE RopaActividad y Zona Geográfica de Piel Escuero
piel_act_zon = piel[c(1,5)]table(piel_act_zon$Exportacion)##
## noexp siexp
## 44 129table(piel_act_zon$Actividad)##
## MeAl PeCu Ropa Zapa
## 11 46 54 62stat_tab1(piel_act_zon)
## $Table
##
## MeAl PeCu Ropa Zapa Marginal
## noexp 7 12 18 7 44
## siexp 4 34 36 55 129
## Marginal 11 46 54 62 173
##
## $Frequencies
##
## MeAl PeCu Ropa Zapa Marginal
## noexp 0.040 0.069 0.104 0.040 0.254
## siexp 0.023 0.197 0.208 0.318 0.746
## Marginal 0.064 0.266 0.312 0.358 1.000
##
## $row.profiles
## MeAl PeCu Ropa Zapa Marginal
## noexp 0.159 0.273 0.409 0.159 1
## siexp 0.031 0.264 0.279 0.426 1
## Marginal 0.064 0.266 0.312 0.358 1
##
## $col.profiles
## MeAl PeCu Ropa Zapa Marginal
## noexp 0.636 0.261 0.333 0.113 0.254
## siexp 0.364 0.739 0.667 0.887 0.746
## Marginal 1.000 1.000 1.000 1.000 1.000
##
## $exp.frequencies
## MeAl PeCu Ropa Zapa Marginal
## 0.016 0.068 0.079 0.091 0.254
## 0.047 0.198 0.233 0.267 0.746
## Marginal 0.064 0.266 0.312 0.358 1.000
##
## $dev.frequencies
##
## MeAl PeCu Ropa Zapa
## noexp 0.024 0.002 0.025 -0.051
## siexp -0.024 -0.002 -0.025 0.051
##
## $dev.values
##
## MeAl PeCu Ropa Zapa
## noexp 4.202 0.301 4.266 -8.769
## siexp -4.202 -0.301 -4.266 8.769
##
## $Entropies
## entropía relativa
## filas 0.81808 0.81808
## columnas 1.81577 0.90789
## conjunta 2.56499 0.85500
## esperada 2.63385 0.87795
##
## $Cond.entropies
## fila|columnas columna|filas
## 0.74922 1.74692
##
## $Information
## mutual_information G² statistics
## 0.06886 16.51447
##
## $Phi_stats
## estadísticas
## phi-cuadrado 0.09706
## chi-cuadrado 16.79183
## grados de libertad 3.00000
## C de Pearson 0.29745
## T de Tchuprow 0.23673
## phi de Cramer 0.31155
##
## $infor_filas
## noexp siexp
## frecuencias 44.000 129.000
## frec.relativas/Riegos 0.254 0.746
## porcentajes 25.434 74.566
## sorpresa 1.975 0.423
## momios/Odds 0.341 2.932
## log momios/Odds 1.552 -1.552
##
## $infor_col
## frecuencias frec.relativas/Riegos porcentajes sorpresa momios/Odds
## MeAl 11 0.064 6.358 -3.459 0.068
## PeCu 46 0.266 26.590 -5.524 0.362
## Ropa 54 0.312 31.214 -5.755 0.454
## Zapa 62 0.358 35.838 -5.954 0.559
## log momios/Odds
## MeAl 3.880
## PeCu 1.465
## Ropa 1.140
## Zapa 0.840
##
## $p_value
## [1] 0.0007799381
##
## $decision_chi2
## [1] "Rechazamos la hipótesis nula. La distribución observada es significativamente diferente de la esperada."
##
## $decision_g2
## [1] "Rechazamos la hipótesis nula con G² = 16.514 > 7.815 . Existe evidencia de que la distribución observada difiere de la esperada."Gruppi_sanguigni
sangre = read.csv("Gruppi_sanguigni.csv",row.names = 1)
sangre = as.table(as.matrix(sangre))
sangre## O A B AB
## RH+ 1885 1613 472 167
## RH- 412 333 103 34stat_tab1(sangre)
## $Table
## O A B AB Marginal
## RH+ 1885 1613 472 167 4137
## RH- 412 333 103 34 882
## Marginal 2297 1946 575 201 5019
##
## $Frequencies
## O A B AB Marginal
## RH+ 0.376 0.321 0.094 0.033 0.824
## RH- 0.082 0.066 0.021 0.007 0.176
## Marginal 0.458 0.388 0.115 0.040 1.000
##
## $row.profiles
## O A B AB Marginal
## RH+ 0.456 0.390 0.114 0.040 1
## RH- 0.467 0.378 0.117 0.039 1
## Marginal 0.458 0.388 0.115 0.040 1
##
## $col.profiles
## O A B AB Marginal
## RH+ 0.821 0.829 0.821 0.831 0.824
## RH- 0.179 0.171 0.179 0.169 0.176
## Marginal 1.000 1.000 1.000 1.000 1.000
##
## $exp.frequencies
## O A B AB Marginal
## 0.377 0.320 0.094 0.033 0.824
## 0.080 0.068 0.020 0.007 0.176
## Marginal 0.458 0.388 0.115 0.040 1.000
##
## $dev.frequencies
## O A B AB
## RH+ -0.002 0.002 0.000 0.000
## RH- 0.002 -0.002 0.000 0.000
##
## $dev.values
## O A B AB
## RH+ -8.343 8.975 -1.954 1.322
## RH- 8.343 -8.975 1.954 -1.322
##
## $Entropies
## entropía relativa
## filas 0.67065 0.67065
## columnas 1.59007 0.79503
## conjunta 2.26063 0.75354
## esperada 2.26072 0.75357
##
## $Cond.entropies
## fila|columnas columna|filas
## 0.67056 1.58998
##
## $Information
## mutual_information G² statistics
## 0.00009 0.60209
##
## $Phi_stats
## estadísticas
## phi-cuadrado 0.00012
## chi-cuadrado 0.60085
## grados de libertad 3.00000
## C de Pearson 0.01094
## T de Tchuprow 0.00831
## phi de Cramer 0.01094
##
## $infor_filas
## RH+ RH-
## frecuencias 4137.000 882.000
## frec.relativas/Riegos 0.824 0.176
## porcentajes 82.427 17.573
## sorpresa 0.279 2.509
## momios/Odds 4.690 0.213
## log momios/Odds -2.230 2.230
##
## $infor_col
## frecuencias frec.relativas/Riegos porcentajes sorpresa momios/Odds
## O 2297 0.458 45.766 -11.166 0.844
## A 1946 0.388 38.773 -10.926 0.633
## B 575 0.115 11.456 -9.167 0.129
## AB 201 0.040 4.005 -7.651 0.042
## log momios/Odds
## O 0.245
## A 0.659
## B 2.950
## AB 4.583
##
## $p_value
## [1] 0.8962387
##
## $decision_chi2
## [1] "No rechazamos la hipótesis nula. No hay evidencia suficiente para concluir que la distribución observada es diferente de la esperada."
##
## $decision_g2
## [1] "No rechazamos la hipótesis nula con G² = 0.602 <= 7.815 . No hay evidencia suficiente para concluir que la distribución observada difiere de la esperada."Blood Pressure
presion <- read_excel("Blood-pressure.xlsx", sheet = 1)
presion <- data.frame(presion)
head(presion)## Blood.pressure Age
## 1 Low Under_30
## 2 Low Under_30
## 3 Low Under_30
## 4 Low Under_30
## 5 Low Under_30
## 6 Low Under_30stat_tab1(presion)
## $Table
##
## 30-49 Over_50 Under_30 Marginal
## High 51 73 23 147
## Low 37 31 27 95
## Normal 91 93 48 232
## Marginal 179 197 98 474
##
## $Frequencies
##
## 30-49 Over_50 Under_30 Marginal
## High 0.108 0.154 0.049 0.310
## Low 0.078 0.065 0.057 0.200
## Normal 0.192 0.196 0.101 0.489
## Marginal 0.378 0.416 0.207 1.000
##
## $row.profiles
## 30-49 Over_50 Under_30 Marginal
## High 0.347 0.497 0.156 1
## Low 0.389 0.326 0.284 1
## Normal 0.392 0.401 0.207 1
## Marginal 0.378 0.416 0.207 1
##
## $col.profiles
## 30-49 Over_50 Under_30 Marginal
## High 0.285 0.371 0.235 0.310
## Low 0.207 0.157 0.276 0.200
## Normal 0.508 0.472 0.490 0.489
## Marginal 1.000 1.000 1.000 1.000
##
## $exp.frequencies
## 30-49 Over_50 Under_30 Marginal
## 0.117 0.129 0.064 0.310
## 0.076 0.083 0.041 0.200
## 0.185 0.203 0.101 0.489
## Marginal 0.378 0.416 0.207 1.000
##
## $dev.frequencies
##
## 30-49 Over_50 Under_30
## High -0.010 0.025 -0.016
## Low 0.002 -0.018 0.016
## Normal 0.007 -0.007 0.000
##
## $dev.values
##
## 30-49 Over_50 Under_30
## High -4.513 11.905 -7.392
## Low 1.124 -8.483 7.359
## Normal 3.388 -3.422 0.034
##
## $Entropies
## entropía relativa
## filas 1.49309 0.94203
## columnas 1.52716 0.96353
## conjunta 3.00618 0.94834
## esperada 3.02025 0.95278
##
## $Cond.entropies
## fila|columnas columna|filas
## 1.47902 1.51309
##
## $Information
## mutual_information G² statistics
## 0.01407 9.24618
##
## $Phi_stats
## estadísticas
## phi-cuadrado 0.01973
## chi-cuadrado 9.35205
## grados de libertad 4.00000
## C de Pearson 0.13910
## T de Tchuprow 0.09932
## phi de Cramer 0.09932
##
## $infor_filas
## High Low Normal
## frecuencias 147.000 95.000 232.000
## frec.relativas/Riegos 0.310 0.200 0.489
## porcentajes 31.013 20.042 48.945
## sorpresa 1.689 2.319 1.031
## momios/Odds 0.450 0.251 0.959
## log momios/Odds 1.153 1.996 0.061
##
## $infor_col
## frecuencias frec.relativas/Riegos porcentajes sorpresa momios/Odds
## 30-49 179 0.378 37.764 -7.484 0.607
## Over_50 197 0.416 41.561 -7.622 0.711
## Under_30 98 0.207 20.675 -6.615 0.261
## log momios/Odds
## 30-49 0.721
## Over_50 0.492
## Under_30 1.940
##
## $p_value
## [1] 0.0528777
##
## $decision_chi2
## [1] "No rechazamos la hipótesis nula. No hay evidencia suficiente para concluir que la distribución observada es diferente de la esperada."
##
## $decision_g2
## [1] "No rechazamos la hipótesis nula con G² = 9.246 <= 9.488 . No hay evidencia suficiente para concluir que la distribución observada difiere de la esperada."Pasteles_w
pasteles = read.csv("Pasteles_w.csv")
pasteles = pasteles[c("Juicio_pastel","Juicio_crema")]
head(pasteles)## Juicio_pastel Juicio_crema
## 1 P_discreto C_discreto
## 2 P_bueno C_bueno
## 3 P_bueno C_discreto
## 4 P_muy bueno C_bueno
## 5 P_discreto C_discreto
## 6 P_muy bueno C_muy buenostat_tab1(pasteles)
## $Table
##
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## P_bueno 129 61 3 21 1 1
## P_discreto 22 32 0 1 0 7
## P_excelente 6 0 16 8 0 0
## P_muy bueno 45 2 10 38 0 0
## P_muy_pobre 0 0 0 0 1 2
## P_pobre 1 2 0 0 3 14
## P_regular 1 8 1 1 2 15
## Marginal 204 105 30 69 7 39
##
## C_regular Marginal
## P_bueno 9 225
## P_discreto 32 94
## P_excelente 0 30
## P_muy bueno 1 96
## P_muy_pobre 0 3
## P_pobre 1 21
## P_regular 21 49
## Marginal 64 518
##
## $Frequencies
##
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## P_bueno 0.249 0.118 0.006 0.041 0.002 0.002
## P_discreto 0.042 0.062 0.000 0.002 0.000 0.014
## P_excelente 0.012 0.000 0.031 0.015 0.000 0.000
## P_muy bueno 0.087 0.004 0.019 0.073 0.000 0.000
## P_muy_pobre 0.000 0.000 0.000 0.000 0.002 0.004
## P_pobre 0.002 0.004 0.000 0.000 0.006 0.027
## P_regular 0.002 0.015 0.002 0.002 0.004 0.029
## Marginal 0.394 0.203 0.058 0.133 0.014 0.075
##
## C_regular Marginal
## P_bueno 0.017 0.434
## P_discreto 0.062 0.181
## P_excelente 0.000 0.058
## P_muy bueno 0.002 0.185
## P_muy_pobre 0.000 0.006
## P_pobre 0.002 0.041
## P_regular 0.041 0.095
## Marginal 0.124 1.000
##
## $row.profiles
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## P_bueno 0.573 0.271 0.013 0.093 0.004 0.004
## P_discreto 0.234 0.340 0.000 0.011 0.000 0.074
## P_excelente 0.200 0.000 0.533 0.267 0.000 0.000
## P_muy bueno 0.469 0.021 0.104 0.396 0.000 0.000
## P_muy_pobre 0.000 0.000 0.000 0.000 0.333 0.667
## P_pobre 0.048 0.095 0.000 0.000 0.143 0.667
## P_regular 0.020 0.163 0.020 0.020 0.041 0.306
## Marginal 0.394 0.203 0.058 0.133 0.014 0.075
## C_regular Marginal
## P_bueno 0.040 1
## P_discreto 0.340 1
## P_excelente 0.000 1
## P_muy bueno 0.010 1
## P_muy_pobre 0.000 1
## P_pobre 0.048 1
## P_regular 0.429 1
## Marginal 0.124 1
##
## $col.profiles
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## P_bueno 0.632 0.581 0.100 0.304 0.143 0.026
## P_discreto 0.108 0.305 0.000 0.014 0.000 0.179
## P_excelente 0.029 0.000 0.533 0.116 0.000 0.000
## P_muy bueno 0.221 0.019 0.333 0.551 0.000 0.000
## P_muy_pobre 0.000 0.000 0.000 0.000 0.143 0.051
## P_pobre 0.005 0.019 0.000 0.000 0.429 0.359
## P_regular 0.005 0.076 0.033 0.014 0.286 0.385
## Marginal 1.000 1.000 1.000 1.000 1.000 1.000
## C_regular Marginal
## P_bueno 0.141 0.434
## P_discreto 0.500 0.181
## P_excelente 0.000 0.058
## P_muy bueno 0.016 0.185
## P_muy_pobre 0.000 0.006
## P_pobre 0.016 0.041
## P_regular 0.328 0.095
## Marginal 1.000 1.000
##
## $exp.frequencies
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## 0.171 0.088 0.025 0.058 0.006 0.033
## 0.071 0.037 0.011 0.024 0.002 0.014
## 0.023 0.012 0.003 0.008 0.001 0.004
## 0.073 0.038 0.011 0.025 0.003 0.014
## 0.002 0.001 0.000 0.001 0.000 0.000
## 0.016 0.008 0.002 0.005 0.001 0.003
## 0.037 0.019 0.005 0.013 0.001 0.007
## Marginal 0.394 0.203 0.058 0.133 0.014 0.075
## C_regular Marginal
## 0.054 0.434
## 0.022 0.181
## 0.007 0.058
## 0.023 0.185
## 0.001 0.006
## 0.005 0.041
## 0.012 0.095
## Marginal 0.124 1.000
##
## $dev.frequencies
##
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## P_bueno 0.078 0.030 -0.019 -0.017 -0.004 -0.031
## P_discreto -0.029 0.025 -0.011 -0.022 -0.002 0.000
## P_excelente -0.011 -0.012 0.028 0.008 -0.001 -0.004
## P_muy bueno 0.014 -0.034 0.009 0.049 -0.003 -0.014
## P_muy_pobre -0.002 -0.001 0.000 -0.001 0.002 0.003
## P_pobre -0.014 -0.004 -0.002 -0.005 0.005 0.024
## P_regular -0.035 -0.004 -0.004 -0.011 0.003 0.022
##
## C_regular
## P_bueno -0.036
## P_discreto 0.039
## P_excelente -0.007
## P_muy bueno -0.021
## P_muy_pobre -0.001
## P_pobre -0.003
## P_regular 0.029
##
## $dev.values
##
## C_bueno C_discreto C_excelente C_muy bueno C_muy_pobre C_pobre
## P_bueno 40.390 15.392 -10.031 -8.971 -2.041 -15.940
## P_discreto -15.019 12.946 -5.444 -11.521 -1.270 -0.077
## P_excelente -5.815 -6.081 14.263 4.004 -0.405 -2.259
## P_muy bueno 7.193 -17.459 4.440 25.212 -1.297 -7.228
## P_muy_pobre -1.181 -0.608 -0.174 -0.400 0.959 1.774
## P_pobre -7.270 -2.257 -1.216 -2.797 2.716 12.419
## P_regular -18.297 -1.932 -1.838 -5.527 1.338 11.311
##
## C_regular
## P_bueno -18.799
## P_discreto 20.386
## P_excelente -3.707
## P_muy bueno -10.861
## P_muy_pobre -0.371
## P_pobre -1.595
## P_regular 14.946
##
## $Entropies
## entropía relativa
## filas 2.21042 0.78737
## columnas 2.35919 0.84036
## conjunta NaN NaN
## esperada 4.56961 0.81386
##
## $Cond.entropies
## fila|columnas columna|filas
## NaN NaN
##
## $Information
## mutual_information G² statistics
## NaN NaN
##
## $Phi_stats
## estadísticas
## phi-cuadrado 1.21549
## chi-cuadrado 629.62361
## grados de libertad 36.00000
## C de Pearson 0.74070
## T de Tchuprow 0.45009
## phi de Cramer 0.45009
##
## $infor_filas
## P_bueno P_discreto P_excelente P_muy bueno P_muy_pobre
## frecuencias 225.000 94.000 30.000 96.000 3.000
## frec.relativas/Riegos 0.434 0.181 0.058 0.185 0.006
## porcentajes 43.436 18.147 5.792 18.533 0.579
## sorpresa 1.203 2.462 4.110 2.432 7.432
## momios/Odds 0.768 0.222 0.061 0.227 0.006
## log momios/Odds 0.381 2.173 4.024 2.136 7.423
## P_pobre P_regular
## frecuencias 21.000 49.000
## frec.relativas/Riegos 0.041 0.095
## porcentajes 4.054 9.459
## sorpresa 4.624 3.402
## momios/Odds 0.042 0.104
## log momios/Odds 4.565 3.259
##
## $infor_col
## frecuencias frec.relativas/Riegos porcentajes sorpresa momios/Odds
## C_bueno 204 0.394 39.382 -7.672 0.650
## C_discreto 105 0.203 20.270 -6.714 0.254
## C_excelente 30 0.058 5.792 -4.907 0.061
## C_muy bueno 69 0.133 13.320 -6.109 0.154
## C_muy_pobre 7 0.014 1.351 -2.807 0.014
## C_pobre 39 0.075 7.529 -5.285 0.081
## C_regular 64 0.124 12.355 -6.000 0.141
## log momios/Odds
## C_bueno 0.622
## C_discreto 1.976
## C_excelente 4.024
## C_muy bueno 2.702
## C_muy_pobre 6.190
## C_pobre 3.618
## C_regular 2.827
##
## $p_value
## [1] 0
##
## $decision_chi2
## [1] "Rechazamos la hipótesis nula. La distribución observada es significativamente diferente de la esperada."
##
## $decision_g2
## [1] "No se puede realizar el test de G² debido a valores NaN."Comentarios en General
- Datos Snee (Colores de ojos y cabello) Riesgos y Odds: Los riesgos relativos (odds) son más altos en las categorías de ojos claros (Verdes y Azules), lo cual sugiere que las personas con ojos claros tienen mayor probabilidad de tener cabello rubio o castaño claro.
En los datos de sorpresas y momios, se nota que la categoría de ojos azules tiene un “log odds” alto para el cabello rubio (0.81), lo que implica que la probabilidad (odds) de tener el cabello rubio es mayor en personas con ojos azules comparado con otras combinaciones.
Pruebas (\(G^2\) y Chi-cuadrado): El \(G^2\) es 146.44 y el chi-cuadrado es 138.29, ambos valores sugieren que la relación entre el color de los ojos y el color del cabello es significativa. La decisión tanto por \(G^2\) como por chi-cuadrado es rechazar la hipótesis nula. Esto indica que existe una dependencia significativa entre las dos variables, es decir, el color de los ojos está asociado con el color del cabello.
- Tabla de Actividad y Zona Geográfica de Piel Escuero Riesgos y Odds: Aquí, los odds indican que las personas expuestas a productos de cuero tienen mayor probabilidad de trabajar en la fabricación de zapatos, lo que tiene sentido dado el tipo de actividad laboral. El valor de sorpresa muestra una probabilidad superior en la categoría “Zapa” en las personas que tienen exposición laboral.
Pruebas (\(G^2\) y Chi-cuadrado): El \(G^2\) es 16.51 y el chi-cuadrado es 16.79, ambos cercanos y también sugieren que existe una relación significativa entre las variables.
Nuevamente, ambas pruebas rechazan la hipótesis nula, lo que sugiere que la exposición laboral está significativamente relacionada con la actividad (fabricación de zapatos, ropa, etc.).
- Tabla de Grupo Sanguíneo Riesgos y Odds: En este caso, los odds no muestran grandes diferencias entre los grupos sanguíneos y el factor RH, lo que implica que no hay una asociación significativa entre estas variables. Los valores de “log odds” son bajos, indicando que no hay una relación fuerte entre el tipo de sangre y el factor RH.
Pruebas (\(G^2\) y Chi-cuadrado): El \(G^2\) es 0.60 y el chi-cuadrado también es 0.60, lo que indica que no hay una relación significativa entre las variables. Tanto por \(G^2\) como por chi-cuadrado, se no rechaza la hipótesis nula, lo que significa que no hay evidencia suficiente para afirmar que el tipo de sangre y el factor RH están relacionados.
- Tabla de Presión Arterial Riesgos y Odds: Las personas con presión alta tienen una mayor probabilidad (odds) de estar en el grupo de mayor edad (“Over_50”), lo cual tiene sentido biológicamente, ya que la presión alta es más común en personas mayores de 50 años. Los valores de “log odds” son más elevados en la categoría “Over_50” y “High”, lo que refleja el mayor riesgo de presión alta en este grupo de edad.
Pruebas (\(G^2\) y Chi-cuadrado): El \(G^2\) es 9.25 y el chi-cuadrado es 9.35, valores cercanos que indican una relación leve entre presión arterial y grupos de edad.
Ambos valores indican que no se puede rechazar la hipótesis nula, lo que implica que no hay suficiente evidencia para afirmar una dependencia significativa entre las categorías de presión arterial y las edades.
- Tabla de Pasteles_w (Calidad del producto y satisfacción) Riesgos y Odds: En esta tabla, los odds y los valores de riesgo relativo son más elevados en las categorías de “calidad excelente” y “satisfacción excelente”, lo que muestra una clara relación entre la calidad del producto percibida y la satisfacción del cliente. Los log odds altos para las categorías de “calidad excelente” y “calidad muy buena” sugieren que los clientes tienden a percibir más satisfacción en productos de mayor calidad, lo cual es esperado en estos escenarios.
Pruebas (\(G^2\) y Chi-cuadrado): En este caso, no se pudo calcular \(G^2\) , pero el chi-cuadrado es 629.62, un valor extremadamente alto que indica una fuerte dependencia entre la calidad del producto y la satisfacción del cliente.
La prueba de chi-cuadrado rechaza la hipótesis nula con mucha fuerza, lo que indica que existe una relación significativa entre la calidad del producto y los niveles de satisfacción.
Lo que finalmente podemos decir:
Riesgos y Odds: En general, los valores de odds y log odds en las tablas indican relaciones de mayor o menor riesgo entre las categorías observadas. Las relaciones más significativas en términos de odds se observan en la tabla de Snee (colores de ojos y cabello) y en la tabla de Piel Escuero (exposición laboral). Los riesgos asociados con la calidad del producto y la satisfacción del cliente también son evidentes en la tabla de Pasteles_w.
Ambas pruebas, en general, ofrecen resultados muy similares, y en todos los casos donde ambos valores se pueden calcular, hay un buen acuerdo entre \(G^2\) y chi-cuadrado. Los resultados más significativos fueron en la tabla de Snee y Pasteles_w, donde las pruebas indican una relación muy fuerte entre las variables. En la tabla de Grupo Sanguíneo, tanto el \(G^2\) como el chi-cuadrado son extremadamente bajos, indicando que las variables son casi completamente independientes.
Comparaciones de Estadísticas y Conclusiones
Comparar la información mutua: La tabla que tiene más información mutua entre las variables es la de Snee, con una información mutua de 0.17844 y un valor de \(G^2=146.44\).Esto indica una fuerte relación entre las variables en esta tabla.
La tabla con menos información mutua es la de Grupo Sanguíneo, con una información mutua casi nula de 0.00009 y un valor de \(G^2=0.60\), lo que sugiere que las variables están casi independientemente distribuidas.
En este caso, los valores de \(G^2\) y chi-cuadrado suelen ser cercanos en magnitud cuando las frecuencias observadas son grandes y los valores esperados son razonablemente grandes. Si observamos los resultados:
Tabla de Snee: \(G^2=146.44\) Chi-cuadrado = 138.29 Relación: Los valores son cercanos, lo que indica que ambas pruebas coinciden en sus conclusiones. Esto es típico cuando las frecuencias esperadas son lo suficientemente grandes.
Tabla de Actividad y Zona Geográfica de Piel Escuero: \(G^2=16.51\) Chi-cuadrado = 16.79 Relación: Aquí también, los valores son muy cercanos. Esta similitud entre \(G^2\) y chi-cuadrado sugiere que ambas estadísticas están detectando una relación significativa de forma similar.
Tabla de Grupo Sanguíneo: \(G^2=0.60\) Chi-cuadrado = 0.60 Relación: Ambos valores son idénticos, lo que refuerza la conclusión de que no hay una relación significativa entre las variables (se acepta la hipótesis nula de independencia).
Tabla de Blood Pressure (Presión Arterial): \(G^2=9.25\) Chi-cuadrado = 9.35 Relación: Los valores son prácticamente idénticos, indicando nuevamente que ambas pruebas están en gran acuerdo en su conclusión de que no hay suficiente evidencia para rechazar la hipótesis de independencia.
Tabla de Pasteles_w: \(G^2 = NaN\) (no se puede calcular, probablemente por la estructura de la tabla) Chi-cuadrado = 629.62 Relación: En este caso, no se puede calcular \(G^2\), lo cual puede ocurrir cuando hay valores en las celdas que generan problemas numéricos, como frecuencias observadas o esperadas muy bajas. El valor de chi-cuadrado es significativamente alto, lo que indica una fuerte evidencia de dependencia entre las variables.
Con lo que podemos decir:
Snee, Piel Escuero, y Grupo Sanguíneo muestran relaciones claras entre las variables, con resultados coherentes entre \(G^2\)y chi-cuadrado.
Pasteles_w presenta un caso especial en el que \(G^2\) no es calculable, esto debido a valores en la tabla.