#==============================ENCABEZADO===================================
# TEMA: EI Variables Continua - Vida Estimada
# AUTOR: GRUPO 4
# FECHA: 18-12-2025
#==============================CARGA DE DATOS===================================
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
setwd("C:/Users/HP/Documents/PROYECTO ESTADISTICA/RStudio")
datos <- read.csv("tablap.csv", header = TRUE, dec = ".", sep = ";")
# Limpieza de caracteres no numericos y filtrado de rango (25-80 anios)
v_util_raw <- as.numeric(gsub("[^0-9.]", "", as.character(datos$Estimated.lifetime)))
df_limpio <- data.frame(VU = v_util_raw) %>% filter(!is.na(VU) & VU >= 25 & VU <= 80)
# Creamos la tabla
cortes_evid <- seq(25, 85, by = 5)
df_limpio$RangoEvid <- cut(df_limpio$VU, breaks = cortes_evid, right = FALSE)
tabla_evid <- as.data.frame(table(df_limpio$RangoEvid)) %>%
mutate(hi = (Freq/sum(Freq))*100)
#Grafica original, para vizualizar de manera general como dividir a la grafica
barplot(tabla_evid$hi, names.arg = tabla_evid$Var1, col = "gray50",
main = "Grafica Nro. 1: Distribucion de Vida Estimada",
xlab = "Vida Estimada (Rangos)", ylab = "hi (%)", las = 2, cex.names = 0.8)
#El modelo se dividio en dos partes: Modelo uniforme y Modelo Geometrico
# ANALISIS PARTE A: MODELO UNIFORME (RANGO 25-50)
#=============MNODELO UNIFORME================
# Paso 1: Justificacion
#JUSTIFICACION: esta Variable es discreta debido a que su dominio son D={x/x ??? ???}")
# Paso 2: TDF
# se agrupo en un dos rangos de (25-30) y de (38-49)
df_a <- df_limpio %>% filter(VU < 50)
tabla_a <- as.data.frame(table(cut(df_a$VU, breaks = c(25, 38, 50), right = FALSE))) %>%
rename(Rango = Var1, ni = Freq)
levels(tabla_a$Rango) <- c("25-37", "38-49")
tdf_a <- tabla_a %>% mutate(hi = ni / sum(ni))
print(tdf_a)
## Rango ni hi
## 1 25-37 178 1
## 2 38-49 0 0
# Paso 3: Grafica Realidad
barplot(tdf_a$hi * 100, names.arg = tdf_a$Rango, col = "skyblue", ylim = c(0, 100),
main = "Grafica Nro. 2: Distribucion de Vida Estimada",
xlab = "Vida Estimada", ylab = "hi (%)")
legend("topright", legend = "Realidad", fill = "skyblue", bty = "n")
# Paso 4: Conjeturamos
p_unif_a <- rep(1 / nrow(tdf_a), nrow(tdf_a))
# Paso 5: Comparamos le realidad con el modelo
pos_a <- barplot(rbind(tdf_a$hi * 100, p_unif_a * 100), beside = TRUE, col = c("skyblue", "orange"),
main = "Grafica Nro. 2:Distribucion de Realidad vs Modelo ",
xlab = "Vida estimada", ylab = "Probabilidad (%)", ylim = c(0, 100))
axis(1, at = colMeans(pos_a), labels = tdf_a$Rango, cex.axis = 0.8)
legend("topright", legend = c("Real", "Modelo"), fill = c("skyblue", "orange"), bty = "n")
# Paso 6: Tests Pearson y chi cuadrado
x2_a <- sum(((tdf_a$hi - p_unif_a)^2) / p_unif_a)
vc_a <- qchisq(0.999, df = nrow(tdf_a) - 1)
#Aqui la grafica de dispersion presenta dos puntos esto se debe a que como es un modeo uniforme entonces tiende a ser
#una linea recta
plot(tdf_a$hi, p_unif_a, xlab = "Realidad (hi)", ylab = "Modelo (P)",
main = "Grafica Nro. 3: Dispersion de Vida Estimada", pch = 19, col = "blue", ylim = c(0, 1))
#en este codigo se genero una tabla de veredicto aqui se pude visualizar y relaizar la comparacion de los resultados
#ya sea de poison y chi cuadrado y ver si aprobo o no los test
#en pearson sale el valor de (-) esto se debe a que como es uniforme entonces la desviacion estandar es cero
#el valor critico es de 10.82 entonces como chi cuadrado es menor que el valor critico entonces aprueba el modelo
print(data.frame(Prueba=c("Pearson (r)", "Chi2"), Valor=c("-", round(x2_a, 6)),
Resultado=c(" APROBADO", ifelse(x2_a < vc_a, "APROBADO", "REPROBADO"))), row.names=F)
## Prueba Valor Resultado
## Pearson (r) - APROBADO
## Chi2 1 APROBADO
#=============MODELO GEOMETRICO================
#Paso 1: "JUSTIFICACION: esta Variable es discreta debido a que su dominio son D={x/x ??? ???}")
# Paso 2: TDF (Se agrupo con intervalos de 5 en 5)
df_b <- df_limpio %>% filter(VU >= 50)
tabla_b <- as.data.frame(table(cut(df_b$VU, breaks = seq(50, 85, by = 5), right = FALSE))) %>%
rename(Rango = Var1, ni = Freq)
tdf_b <- tabla_b %>% mutate(hi = ni / sum(ni))
print(tdf_b)
## Rango ni hi
## 1 [50,55) 10460 0.84470645
## 2 [55,60) 394 0.03181781
## 3 [60,65) 549 0.04433498
## 4 [65,70) 699 0.05644836
## 5 [70,75) 281 0.02269240
## 6 [75,80) 0 0.00000000
## 7 [80,85) 0 0.00000000
# Paso 3: Grafica original, para vizualizar de manera general como dividir a la grafica
barplot(tdf_b$hi * 100, names.arg = tdf_b$Rango, col = "green4", ylim = c(0, 100),
main = "Grafica Nro. 4: Distribucion de Vida Estimada",
xlab = "Vida Estimada", ylab = "hi (%)", las = 2, cex.names = 0.7)
legend("topright", legend = "Realidad", fill = "green4", bty = "n")
# Paso 4: Conjeturamos de acuerdo al modelo geometrico
xi_b <- 0:(nrow(tdf_b)-1)
p_param <- 1 / (sum(xi_b * tdf_b$hi) + 1)
prob_geom_b <- dgeom(xi_b, prob = p_param)
# Paso 5: Comparacion de grafica
pos_b <- barplot(rbind(tdf_b$hi * 100, prob_geom_b * 100), beside = TRUE, col = c("green4", "gold"),
main = "Grafica Nro. 5: Comparacion del Modelo Geometrico con la Realidad",
xlab = "Rangos", ylab = "Porcentaje", ylim = c(0, 100))
axis(1, at = colMeans(pos_b), labels = tdf_b$Rango, las = 2, cex.axis = 0.7)
legend("topright", legend = c("Real", "Modelo"), fill = c("green4", "gold"), bty = "n")
# Paso 6: Tests
#Person:
r_b <- cor(tdf_b$hi, prob_geom_b)
plot(tdf_b$hi, prob_geom_b, xlab = "Observado (hi)", ylab = "Esperado (P)",
main = "Grafica Nro. 6: Dispersion y Regresion (B)", pch = 19, col = "green4")
abline(lm(prob_geom_b ~ tdf_b$hi), col = "red", lwd = 2)
text(x = mean(tdf_b$hi), y = max(prob_geom_b), labels = paste("r =", round(r_b, 4)), col = "red", font = 2)
#chi cuadrado
x2_b <- sum(((tdf_b$hi - prob_geom_b)^2) / pmax(prob_geom_b, 0.0001))
vc_b <- qchisq(0.9999, df = nrow(tdf_b) - 1)
#Tabla veredicto
print(data.frame(Prueba=c("Pearson (r)", "Chi2"), Valor=c(round(r_b, 4), round(x2_b, 6)),
Resultado=c(ifelse(r_b > 0.7, "APROBADO", "REPROBADO"),
ifelse(x2_b < vc_b, "APROBADO", "REPROBADO"))), row.names=F)
## Prueba Valor Resultado
## Pearson (r) 0.966500 APROBADO
## Chi2 0.358817 APROBADO
# Paso 8: Pregunta de Probabilidad
ubicacion_p8 <- 1 # Ejemplo: segundo rango (55-60)
cat("\n8. PREGUNTA: Probabilidad calculada para la ubicacion", ubicacion_p8, "es:", round(dgeom(ubicacion_p8, p_param)*100, 2), "%\n")
##
## 8. PREGUNTA: Probabilidad calculada para la ubicacion 1 es: 19.97 %