ANÁLISIS ESTADÍSTICO
1. CARGA DE LIBRERÍAS Y DATOS
#==============================ENCABEZADO================================
# TEMA: MODELOS PROBABILISTICOS- SLOPE (PENDIENTE)
# AUTOR: GRUPO 3
# FECHA: 03-2026
#========================================================================
library(dplyr)
library(knitr)
library(gt)
setwd("C:/Users/HP/Documents/PROYECTO ESTADISTICA/RStudio")
datos <- read.csv("tablap.csv", header = TRUE, dec = ",", sep = ";")
2. TABLA DE DISTRIBUCIÓN DE CANTIDAD
# LIMPIEZA DE LA VARIABLE SLOPE
slope <- as.numeric(datos$Slope)
slope <- na.omit(slope)
slope_sin_outliers <- subset(slope, slope > 0)
cat("Cantidad total de datos analizados:", length(slope_sin_outliers), "\n")
## Cantidad total de datos analizados: 10051
histograma <- hist(slope_sin_outliers, plot = FALSE)
ni <- histograma$counts
hi <- ni / sum(ni) * 100
intervalos <- paste0("[", round(histograma$breaks[-length(histograma$breaks)], 2),
", ", round(histograma$breaks[-1], 2), ")")
tabla_frecuencias <- data.frame(Intervalo = intervalos, ni = ni, hi = round(hi, 2))
totales <- data.frame(Intervalo = "TOTAL", ni = sum(ni), hi = sum(round(hi, 2)))
tabla_frecuencias_final <- rbind(tabla_frecuencias, totales)
# Aplicación de gt
tabla_frecuencias_final %>%
gt() %>%
tab_header(title = md("**Tabla Nº1. Distribución de Frecuencias de la Pendiente**")) %>%
cols_label(ni = "Frecuencia (ni)", hi = "Relativa (hi %)") %>%
tab_style(
style = list(cell_fill(color = "lightgray", alpha = 0.2), cell_text(weight = "bold")),
locations = cells_body(rows = Intervalo == "TOTAL")
) %>%
cols_align(align = "center")
| Tabla Nº1. Distribución de Frecuencias de la Pendiente |
| Intervalo |
Frecuencia (ni) |
Relativa (hi %) |
| [0, 2) |
3330 |
33.13 |
| [2, 4) |
2602 |
25.89 |
| [4, 6) |
1497 |
14.89 |
| [6, 8) |
902 |
8.97 |
| [8, 10) |
602 |
5.99 |
| [10, 12) |
382 |
3.80 |
| [12, 14) |
242 |
2.41 |
| [14, 16) |
174 |
1.73 |
| [16, 18) |
118 |
1.17 |
| [18, 20) |
75 |
0.75 |
| [20, 22) |
47 |
0.47 |
| [22, 24) |
21 |
0.21 |
| [24, 26) |
22 |
0.22 |
| [26, 28) |
15 |
0.15 |
| [28, 30) |
11 |
0.11 |
| [30, 32) |
4 |
0.04 |
| [32, 34) |
4 |
0.04 |
| [34, 36) |
3 |
0.03 |
| TOTAL |
10051 |
100.00 |
3. GRÁFICA DE DISTRIBUCIÓN DE CANTIDAD
# 3. GRÁFICA DE DISTRIBUCIÓN DE CANTIDAD
hist(slope_sin_outliers,
freq = TRUE,
main = "Gráfica Nº1. Distribución de frecuencia de la Pendiente",
xlab = "Pendiente",
ylab = "Cantidad",
col = "skyblue",
border = "white")
4. CONJETURA DEL MODELO
cat("Debido a la similitud de las barras asociamos con el modelo de probabilidad exponencial")
## Debido a la similitud de las barras asociamos con el modelo de probabilidad exponencial
media <- mean(slope_sin_outliers)
media
## [1] 5.101681
lamdba <- 1 / media
lamdba
## [1] 0.1960138
h <- length(histograma$counts)
h
## [1] 18
hist(slope_sin_outliers,
freq = FALSE,
main = "Gráfica Nº2. Comparación de la realidad con el modelo Exponencial",
xlab = "Pendiente",
ylab = "Densidad",
col = "navajowhite",
border = "gray30")
curve(dexp(x, rate = lamdba), add = TRUE, col = "red", lwd = 3)
5. TESTS DE APROBACIÓN
# 5. TEST DE APROBACIÓN
Fo <- histograma$counts
P <- sapply(1:h, function(i) pexp(histograma$breaks[i+1], rate = lamdba) - pexp(histograma$breaks[i], rate = lamdba))
Fe <- P * length(slope_sin_outliers)
n <- length(slope_sin_outliers)
n
## [1] 10051
Fo_perc <- (Fo / n) * 100
Fo_perc
## [1] 33.13103174 25.88797135 14.89404039 8.97423142 5.98945379 3.80061685
## [7] 2.40772062 1.73117103 1.17401254 0.74619441 0.46761516 0.20893443
## [13] 0.21888369 0.14923888 0.10944185 0.03979704 0.03979704 0.02984778
Fe_perc <- (Fe / n) * 100
Fe_perc
## [1] 32.43145452 21.91346210 14.80660760 10.00460939 6.75996905 4.56761276
## [7] 3.08626951 2.08534741 1.40903892 0.95206710 0.64329789 0.43466703
## [13] 0.29369819 0.19844759 0.13408815 0.09060141 0.06121806 0.04136415
# Gráfica de Correlación
plot(Fo_perc, Fe_perc,
xlim = c(0, max(Fo_perc)),
ylim = c(0, max(Fe_perc)),
main = "Gráfica Nº3: Correlación de frecuencias (Modelo Slope)",
xlab = "Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
pch = 19, col = "black")
abline(a = 0, b = 1, col = "red", lwd = 3)
Correlación <- cor(Fo_perc, Fe_perc) * 100
x2 <- sum((Fe_perc - Fo_perc)^2 / Fe_perc)
umbral_aceptacion <- qchisq(0.95, h - 1)
# Tabla Resumen con gt
data.frame(
Prueba = c("Correlación Pearson (%)", "Chi-cuadrado"),
Valor = c(round(Correlación, 2), round(x2, 2)),
Umbral = c("> 80%", round(umbral_aceptacion, 2)),
Resultado = c(ifelse(Correlación > 80, "APROBADO", "RECHAZADO"),
ifelse(x2 < umbral_aceptacion, "APROBADO", "RECHAZADO"))
) %>% gt() %>%
tab_header(title = md("**Tabla Nº2. Resultados de los Tests de Aprobación**")) %>%
cols_align(align = "center")
| Tabla Nº2. Resultados de los Tests de Aprobación |
| Prueba |
Valor |
Umbral |
Resultado |
| Correlación Pearson (%) |
99.56 |
> 80% |
APROBADO |
| Chi-cuadrado |
1.59 |
27.59 |
APROBADO |
6. CÁLCULO DE PROBABILIDADES
plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 100))
# Dibujo de la tarjeta (Borde y Fondo)
rect(2, 20, 98, 80, border = "#2A9D8F", col = "#F0F9F8", lwd = 3)
text(52, 55, "¿Cuál es la probabilidad de que una
medición de la pendiente presente un valor
comprendido entre 20 y 30?", cex = 1.2, font = 2, col = "#1D3557")
probabilidad_slope <- pexp(30, lamdba) - pexp(20, lamdba)
cat("Probabilidad calculada en porcentaje:")
## Probabilidad calculada en porcentaje:
probabilidad_slope * 100
## [1] 1.704199
# Rango para la curva
x <- seq(min(slope_sin_outliers), max(slope_sin_outliers), 0.01)
# Curva exponencial
plot(x, dexp(x, lamdba),
col = "skyblue3", lwd = 2, type = "l",
main = "Gráfica 4. Cálculo de probabilidades de la Pendiente (Slope)",
ylab = "Densidad de probabilidad",
xlab = "Pendiente")
# Área de probabilidad
x_area <- seq(20, 30, 0.01)
y_area <- dexp(x_area, lamdba)
# Línea del área
lines(x_area, y_area, col = "red", lwd = 2)
# Área sombreada
polygon(c(x_area, rev(x_area)),
c(y_area, rep(0, length(y_area))),
col = rgb(1, 0, 0, 0.5),
border = NA)
# Leyenda
legend("topright",
legend = c("Modelo exponencial", "Área de Probabilidad"),
col = c("skyblue3", "red"),
lwd = 2,
cex = 0.7)
# Texto informativo en la gráfica
texto_prob <- paste0("Probabilidad = ", round(probabilidad_slope * 100, 2), " %")
# Ajuste de posicion X
text(x = max(x) * 0.7,
y = max(dexp(x, lamdba)) * 0.7,
labels = texto_prob,
col = "black",
cex = 0.9,
font = 2)
plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 100))
# Dibujo de la tarjeta (Borde y Fondo)
rect(2, 20, 98, 80, border = "#2A9D8F", col = "#F0F9F8", lwd = 3)
# Texto de la pregunta
text(52, 55, "¿De 300 nuevas mediciones cuántas tendrían
una pendiente entre 20 y 30?", cex = 1.2, font = 2, col = "#1D3557")
cat("Cantidad esperada en una muestra de 300:")
## Cantidad esperada en una muestra de 300:
probabilidad_slope * 300
## [1] 5.112597
7. INTERVALOS DE CONFIANZA
#El teorema de límite central nos indica que, aunque las variables individuales no sigan una distribución normal, la distribución de las medias aritméticas de n conjuntos muestrales, sean normal, y por lo tanto, podemos obtener la media poblacional mediante intervalos de confianza, con tres postulados principales: (x-e<u<x+e)=68% (x-2e<u<x+2e)=95% (x-3e<u<x+3e)=99%
#Donde, x es la media aritmética muestral y e es el margen de error (desviación estándar poblacional)
#Media aritmetica
x <- mean(slope_sin_outliers)
x
## [1] 5.101681
#Desviación estandar
sigma <- sd(slope_sin_outliers)
sigma
## [1] 4.527397
#Tamaño muestral
n <- length(slope_sin_outliers)
n
## [1] 10051
#P(x-2e<u<x+2e)=95%
e <- sigma / sqrt(n)
e
## [1] 0.04515896
li <- x - 2 * e
li
## [1] 5.011364
ls <- x + 2 * e
ls
## [1] 5.191999
# Creación de la tabla con gt
data.frame(
Limite_Inferior = round(li, 2),
Variable = "Pendiente (Slope)",
Limite_Superior = round(ls, 2),
Desviacion_Estandar = round(e, 4)
) %>%
gt() %>%
tab_header(
title = md("**Tabla Nº3. Media Poblacional mediante Intervalos de Confianza**"),
subtitle = md("Basado en el Teorema del Límite Central (95%)")
) %>%
cols_label(
Limite_Inferior = "Límite Inferior",
Variable = "Variable Analizada",
Limite_Superior = "Límite Superior",
Desviacion_Estandar = "Desviación Estándar Poblacional (e)"
) %>%
cols_align(align = "center") %>%
tab_options(
table.background.color = "#FBFCFC",
heading.background.color = "#F4F6F7",
column_labels.font.weight = "bold"
)
| Tabla Nº3. Media Poblacional mediante Intervalos de Confianza |
| Basado en el Teorema del Límite Central (95%) |
| Límite Inferior |
Variable Analizada |
Límite Superior |
Desviación Estándar Poblacional (e) |
| 5.01 |
Pendiente (Slope) |
5.19 |
0.0452 |
8. CONCLUSIÓN
# 8. CONCLUSIÓN
cat("La variable Slope se ajusta al modelo exponencial con una correlación del",
round(Correlación, 2), "%. La probabilidad calculada para el rango de 20 a 30 es de",
round(probabilidad_slope, 2), "%. Bajo el Teorema del Límite Central, la media poblacional se ubica entre",
round(li, 2), "y", round(ls, 2), "con un 95% de confianza.")
## La variable Slope se ajusta al modelo exponencial con una correlación del 99.56 %. La probabilidad calculada para el rango de 20 a 30 es de 0.02 %. Bajo el Teorema del Límite Central, la media poblacional se ubica entre 5.01 y 5.19 con un 95% de confianza.