0.-Carga de librerías

library(gt)
library(e1071)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

1.-Carga de datos

setwd("/cloud/project/")
datos<-read.csv("DerramesEEUU.csv", header = TRUE, sep=";" , dec=".",,na.strings ="-")

2.-Selección de la variable aleatoria

EvacuacionesPublicas <- datos$EvacuacionesPublicas
EvacuacionesPublicas <- na.omit(EvacuacionesPublicas)

3.-Tabla de distribución de frecuencia

Evacuaciones_1_90 <- subset(EvacuacionesPublicas, EvacuacionesPublicas >= 1 & EvacuacionesPublicas <= 100)
limites <- seq(1, 91, by = 10) 
clasificacion <- cut(Evacuaciones_1_90,
                     breaks = limites,
                     include.lowest = TRUE,
                     right = FALSE)
TablaEvacuacion <- as.data.frame(table(clasificacion))
colnames(TablaEvacuacion) <- c("Intervalo", "ni")

TablaEvacuacion$hi <- round((TablaEvacuacion$ni / sum(TablaEvacuacion$ni)) * 100, 2)

# Frecuencia acumulada absoluta
TablaEvacuacion$Niasc <- cumsum(TablaEvacuacion$ni)        
TablaEvacuacion$Nidsc <- rev(cumsum(rev(TablaEvacuacion$ni)))

# Frecuencia acumulada relativa 
TablaEvacuacion$Hiasc <- cumsum(TablaEvacuacion$hi)
TablaEvacuacion$Hiasc[length(TablaEvacuacion$Hiasc)] <- 100

TablaEvacuacion$Hidsc <- rev(cumsum(rev(TablaEvacuacion$hi)))
TablaEvacuacion$Hidsc[1] <- 100

TDFFinalEvacuaciones<- rbind(TablaEvacuacion, data.frame(
  Intervalo = "TOTAL",
  ni = sum(TablaEvacuacion$ni),
  hi = 100,
  Niasc = " ",
  Hiasc = " ",
  Nidsc = " ",
  Hidsc = " "
  ))

library(gt)
tablaEvacuaciones <- TDFFinalEvacuaciones %>%
  gt() %>%
  cols_label(
    Intervalo = md("**Intervalo**"),
    ni = md("**ni**"),
    hi = md("**hi (%)**"),
    Niasc = md("**Ni ↑**"),
    Hiasc = md("**Hi ↑ (%)**"),
    Nidsc = md("**Ni ↓**"),
    Hidsc = md("**Hi ↓ (%)**")
  ) %>%
  tab_header(
    title = md("**Tabla N°1**"),
    subtitle = md("**Distribución de las Evacuaciones públicas por accidentes ocurridos en EE.UU (2010-2017)**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 1")
  ) %>%
  tab_options(
    table.background.color = "white",
    row.striping.background_color = "white",
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black"
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = Intervalo == "TOTAL"
    )
  )

tablaEvacuaciones

Intervalo	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla N°1
Distribución de las Evacuaciones públicas por accidentes ocurridos en EE.UU (2010-2017)
[1,11)	23	46.94	23	49	46.94	100
[11,21)	10	20.41	33	26	67.35	53.05
[21,31)	6	12.24	39	16	79.59	32.64
[31,41)	4	8.16	43	10	87.75	20.4
[41,51)	1	2.04	44	6	89.79	12.24
[51,61)	1	2.04	45	5	91.83	10.2
[61,71)	2	4.08	47	4	95.91	8.16
[71,81)	1	2.04	48	2	97.95	4.08
[81,91]	1	2.04	49	1	100	2.04
TOTAL	49	100.00
Autor: Grupo 1

4.-Gráfica de distribución de frecuencia

par(mar = c(7, 6, 4, 2))  
barplot(
  TablaEvacuacion$ni,
   main = "Gráfica N°2: Distribución de evacuaciones públicas\npor accidentes en oleoductos de EE.UU.",
  ylab = "Cantidad",
  names.arg = TablaEvacuacion$Intervalo,   
  col = "darkseagreen2",
  las = 1,                
  cex.main = 1.1,
  cex.lab  = 1.1,
  cex.axis = 0.9,
  cex.names = 0.8,
)

mtext("Evacuaciones públicas", side = 1, line = 4, cex = 1)

5.-Conjetura

Se conjetura que la variable EvacuacionesPublicas, podría seguir una distribución geometrica, bajo el supuesto de que la probabilidad de ocurrencia es máxima para valores bajos de la variable y disminuye progresivamente a medida que el número de evacuaciones aumenta..

6.-Parámetros

media_obs <- mean(Evacuaciones_1_90)
p <- 1 / (media_obs + 1)

Parámetro estimado (p): 0.05

7.-Sobreposición de la realidad con el modelo

# Frecuencias Observadas
Fo <- TablaEvacuacion$ni

# Probabilidades geométricas y frecuencias esperadas
k <- length(Inicio)
P_geom <- numeric(k)
Fe <- numeric(k)

for(i in 1:k){
  P_geom[i] <- pgeom(Fin[i]-1, prob = p) - pgeom(Inicio[i]-1, prob = p)
  Fe[i] <- P_geom[i] * sum(TablaEvacuacion$ni)
}
barplot(rbind(Fo, Fe),
        main = "Gráfica N°3: Comparación Modelo Geométrico con la Realidad",
        beside = TRUE,
        col = c("darkseagreen2", "#FFC685"),
        names.arg = TablaEvacuacion$Intervalo,
        ylab = "Probabilidad",
        las = 1,
        cex.names = 0.8,
        cex.axis = 1,
        cex.main = 1.1)

