Ejercicio 2 - Análisis de Datos Categóricos
Kevin Gargate Osorio
2024-09-07
datos_fiebre <- data.frame(
"Fiebre_de_heno" = c(141, 928, 1069),
"No_fiebre" = c(420, 13525, 13945),
"Total" = c(561, 14453, 15014),
row.names = c("Eccema", "No_eccema", "Total")
)
print(datos_fiebre)## Fiebre_de_heno No_fiebre Total
## Eccema 141 420 561
## No_eccema 928 13525 14453
## Total 1069 13945 15014calcular_metricas_completas <- function(frecuencias, nombres) {
# Asignar nombres
names(frecuencias) <- nombres
# Calcular el total de la muestra
n <- sum(frecuencias)
# Calcular frecuencias relativas
frecuencias_relativas <- frecuencias / n
# Calcular porcentajes
porcentajes <- frecuencias_relativas * 100
# Calcular sorpresa (información)
sorpresas <- -log(frecuencias_relativas, 2)
# Calcular momios (odds ratio) tomando como referencia la primera categoría
momios <- frecuencias / frecuencias[1]
# Calcular logaritmo de los momios
log_momios <- -log(momios, 2)
# Calcular entropía observada
entropia_observada <- -sum(frecuencias_relativas * log2(frecuencias_relativas))
# Calcular entropía máxima
entropia_maxima <- log2(length(frecuencias))
# Calcular entropía relativa
entropia_relativa <- entropia_observada / entropia_maxima
# Encontrar la moda
moda <- nombres[which.max(frecuencias)]
moda_frecuencia <- max(frecuencias)
moda_frec_relativa <- max(frecuencias_relativas)
moda_porcentaje <- max(porcentajes)
# Construcción e impresión de los resultados en tabla
tabla <- t(cbind(frecuencias, frecuencias_relativas, porcentajes, sorpresas,
momios, c(NA, log_momios[2:length(log_momios)])))
rownames(tabla) <- c("frecuencias", "frec.relativas", "porcentajes", "sorpresas",
"momios", "log.momios")
colnames(tabla) <- nombres
# Imprimir la tabla
cat("\n Distribución de la Actividad \n")
print.table(round(tabla, 3))
# Imprimir estadísticas adicionales
cat("\nEstadísticas de Actividad\n")
cat("Moda:", which.max(frecuencias), "\n")
cat("Etiqueta:", moda, "\n")
cat("Frecuencia:", moda_frecuencia, "\n")
cat("Frec. relativa:", round(moda_frec_relativa, 3), "\n")
cat("Porcentaje:", round(moda_porcentaje, 3), "\n\n")
cat("Entropía máxima:", round(entropia_maxima, 3), "\n")
cat("Entropía observada:", round(entropia_observada, 3), "\n")
cat("Entropía relativa:", round(entropia_relativa, 3), "\n")
# Construcción del gráfico de pie (torta)
nompie <- paste(nombres, round(frecuencias_relativas, 3), sep = " ")
pie(frecuencias_relativas, col = c("red", "lightblue", "green", "yellow"), labels = nompie,
init.angle = 90, main = "Distribución de la Actividad")
# Agregar el momio y log-momio al gráfico
mtext(paste0("Momio máx = ", round(max(momios), 3), ", Log-momio = ", round(log_momios[2], 3)),
side = 1, line = 0)
# Retornar los resultados como una lista (si deseas usar los datos después)
return(list(
frecuencias = frecuencias,
frecuencias_relativas = frecuencias_relativas,
porcentajes = porcentajes,
sorpresas = sorpresas,
momios = momios,
log_momios = log_momios,
entropia_observada = entropia_observada,
entropia_maxima = entropia_maxima,
entropia_relativa = entropia_relativa,
moda = list(etiqueta = moda, frecuencia = moda_frecuencia, frec_relativa = moda_frec_relativa, porcentaje = moda_porcentaje),
tabla = tabla
))
}Datos Dicotomicos
Presencia de eczema
pres_eczema <- c( 561, 14453)
nombres <- c("Si", "No")
resultados <- calcular_metricas_completas(pres_eczema, nombres)##
## Distribución de la Actividad
## Si No
## frecuencias 561.000 14453.000
## frec.relativas 0.037 0.963
## porcentajes 3.737 96.263
## sorpresas 4.742 0.055
## momios 1.000 25.763
## log.momios -4.687
##
## Estadísticas de Actividad
## Moda: 2
## Etiqueta: No
## Frecuencia: 14453
## Frec. relativa: 0.963
## Porcentaje: 96.263
##
## Entropía máxima: 1
## Entropía observada: 0.23
## Entropía relativa: 0.23
#### Presencia de Hongos
pres_hongos <- c( 64, 1256)
nombres <- c("Si", "No")
resultados <- calcular_metricas_completas(pres_hongos, nombres)##
## Distribución de la Actividad
## Si No
## frecuencias 64.000 1256.000
## frec.relativas 0.048 0.952
## porcentajes 4.848 95.152
## sorpresas 4.366 0.072
## momios 1.000 19.625
## log.momios -4.295
##
## Estadísticas de Actividad
## Moda: 2
## Etiqueta: No
## Frecuencia: 1256
## Frec. relativa: 0.952
## Porcentaje: 95.152
##
## Entropía máxima: 1
## Entropía observada: 0.28
## Entropía relativa: 0.28
### Snee.csv
snee = read.csv("Snee.csv",sep=",")
head(snee)## Color_Ojos Color_Pelo
## 1 1 1
## 2 1 1
## 3 1 1
## 4 1 1
## 5 1 1
## 6 1 1snee$Color_Ojos <- factor(snee$Color_Ojos,
levels = c(1,2,3,4),
labels = c("Pardo Oscuro","Pardo Claro","Verde","Azul"))snee$Color_Pelo <- factor(snee$Color_Pelo,
levels = c(1,2,3,4),
labels = c("Negro","Pardo","Rojo","Rubio"))# Comprobamos que hemos transformado en factores a las variables
str(snee)## 'data.frame': 592 obs. of 2 variables:
## $ Color_Ojos: Factor w/ 4 levels "Pardo Oscuro",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Color_Pelo: Factor w/ 4 levels "Negro","Pardo",..: 1 1 1 1 1 1 1 1 1 1 ...write.csv(snee, file = "snee.csv", row.names = FALSE)table(snee)## Color_Pelo
## Color_Ojos Negro Pardo Rojo Rubio
## Pardo Oscuro 68 119 26 7
## Pardo Claro 15 54 14 10
## Verde 5 29 14 16
## Azul 20 84 17 94stat_nom <- function(vector, ...) {
res <- list() # Lista para resultados
# Verificar si el vector es un factor
if (is.factor(vector)) {
vector <- as.character(vector) # Convertir el factor a caracteres
}
# Tabla de distribución
t <- table(vector)
tot <- sum(t)
f <- t / tot # Frecuencias
fcum <- cumsum(f) # Frecuencias acumuladas
# Cálculo de odds y log odds para cada categoría
odds <- f / (1 - f)
log_odds <- log(odds)
# Crear la tabla con todas las métricas
tab <- cbind(
t,
round(f, 5),
round(fcum, 5),
round(f * 100, 3),
round(fcum * 100, 3),
round(odds, 5),
round(log_odds, 5)
)
# Definir nombres de las columnas
colnames(tab) <- c(
"numbers", "frequencies", "cumul.freq.",
"percentages", "cum. percentages", "odds", "log odds"
)
# Guardar la tabla en los resultados
res$summary <- tab
# Moda
moda <- c(names(t)[which(f == max(f))], max(t), round(max(f), 3))
names(moda) <- c("Mode", "numbers", "frequency")
res$mode <- noquote(moda)
# Entropías
h <- -sum(f * log(f, 2))
hm <- log(length(f), 2) # Corregido: usar length en lugar de dim para vectores
hr <- h / hm
ent <- cbind(h, hm, hr)
colnames(ent) <- c("entropy", "max entropy", "relative entropy")
res$entropy <- round(ent, 3)
# Calcular mediana y cuantiles solo si el vector es numérico
if (is.numeric(vector)) {
res$Median <- quantile(vector, c(0.50), type = 1)
res$Quantiles <- quantile(vector, c(0.01, 0.05, 0.25, 0.50, 0.75, 0.95, 0.99), type = 1)
}
# Gráfico de barras
barplot(t(tab[, 2:3]), beside = TRUE, col = c("red", "blue"), ...)
legend("topleft", pch = 20, col = c("red", "blue"), legend = c("frequency", "cumulative frequency"))
return(res)
}resultado_ojos <- stat_nom(snee$Color_Ojos);
resultado_ojos## $summary
## numbers frequencies cumul.freq. percentages cum. percentages
## Azul 215 0.36318 0.36318 36.318 36.318
## Pardo Claro 93 0.15709 0.52027 15.709 52.027
## Pardo Oscuro 220 0.37162 0.89189 37.162 89.189
## Verde 64 0.10811 1.00000 10.811 100.000
## odds log odds
## Azul 0.57029 -0.56161
## Pardo Claro 0.18637 -1.68001
## Pardo Oscuro 0.59140 -0.52527
## Verde 0.12121 -2.11021
##
## $mode
## Mode numbers frequency
## Pardo Oscuro 220 0.372
##
## $entropy
## entropy max entropy relative entropy
## [1,] 1.828 2 0.914resultado_pelo <- stat_nom(snee$Color_Pelo);
resultado_pelo## $summary
## numbers frequencies cumul.freq. percentages cum. percentages odds
## Negro 108 0.18243 0.18243 18.243 18.243 0.22314
## Pardo 286 0.48311 0.66554 48.311 66.554 0.93464
## Rojo 71 0.11993 0.78547 11.993 78.547 0.13628
## Rubio 127 0.21453 1.00000 21.453 100.000 0.27312
## log odds
## Negro -1.49995
## Pardo -0.06759
## Rojo -1.99307
## Rubio -1.29785
##
## $mode
## Mode numbers frequency
## Pardo 286 0.483
##
## $entropy
## entropy max entropy relative entropy
## [1,] 1.798 2 0.899Pielescuero.csv
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 Ropastr(piel)## 'data.frame': 173 obs. of 5 variables:
## $ Exportacion : chr "siexp" "noexp" "siexp" "siexp" ...
## $ Tamano : chr "11-20" "11-20" "11-20" "11-20" ...
## $ Financiacion: chr "nopre" "nopre" "nopre" "nopre" ...
## $ Zona : chr "NE" "CE" "NE" "NE" ...
## $ Actividad : chr "MeAl" "Ropa" "Ropa" "Ropa" ...table(piel$Exportacion) # Dicotomico##
## noexp siexp
## 44 129table(piel$Financiacion) # Dicotomico##
## nopre sipre
## 120 53piel$Tamano <- factor(piel$Exportacion)
piel$Financiacion <- factor(piel$Financiacion)
table(piel$Tamano)##
## noexp siexp
## 44 129table(piel$Financiacion)##
## nopre sipre
## 120 53Tamaño
val_tamano <- c( 44, 129)
nomb_tamano <- c("noexp", "siexp")
resultados <- calcular_metricas_completas(val_tamano, nomb_tamano)##
## Distribución de la Actividad
## noexp siexp
## frecuencias 44.000 129.000
## frec.relativas 0.254 0.746
## porcentajes 25.434 74.566
## sorpresas 1.975 0.423
## momios 1.000 2.932
## log.momios -1.552
##
## Estadísticas de Actividad
## Moda: 2
## Etiqueta: siexp
## Frecuencia: 129
## Frec. relativa: 0.746
## Porcentaje: 74.566
##
## Entropía máxima: 1
## Entropía observada: 0.818
## Entropía relativa: 0.818
Financiación
val_Financiacion <- c( 120, 53)
nomb_Financiacion <- c("nopre", "sipre")
resultados <- calcular_metricas_completas(val_tamano, nomb_tamano)##
## Distribución de la Actividad
## noexp siexp
## frecuencias 44.000 129.000
## frec.relativas 0.254 0.746
## porcentajes 25.434 74.566
## sorpresas 1.975 0.423
## momios 1.000 2.932
## log.momios -1.552
##
## Estadísticas de Actividad
## Moda: 2
## Etiqueta: siexp
## Frecuencia: 129
## Frec. relativa: 0.746
## Porcentaje: 74.566
##
## Entropía máxima: 1
## Entropía observada: 0.818
## Entropía relativa: 0.818