# TEMA: EI de variables nominales
# FECHA: 09/10/2025
# AUTOR: Grupo
# Carga de datos
setwd("/cloud/project/PROYECTO/DATOS")
datos<-read.csv("Derrames_globales.csv",
header= TRUE, sep= ";", dec=",")
# ESTADÍSTICA INFERENCIAL
años<-as.numeric(datos$A.o)
## Warning: NAs introduced by coercion
años<-na.omit(años)
min<- 1981
max<- 2004
breaks <- seq(min, max, by = 6)
if (max(breaks) < max) {
breaks <- c(breaks, max+ 1)
}
labels_intervalos <- paste(breaks[-length(breaks)],
breaks[-1] - 1,
sep = "-")
años_intervalos <- cut(años,
breaks = breaks,
labels = labels_intervalos,
include.lowest = TRUE,
right = TRUE)
TDF_años <- table(años_intervalos)
Tabla_años <- as.data.frame(TDF_años)
barplot(Tabla_años$Freq,
names.arg = Tabla_años$años_intervalos,
col = "salmon3",
main = "diagrama de barras: Gráfica de Distribución de derrames por intervalos de 6 años",
xlab = "Intervalos de años",
ylab = "Cantidad",
cex.names= 0.7)
# Modelo Uniforme
k <- nrow(Tabla_años)
Fo <- Tabla_años$Freq
p_uniforme <- rep(1/k, k)
Fe <- rep(sum(Fo)/k, k)
tabla_uniforme <- data.frame(
Año = Tabla_años$años,
Observado = Fo,
Esperado = Fe)
# Gráfico comparativo
barplot(rbind(Fo, Fe),
beside = TRUE,
names.arg = Tabla_años$años_intervalos,
col = c("salmon3", "yellow3"),
main = "Gráfico No.9: Modelo Uniforme (1981–2004)",
xlab = "Intervalo de Años", ylab = "Frecuencia",
cex.names = 0.8)
legend("topright",
legend = c("Real", "Modelo"),
fill = c("salmon3", "yellow3"),
bty = "n",
cex = 0.6,
inset = c(-0.1, 0))
# Correlación observadas vs esperadas
cor_uniforme <- cor(Fo, Fe)
## Warning in cor(Fo, Fe): the standard deviation is zero
# Test
#Cálculo del estadístico chi-cuadrado
x2<-sum((Fo-Fe)^2/Fe)
#Mostrar el valor de chi-cuadrado
cat("X2=",x2,"\n")
## X2= 4.548576
# VARIABLE AÑOS (2016-2020)
años<-as.numeric(datos$A.o)
## Warning: NAs introduced by coercion
años<-na.omit(años)
años<- años[!is.na(años) & años >= 2016 & años <= 2020]
TDF_años <- table(años)
Tabla_años <- as.data.frame(TDF_años)
# Gráfica de barras
barplot(Tabla_años$Freq,
names.arg = Tabla_años$años,
main = "Gráfico No.1: Distribución por Años (2016–2020)",
xlab = "Año", ylab = "Frecuencia",
col = "salmon",
las = 2,
cex.names = 0.8,
ylim = c(0, max(Tabla_años$Freq) + 100))
# Modelo Uniforme
k <- nrow(Tabla_años)
Fo <- Tabla_años$Freq
p_uniforme <- rep(1/k, k)
Fe <- rep(sum(Fo)/k, k)
tabla_uniforme <- data.frame(
Año = Tabla_años$años,
Observado = Fo,
Esperado = Fe)
# Gráfico comparativo
barplot(rbind(Fo, Fe),
beside = TRUE,
names.arg = Tabla_años$años,
col = c("salmon", "orange"),
main = "Gráfico No.2: Modelo Uniforme (2016–2020)",
xlab = "Año", ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
legend("topright",
legend = c("Real", "Modelo"),
fill = c("salmon", "orange"),
bty = "n",
cex = 0.6,
inset = c(-0.1, 0))
# Correlación observadas vs esperadas
cor_uniforme <- cor(Fo, Fe)
## Warning in cor(Fo, Fe): the standard deviation is zero
# Test
#Cálculo del estadístico chi-cuadrado
x2<-sum((Fo-Fe)^2/Fe)
#Mostrar el valor de chi-cuadrado
cat("X2=",x2,"\n")
## X2= 0.6536965
# VARIABLE MES
mes <- as.numeric(datos$Mes)
mes <- na.omit(mes)
TDF_mes <- table(mes)
Tabla_mes <- as.data.frame(TDF_mes)
nombres_meses <- c("Enero","Febrero","Marzo","Abril","Mayo","Junio",
"Julio","Agosto","Septiembre","Octubre","Noviembre","Diciembre")
barplot(Tabla_mes$Freq,
main = "Diagrama de barras: Gráfica de Distribución de meses",
xlab = "Meses del año",
ylab = "Cantidad",
col = "darkred",
names.arg = nombres_meses,
ylim = c(0, max(Tabla_mes$Freq) * 1.1),
las = 2,
cex.names = 0.7)
# Modelo Uniforme
k <- nrow(Tabla_mes)
Fo <- Tabla_mes$Freq
p_uniforme <- rep(1/k, k)
Fe <- rep(sum(Fo)/k, k)
tabla_uniforme <- data.frame(
Mes = Tabla_mes$mes,
Observado = Fo,
Esperado = Fe)
# Gráfico comparativo
barplot(rbind(Fo, Fe),
beside = TRUE,
names.arg = nombres_meses,
col = c("darkred", "salmon"),
main = "Gráfico No.2: Modelo Uniforme",
xlab = "Mes", ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
legend("topright",
legend = c("Real", "Modelo"),
fill = c("darkred", "salmon"),
bty = "n",
cex = 0.6,
inset = c(-0.1, 0))
# Correlación observadas vs esperadas
cor_uniforme <- cor(Fo, Fe)
## Warning in cor(Fo, Fe): the standard deviation is zero
# Test
#Cálculo del estadístico chi-cuadrado
x2<-sum((Fo-Fe)^2/Fe)
#Mostrar el valor de chi-cuadrado
cat("X2=",x2,"\n")
## X2= 20.50366
# VARIABLE BARRERAS DE CONTENCIÓN (0-30)
barreras<-as.numeric(datos$Barreras_de_contencion_flotantes)
barreras<-na.omit(barreras)
barreras<-barreras[!is.na(barreras) & barreras>=0 & barreras<=30]
breaks_1 <- seq(0, 30, by = 2)
cut_1 <- cut(barreras[barreras >= 0 & barreras <= 30], breaks = breaks_1, right = TRUE, include.lowest = TRUE)
TDF_1 <- table(cut_1)
Tabla_1 <- as.data.frame(TDF_1)
barplot(Tabla_1$Freq,
names.arg = Tabla_1$cut_1,
col = "darkblue",
main = "Gráfica de Barras (0 a 30)",
xlab = "Intervalos",
ylab = "Cantidad",
las = 2,
cex.names = 0.7)
# Modelo Geometrico
breaks_1_medias <- breaks_1[-length(breaks_1)] + diff(breaks_1)/2
# Usar el punto medio como el valor numérico para cada intervalo
conteo_geom <- breaks_1_medias
frecuencia_obs <- Tabla_1$Freq
# Estimar parámetro p
media_x <- mean(rep(conteo_geom, frecuencia_obs))
p_hat <- 1 / media_x
# Probabilidades teóricas y frecuencias esperadas
probs_geom <- dgeom(conteo_geom - 1, prob = p_hat)
frecuencia_esp <- round(sum(frecuencia_obs) * probs_geom)
tabla_geom <- data.frame(
Barreras = Tabla_1$cut_1,
X = conteo_geom,
`ni (obs)`= frecuencia_obs,
`ni (esp)`= frecuencia_esp,
`P(x)`= round(probs_geom, 4))
tabla_geom
## Barreras X ni..obs. ni..esp. P.x.
## 1 [0,2] 1 1949 890 0.2591
## 2 (2,4] 3 507 489 0.1422
## 3 (4,6] 5 262 268 0.0781
## 4 (6,8] 7 267 147 0.0429
## 5 (8,10] 9 127 81 0.0235
## 6 (10,12] 11 86 44 0.0129
## 7 (12,14] 13 53 24 0.0071
## 8 (14,16] 15 32 13 0.0039
## 9 (16,18] 17 32 7 0.0021
## 10 (18,20] 19 26 4 0.0012
## 11 (20,22] 21 28 2 0.0006
## 12 (22,24] 23 14 1 0.0004
## 13 (24,26] 25 19 1 0.0002
## 14 (26,28] 27 14 0 0.0001
## 15 (28,30] 29 19 0 0.0001
# Gráfico comparativo observados vs esperados
barplot(rbind(frecuencia_obs, frecuencia_esp),
beside = TRUE,
names.arg = Tabla_1$cut_1,
col = c("darkblue", "orange"),
main = "Gráfico No.2: Modelo Geométrico (0-30)",
xlab = "Barreras de contención", ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
legend("topright",
legend = c("Real", "Modelo"),
fill = c("darkblue", "orange"),
bty = "n",
cex = 0.6,
inset = c(-0.1, 0))
# Correlación observadas vs esperadas
cor_geome <- cor(frecuencia_obs, frecuencia_esp)
# Test
#Cálculo del estadístico chi-cuadrado
frecuencia_esp<- ifelse(frecuencia_esp == 0, 0.0001, frecuencia_esp)
x2<-sum(((frecuencia_obs-frecuencia_esp)^2)/frecuencia_esp)
#Mostrar el valor de chi-cuadrado
cat("X2=",x2,"\n")
## X2= 5572463
k <- length(frecuencia_obs)
Vc<-qchisq(0.95,k-1)
#Mostrar el valor crítico
cat("Valor crítico =", Vc, "\n")
## Valor crítico = 23.68479
# VARIABLE BARRERAS DE CONTENCIÓN (31-380)
barreras<-as.numeric(datos$Barreras_de_contencion_flotantes)
barreras<-na.omit(barreras)
barreras<-barreras[!is.na(barreras) & barreras>=31 & barreras<=380]
breaks_2 <- seq(31, 380, by = 35)
cut_2 <- cut(barreras[barreras >= 31 & barreras <= 380], breaks = breaks_2, right = TRUE, include.lowest = TRUE)
TDF_barreras<-table(cut_2)
Tabla_barreras<-as.data.frame(TDF_barreras)
barplot(Tabla_barreras$Freq,
names.arg = Tabla_barreras$cut_2,
col = "blue",
main = "Gráfica de Barras (31 a 380)",
xlab = "Intervalos",
ylab = "Cantidad",
cex.names = 0.7)
# Modelo exponencial
breaks_2_medias <- breaks_2[-length(breaks_2)] + diff(breaks_2)/2
x_entero <- round(breaks_2_medias)
lambda_exp <- 1 / mean(barreras)
n_total <- length(barreras)
breaks_2_limites <- breaks_2[1:length(breaks_2)]
prob_acumulada_exp <- pexp(breaks_2_limites, rate = lambda_exp)
prob_intervalo_exp <- diff(prob_acumulada_exp)
frecuencias_esperadas_exp <- n_total * prob_intervalo_exp
Tabla_barreras$esperados_exp <- frecuencias_esperadas_exp
cat("Resultado del Modelo Exponencial (lambda =", round(lambda_exp, 4), "):\n")
## Resultado del Modelo Exponencial (lambda = 0.012 ):
print(Tabla_barreras)
## cut_2 Freq esperados_exp
## 1 [31,66] 68 27.230020
## 2 (66,101] 20 17.864401
## 3 (101,136] 10 11.720036
## 4 (136,171] 7 7.688992
## 5 (171,206] 2 5.044405
## 6 (206,241] 2 3.309409
## 7 (241,276] 1 2.171155
## 8 (276,311] 2 1.424398
## 9 (311,346] 1 0.934484
etiquetas_x <- as.character(Tabla_barreras$cut_2)
datos_plot <- t(Tabla_barreras[, c("Freq", "esperados_exp")])
max_freq_plot <- max(Tabla_barreras$Freq, Tabla_barreras$esperados_exp)
par(mfrow=c(1,1), mar=c(8, 4, 4, 2) + 0.1)
barplot(datos_plot,
beside = TRUE,
names.arg = etiquetas_x,
ylim = c(0, max_freq_plot * 1.2),
main = "Modelo Exponencial: Frecuencias Observadas vs. Esperadas",
xlab = "Intervalos de Barrera",
ylab = "Frecuencia (Cantidad)",
col = c("blue", "green3"),
legend.text = c("Observado", "Esperado Exponencial"),
args.legend = list(x = "topright", bty = "n"),
cex.names = 0.8)
correlacion <- cor(Tabla_barreras$Freq, Tabla_barreras$esperados_exp)
correlacion
## [1] 0.9245771
# Chi-Cuadrado
freq_observada_agrupada <- c(
Tabla_barreras$Freq[1],
Tabla_barreras$Freq[2],
Tabla_barreras$Freq[3],
sum(Tabla_barreras$Freq[4:6])
)
freq_esperada_agrupada <- c(
Tabla_barreras$esperados_exp[1],
Tabla_barreras$esperados_exp[2],
Tabla_barreras$esperados_exp[3],
sum(Tabla_barreras$esperados_exp[4:6])
)
chi_cuadrado <- sum((freq_observada_agrupada - freq_esperada_agrupada)^2 / freq_esperada_agrupada)
chi_cuadrado
## [1] 63.13546
# Valor crítico
valor_critico <- qchisq(0.95, df = 2)
valor_critico
## [1] 5.991465