mtext("Evacuaciones públicas", side = 1, line = 3.5, cex = 1)
legend(x = 27, y = 170,
       legend = c("Realidad", "Uniforme"),
       fill = c("darkseagreen2", "#FFC685"),
       bty = "o",
       y.intersp = 0.7,
       cex = 0.8)

8.-Test de bondad

8.1.-Test de Pearson

Correlacion_geo <- cor(Fo, Fe) * 100

La correlación de frecuencias es de = 97.94 %

# Gráfica de correlación
plot(Fo, Fe,
     main = "Gráfica N°4: Correlación de frecuencias en el modelo Geométrico",
     xlab = "Frecuencia Observada ", 
     ylab = "Frecuencia Esperada",
     col = "darkseagreen3", pch = 19)
abline(lm(Fe ~ Fo), col = "red", lwd = 2)

8.2.- Test de chi-cuadrado

# Chi-cuadrado calculado con frecuencias relativas
x2_g <- sum((Fo - Fe)^2 / Fe)

# Grados de libertad 
gl_g <- (k - 1) - 1 

# Nivel de significancia
nivel_significancia <- 0.05

# Umbral de aceptación 
umbral_aceptacion<- qchisq(1 - nivel_significancia, gl_g)

cat("El estadístico Chi-cuadrado calculado =", round(x2_g, 4), "\n\n")

## El estadístico Chi-cuadrado calculado = 5.6375

cat("Grados de libertad =", gl_g, "\n\n")

## Grados de libertad = 7

cat("El umbral de aceptación =", round(umbral_aceptacion, 4), "\n\n")

## El umbral de aceptación = 14.0671

if (x2_g < umbral_aceptacion) {
  cat(
    "ESTADO: APRUEBA. ",
    "No existe una diferencia significativa ",
    "entre los valores observados y los esperados."
  )
} else {
  cat(
    "ESTADO: NO APRUEBA. ",
    "Existe una diferencia significativa ",
    "entre los valores observados y los esperados."
  )
}

## ESTADO: APRUEBA.  No existe una diferencia significativa  entre los valores observados y los esperados.

9.-Cálculo de probabilidades

¿Qué probabilidad hay de que se registren entre 1 y 11 evacuaciones públicas en un accidente de oleoductos en EE.UU.?

# Rango de valores
rango_inicio <- 1
rango_fin <- 11

# Probabilidad total para el rango
prob_rango <- pgeom(rango_fin - 1, prob = p) - pgeom(rango_inicio - 1, prob = p)

Probabilidad de que se de, de 1 a 11 evacuaciones: 38.06 %

Gráfica de Probabilidad

TablaEvacuacion$P_geom <- P_geom
colores <- ifelse(Inicio >= rango_inicio & Fin <= rango_fin, "#D75C20", "#FFC685")

# Gráfico 
barplot(height = TablaEvacuacion$P_geom,
  names.arg = TablaEvacuacion$Intervalo,
  main = "Gráfica N°5: Probabilidad Geométrica - Evacuaciones públicas",
  ylab = "Probabilidad (%)",
  col = colores,
  las = 1,
  cex.names = 0.8,
  ylim = c(0, max(TablaEvacuacion$P_geom)+0.1)
)

mtext("Evacuaciones públicas", side = 1, line = 3.5, cex = 1)

# Leyenda 
legend("topright",
legend = c("Evacuaciones fuera del rango", "Rango de Evacuaciones"),
fill = c("#FFC685", "#D75C20"),
border = NA,
cex = 0.8)

10.-Intervalo de confianza

# ==============================================================================
# 10. INTERVALO DE CONFIANZA
# ==============================================================================

# 1. Media aritmética muestral 
x <- mean(Evacuaciones_1_90)

# 2. Desviación estándar muestral
sigma_g <- sd(Evacuaciones_1_90)

# 3. Error estándar de la media
n <- length(Evacuaciones_1_90)
e <- sigma_g/ sqrt(n)

# 4. Límites del intervalo de confianza del 95%
limite_inferior <- round(x - e, 2)
limite_superior <- round(x + e, 2)

# 5. Creación de la tabla con el formato requerido
tabla_media_exp <- data.frame(
  Intervalo = paste0(
    "P [",
    limite_inferior,
    " < µ < ",
    limite_superior,
    "] = 95%"
  )
)

# 6. Presentación de la tabla con la librería gt
library(gt)
tabla_media_exp %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°3**"),
    subtitle = md("**Intervalo de confianza del 95% para la variable **EvacuacionesPublicas** de los accidentes en oleoductos ocurridos en EE.UU. (2010-2017)**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 1")
  ) %>%
  cols_align(
    align = "center",    
    columns = everything()  
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    column_labels.font.weight = "bold",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    table_body.hlines.color = "grey",
    table_body.border.bottom.color = "black",
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1)
  )

Intervalo
Tabla N°3
Intervalo de confianza del 95% para la variable EvacuacionesPublicas de los accidentes en oleoductos ocurridos en EE.UU. (2010-2017)
P [16.05 < µ < 22.03] = 95%
Autor: Grupo 1

11.-Conclusión

El comportamiento de la variable EvacuacionesPublicas se explica con un modelo geométrico de parámetros (p = 0.05). Podemos afirmar con un 95% de confianza que la media aritmética real de EvacuacionesPublicas se encuentra entre [16.05 < µ < 22.03] y una desviación estándar de 20.91.

Modelo Geometrico - Evacuaciones públicas

Grupo 1