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

Latitud <- as.numeric(datos$LatitudAccidente)

3.-Tabla de distribución de frecuencia

# ==============================================================================
# TABLA DE DISTRIBUCIÓN DE FRECUENCIAS DESDE EL HISTOGRAMA 
# ==============================================================================

# 1. Generar el histograma de forma oculta (sin mostrar la gráfica)
png(filename = tempfile())
histoLatitud <- hist(Latitud, plot = FALSE)
dev.off()
## png 
##   2
# 2. Extracción de límites y cálculo de marcas de clase
Limites <- histoLatitud$breaks
LimInf <- Limites[1:(length(Limites) - 1)] 
LimSup <- Limites[2:length(Limites)]  
MC <- (LimInf + LimSup) / 2

# 3. Frecuencias simples
ni <- histoLatitud$counts
hi <- (ni / sum(ni)) * 100

# 4. Frecuencias acumuladas con ajuste exacto en los extremos a 100
Niasc <- cumsum(ni)                     
Nidsc <- rev(cumsum(rev(ni)))           
Hiasc <- round(cumsum(hi), 2)          
Hiasc[length(Hiasc)] <- 100

Hidsc <- round(rev(cumsum(rev(hi))), 2)
Hidsc[1] <- 100

# 5. Creación del data.frame final de frecuencias
TDFLatitudR <- data.frame(
  LimInf, LimSup, MC, ni, 
  hi = round(hi, 2),
  Niasc, Nidsc, Hiasc, Hidsc
)

total_ni <- sum(ni)
total_hi <- 100  

TDFLatitudRFinal <- rbind(
  TDFLatitudR,
  data.frame(
    LimInf = "Total",
    LimSup = " ", 
    MC = " ",
    ni = total_ni, 
    hi = total_hi, 
    Niasc = " ", 
    Nidsc = " ", 
    Hiasc = " ", 
    Hidsc = " "
  )
)

# 6. Presentación con la librería gt
library(gt)
tabla_LatitudR_gt <- TDFLatitudRFinal %>%
  gt() %>%
  cols_label(
    LimInf = md("**LimInf**"),
    LimSup = md("**LimSup**"),
    MC = md("**MC**"),
    ni = md("**ni**"),
    hi = md("**hi (%)**"),
    Niasc = md("**Ni ↑**"),
    Nidsc = md("**Ni ↓**"),
    Hiasc = md("**Hi ↑ (%)**"),
    Hidsc = md("**Hi ↓ (%)**")
  ) %>%
  tab_header(
    title = md("**Tabla N° 2**"),
    subtitle = md("**Distribución de la latitud de accidentes en oleoductos 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",
    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)
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = LimInf == "Total"
    )
  )

tabla_LatitudR_gt
Tabla N° 2
Distribución de la latitud de accidentes en oleoductos ocurridos en EE.UU (2010-2017)
LimInf LimSup MC ni hi (%) Ni ↑ Ni ↓ Hi ↑ (%) Hi ↓ (%)
20 25 22.5 3 0.11 3 2760 0.11 100
25 30 27.5 462 16.74 465 2757 16.85 99.89
30 35 32.5 908 32.90 1373 2295 49.75 83.15
35 40 37.5 670 24.28 2043 1387 74.02 50.25
40 45 42.5 552 20.00 2595 717 94.02 25.98
45 50 47.5 154 5.58 2749 165 99.6 5.98
50 55 52.5 0 0.00 2749 11 99.6 0.4
55 60 57.5 0 0.00 2749 11 99.6 0.4
60 65 62.5 2 0.07 2751 11 99.67 0.4
65 70 67.5 4 0.14 2755 9 99.82 0.33
70 75 72.5 5 0.18 2760 5 100 0.18
Total 2760 100.00
Autor: Grupo 1

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

par(mar = c(4, 6, 4, 2))
options(scipen = 999)
hist(LatitudVC,freq = TRUE,
     main = "Gráfica N°2: Distribución de latitud en los accidentes de oleoductos en EEUU",
     breaks = 7, 
     xlab = "Latitud (°)",
     ylab = "Cantidad",
     col = "darkseagreen3",
     las=1)

5.-Conjetura

Se considera que la variable LatitudVC, podría seguir una distribución lognormal.Bajo este modelo se asume que los valores de la variable se distribuyen de manera asimétrica, con una mayor concentración en valores relativamente bajos y una cola extendida hacia la derecha. Esto implica que la probabilidad de ocurrencia disminuye rápidamente hacia la izquierda, mientras que hacia la derecha decrece de forma más gradual, permitiendo la presencia de valores grandes aunque con menor frecuencia.

6.-Parámetros

log_lat <- log(LatitudVC)
ulog <- mean(log_lat)
sigmalog <- sd(log_lat)

Media (u) = 3.565183

Desviación estándar (sigma) = 0.1446842

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

par(mar = c(4, 6, 4, 2))
HistLati <- hist(LatitudVC,
                   freq = FALSE,
                   breaks = 7,  
                   main = "Gráfica N°3: Comparación de la Realidad y el Modelo Log-normal
          de la latitud de los accidentes en oleoductos ocurridos en EE.UU.",
                   xlab = "Latitud (°)",
                   las = 1,
                   ylab = "Densidad de probabilidad",
                   col = "darkseagreen3",
                   ylim = c(0, 0.08))
