ÁREA INFERENCIAL
Modelo Weibull
Grupo 1
2026-02-21
# Cerramos correctamente el bloque de configuración
setwd("C:/Users/ASUS/OneDrive/Escritorio/ESTADÍSTICA/EXPO/ACTIVIDADES")
library(knitr)
knitr::opts_chunk$set(echo = TRUE)# --- BLOQUE DE CONFIGURACION MAESTRA ---
library(knitr)
# Este comando hace que TODAS las gráficas del documento
# tengan las letras un 20% más pequeñas automáticamente (cex = 0.8)
opts_chunk$set(echo = TRUE, dev = "png", dpi = 300, cex = 0.8)
# También configuramos los parámetros de R base para que sean más limpios
# cex.main: Título, cex.lab: Ejes, cex.axis: Números
options(OutDec = ",")1 IDENTIFICACIÓN Y JUSTIFICACIÓN DE LA VARIABLE
Variable de Estudio: Área (\(m^2\))
Se determina que esta variable es Cuantitativa Continua.
Debido a la hiper-concentración de datos en rangos iniciales y la presencia de valores atípicos de gran magnitud, se opta por una Estrategia de Refinamiento de Escala y Modelado Flexible:
- Estrategia de Segmentación y Frecuencia:
Fase de Diagnóstico: La distribución general presentó una saturación extrema en el primer intervalo. Se realizaron tres iteraciones de tablas de distribución de frecuencias para mejorar la resolución visual.
Fase de Ajuste (Intervalo Crítico): Se aisló el segmento de mayor densidad (desde \(0.013\) hasta \(916,796.88\) \(m^2\)). Este proceso permitió una distribución de áreas más razonable y equilibrada, facilitando la identificación de patrones que en la escala global quedaban ocultos.
- Modelo Inferencial:
Modelo de Weibull: Se seleccionó este modelo dada su alta flexibilidad paramétrica para adaptarse a distribuciones con asimetría pronunciada, donde otros modelos rígidos fallaron.
Validación: El modelo fue validado exitosamente mediante Pruebas de Bondad de Ajuste, superando satisfactoriamente el Test de Pearson (\(\chi^2\)) y la prueba de Chi-cuadrado, garantizando una precisión estadística óptima para el análisis de superficies.
2 CARGA DE DATOS Y LIBRERÍAS
Importamos el archivo “Dataset_Mundial_Final.xls” desde una ruta local y lo almacenamos en el objeto Datos.
# 1. CARGA DE LIBRERÍAS (Silenciadas para el informe)
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(readxl))
# 2. CARGAR EL ARCHIVO
# Mantenemos tu ruta original
Datos <- read_excel(file.choose(), sheet = "Dataset_Mundial_Final")
# 3. VERIFICAR DATOS
str(Datos)## tibble [58.978 × 29] (S3: tbl_df/tbl/data.frame)
## $ OBJECTID : num [1:58978] 2 3 4 5 6 7 8 9 10 11 ...
## $ code : chr [1:58978] "00001-AFG-P" "00002-AFG-P" "00003-AFG-P" "00004-AFG-P" ...
## $ plant_name : chr [1:58978] "Badghis Solar Power Plant" "Balkh solar farm" "Behsood solar farm" "Dab Pal 4 solar farm" ...
## $ country : chr [1:58978] "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
## $ operational_status : chr [1:58978] "cancelled - inferred 4 y" "cancelled - inferred 4 y" "cancelled - inferred 4 y" "shelved - inferred 2 y" ...
## $ longitude : num [1:58978] 62,9 67,1 70,4 66,2 65,7 ...
## $ latitude : num [1:58978] 35,1 36,7 34,4 33,8 31,7 ...
## $ elevation : num [1:58978] 918 359 629 2288 1060 ...
## $ area : num [1:58978] 6,74 10,72 487,73 111,8 1929,96 ...
## $ size : chr [1:58978] "Small" "Small" "Small" "Small" ...
## $ slope : num [1:58978] 7,38 0,49 1,1 6,16 1,23 ...
## $ slope_type : chr [1:58978] "Moderado" "Plano o casi plano" "Plano o casi plano" "Moderado" ...
## $ curvature : num [1:58978] -0,024 0 0 0,045 -0,005 -0,005 -0,015 0 0 -0,009 ...
## $ curvature_type : chr [1:58978] "Superficies cóncavas / Valles" "Superficies planas o intermedias" "Superficies planas o intermedias" "Superficies convexas / Crestas" ...
## $ aspect : num [1:58978] 96,8 358,5 36,2 305,8 248,4 ...
## $ aspect_type : chr [1:58978] "East" "North" "Northeast" "Northwest" ...
## $ dist_to_road : num [1:58978] 7037,1 92,7 112,1 1705,3 115,8 ...
## $ ambient_temperature : num [1:58978] 14,4 17,88 21,32 8,86 19,64 ...
## $ ghi : num [1:58978] 5,82 5,58 5,8 6,75 6,62 ...
## $ humidity : num [1:58978] 47,7 42,3 36,4 37,3 24,2 ...
## $ wind_speed : num [1:58978] 0,039 0,954 0,234 0,943 0,37 ...
## $ wind_direction : num [1:58978] 187,5 207,4 255,6 160,3 97,7 ...
## $ dt_wind : chr [1:58978] "South" "Southwest" "West" "South" ...
## $ solar_aptitude : num [1:58978] 0,72 0,635 0,685 0,659 0,819 0,819 0,818 0,642 0,63 0,374 ...
## $ solar_aptitude_rounded: num [1:58978] 7 6 7 7 8 8 8 6 6 4 ...
## $ solar_aptittude_class : chr [1:58978] "Alta" "Alta" "Alta" "Alta" ...
## $ capacity : num [1:58978] 32 40 60 3000 100 100 36 50 25 100 ...
## $ optimal_tilt : num [1:58978] 30 31 31,1 33 31 ...
## $ pv_potential : num [1:58978] 4,61 4,41 4,57 5,42 5,17 ...3 EXTRAER VARIABLE
Extraemos la variable de curvatura (curvature), omitimos las celdas en blanco y verificamos el tamaño muestral.
4 TABLA DE DISTRIBUCIÓN DE FRECUENCIA
La tabla de distribución de frecuencias del Área (Area) se estructuró aplicando la regla de Sturges para definir el número de intervalos idóneos. Complementariamente, el ancho de cada clase se estableció con base en el rango total de los datos, permitiendo una organización sistemática y precisa de la extensión superficial y la variabilidad del tamaño espacial observado en la muestra.
# 1. CARGAR LIBRERIAS (Silenciadas)
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
# 2. PREPARACIÓN DE LA VARIABLE GLOBAL (AREA)
area_global <- na.omit(Datos$area)
n_total <- length(area_global)
# 3. CÁLCULO DE INTERVALOS (Sturges)
K_area <- floor(1 + 3.322 * log10(n_total))
min_abs <- min(area_global)
max_abs <- max(area_global)
# Definición de límites
breaks_area <- seq(min_abs, max_abs, length.out = K_area + 1)
lim_inf_s <- breaks_area[1:K_area]
lim_sup_s <- breaks_area[2:(K_area+1)]
MC_s <- (lim_inf_s + lim_sup_s) / 2
# Frecuencias simples (ni y hi)
ni_s <- as.vector(table(cut(area_global, breaks = breaks_area, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / n_total) * 100
# 4. CONSTRUCCIÓN DEL DATAFRAME (Solo ni y hi)
df_temp <- data.frame(
Li = lim_inf_s,
Ls = lim_sup_s,
MC = MC_s,
ni = ni_s,
hi = hi_s
)
# Filtrar filas vacías en los extremos
primera_con_datos <- min(which(df_temp$ni > 0))
ultima_con_datos <- max(which(df_temp$ni > 0))
df_tabla_final <- df_temp[primera_con_datos:ultima_con_datos, ]
# 5. GENERACIÓN DE LA TABLA GT
df_tabla_final %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 1: DISTRIBUCI\u00d3N DE FRECUENCIAS DE \u00c1REA**"),
) %>%
cols_label(
Li = "Lim. Inf",
Ls = "Lim. Sup",
MC = "Marca Clase (Xi)",
ni = "ni",
hi = "hi (%)"
) %>%
fmt_number(columns = c(Li, Ls, MC), decimals = 3) %>%
fmt_number(columns = hi, decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#F2F2F2"), cell_text(weight = "bold", color = "#333333")),
locations = cells_column_labels()
) %>%
tab_options(
table.width = pct(100),
data_row.padding = px(5),
table.border.top.style = "solid",
table.border.top.color = "black",
table.border.bottom.style = "solid",
table.border.bottom.color = "black"
)| TABLA Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE ÁREA | ||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) |
|---|---|---|---|---|
| 0.013 | 14,668,750.012 | 7,334,375.013 | 42613 | 99.92 |
| 14,668,750.012 | 29,337,500.011 | 22,003,125.012 | 20 | 0.05 |
| 29,337,500.011 | 44,006,250.011 | 36,671,875.011 | 5 | 0.01 |
| 44,006,250.011 | 58,675,000.010 | 51,340,625.010 | 6 | 0.01 |
| 58,675,000.010 | 73,343,750.009 | 66,009,375.009 | 1 | 0.00 |
| 73,343,750.009 | 88,012,500.008 | 80,678,125.009 | 0 | 0.00 |
| 88,012,500.008 | 102,681,250.007 | 95,346,875.008 | 1 | 0.00 |
| 102,681,250.007 | 117,350,000.006 | 110,015,625.007 | 0 | 0.00 |
| 117,350,000.006 | 132,018,750.006 | 124,684,375.006 | 1 | 0.00 |
| 132,018,750.006 | 146,687,500.005 | 139,353,125.005 | 0 | 0.00 |
| 146,687,500.005 | 161,356,250.004 | 154,021,875.004 | 0 | 0.00 |
| 161,356,250.004 | 176,025,000.003 | 168,690,625.004 | 0 | 0.00 |
| 176,025,000.003 | 190,693,750.002 | 183,359,375.003 | 0 | 0.00 |
| 190,693,750.002 | 205,362,500.002 | 198,028,125.002 | 1 | 0.00 |
| 205,362,500.002 | 220,031,250.001 | 212,696,875.001 | 0 | 0.00 |
| 220,031,250.001 | 234,700,000.000 | 227,365,625.000 | 1 | 0.00 |
4.1 NUEVA TABLA DE DISTRIBUCIÓN DE FRECUENCIA
Se segmentó el rango de mayor densidad (0.013 a 14,668,750.012 \(m^2\)) para obtener un subconjunto homogéneo que evitara la distorsión de los valores extremos. Esto permitió que la Regla de Sturges ganara resolución estadística, facilitando la identificación de áreas aptas para infraestructura y garantizando que el modelo Weibull se ajustara con mayor precisión a la realidad de los datos.
# 1. CARGAR LIBRERIAS (Silenciadas)
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
# 2. PREPARACIÓN DE LA VARIABLE (FILTRADA AL INTERVALO 0.013 - 14668750.012)
area_global <- na.omit(Datos$area)
area_filtrada <- area_global[area_global >= 0.013 & area_global <= 14668750.012]
n_total <- length(area_filtrada)
# 3. CÁLCULO DE INTERVALOS (Sturges)
K_area <- floor(1 + 3.322 * log10(n_total))
min_abs <- 0.013
max_abs <- 14668750.012
# Definición de límites
breaks_area <- seq(min_abs, max_abs, length.out = K_area + 1)
lim_inf_s <- breaks_area[1:K_area]
lim_sup_s <- breaks_area[2:(K_area+1)]
MC_s <- (lim_inf_s + lim_sup_s) / 2
# Frecuencias simples
ni_s <- as.vector(table(cut(area_filtrada, breaks = breaks_area, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / n_total) * 100
# 4. CONSTRUCCIÓN DEL DATAFRAME (Solo ni y hi)
df_temp <- data.frame(
Li = lim_inf_s,
Ls = lim_sup_s,
MC = MC_s,
ni = ni_s,
hi = hi_s
)
# 5. GENERACIÓN DE LA TABLA GT
df_temp %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 2: DISTRIBUCI\u00d3N DE FRECUENCIAS DE \u00c1REA**"),
) %>%
cols_label(
Li = "Lim. Inf",
Ls = "Lim. Sup",
MC = "Marca Clase (Xi)",
ni = "ni",
hi = "hi (%)"
) %>%
fmt_number(columns = c(Li, Ls, MC), decimals = 3) %>%
fmt_number(columns = hi, decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#F2F2F2"), cell_text(weight = "bold", color = "#333333")),
locations = cells_column_labels()
) %>%
tab_options(
table.width = pct(100),
data_row.padding = px(5),
table.border.top.style = "solid",
table.border.top.color = "black",
table.border.bottom.style = "solid",
table.border.bottom.color = "black"
)| TABLA Nº 2: DISTRIBUCIÓN DE FRECUENCIAS DE ÁREA | ||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) |
|---|---|---|---|---|
| 0.013 | 916,796.888 | 458,398.450 | 41303 | 96.93 |
| 916,796.888 | 1,833,593.763 | 1,375,195.325 | 646 | 1.52 |
| 1,833,593.763 | 2,750,390.638 | 2,291,992.200 | 258 | 0.61 |
| 2,750,390.638 | 3,667,187.513 | 3,208,789.075 | 107 | 0.25 |
| 3,667,187.513 | 4,583,984.388 | 4,125,585.950 | 88 | 0.21 |
| 4,583,984.388 | 5,500,781.263 | 5,042,382.825 | 64 | 0.15 |
| 5,500,781.263 | 6,417,578.138 | 5,959,179.700 | 35 | 0.08 |
| 6,417,578.138 | 7,334,375.013 | 6,875,976.575 | 27 | 0.06 |
| 7,334,375.013 | 8,251,171.887 | 7,792,773.450 | 18 | 0.04 |
| 8,251,171.887 | 9,167,968.762 | 8,709,570.325 | 11 | 0.03 |
| 9,167,968.762 | 10,084,765.637 | 9,626,367.200 | 11 | 0.03 |
| 10,084,765.637 | 11,001,562.512 | 10,543,164.075 | 11 | 0.03 |
| 11,001,562.512 | 11,918,359.387 | 11,459,960.950 | 15 | 0.04 |
| 11,918,359.387 | 12,835,156.262 | 12,376,757.825 | 8 | 0.02 |
| 12,835,156.262 | 13,751,953.137 | 13,293,554.700 | 5 | 0.01 |
| 13,751,953.137 | 14,668,750.012 | 14,210,351.575 | 6 | 0.01 |
4.2 TABLA DE DISTRIBUCIÓN DE FRECUENCIA FINAL
Al detectar que la Tabla N°2 ocultaba la variabilidad de los datos, se aplicó un “zoom” estadístico reduciendo el rango de análisis a \(916,796.88\) \(m^2\). Esta segmentación eliminó el sesgo de los valores extremos, permitiendo desglosar mejor las áreas más frecuentes y obtener una caracterización precisa del espacio físico.
# 1. CARGAR LIBRERIAS (Silenciadas)
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
# 2. PREPARACIÓN DE LA VARIABLE (FILTRADA AL NUEVO INTERVALO 0.013 - 916796.888)
area_global <- na.omit(Datos$area)
# Aplicamos el filtro al nuevo rango de interés
area_filtrada <- area_global[area_global >= 0.013 & area_global <= 916796.888]
n_total <- length(area_filtrada)
# 3. CÁLCULO DE INTERVALOS (Sturges)
K_area <- floor(1 + 3.322 * log10(n_total))
min_abs <- 0.013
max_abs <- 916796.888
# Definición de límites exactos
breaks_area <- seq(min_abs, max_abs, length.out = K_area + 1)
lim_inf_s <- breaks_area[1:K_area]
lim_sup_s <- breaks_area[2:(K_area+1)]
MC_s <- (lim_inf_s + lim_sup_s) / 2
# Frecuencias simples
ni_s <- as.vector(table(cut(area_filtrada, breaks = breaks_area, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / n_total) * 100
# 4. CONSTRUCCIÓN DEL DATAFRAME (Solo ni y hi)
df_temp <- data.frame(
Li = lim_inf_s,
Ls = lim_sup_s,
MC = MC_s,
ni = ni_s,
hi = hi_s
)
# 5. GENERACIÓN DE LA TABLA GT
df_temp %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 3: DISTRIBUCI\u00d3N DE FRECUENCIAS DE \u00c1REA**"),
) %>%
cols_label(
Li = "Lim. Inf",
Ls = "Lim. Sup",
MC = "Marca Clase (Xi)",
ni = "ni",
hi = "hi (%)"
) %>%
fmt_number(columns = c(Li, Ls, MC), decimals = 3) %>%
fmt_number(columns = hi, decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#F2F2F2"), cell_text(weight = "bold", color = "#333333")),
locations = cells_column_labels()
) %>%
tab_options(
table.width = pct(100),
data_row.padding = px(5),
table.border.top.style = "solid",
table.border.top.color = "black",
table.border.bottom.style = "solid",
table.border.bottom.color = "black"
)| TABLA Nº 3: DISTRIBUCIÓN DE FRECUENCIAS DE ÁREA | ||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) |
|---|---|---|---|---|
| 0.013 | 57,299.818 | 28,649.915 | 31497 | 76.26 |
| 57,299.818 | 114,599.622 | 85,949.720 | 3979 | 9.63 |
| 114,599.622 | 171,899.427 | 143,249.525 | 1880 | 4.55 |
| 171,899.427 | 229,199.232 | 200,549.329 | 1047 | 2.53 |
| 229,199.232 | 286,499.036 | 257,849.134 | 672 | 1.63 |
| 286,499.036 | 343,798.841 | 315,148.939 | 520 | 1.26 |
| 343,798.841 | 401,098.646 | 372,448.743 | 367 | 0.89 |
| 401,098.646 | 458,398.450 | 429,748.548 | 243 | 0.59 |
| 458,398.450 | 515,698.255 | 487,048.353 | 227 | 0.55 |
| 515,698.255 | 572,998.060 | 544,348.158 | 197 | 0.48 |
| 572,998.060 | 630,297.865 | 601,647.962 | 180 | 0.44 |
| 630,297.865 | 687,597.669 | 658,947.767 | 132 | 0.32 |
| 687,597.669 | 744,897.474 | 716,247.572 | 117 | 0.28 |
| 744,897.474 | 802,197.279 | 773,547.376 | 95 | 0.23 |
| 802,197.279 | 859,497.083 | 830,847.181 | 80 | 0.19 |
| 859,497.083 | 916,796.888 | 888,146.986 | 70 | 0.17 |
5 ANÁLISIS GRÁFICO
El histograma permite visualizar intuitivamente dónde se concentran las mayores extensiones de terreno, revelando la forma y el sesgo de los datos. Esta claridad gráfica complementa la tabla de frecuencias y es clave para determinar la capacidad real de ocupación del suelo, validando que el modelo matemático elegido se ajusta correctamente a la distribución de los paneles solares.
5.1 HISTOGRAMA DE FRECUENCIA
### 5.1 HISTOGRAMA DE FRECUENCIA (SEGMENTO DE MAYOR DENSIDAD)
# 1. PREPARACIÓN DE LOS DATOS Y FILTRADO
# Filtramos la variable area para el nuevo rango de interés
area_completa <- na.omit(Datos$area)
# Definimos el segmento de interés (0.013 a 916796.888)
area_segmento <- area_completa[area_completa >= 0.013 & area_completa <= 916796.888]
n_seg <- length(area_segmento) # Sincronizado con el n_total de tu tabla Nº 3
# 2. CÁLCULO DE INTERVALOS (Regla de Sturges aplicada al segmento)
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_sturges + 1)
# 3. CREACIÓN Y ESCALADO DEL HISTOGRAMA
par(mar = c(8, 5, 4, 2)) # Aumentamos margen inferior para etiquetas largas
h_area_seg <- hist(area_segmento, breaks = cortes_seg, plot = FALSE, right = FALSE)
# hi = (ni / n_seg) * 100 -> Porcentaje respecto al segmento filtrado
h_area_seg$counts <- (h_area_seg$counts / n_seg) * 100
# 4. DIBUJAR LA GRÁFICA (Solo Histograma)
# \u00ba = º | \u00f3 = ó | \u00c1 = Á
plot(h_area_seg,
main = "Gr\u00e1fica N\u00ba 1: Distribuci\u00f3n de Frecuencias de \u00c1rea",
xlab = "", # Quitamos xlab aquí para ponerlo con mtext y no choque con el eje
ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE",
border = "white",
axes = FALSE,
ylim = c(0, max(h_area_seg$counts) * 1.2))
# 5. EJES Y DISEÑO PROFESIONAL
axis(2, las = 2, cex.axis = 0.7)
# Eje X con los cortes exactos. Usamos cex.axis un poco más pequeño por la magnitud de los números
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.5)
# Título del eje X posicionado manualmente para evitar solapamientos
mtext("\u00c1rea del Terreno (m\u00b2)", side = 1, line = 6.5, cex = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 6. LEYENDA (Solo datos empíricos)
legend("topright",
legend = "Datos Emp\u00edricos",
fill = "#B0C4DE",
border = "white",
bty = "n",
cex = 0.8)
6 JUSTIFICACIÓN Y ESTRATIFICACIÓN DEL MODELO
Se estratificó la muestra de Área enfocándose en el sector de mayor densidad (\(0.013\) a \(916,796.88\) \(m^2\)) para identificar el modelo teórico que mejor se adaptara a este rango central. A continuación, se presentan las conjeturas validadas mediante pruebas de bondad de ajuste, lo que garantiza una planificación del terreno sólida y técnicamente robusta.
suppressPackageStartupMessages(library(MASS))
# 1. Preparación
area_segmento <- na.omit(Datos$area[Datos$area >= 0.013 & Datos$area <= 916796.888])
n_seg <- length(area_segmento)
# 2. Ajuste del Modelo Weibull
ajuste_w <- suppressWarnings(fitdistr(area_segmento, "weibull"))
shape_w <- ajuste_w$estimate["shape"]
scale_w <- ajuste_w$estimate["scale"]
# 3. Preparación del Histograma
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_sturges + 1)
# Mantenemos el margen de 8 igual al original
par(mar = c(8, 5, 4, 2))
h_area_seg <- hist(area_segmento, breaks = cortes_seg, plot = FALSE, right = FALSE)
h_area_seg$counts <- (h_area_seg$counts / n_seg) * 100
# 4. Dibujar Gráfica
plot(h_area_seg,
main = "Gr\u00e1fica N\u00ba 2: Validaci\u00f3n de Modelo Weibull",
xlab = "", ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
ylim = c(0, max(h_area_seg$counts) * 1.3))
# 5. Línea del Modelo Weibull (Curva de Ajuste)
x_curva <- seq(0.013, 916796.888, length.out = 500)
y_densidad <- dweibull(x_curva, shape = shape_w, scale = scale_w)
ancho_barra <- cortes_seg[2] - cortes_seg[1]
y_curva_hi <- y_densidad * ancho_barra * 100
lines(x_curva, y_curva_hi, col = "#C0392B", lwd = 4)
# 6. Ejes y Estética (CORREGIDO IGUAL AL ORIGINAL)
axis(2, las = 2, cex.axis = 0.7)
# CAMBIO CLAVE: Cambié %.0f por %.3f para que salgan los decimales
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.5)
# Título del eje X con el mismo espacio que el original
mtext("\u00c1rea del Terreno (m\u00b2)", side = 1, line = 6.5, cex = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
legend("topright",
legend = c("Datos Emp\u00edricos", "Modelo Weibull"),
col = c("#B0C4DE", "#C0392B"), lwd = c(8, 4), bty = "n", cex = 0.8)
6.1 TEST DE PEARSON Y CHI-CUDRADO
K_val <- length(cortes_seg) - 1
probs_w <- numeric(K_val)
for(i in 1:K_val) {
probs_w[i] <- pweibull(cortes_seg[i+1], shape = shape_w, scale = scale_w) -
pweibull(cortes_seg[i], shape = shape_w, scale = scale_w)
}
probs_w <- probs_w / sum(probs_w)
n_base <- 100
Fo_c <- as.vector(table(cut(area_segmento, breaks = cortes_seg, right = FALSE))) * (n_base / n_seg)
Fe_c <- probs_w * n_base
chi_calc <- sum((Fo_c - Fe_c)^2 / Fe_c)
# Grados de Libertad para Weibull: K - 1 - 2 (tiene 2 parámetros)
chi_crit <- qchisq(0.99, max(1, K_val - 1 - 2))
resultado_chi <- if(chi_calc < chi_crit) "APROBADO" else "RECHAZADO"
pearson_val <- cor(Fo_c, Fe_c) * 100
cat("\n--- RESULTADOS DE VALIDACI\u00d3N \u00c1REA (WEIBULL) ---\n")##
## --- RESULTADOS DE VALIDACIÓN ÁREA (WEIBULL) ---## Prueba Chi-cuadrado: APROBADO## Chi-calculado: 0,44 | Chi-crítico: 27,69## Correlación de Pearson: 99,98 %7 TABLA DE RESUMEN DE BONDAD DE AJUSTE
# 1. CARGAR LIBRERIAS
library(knitr)
suppressPackageStartupMessages(library(MASS))
# 2. CÁLCULOS TÉCNICOS (Variable Área)
area_seg <- na.omit(Datos$area[Datos$area >= 0.013 & Datos$area <= 916796.888])
n_seg <- length(area_seg)
# Ajuste Weibull (El más apto para esta variable)
ajuste_w <- suppressWarnings(
fitdistr(area_seg, "weibull")
)
shape_w <- ajuste_w$estimate["shape"]
scale_w <- ajuste_w$estimate["scale"]
# Intervalos y Frecuencias (Sturges)
K_val <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_val + 1)
# Probabilidades teóricas (Weibull) y Frecuencias base 100
probs_w <- numeric(K_val)
for(i in 1:K_val) {
probs_w[i] <- pweibull(cortes_seg[i+1], shape = shape_w, scale = scale_w) -
pweibull(cortes_seg[i], shape = shape_w, scale = scale_w)
}
probs_w <- probs_w / sum(probs_w)
Fo_c <- as.vector(table(cut(area_seg, breaks = cortes_seg, right = FALSE))) * (100 / n_seg)
Fe_c <- probs_w * 100
# Estadísticos finales
pear_c <- cor(Fo_c, Fe_c) * 100
chi_c <- sum((Fo_c - Fe_c)^2 / Fe_c)
# Grados de Libertad: K_val - 1 - 2 (Weibull tiene 2 parámetros)
crit_c <- qchisq(0.99, max(1, K_val - 1 - 2))
res_c <- if(chi_c < crit_c) "APROBADO" else "RECHAZADO"
# 3. GENERACIÓN DE LA TABLA RESUMEN
# \u00f3 = ó | \u00ed = í | \u00c1 = Á
resumen_area <- data.frame(
"Segmento" = "Zona de Mayor Densidad (0.013 a 916,796.888)",
"Modelo" = "Weibull",
"Pearson (%)" = round(pear_c, 2),
"Chi-Calc" = round(chi_c, 2),
"Chi-Crit" = round(crit_c, 2),
"Estado" = res_c
)
# Imprimir tabla con formato kable
kable(resumen_area,
format = "markdown",
align = "llcccc",
caption = "Tabla No. 4: Resumen de validaci\u00f3n del modelo de probabilidad (Variable \u00c1rea)")| Segmento | Modelo | Pearson…. | Chi.Calc | Chi.Crit | Estado |
|---|---|---|---|---|---|
| Zona de Mayor Densidad (0.013 a 916,796.888) | Weibull | 99,98 | 0,44 | 27,69 | APROBADO |
8 CÁLCULO DE PROBABILIDADES
Tras validar que el comportamiento de la extensión superficial del terreno se ajusta con precisión a un modelo de distribución Weibull, procedemos a proyectar los escenarios operativos y de planificación espacial para la implementación de los parques solares:
\(Pregunta\) \(1\) : ¿Cuál es la probabilidad teórica de encontrar un sector del terreno con un área entre \(100,000\) y \(400,000\) \(m^2\)?
\(Pregunta\) \(2\) : Si se evalúan \(200\) lotes potenciales dentro del área de estudio, ¿cuántos de estos se estima que tendrán un área entre \(50,000\) y \(600,000\) \(m^2\)?
# ==========================================================
# GRÁFICA: MODELO WEIBULL CON ÁREAS DE PROBABILIDAD (EJE X CORREGIDO)
# ==========================================================
suppressPackageStartupMessages(library(MASS))
# 1. Preparación (Se mantiene igual)
area_segmento <- na.omit(Datos$area[Datos$area >= 0.013 & Datos$area <= 916796.888])
n_seg <- length(area_segmento)
# 2. Ajuste del Modelo Weibull
ajuste_w <- suppressWarnings(fitdistr(area_segmento, "weibull"))
shape_w <- ajuste_w$estimate["shape"]
scale_w <- ajuste_w$estimate["scale"]
# 3. Preparación de la Escala
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_sturges + 1)
h_area_seg <- hist(area_segmento, breaks = cortes_seg, plot = FALSE, right = FALSE)
h_area_seg$counts <- (h_area_seg$counts / n_seg) * 100
ancho_barra <- cortes_seg[2] - cortes_seg[1]
# 4. Crear Lienzo
par(mar = c(8, 5, 4, 2))
x_curva <- seq(0.013, 916796.888, length.out = 1000)
y_curva_hi <- dweibull(x_curva, shape = shape_w, scale = scale_w) * ancho_barra * 100
plot(x_curva, y_curva_hi, type = "n",
main = "Gr\u00e1fica N\u00ba 3: Zonas de Probabilidad (Modelo Weibull)",
xlab = "", ylab = "Densidad de Probabilidad",
axes = FALSE, ylim = c(0, max(h_area_seg$counts) * 1.3))
# 5. Sombreado de Intervalos (Se mantiene igual)
x_q2 <- seq(50000, 600000, length.out = 500)
y_q2 <- dweibull(x_q2, shape = shape_w, scale = scale_w) * ancho_barra * 100
polygon(c(50000, x_q2, 600000), c(0, y_q2, 0), col = "#D4E6F1", border = NA)
x_q1 <- seq(100000, 400000, length.out = 500)
y_q1 <- dweibull(x_q1, shape = shape_w, scale = scale_w) * ancho_barra * 100
polygon(c(100000, x_q1, 400000), c(0, y_q1, 0), col = "#7FB3D5", border = NA)
# 6. Línea del Modelo Weibull
lines(x_curva, y_curva_hi, col = "#C0392B", lwd = 4)
# 7. Ejes y Estética (CORREGIDO CON 3 DECIMALES)
axis(2, las = 2, cex.axis = 0.7)
# CAMBIO CLAVE: Cambié %.0f por %.3f para que coincida con el original
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.5)
# Título del eje X posicionado correctamente
mtext("\u00c1rea del Terreno (m\u00b2)", side = 1, line = 6.5, cex = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
legend("topright",
legend = c("Modelo Weibull", "P1: Zona \u00d3ptima", "P2: Zona Aceptable"),
col = c("#C0392B", "#7FB3D5", "#D4E6F1"), lwd = c(4, 8, 8), bty = "n", cex = 0.8)
\(Respuesta\) \(1\): La probabilidad de encontrar terrenos con el tamaño óptimo (100k-400k \(m^2\)) es del \(11.39\)%. Esta disponibilidad limitada exige una localización técnica precisa para asegurar que los bloques fotovoltaicos alcancen la máxima densidad de potencia instalada.
\(Respuesta\) \(2\): Se estima que 43 de los 200 lotes analizados cumplen con el rango de eficiencia operativa (50k-600k \(m^2\)). Esto confirma que el 21.5% de la muestra es logísticamente viable, permitiendo instalaciones compactas que optimizan costos en cableado y soportes estructurales.
9 TEOREMA DE LÍMITE CENTRAL
El TLC establece que, dada una muestra suficientemente grande (\(n\) > \(30\)), la distribución de las medias muestrales seguirá una distribución Normal. Esto nos permite estimar la Media Poblacional (\(\mu\)) verdadera utilizando intervalos de confianza.Los postulados de confianza empírica sugieren:
\(P(\bar{x} - E < \mu < \bar{x} + E) \approx 68\%\)
\(P(\bar{x} - 2E < \mu < \bar{x} + 2E) \approx 95\%\)
\(P(\bar{x} - 3E < \mu < \bar{x} + 3E) \approx 99\%\)
Donde el Margen de Error (E) se define como: \[E = \frac{\sigma}{\sqrt{n}}\]
# ==========================================================
# BLOQUE: TEOREMA DEL LÍMITE CENTRAL (ÁREA / AREA)
# ==========================================================
# 1. CARGAR LIBRERIAS (SILENCIADO)
suppressPackageStartupMessages({
library(gt)
library(dplyr)
library(MASS)
})
# 2. PREPARACIÓN DE LA VARIABLE
# Usamos los datos dentro del rango de estudio de mayor densidad (0.013 a 916,796.888)
area_variable <- na.omit(Datos$area)
area_variable <- area_variable[area_variable >= 0.013 & area_variable <= 916796.888]
# 3. CALCULO DE ESTADISTICOS ARITMETICOS
x_bar_a <- mean(area_variable)
sigma_a <- sd(area_variable)
n_a <- length(area_variable)
# 4. CALCULO DEL ERROR ESTANDAR Y MARGEN AL 95%
# El TLC establece que la distribución de medias tiende a la normalidad
error_est_a <- sigma_a / sqrt(n_a)
margen_error_a <- 2 * error_est_a # Aproximación para el 95% de confianza
# 5. INTERVALO DE CONFIANZA
lim_inf_a <- x_bar_a - margen_error_a
lim_sup_a <- x_bar_a + margen_error_a
# 6. CONSTRUCCION DE LA TABLA RESUMEN
tabla_tlc_a <- data.frame(
Parametro = "\u00c1rea Promedio (Area)",
Lim_Inferior = lim_inf_a,
Media_Muestral = x_bar_a,
Lim_Superior = lim_sup_a,
Error_Estandar = paste0("+/- ", sprintf("%.3f", margen_error_a)),
Confianza = "95% (2*E)"
)
# 7. GENERACION DE LA TABLA VISUAL
# \u00d3 = Ó | \u00f3 = ó | \u00ed = í | \u00e1 = á | \u00c1 = Á
tabla_tlc_a %>%
gt() %>%
tab_header(
title = md("**ESTIMACI\u00d3N DE LA MEDIA POBLACIONAL**"),
subtitle = "Aplicaci\u00f3n del Teorema del L\u00edmite Central (\u00c1rea)"
) %>%
cols_label(
Parametro = "Par\u00e1metro",
Lim_Inferior = "L\u00edmite Inferior",
Media_Muestral = "Media Calculada",
Lim_Superior = "L\u00edmite Superior",
Error_Estandar = "Error Estimado"
) %>%
fmt_number(
columns = c(Lim_Inferior, Media_Muestral, Lim_Superior),
decimals = 3
) %>%
tab_style(
style = list(cell_fill(color = "#F4ECF7"), cell_text(color = "#5B2C6F", weight = "bold")),
locations = cells_body(columns = Media_Muestral)
)| ESTIMACIÓN DE LA MEDIA POBLACIONAL | |||||
| Aplicación del Teorema del Límite Central (Área) | |||||
| Parámetro | Límite Inferior | Media Calculada | Límite Superior | Error Estimado | Confianza |
|---|---|---|---|---|---|
| Área Promedio (Area) | 56,710.967 | 57,925.904 | 59,140.841 | +/- 1214.937 | 95% (2*E) |
10 CONCLUSIÓN
La variable Área se modeló mediante una Distribución Weibull, logrando una caracterización muy precisa de la superficie disponible. Con una media muestral de \(57,925.90\) \(m^2\) y aplicando el Teorema del Límite Central, se estima que la media poblacional se sitúa entre [\(56,710.97\); \(59,140.84\)] con un \(95\%\) de confianza. Este rango permite estandarizar la planificación de los bloques fotovoltaicos y optimizar al máximo el aprovechamiento del terreno (\(\mu = 57,925.90 \pm 1,214.94\)).