ANÁLISIS ESTADÍSTICO
1. CARGA DE LIBRERÍAS Y DATOS
# CARGA DE DATOS
library(dplyr)
library(knitr)
library(gt)
library(scatterplot3d)
setwd("C:/Users/HP/Documents/PROYECTO ESTADISTICA/RStudio")
datos <- read.csv("tablap.csv", header = TRUE, sep = ";", dec = ",")
# Adaptación de variables
# y = Volumen, x1 = Acero, x2 = Concreto
volumen <- as.numeric(datos$Volume.excavated.soil..slope)
acero <- as.numeric(datos$Mass.of.steel..pad.)
concreto <- as.numeric(datos$Mass.of.concrete..pad.)
TPV <- data.frame(y = volumen, x1 = acero, x2 = concreto)
TPV <- na.omit(TPV)
# Solo positivos
TPV <- TPV[TPV$y > 0 & TPV$x1 > 0 & TPV$x2 > 0, ]
2. TABLA PARES DE VALORES
# Filtrar outliers (Mantenemos tu función por seguridad metodológica)
filtro_iqr <- function(v){
Q1 <- quantile(v, 0.25)
Q3 <- quantile(v, 0.75)
IQRv <- Q3 - Q1
li <- Q1 - 1 * IQRv
ls <- Q3 + 1 * IQRv
return(v >= li & v <= ls)
}
# Aplicamos el filtro a los datos
TPV <- TPV[filtro_iqr(TPV$y) & filtro_iqr(TPV$x1) & filtro_iqr(TPV$x2), ]
# --- CAMBIO CRÍTICA: Forzamos a trabajar exactamente con los primeros 1,000 registros ---
TPV <- head(TPV, 1000)
# Creamos el índice Nro para la visualización de la tabla
tabla_display <- cbind(Nro = 1:nrow(TPV), TPV)
# Mostrar los primeros 20 datos en el reporte con un scroll interactivo
# (Muestra 20 a la vez pero almacena los 1,000 para no hacer infinito el PDF/HTML)
head(tabla_display, 20) %>%
gt() %>%
cols_label(Nro = "N°", y = "Volumen (y)", x1 = "Masa Acero (x1)", x2 = "Masa Concreto (x2)") %>%
tab_header(title = md("**Tabla N° 4. Muestra de Pares de Valores (Primeros 20 de 1,000)**")) %>%
cols_align(align = "center") %>%
fmt_number(columns = c(y, x1, x2), decimals = 2) %>%
tab_options(
table.width = pct(80),
column_labels.font.weight = "bold",
container.height = px(400),
container.overflow.y = TRUE
)
| Tabla N° 4. Muestra de Pares de Valores (Primeros 20 de 1,000) |
| N° |
Volumen (y) |
Masa Acero (x1) |
Masa Concreto (x2) |
| 1 |
14,931.00 |
68,874.00 |
35,882.00 |
| 2 |
18,101.00 |
88,868.00 |
80,947.00 |
| 3 |
17,164.00 |
86,142.00 |
46,808.00 |
| 4 |
14,274.00 |
20,179.00 |
89,471.00 |
| 5 |
15,497.00 |
32,966.00 |
94,641.00 |
| 6 |
13,838.00 |
52,559.00 |
14,100.00 |
| 7 |
17,655.00 |
91,265.00 |
57,529.00 |
| 8 |
17,345.00 |
61,720.00 |
90,317.00 |
| 9 |
15,306.00 |
56,425.00 |
59,629.00 |
| 10 |
12,841.00 |
17,702.00 |
51,095.00 |
| 11 |
14,555.00 |
15,905.00 |
96,114.00 |
| 12 |
15,719.00 |
47,814.00 |
50,800.00 |
| 13 |
14,572.00 |
31,756.00 |
70,981.00 |
| 14 |
16,958.00 |
80,340.00 |
61,536.00 |
| 15 |
15,572.00 |
74,304.00 |
19,263.00 |
| 16 |
18,026.00 |
66,122.00 |
90,983.00 |
| 17 |
12,634.00 |
22,183.00 |
32,148.00 |
| 18 |
14,846.00 |
63,579.00 |
13,785.00 |
| 19 |
11,990.00 |
12,778.00 |
39,513.00 |
| 20 |
15,932.00 |
45,642.00 |
90,058.00 |
# Extraer las variables exactas de los 1,000 datos sincronizados
x1 <- TPV$x1 # Acero
x2 <- TPV$x2 # Concreto
y <- TPV$y / 1000 # Volumen transformado a miles para mantener la escala del gráfico limpia
# CÁLCULO AUTOMÁTICO DE LÍMITES (Para que el cubo 3D no se rompa con 1,000 datos)
max_x1 <- max(x1, na.rm = TRUE)
max_x2 <- max(x2, na.rm = TRUE)
max_y <- max(y, na.rm = TRUE)
3. DIAGRAMA DE DISPERSIÓN
# Diagrama de Dispersión (Gráfica N°1) - Renderizado perfecto de los 1,000 puntos
par(mar = c(5, 6, 4, 2))
Cobrereg <- scatterplot3d(x1, x2, y, angle = 225, pch = 16, color = "blue",
cex.symbols = 0.6, # Reducimos el tamaño del punto para que la nube sea legible
main = "Gráfica N°1: Diagrama de dispersión de Volumen, Acero y Concreto (N = 1000)",
xlab = "Masa de Acero (x1)",
ylab = "Masa de Concreto (x2)",
zlab = "Volumen (miles de m3)",
y.margin.add = 0.9,
las = 1,
xlim = c(0, max_x1), # Límites automáticos ajustados al dato máximo real
ylim = c(0, max_x2),
zlim = c(0, max_y + 5))
4. CONJETURA DEL MODELO
par(mar = c(5, 6, 4, 2))
Cobrereg <- scatterplot3d(x1, x2, y, angle = 225, pch = 16, color = "blue",
cex.symbols = 0.6, # Puntos pequeños para ver la densidad de la nube
main = "Gráfica N°2: Comparación de la realidad \n con el modelo multivariable lineal",
xlab = "Masa de Acero (x1)",
ylab = "Masa de Concreto (x2)",
zlab = "Volumen (miles de m3)",
y.margin.add = 0.5,
las = 1,
xlim = c(0, max_x1),
ylim = c(0, max_x2),
zlim = c(0, max_y + 5))
# CÁLCULO DE PARÁMETROS SOBRE LOS 1,000 DATOS
regresion_multiple <- lm(y ~ x1 + x2)
# El plano se estabilizará cruzando de forma óptima a través de los 1,000 datos
Cobrereg$plane3d(regresion_multiple, col = "red", lwd = 1.5)
a_val <- round(coef(regresion_multiple)[1], 3)
b_val <- round(coef(regresion_multiple)[2], 5) # Usamos 5 decimales por la precisión que otorgan 1,000 datos
c_val <- round(coef(regresion_multiple)[3], 5)
plot.new()
par(mar = c(1, 1, 1, 1))
plot.window(xlim = c(0, 100), ylim = c(0, 100))
rect(5, 15, 95, 85, border = "blue", lwd = 3)
text(50, 70, "Ecuación Múltiple Lineal (N = 1000)", cex = 1.4, font = 2, col = "blue")
text(50, 50, "Y = a + bx1 + cx2", cex = 1.2, font = 1, col = "black")
text(50, 30, paste0("Y = ", a_val, " + (", b_val, ")x1 + (", c_val, ")x2"), cex = 1.1, font = 2, col = "darkgreen")
5. TEST DE APROBACIÓN Y RESTRICCIONES
# TEST DE PEARSON Y DETERMINACIÓN
r2 <- summary(regresion_multiple)$r.squared
r_multiple <- sqrt(r2)
tabla_tests <- data.frame(
Indicador = c("Coeficiente de Correlación Múltiple (r)", "Coeficiente de Determinación (R2)"),
Valor = c(paste0(round(r_multiple * 100, 2), " %"), paste0(round(r2 * 100, 2), " %"))
)
# Imprimir la tabla de indicadores
tabla_tests %>%
gt() %>%
tab_header(title = md("**Tests de Aprobación del Modelo Multivariable**")) %>%
cols_align(align = "center") %>%
tab_options(table.width = pct(65), column_labels.font.weight = "bold")
| Tests de Aprobación del Modelo Multivariable |
| Indicador |
Valor |
| Coeficiente de Correlación Múltiple (r) |
96.52 % |
| Coeficiente de Determinación (R2) |
93.16 % |
# Generación de la tarjeta gráfica independiente de restricciones
plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 100))
text(50, 85, "RESTRICCIONES DEL MODELO", cex = 1.4, font = 2, col = "#D9534F")
parrafo_1 <- "La interpretación del modelo se limita estrictamente
al rango observado de variables.Se deben evitar
extrapolaciones fuera del dominio analizado de
Masa de Acero y Concreto."
text(50, 55, parrafo_1, cex = 1.1, font = 3, col = "black")
rect(2, 5, 98, 95, border = "#D9534F", lwd = 3)
6. CÁLCULO DE PRONÓSTICOS
# CÁLCULO DE ESTIMACIONES
x1_test <- 500 # Valor de Acero de ejemplo
x2_test <- 2500 # Valor de Concreto de ejemplo
C_Est <- a_val + (b_val * x1_test) + (c_val * x2_test)
plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 1))
rect(10, 0.4, 90, 0.6, col = "#E5E7E9", border = NA)
text(50, 0.85, "PRONÓSTICO DEL MODELO MULTIVARIABLE", cex = 1.5, font = 2, col = "#2A9D8F")
texto_pregunta <- paste0("¿Qué volumen se espera con acero de ", x1_test, " y concreto de ", x2_test, "?")
text(50, 0.75, texto_pregunta, cex = 1.1, font = 3)
text(50, 0.5, paste0("R = ", round(C_Est, 3), " m3"), cex = 1.6, font = 2, col = "#1F618D")
rect(10, 0.4, 90, 0.6, border = "#2A9D8F", lwd = 2)
7. CONCLUSIÓN
## Entre el volumen y la combinación de Acero y Concreto existe una regresión múltiple lineal. El volumen está influenciado en un 93.16% por la combinación de estas variables. Por ejemplo: Para una masa de acero de 500 y una masa de concreto de 2500, se espera un volumen de 10.16 m3.