#UNIVERSIDAD CENTRAL DEL ECUADOR
#GRUPO 6
#VARIABLE DISCRETA-INFERENCIAL
#CARGA DE DATOS
setwd("~/")
datos <- read.csv("DATOS.csv", header = TRUE, sep = ";" , dec = ".")
str(datos)
## 'data.frame': 10190 obs. of 17 variables:
## $ Distrito_edit : chr "1" "1" "1" "1" ...
## $ Year_edit_Fecha_del_derrame : int 2013 2013 2013 2013 2013 2013 2013 2013 2013 2013 ...
## $ Mes_edit_Fecha_del_derrame : int 6 3 4 4 6 6 3 9 10 6 ...
## $ Categoria_Instalaciones : chr "Instalacion fija" "Pozos" "Pozos" "Pozos" ...
## $ Operacion_general : chr "Produccion" "Otro" "Produccion" "Produccion" ...
## $ Categoria_Fuente : chr NA "Tanques/Almacenamiento" "Lineas/Tuberias" "Infraestructura Fija" ...
## $ Grupo_causas_probable : chr NA "Afectaciones externas" "Factores humanos" "Problemas tecnicos" ...
## $ Liberacion_petroleo_crudo_edicion : num 0 0 0 0 0 ...
## $ Edicion_recuperacion_petroleo_crudo : num NA 0 0 0 0 0 0 0 0 NA ...
## $ Volumen_liberado_Cond_Final : num 0 0 0 10 0 0 0 1 0 0 ...
## $ Liberacion_agua_de_produccion_edicion: num 6720 3780 5040 420 10920 ...
## $ Liberacion_volumen_gas : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Volumen_condensado_recuperado : num NA 0 0 1 0 0 0 0 0 NA ...
## $ Edicion_Recuperacion_agua_producida : num NA 420 4620 0 10920 ...
## $ Derrame_sobre_agua_limpio : chr "NO" "NO" "NO" "NO" ...
## $ Estado_general : chr "Observaciones tecnicas" NA NA NA ...
## $ Codigo_area : int 1 1 1 1 1 1 1 1 1 3 ...
#VARIABLE DISCRETA 2:MES EN EL QUE OCURRIO CADA DERRAME---------------------------
# Extraer la variable Mes_edit_Fecha_del_derrame
Mes_edit_Fecha_del_derrame <- datos$Mes_edit_Fecha_del_derrame
# Tabla de frecuencias
tabla_Mes_edit_Fecha_del_derrame <- table(Mes_edit_Fecha_del_derrame)
tabla_Mes_edit_Fecha_del_derrame_df <- as.data.frame(tabla_Mes_edit_Fecha_del_derrame)
colnames(tabla_Mes_edit_Fecha_del_derrame_df) <- c("Mes_edit_Fecha_del_derrame", "ni")
# Calcular la frecuencia relativa (hi)
hi <- tabla_Mes_edit_Fecha_del_derrame_df$ni / sum(tabla_Mes_edit_Fecha_del_derrame_df$ni)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(tabla_Mes_edit_Fecha_del_derrame_df$ni)
# Calcular la frecuencia acumulada descendente (Ni_dsc)
Ni_dsc <- rev(cumsum(rev(tabla_Mes_edit_Fecha_del_derrame_df$ni)))
Hi_asc <- cumsum(hi_porc)
# Calcular la frecuencia acumulada relativa descendente (Hi_dsc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Mostrar la tabla final con las nuevas columnas
tabla_Mes_edit_Fecha_del_derrame_df$hi <- hi
tabla_Mes_edit_Fecha_del_derrame_df$hi_porc <- hi_porc
tabla_Mes_edit_Fecha_del_derrame_df$Ni_asc <- Ni_asc
tabla_Mes_edit_Fecha_del_derrame_df$Ni_dsc <- Ni_dsc
tabla_Mes_edit_Fecha_del_derrame_df$Hi_asc <- Hi_asc
tabla_Mes_edit_Fecha_del_derrame_df$Hi_dsc <- Hi_dsc
# Mostrar la tabla final
print(tabla_Mes_edit_Fecha_del_derrame_df)
## Mes_edit_Fecha_del_derrame ni hi hi_porc Ni_asc Ni_dsc Hi_asc
## 1 1 956 0.09381747 9.38 956 10190 9.38
## 2 2 834 0.08184495 8.18 1790 9234 17.56
## 3 3 811 0.07958783 7.96 2601 8400 25.52
## 4 4 772 0.07576055 7.58 3373 7589 33.10
## 5 5 966 0.09479882 9.48 4339 6817 42.58
## 6 6 931 0.09136408 9.14 5270 5851 51.72
## 7 7 886 0.08694799 8.69 6156 4920 60.41
## 8 8 936 0.09185476 9.19 7092 4034 69.60
## 9 9 754 0.07399411 7.40 7846 3098 77.00
## 10 10 760 0.07458292 7.46 8606 2344 84.46
## 11 11 825 0.08096173 8.10 9431 1584 92.56
## 12 12 759 0.07448479 7.45 10190 759 100.01
## Hi_dsc
## 1 100.01
## 2 90.63
## 3 82.45
## 4 74.49
## 5 66.91
## 6 57.43
## 7 48.29
## 8 39.60
## 9 30.41
## 10 23.01
## 11 15.55
## 12 7.45
# Crear la tabla final con las variables modificadas
TDFMesEdit <- data.frame(
Mes_edit_Fecha_del_derrame = tabla_Mes_edit_Fecha_del_derrame_df$Mes_edit_Fecha_del_derrame,
ni = tabla_Mes_edit_Fecha_del_derrame_df$ni,
hi_porc = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
# Mostrar la tabla final
print(TDFMesEdit)
## Mes_edit_Fecha_del_derrame ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 1 956 9.38 956 10190 9.38 100.01
## 2 2 834 8.18 1790 9234 17.56 90.63
## 3 3 811 7.96 2601 8400 25.52 82.45
## 4 4 772 7.58 3373 7589 33.10 74.49
## 5 5 966 9.48 4339 6817 42.58 66.91
## 6 6 931 9.14 5270 5851 51.72 57.43
## 7 7 886 8.69 6156 4920 60.41 48.29
## 8 8 936 9.19 7092 4034 69.60 39.60
## 9 9 754 7.40 7846 3098 77.00 30.41
## 10 10 760 7.46 8606 2344 84.46 23.01
## 11 11 825 8.10 9431 1584 92.56 15.55
## 12 12 759 7.45 10190 759 100.01 7.45
# Gráfico de barras de los meses de derrames
barplot(TDFMesEdit$ni,
main = "Gráfica No.1: Distribución de cada derrame por Mes",
xlab = "Mes", ylab = "Frecuencia Absoluta",
col = "magenta",
ylim = c(0, max(TDFMesEdit$ni) + 5),
names.arg = TDFMesEdit$Mes_edit_Fecha_del_derrame,
las = 2)
#De enero a Marzo
Mes1 <- as.numeric(datos$Mes_edit_Fecha_del_derrame)
Mes1 <- Mes1[!is.na(Mes1) & Mes1 >= 1 & Mes1 <= 3]
tabla_Mes1 <- table(Mes1)
df_Mes1 <- as.data.frame(tabla_Mes1)
colnames(df_Mes1) <- c("Mes", "ni")
# Calcular la frecuencia relativa (hi)
hi <- df_Mes1$ni / sum(df_Mes1$ni)
hi_porc <- round(hi * 100, 2)
# Calcular la frecuencia acumulada ascendente (Ni_asc)
Ni_asc <- cumsum(df_Mes1$ni)
Ni_dsc <- rev(cumsum(rev(df_Mes1$ni)))
# Calcular la frecuencia acumulada relativa ascendente (Hi_asc)
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Crear la tabla final con las variables modificadas
tabla_Mes_final <- data.frame(
Mes = df_Mes1$Mes,
ni = df_Mes1$ni,
hi_porc = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
# Mostrar la tabla final
print(tabla_Mes_final)
## Mes ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 1 956 36.76 956 2601 36.76 100.00
## 2 2 834 32.06 1790 1645 68.82 63.24
## 3 3 811 31.18 2601 811 100.00 31.18
# Gráfico de barras solo para los meses de Enero hasta Marzo
barplot(tabla_Mes_final$ni,
names.arg = tabla_Mes_final$Mes,
main = "Gráfico No.2: Distribución de derrames entre los meses de Enero a Marzo",
cex.main = 0.8,
xlab = "Mes",
ylab = "Frecuencia",
col = "aquamarine",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_Mes_final$ni) + 5))
conteo_geom <- as.numeric(as.character(tabla_Mes_final$Mes))
# Frecuencia observada (ni) de la tabla
frecuencia_obs <- tabla_Mes_final$ni
# Estimar parámetro p (modelo geométrico)
media_x <- mean(rep(conteo_geom, frecuencia_obs))
p_hat <- 1 / media_x # Estimación de p
cat("Parámetro estimado p =", round(p_hat, 4), "\n")
## Parámetro estimado p = 0.5143
probs_geom <- dgeom(conteo_geom - 1, prob = p_hat)
frecuencia_esp <- round(sum(frecuencia_obs) * probs_geom)
# Crear la tabla final con los valores observados y esperados
tabla_geom <- data.frame(
Mes = tabla_Mes_final$Mes,
ni_obs = frecuencia_obs,
ni_esp = frecuencia_esp,
P_x = round(probs_geom, 4)
)
# Mostrar la tabla de frecuencias observadas y esperadas
print(tabla_geom)
## Mes ni_obs ni_esp P_x
## 1 1 956 1338 0.5143
## 2 2 834 650 0.2498
## 3 3 811 316 0.1213
# Gráfico comparativo observados vs esperados
barplot(rbind(frecuencia_obs, frecuencia_esp),
beside = TRUE,
names.arg = tabla_Mes_final$Mes,
col = c("aquamarine2", "aquamarine4"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.3: Comparación Observado vs Esperado entre Enero y Marzo",
cex.main=0.8,
xlab = "Mes",
ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
# Test de bondad de ajuste (Chi-cuadrado)
Fo1 <- frecuencia_obs
Fe1 <- frecuencia_esp
if (any(Fe1 == 0)) {
cat("Advertencia: Hay frecuencias esperadas iguales a 0. El test de chi-cuadrado puede no ser válido.\n")
}
#Pearson
# Calcular el estadístico Chi-cuadrado (Pearson)
x2 <- sum((Fo1 - Fe1)^2 / Fe1)
cat("Estadístico Chi-cuadrado (Pearson):", round(x2, 4), "\n")
## Estadístico Chi-cuadrado (Pearson): 936.543
# Correlación entre observadas y esperadas
correlacion <- cor(Fo1, Fe1)
cat("Correlación entre observadas y esperadas:", round(correlacion, 4), "\n")
## Correlación entre observadas y esperadas: 0.9842
# Gráfico de correlación
plot(Fo1, Fe1,
main = "Gráfico No.4: Correlación Observadas vs Esperadas entre Enero y Marzo",
cex.main=0.8,
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "aquamarine")
abline(lm(Fe1 ~ Fo1), col = "aquamarine4", lwd = 2)
# Mostrar r en el gráfico
text(x = max(Fo1)*0.7,
y = max(Fe1)*0.9,
labels = paste("r =", round(correlacion, 4)),
col = "darkred", cex = 1.2)
# Valor crítico para contraste
k <- length(Fo1)
vc <- qchisq(0.95, df = k - 1)
cat("Valor crítico Chi-cuadrado (95%):", round(vc, 4), "\n")
## Valor crítico Chi-cuadrado (95%): 5.9915
cat("¿x² < valor crítico?", x2 < vc, "\n")
## ¿x² < valor crítico? FALSE
# Evaluación del modelo
if (x2 < vc) {
cat("No se rechaza la hipótesis nula (buen ajuste del modelo geométrico).\n")
} else {
cat("Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).\n")
}
## Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).
#De Abril a Junio
Mes2 <- as.numeric(datos$Mes_edit_Fecha_del_derrame)
Mes2 <- Mes2[!is.na(Mes2) & Mes2 >= 4 & Mes2 <= 6]
# Crear la tabla de frecuencias para Mes2 entre Abril y Junio
tabla_Mes2 <- table(Mes2)
df_Mes2 <- as.data.frame(tabla_Mes2)
colnames(df_Mes2) <- c("Mes_edit_Fecha_del_derrame", "ni")
# Calcular la frecuencia relativa (hi)
hi <- df_Mes2$ni / sum(df_Mes2$ni)
hi_porc <- round(hi * 100, 2)
# Calcular la frecuencia acumulada ascendente (Ni_asc)
Ni_asc <- cumsum(df_Mes2$ni)
# Calcular la frecuencia acumulada descendente (Ni_dsc)
Ni_dsc <- rev(cumsum(rev(df_Mes2$ni)))
# Calcular la frecuencia acumulada relativa ascendente (Hi_asc)
Hi_asc <- cumsum(hi_porc)
# Calcular la frecuencia acumulada relativa descendente (Hi_dsc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Crear la tabla final con las variables modificadas
tabla_Mes2_final <- data.frame(
Mes_edit_Fecha_del_derrame = df_Mes2$Mes_edit_Fecha_del_derrame,
ni = df_Mes2$ni,
hi_porc = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
# Mostrar la tabla final
print(tabla_Mes2_final)
## Mes_edit_Fecha_del_derrame ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 4 772 28.92 772 2669 28.92 99.99
## 2 5 966 36.19 1738 1897 65.11 71.07
## 3 6 931 34.88 2669 931 99.99 34.88
# Gráfico de barras solo para los meses Abril a Junio
barplot(tabla_Mes2_final$ni,
names.arg = tabla_Mes2_final$Mes_edit_Fecha_del_derrame,
main = "Gráfico No.2: Distribución de derrames entre Abril a Junio ",
cex.main = 0.8,
xlab = "Mes",
ylab = "Frecuencia",
col = "cyan",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_Mes2_final$ni) + 5))
conteo_geom <- as.numeric(as.character(tabla_Mes2_final$Mes_edit_Fecha_del_derrame)) - 3
# Frecuencia observada (ni) de la tabla
frecuencia_obs <- tabla_Mes2_final$ni
# Estimar parámetro p (modelo geométrico)
media_x <- mean(rep(conteo_geom, frecuencia_obs))
p_hat <- 1 / media_x
cat("Parámetro estimado p =", round(p_hat, 4), "\n")
## Parámetro estimado p = 0.4855
probs_geom <- dgeom(conteo_geom - 1, prob = p_hat) # Probabilidades teóricas
frecuencia_esp <- round(sum(frecuencia_obs) * probs_geom)
# Crear la tabla final con los valores observados y esperados
tabla_geom <- data.frame(
Mes = tabla_Mes2_final$Mes_edit_Fecha_del_derrame,
ni_obs = frecuencia_obs,
ni_esp = frecuencia_esp,
P_x = round(probs_geom, 4)
)
# Mostrar la tabla de frecuencias observadas y esperadas
print(tabla_geom)
## Mes ni_obs ni_esp P_x
## 1 4 772 1296 0.4855
## 2 5 966 667 0.2498
## 3 6 931 343 0.1285
# Gráfico comparativo observados vs esperados
barplot(rbind(frecuencia_obs, frecuencia_esp),
beside = TRUE, # Para que las barras estén separadas
names.arg = tabla_Mes2_final$Mes_edit_Fecha_del_derrame,
col = c("cyan2", "cyan3"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.3: Comparación Observado vs Esperado entre Abril y Junio",
cex.main = 0.8,
xlab = "Mes",
ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
# Test de bondad de ajuste (Chi-cuadrado)
Fo1 <- frecuencia_obs
Fe1 <- frecuencia_esp
if (any(Fe1 == 0)) {
cat("Advertencia: Hay frecuencias esperadas iguales a 0. El test de chi-cuadrado puede no ser válido.\n")
}
# Calcular el estadístico Chi-cuadrado (Pearson)
x2 <- sum((Fo1 - Fe1)^2 / Fe1)
cat("Estadístico Chi-cuadrado (Pearson):", round(x2, 4), "\n")
## Estadístico Chi-cuadrado (Pearson): 1353.899
# Correlación entre observadas y esperadas
correlacion <- cor(Fo1, Fe1)
cat("Correlación entre observadas y esperadas:", round(correlacion, 4), "\n")
## Correlación entre observadas y esperadas: -0.8723
# Gráfico de correlación
plot(Fo1, Fe1,
main = "Gráfico No.4: Correlación Observadas vs Esperadas entre Abril y Junio",
cex.main=0.8,
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "cyan")
abline(lm(Fe1 ~ Fo1), col = "cyan4", lwd = 2)
# Valor crítico para contraste
k <- length(Fo1)
vc <- qchisq(0.95, df = k - 1)
cat("Valor crítico Chi-cuadrado (95%):", round(vc, 4), "\n")
## Valor crítico Chi-cuadrado (95%): 5.9915
cat("¿x² < valor crítico?", x2 < vc, "\n")
## ¿x² < valor crítico? FALSE
# Evaluación del modelo
if (x2 < vc) {
cat("No se rechaza la hipótesis nula (buen ajuste del modelo geométrico).\n")
} else {
cat("Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).\n")
}
## Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).
#De Julio a Septiembre
Mes3 <- as.numeric(datos$Mes_edit_Fecha_del_derrame)
Mes3 <- Mes3[!is.na(Mes3) & Mes3 >= 7 & Mes3 <= 9]
# Crear la tabla de frecuencias para Mes3 entre Julio a Septiembre
tabla_Mes3 <- table(Mes3)
df_Mes3 <- as.data.frame(tabla_Mes3)
colnames(df_Mes3) <- c("Mes_edit_Fecha_del_derrame", "ni")
# Calcular la frecuencia relativa (hi)
hi <- df_Mes3$ni / sum(df_Mes3$ni)
hi_porc <- round(hi * 100, 2)
# Calcular la frecuencia acumulada ascendente (Ni_asc)
Ni_asc <- cumsum(df_Mes3$ni)
# Calcular la frecuencia acumulada descendente (Ni_dsc)
Ni_dsc <- rev(cumsum(rev(df_Mes3$ni)))
# Calcular la frecuencia acumulada relativa ascendente (Hi_asc)
Hi_asc <- cumsum(hi_porc)
# Calcular la frecuencia acumulada relativa descendente (Hi_dsc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Crear la tabla final con las variables modificadas
tabla_Mes3_final <- data.frame(
Mes_edit_Fecha_del_derrame = df_Mes3$Mes_edit_Fecha_del_derrame,
ni = df_Mes3$ni,
hi_porc = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
# Mostrar la tabla final
print(tabla_Mes3_final)
## Mes_edit_Fecha_del_derrame ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 7 886 34.39 886 2576 34.39 100.00
## 2 8 936 36.34 1822 1690 70.73 65.61
## 3 9 754 29.27 2576 754 100.00 29.27
# Gráfico de barras solo para los meses de Julio a Septiembre
barplot(tabla_Mes3_final$ni,
names.arg = tabla_Mes3_final$Mes_edit_Fecha_del_derrame,
main = "Gráfico No.2: Distribución por derrames entre los meses de Julio a Septiembre ",
cex.main = 0.8,
xlab = "Mes", ylab = "Frecuencia",
col = "aquamarine",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_Mes3_final$ni) + 5))
conteo_geom <- as.numeric(as.character(tabla_Mes3_final$Mes_edit_Fecha_del_derrame)) - 6
# Frecuencia observada (ni) de la tabla
frecuencia_obs <- tabla_Mes3_final$ni
# Estimar parámetro p (modelo geométrico)
media_x <- mean(rep(conteo_geom, frecuencia_obs))
p_hat <- 1 / media_x # Estimación de p
cat("Parámetro estimado p =", round(p_hat, 4), "\n")
## Parámetro estimado p = 0.5131
probs_geom <- dgeom(conteo_geom - 1, prob = p_hat) # Probabilidades teóricas
frecuencia_esp <- round(sum(frecuencia_obs) * probs_geom)
# Crear la tabla final con los valores observados y esperados
tabla_geom <- data.frame(
Mes = tabla_Mes3_final$Mes_edit_Fecha_del_derrame, # Usamos la variable de los meses de derrame
ni_obs = frecuencia_obs,
ni_esp = frecuencia_esp,
P_x = round(probs_geom, 4)
)
# Mostrar la tabla de frecuencias observadas y esperadas
print(tabla_geom)
## Mes ni_obs ni_esp P_x
## 1 7 886 1322 0.5131
## 2 8 936 644 0.2498
## 3 9 754 313 0.1216
# Gráfico comparativo observados vs esperados
barplot(rbind(frecuencia_obs, frecuencia_esp),
beside = TRUE,
names.arg = tabla_Mes3_final$Mes_edit_Fecha_del_derrame,
col = c("aquamarine2", "aquamarine4"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.3: Comparación Observado vs Esperado entre el mes de Julio y Septiembre",
cex.main=0.8,
xlab = "Mes",
ylab = "Frecuencia",
las = 2, #
cex.names = 0.8)
# Test de bondad de ajuste (Chi-cuadrado)
Fo1 <- frecuencia_obs
Fe1 <- frecuencia_esp
if (any(Fe1 == 0)) {
cat("Advertencia: Hay frecuencias esperadas iguales a 0. El test de chi-cuadrado puede no ser válido.\n")
}
# Calcular el estadístico Chi-cuadrado (Pearson)
x2 <- sum((Fo1 - Fe1)^2 / Fe1)
cat("Estadístico Chi-cuadrado (Pearson):", round(x2, 4), "\n")
## Estadístico Chi-cuadrado (Pearson): 897.5368
# Correlación entre observadas y esperadas
correlacion <- cor(Fo1, Fe1)
cat("Correlación entre observadas y esperadas:", round(correlacion, 4), "\n")
## Correlación entre observadas y esperadas: 0.5498
# Gráfico de correlación
plot(Fo1, Fe1,
main = "Gráfico No.4: Correlación Observadas vs Esperadas",
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "aquamarine3")
abline(lm(Fe1 ~ Fo1), col = "red", lwd = 2)
# Valor crítico para contraste
k <- length(Fo1)
vc <- qchisq(0.95, df = k - 1)
cat("Valor crítico Chi-cuadrado (95%):", round(vc, 4), "\n")
## Valor crítico Chi-cuadrado (95%): 5.9915
cat("¿x² < valor crítico?", x2 < vc, "\n")
## ¿x² < valor crítico? FALSE
# Evaluación del modelo
if (x2 < vc) {
cat("No se rechaza la hipótesis nula (buen ajuste del modelo geométrico).\n")
} else {
cat("Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).\n")
}
## Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).
#De Octubre a Diciembre
Mes4 <- as.numeric(datos$Mes_edit_Fecha_del_derrame)
Mes4 <- Mes4[!is.na(Mes4) & Mes4 >= 10 & Mes4 <= 12]
# Crear la tabla de frecuencias para Mes4 entre Octubre a Diciembre
tabla_Mes4 <- table(Mes4)
df_Mes4 <- as.data.frame(tabla_Mes4)
colnames(df_Mes4) <- c("Mes_edit_Fecha_del_derrame", "ni")
# Calcular la frecuencia relativa (hi)
hi <- df_Mes4$ni / sum(df_Mes4$ni)
# Convertir la frecuencia relativa a porcentaje (hi_porc)
hi_porc <- round(hi * 100, 2)
# Calcular la frecuencia acumulada ascendente (Ni_asc)
Ni_asc <- cumsum(df_Mes4$ni)
# Calcular la frecuencia acumulada descendente (Ni_dsc)
Ni_dsc <- rev(cumsum(rev(df_Mes4$ni)))
# Calcular la frecuencia acumulada relativa ascendente (Hi_asc)
Hi_asc <- cumsum(hi_porc)
# Calcular la frecuencia acumulada relativa descendente (Hi_dsc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Crear la tabla final con las variables modificadas
tabla_Mes4_final <- data.frame(
Mes_edit_Fecha_del_derrame = df_Mes4$Mes_edit_Fecha_del_derrame,
ni = df_Mes4$ni,
hi_porc = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
# Mostrar la tabla final
print(tabla_Mes4_final)
## Mes_edit_Fecha_del_derrame ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 10 760 32.42 760 2344 32.42 100.00
## 2 11 825 35.20 1585 1584 67.62 67.58
## 3 12 759 32.38 2344 759 100.00 32.38
# Gráfico de barras solo para los meses de 10 a 12
barplot(tabla_Mes4_final$ni,
names.arg = tabla_Mes4_final$Mes_edit_Fecha_del_derrame,
main = "Gráfico No.2: Distribución de derrames de petroleo entre Octubre y Diciembre",
cex.main=0.8,
xlab = "Mes",
ylab = "Frecuencia",
col = "blue2",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_Mes4_final$ni) + 5))
# Transformar los meses en conteo (10 = 1, ..., 12 = 3)
conteo_geom <- as.numeric(as.character(tabla_Mes4_final$Mes_edit_Fecha_del_derrame)) - 9
# Frecuencia observada (ni) de la tabla
frecuencia_obs <- tabla_Mes4_final$ni
# Estimar parámetro p (modelo geométrico)
media_x <- mean(rep(conteo_geom, frecuencia_obs))
p_hat <- 1 / media_x # Estimación de p
cat("Parámetro estimado p =", round(p_hat, 4), "\n")
## Parámetro estimado p = 0.5001
probs_geom <- dgeom(conteo_geom - 1, prob = p_hat) # Probabilidades teóricas
frecuencia_esp <- round(sum(frecuencia_obs) * probs_geom)
# Crear la tabla final con los valores observados y esperados
tabla_geom <- data.frame(
Mes = tabla_Mes4_final$Mes_edit_Fecha_del_derrame,
ni_obs = frecuencia_obs,
ni_esp = frecuencia_esp,
P_x = round(probs_geom, 4)
)
# Mostrar la tabla de frecuencias observadas y esperadas
print(tabla_geom)
## Mes ni_obs ni_esp P_x
## 1 10 760 1172 0.5001
## 2 11 825 586 0.2500
## 3 12 759 293 0.1250
# Gráfico comparativo observados vs esperados
barplot(rbind(frecuencia_obs, frecuencia_esp),
beside = TRUE,
names.arg = tabla_Mes4_final$Mes_edit_Fecha_del_derrame,
col = c("blue4", "blue"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.3: Comparación Observado vs Esperado (10-12)",
xlab = "Mes",
ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
# Test de bondad de ajuste (Chi-cuadrado)
Fo1 <- frecuencia_obs
Fe1 <- frecuencia_esp
if (any(Fe1 == 0)) {
cat("Advertencia: Hay frecuencias esperadas iguales a 0. El test de chi-cuadrado puede no ser válido.\n")
}
# Calcular el estadístico Chi-cuadrado (Pearson)
x2 <- sum((Fo1 - Fe1)^2 / Fe1)
cat("Estadístico Chi-cuadrado (Pearson):", round(x2, 4), "\n")
## Estadístico Chi-cuadrado (Pearson): 983.4556
# Correlación entre observadas y esperadas
correlacion <- cor(Fo1, Fe1)
cat("Correlación entre observadas y esperadas:", round(correlacion, 4), "\n")
## Correlación entre observadas y esperadas: -0.176
# Gráfico de correlación
plot(Fo1, Fe1,
main = "Gráfico No.4: Correlación Observadas vs Esperadas",
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "blue")
abline(lm(Fe1 ~ Fo1), col = "red", lwd = 2)
# Valor crítico para contraste
k <- length(Fo1)
vc <- qchisq(0.95, df = k - 1)
cat("Valor crítico Chi-cuadrado (95%):", round(vc, 4), "\n")
## Valor crítico Chi-cuadrado (95%): 5.9915
cat("¿x² < valor crítico?", x2 < vc, "\n")
## ¿x² < valor crítico? FALSE
# Evaluación del modelo
if (x2 < vc) {
cat("No se rechaza la hipótesis nula (buen ajuste del modelo geométrico).\n")
} else {
cat("Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).\n")
}
## Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).