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

MesCierre <- na.omit(as.numeric(datos$MesCierre))

3.-Tabla de distribución de frecuencia

TDFMesCierre <- table(MesCierre)
TablaMesCierre <- as.data.frame(TDFMesCierre)
names(TablaMesCierre) <- c("Mes","ni")

TablaMesCierre$hi_porc <- round((TablaMesCierre$ni / sum(TablaMesCierre$ni)) * 100, 2)

TablaMesCierre$Ni_asc <- cumsum(TablaMesCierre$ni)
TablaMesCierre$Ni_dsc <- rev(cumsum(rev(TablaMesCierre$ni)))

# Frecuencias acumuladas relativas con ajuste exacto a 100
TablaMesCierre$Hi_asc <- round(cumsum(TablaMesCierre$hi_porc), 2)
TablaMesCierre$Hi_asc[length(TablaMesCierre$Hi_asc)] <- 100

TablaMesCierre$Hi_dsc <- round(rev(cumsum(rev(TablaMesCierre$hi_porc))), 2)
TablaMesCierre$Hi_dsc[1] <- 100

TDFFinalMes <- rbind(TablaMesCierre, data.frame(
  Mes = "TOTAL",
  ni = sum(TablaMesCierre$ni),
  hi_porc = 100,
  Ni_asc = " ",
  Ni_dsc = " ",
  Hi_asc = " ",
  Hi_dsc = " "
  ))

library(gt)
tabla_MesC <- TDFFinalMes %>%
  gt() %>%
  cols_label(
    Mes = md("**Año**"),
    ni = md("**ni**"),
    hi_porc = md("**hi (%)**"),
    Ni_asc = md("**Ni ↑**"),
    Ni_dsc = md("**Ni ↓**"),
    Hi_asc = md("**Hi ↑ (%)**"),
    Hi_dsc = md("**Hi ↓ (%)**")
  ) %>%
  tab_header(
    title = md("**Tabla N°1**"),
    subtitle = md("**Distribución de accidentes en oleoductos por año 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.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 = "gray",
    table_body.border.bottom.color = "black"
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = as.character(Mes) == "TOTAL"
    )
  )
tabla_MesC

Año	ni	hi (%)	Ni ↑	Ni ↓	Hi ↑ (%)	Hi ↓ (%)
Tabla N°1
Distribución de accidentes en oleoductos por año en EE.UU. (2010-2017)
1	122	8.88	122	1374	8.88	100
2	114	8.30	236	1252	17.18	91.13
3	114	8.30	350	1138	25.48	82.83
4	129	9.39	479	1024	34.87	74.53
5	104	7.57	583	895	42.44	65.14
6	102	7.42	685	791	49.86	57.57
7	111	8.08	796	689	57.94	50.15
8	125	9.10	921	578	67.04	42.07
9	125	9.10	1046	453	76.14	32.97
10	87	6.33	1133	328	82.47	23.87
11	111	8.08	1244	241	90.55	17.54
12	130	9.46	1374	130	100	9.46
TOTAL	1374	100.00
Autor: Grupo 1

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

par(mar = c(6, 6, 4, 2)) 
barplot(
  TablaMesCierre$ni, 
  main = "Gráfica N°1: Distribución de accidentes
  por año en EE.UU.",
  xlab = "Año",
  ylab = "Cantidad",
  col = "slategray1",
  names.arg = TablaMesCierre$Mes,
  las = 1,
  cex.main = 1.2,    
  cex.lab = 1.2,   
  cex.axis = 0.8,
  cex.names = 0.8
)

5.-Conjetura

Se conjetura que la variable MesCierre, podría seguir una distribución uniforme discreta, bajo el supuesto de que cada mes tiene la misma probabilidad de registrar un cierre de operaciones. Esta suposición permite analizar si los eventos se encuentran equitativamente distribuidos a lo largo del año.

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

# Cálculo de Fo y Fe 
Fo <- TablaMesCierre$ni
# Número de categorías (años)
k <- length(Fo)
total_accidentes <- sum(Fo)

Fe <- rep(total_accidentes / k, k)

barplot(rbind(Fo, Fe),
        beside = TRUE,
        col = c("slategray2", "lightcoral"),
        names.arg = as.character(TablaMesCierre$Mes),
        xlab = "Mes del Cierre de Operaciones",
        ylab = "Frecuencia",
        las = 1,
        cex.names = 0.8,
        cex.axis = 1, 
        ylim= c(0, 180))

title(main = "Gráfica N°2: Comparación del  Modelo Uniforme con la Realidad",
      cex.main = 1.2)

legend(x = 27, y = 170,
       legend = c("Realidad", "Uniforme"),
       fill = c("slategray2", "lightcoral"),
       bty = "o",
       y.intersp = 0.7,
       cex = 0.8)

7.-Test de bondad

- Test chi-cuadrado

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

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

# Nivel de significancia
nivel_significancia <- 0.05

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

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

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

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

## Grados de libertad = 11

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

## El umbral de aceptación = 19.6751

if (x2_u < 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.

8.-Cálculo de probabilidades

¿Cuál es la probabilidad de que el cierre de operaciones ocurra entre los meses de junio y agosto (Mes 6 al 8)?

# Probabilidad de cada mes
p_mes <- 1 / k

# Rango de interés: junio (6) a agosto (8)
mes_inicio <- 6
mes_fin <- 8

# Probabilidad total para el rango
prob_uniforme <- (mes_fin - mes_inicio + 1) * p_mes

La probabilidad de que el cierre de operaciones ocurra entre los meses de junio y agosto es de: 25 %

Gráfica de Probabilidad

x <- 1:12

# Densidad de probabilidad uniforme
y <- rep(p_mes, k)

# Gráfica
barplot(y,
        names.arg = x,
        col = ifelse(x >= 6 & x <= 8, "lightcoral", "slategray2"),
        main = "Gráfica N°3: Probabilidad uniforme discreta - Mes de Cierre de Operaciones",
        xlab = "Mes del Cierre de Operaciones",
        ylab = "Densidad de probabilidad",
        ylim = c(0, 0.12),
        las = 1)
# Leyenda
legend("topright",
legend = c("Meses fuera del rango", "Meses 6 al 8"),
fill = c("skyblue", "lightcoral"),
border = NA,
cex = 0.8)

9.-Intervalo de confianza

# Media aritmética 
x <- mean(MesCierre)

# Desviación estándar 
sigma_u<- sd(MesCierre)

# Error estándar de la media
n <- length(MesCierre)
e <- sigma_u/ sqrt(n)

# Intervalo de Confianza del 95%
limite_inferior <- round(x - e, 2)
limite_superior <- round(x + e, 2)

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

# 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 **MesCierre** 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 MesCierre de los accidentes en oleoductos ocurridos en EE.UU. (2010-2017)
P [6.38 < µ < 6.57] = 95%
Autor: Grupo 1

10.-Conclusión

El comportamiento de la variable MesCierre se explica con un modelo uniforme. Podemos afirmar con un 95% de confianza que la media aritmética real de la variable MesCierre se encuentra entre [6.38 < µ < 6.57] y una desviación estándar de 3.5.

Modelo Uniforme Discreto- Mes de Cierre de operaciones

Grupo 1