h <- length(HistLati$counts)

# Curva log-normal
x <- seq(min(LatitudVC), max(LatitudVC), 0.01)
curve(dlnorm(x, meanlog = ulog, sdlog = sigmalog),
      type = "l", add = TRUE, col = "red", lwd = 4)

# Leyenda
legend("topright", legend = "Modelo Log-Normal",
       col = "red", lwd = 2, lty = 1, 
       box.lty = 1,box.col = "black",
       cex = 0.8)

8.-Test de bondad

8.1-Test de Pearson

# Correlación de frecuencias
Fo<-HistLati$counts
P <- c(0)
 for (i in 1:h) 
 {P[i] <-(plnorm(HistLati$breaks[i+1],ulog,sigmalog)-
            plnorm(HistLati$breaks[i],ulog,sigmalog))}
Fe<-P*length(LatitudVC)
Correlacion_log <- cor(Fo, Fe) * 100

La correlación de frecuencias es de = 93.81 %

# Gráfica de correlación 

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

8.2-Test de Chi-cuadrado

n <- length(LatitudVC)
Fo_pct <- (Fo / n) * 100
Fe_pct <- P * 100

# Calcular estadístico Chi-cuadrado
x2_log <- sum((Fe_pct - Fo_pct)^2 / Fe_pct)

# Grados de libertad 
gl_log <- (h - 1) - 2 

# Nivel de significancia y valor crítico al 95% de confianza
nivel_significancia <- 0.05
umbral_aceptacion <- qchisq(1 - nivel_significancia, df = gl_log)

cat("El estadístico Chi-cuadrado calculado =", round(x2_log, 4), "\n\n")
## El estadístico Chi-cuadrado calculado = 7.4181
cat("Grados de libertad =", gl_log, "\n\n")
## Grados de libertad = 3
cat("El umbral de aceptación =", round(umbral_aceptacion, 4), "\n\n")
## El umbral de aceptación = 7.8147
if (x2_log < umbral_aceptacion) {
  cat(
    "ESTADO: APRUEBA. ",
    "Conclusión: No se rechaza H0, las latitudes de los accidentes podrían seguir una distribución lognormal."
  )
} else {
  cat(
    "ESTADO: NO APRUEBA. ",
    "Conclusión: Se rechaza H0, las latitudes de los accidentes NO siguen una distribución lognormal."
  )
}
## ESTADO: APRUEBA.  Conclusión: No se rechaza H0, las latitudes de los accidentes podrían seguir una distribución lognormal.

9.-Cálculo de probabilidades

  • ¿Cuál es la probabilidad de que la latitud de accidentes se encuentre entre los 30° y 45°?
prob_log <- plnorm(45, mean = ulog, sd = sigmalog) - plnorm(30, mean = ulog, sd = sigmalog)

La probabilidad de que las longitudes de los accidentes se encuentren entre 30° y 45°: 82.39 %

Gráfica de Probabilidad

y <- dlnorm(x, meanlog = ulog, sdlog = sigmalog)
plot(x, y, type = "l", col = "blue", lwd = 2,
     main = "Gráfica N°5:  Demostración de cálculo de probabilidades de la Latitud 
     de los accidentes en oleoductos ocurridos en EE.UU.",
     xlab = "Latitud del accidente",
     ylab = "Densidad de probabilidad")

x_sombreado <- seq(30, 45, length.out = 500)
y_sombreado <- dlnorm(x_sombreado, meanlog = ulog, sdlog = sigmalog)

polygon(c(x_sombreado, rev(x_sombreado)),
        c(y_sombreado, rep(0, length(y_sombreado))),
        col = rgb(1, 0, 0, 0.5), border = NA)

legend("topright",
       legend = c("Modelo Log-normal", "Área de Probabilidad"),
       col = c("blue", "#B03060"), 
       lwd = 2, pch = c(NA,15))

10.-Intervalo de confianza

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

# 2. Desviación estándar muestral
sigma_l <- sd(LatitudVC)

# 3. Error estándar de la media (con Z = 1.96 para el 95% de confianza)
n <- length(LatitudVC)
e <- 1.96 * (sigma_l / 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°2**"),
    subtitle = md("**Intervalo de confianza del 95% para la variable **Latitud** de los accidentes en oleoductos ocurridos en EE.UU.**")
  ) %>%
  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)
  )
Tabla N°2
Intervalo de confianza del 95% para la variable Latitud de los accidentes en oleoductos ocurridos en EE.UU.
Intervalo
P [35.52 < µ < 35.92] = 95%
Autor: Grupo 1

11.-Conclusión

El comportamiento de la variable Latitud se explica con un modelo lognormal de parámetros μ = 3.56 y σ = 0.14. Podemos afirmar con un 95% de confianza que la media aritmética real de Latitud se encuentra entre [35.52 < µ < 35.92] y una desviación estándar de 5.26.