\(Variable\) \(de\) \(Estudio\): Área (m²).
Se determina que esta variable es Cuantitativa Continua. La superficie disponible condiciona directamente la capacidad de instalación y la escalabilidad del proyecto. Debido a la hiper-concentración de datos en rangos iniciales y la presencia de valores atípicos extremos, se opta por una Estrategia de Refinamiento y Modelado Flexible:
\(Fase\) \(de\) \(Segmentación\): Se aisló el intervalo crítico de mayor densidad (desde 0.013 hasta 916,796.88 m²) tras varias iteraciones, logrando equilibrar la distribución y revelando patrones que quedaban ocultos a escala global.
\(Modelo\) \(Aceptado\): Distribución de Weibull (Validado exitosamente mediante el Test de Pearson y la Prueba Chi-cuadrado. Su alta flexibilidad paramétrica permitió adaptarse perfectamente a la asimetría pronunciada de los datos, garantizando precisión estadística para la planificación de superficies).
Importamos el archivo “Dataset_Mundial_Final.xls” desde una ruta local y lo almacenamos en el objeto Datos.
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(readxl))
Datos <- read_excel(file.choose(), sheet = "Dataset_Mundial_Final")
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 ...
Extraemos la variable de curvatura (curvature), omitimos las celdas en blanco y verificamos el tamaño muestral.
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.
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
area_global <- na.omit(Datos$area)
n_total <- length(area_global)
K_area <- floor(1 + 3.322 * log10(n_total))
min_abs <- min(area_global)
max_abs <- max(area_global)
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
ni_s <- as.vector(table(cut(area_global, breaks = breaks_area, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / n_total) * 100
df_temp <- data.frame(
Li = lim_inf_s,
Ls = lim_sup_s,
MC = MC_s,
ni = ni_s,
hi = hi_s
)
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, ]
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 |
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.
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
area_global <- na.omit(Datos$area)
area_filtrada <- area_global[area_global >= 0.013 & area_global <= 14668750.012]
n_total <- length(area_filtrada)
K_area <- floor(1 + 3.322 * log10(n_total))
min_abs <- 0.013
max_abs <- 14668750.012
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
ni_s <- as.vector(table(cut(area_filtrada, breaks = breaks_area, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / n_total) * 100
df_temp <- data.frame(
Li = lim_inf_s,
Ls = lim_sup_s,
MC = MC_s,
ni = ni_s,
hi = hi_s
)
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 |
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.
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
area_global <- na.omit(Datos$area)
area_filtrada <- area_global[area_global >= 0.013 & area_global <= 916796.888]
n_total <- length(area_filtrada)
K_area <- floor(1 + 3.322 * log10(n_total))
min_abs <- 0.013
max_abs <- 916796.888
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
ni_s <- as.vector(table(cut(area_filtrada, breaks = breaks_area, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / n_total) * 100
df_temp <- data.frame(
Li = lim_inf_s,
Ls = lim_sup_s,
MC = MC_s,
ni = ni_s,
hi = hi_s
)
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 |
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.
area_completa <- na.omit(Datos$area)
area_segmento <- area_completa[area_completa >= 0.013 & area_completa <= 916796.888]
n_seg <- length(area_segmento)
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_sturges + 1)
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
plot(h_area_seg,
main = "Gr\u00e1fica N\u00ba 1: Distribuci\u00f3n de Frecuencias de \u00c1rea",
xlab = "",
ylab = "Porcentaje (%)",
col = "#B0C4DE",
border = "white",
axes = FALSE,
ylim = c(0, max(h_area_seg$counts) * 1.2))
axis(2, las = 2, cex.axis = 0.7)
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.5)
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 = "Datos Emp\u00edricos",
fill = "#B0C4DE",
border = "white",
bty = "n",
cex = 0.8)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))
area_segmento <- na.omit(Datos$area[Datos$area >= 0.013 & Datos$area <= 916796.888])
n_seg <- length(area_segmento)
ajuste_w <- suppressWarnings(fitdistr(area_segmento, "weibull"))
shape_w <- ajuste_w$estimate["shape"]
scale_w <- ajuste_w$estimate["scale"]
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_sturges + 1)
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
plot(h_area_seg,
main = "Gr\u00e1fica N\u00ba 2: Validaci\u00f3n de Modelo Weibull",
xlab = "", ylab = "Porcentaje (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
ylim = c(0, max(h_area_seg$counts) * 1.3))
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)
axis(2, las = 2, cex.axis = 0.7)
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.5)
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)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)
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 %
library(knitr)
suppressPackageStartupMessages(library(MASS))
area_seg <- na.omit(Datos$area[Datos$area >= 0.013 & Datos$area <= 916796.888])
n_seg <- length(area_seg)
ajuste_w <- suppressWarnings(
fitdistr(area_seg, "weibull")
)
shape_w <- ajuste_w$estimate["shape"]
scale_w <- ajuste_w$estimate["scale"]
K_val <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(0.013, 916796.888, length.out = K_val + 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)
Fo_c <- as.vector(table(cut(area_seg, breaks = cortes_seg, right = FALSE))) * (100 / n_seg)
Fe_c <- probs_w * 100
pear_c <- cor(Fo_c, Fe_c) * 100
chi_c <- sum((Fo_c - Fe_c)^2 / Fe_c)
crit_c <- qchisq(0.99, max(1, K_val - 1 - 2))
res_c <- if(chi_c < crit_c) "APROBADO" else "RECHAZADO"
# \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
)
resumen_area[nrow(resumen_area) + 1, ] <- c("Autor: Fernando Neira", "", "", "", "", "")
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 |
| Autor: Fernando Neira |
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\)?
suppressPackageStartupMessages(library(MASS))
area_segmento <- na.omit(Datos$area[Datos$area >= 0.013 & Datos$area <= 916796.888])
n_seg <- length(area_segmento)
ajuste_w <- suppressWarnings(fitdistr(area_segmento, "weibull"))
shape_w <- ajuste_w$estimate["shape"]
scale_w <- ajuste_w$estimate["scale"]
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]
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))
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)
lines(x_curva, y_curva_hi, col = "#C0392B", lwd = 4)
axis(2, las = 2, cex.axis = 0.7)
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.5)
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.
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}}\]
suppressPackageStartupMessages({
library(gt)
library(dplyr)
library(MASS)
})
area_variable <- na.omit(Datos$area)
area_variable <- area_variable[area_variable >= 0.013 & area_variable <= 916796.888]
x_bar_a <- mean(area_variable)
sigma_a <- sd(area_variable)
n_a <- length(area_variable)
error_est_a <- sigma_a / sqrt(n_a)
margen_error_a <- 2 * error_est_a
lim_inf_a <- x_bar_a - margen_error_a
lim_sup_a <- x_bar_a + margen_error_a
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)"
)
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) |
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\)).