\(Variable\) \(de\) \(Estudio\): Nivel de Aptitud Solar Redondeada (Solar_Aptitude_Rounded).
Se determina que esta variable es Cuantitativa Discreta, categorizada en tres rangos técnicos (Baja, Media y Alta). El nivel de aptitud solar condiciona directamente el potencial energético y la rentabilidad del terreno. Debido a la tendencia de los datos a agruparse en torno a valores centrales y decaer hacia los extremos, se opta por una Estrategia de Modelado Único:
\(Modelo\) \(Aceptado\): Distribución Binomial (Validado mediante Test de Pearson con \(r \approx 0.99\), lo que asegura un modelo altamente preciso y confiable para una planificación técnica sólida).
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 solar_aptitude_rounded, omitimos las celdas en blanco y verificamos el tamaño muestral.
Extraemos la variable size para obtener su frecuencia absoluta (ni) y calculamos el porcentaje (hi) sobre el total. Finalmente, añadimos una Asignación jerárquica y consolidamos todo en el data frame TDF_Solar con un diseño profesional y centrado.
Datos$solar_range <- cut(Datos$solar_aptitude_rounded,
breaks = c(-Inf, 3, 6, 9),
labels = c("Baja (0-3)", "Media (4-6)", "Alta (7-9)"),
include.lowest = TRUE)
conteo_solar <- table(Datos$solar_range)
df_solar_tabla <- data.frame(
Rango = names(conteo_solar),
ni = as.numeric(conteo_solar),
hi = (as.numeric(conteo_solar) / sum(conteo_solar)) * 100
) %>%
mutate(
Ni = cumsum(ni),
Hi = cumsum(hi)
)
library(gt)
df_solar_tabla %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 1: DISTRIBUCI\u00d3N POR NIVELES DE APTITUD SOLAR**"),
) %>%
cols_label(
Rango = "Intervalo",
ni = "ni", hi = "hi (%)", Ni = "Ni", Hi = "Hi (%)"
) %>%
fmt_number(columns = c(hi, Hi), decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
)| TABLA Nº 1: DISTRIBUCIÓN POR NIVELES DE APTITUD SOLAR | ||||
| Intervalo | ni | hi (%) | Ni | Hi (%) |
|---|---|---|---|---|
| Baja (0-3) | 1446 | 2.45 | 1446 | 2.45 |
| Media (4-6) | 19466 | 33.01 | 20912 | 35.46 |
| Alta (7-9) | 38066 | 64.54 | 58978 | 100.00 |
par(mar = c(5, 5, 4, 2))
barplot(df_solar_tabla$hi,
main = "GR\u00c1FICO N\u00ba 1: PORCENTAJE POR RANGOS DE APTITUD",
ylab = "Porcentaje (%)",
col = c("#B0C4DE", "#B0C4DE", "#B0C4DE"), # Degradado de azul
names.arg = df_solar_tabla$Rango,
las = 1,
cex.names = 0.9,
ylim = c(0, max(df_solar_tabla$hi) + 15))
mtext("Nivel de Aptitud Solar Agrupado", side = 1, line = 3)Se eligió el Modelo Binomial porque se ajusta mejor a la realidad que el geométrico al manejar rangos fijos (nuestras 3 categorías). Esto permitió alcanzar una afinidad del 99%, validando que la alta aptitud solar sigue un patrón estadístico firme y totalmente confiable para el proyecto.
X_indices_solar <- 0:2
n_ensayos <- 2
n_total_solar <- sum(df_solar_tabla$ni)
media_obs_solar <- sum(X_indices_solar * df_solar_tabla$ni) / n_total_solar
prob_p_bin_solar <- media_obs_solar / n_ensayos
P_Binomial_Solar <- dbinom(X_indices_solar, size = n_ensayos, prob = prob_p_bin_solar) * 100
par(mar = c(6, 5, 4, 2))
max_y_solar <- max(max(df_solar_tabla$hi), max(P_Binomial_Solar))
barplot(rbind(df_solar_tabla$hi, P_Binomial_Solar),
beside = TRUE,
main = "GR\u00c1FICO N\u00ba 2: COMPARACI\u00d3N REALIDAD VS MODELO BINOMIAL",
ylab = "Porcentaje (%)",
names.arg = df_solar_tabla$Rango,
col = c("#B0C4DE", "#2E86C1"),
ylim = c(0, max_y_solar + 20),
las = 1,
cex.names = 0.9,
cex.main = 0.85)
legend("topright",
legend = c("Realidad", "Modelo Binomial"),
fill = c("#B0C4DE", "#2E86C1"),
bty = "n",
cex = 0.8)
mtext("Niveles de Aptitud Solar", side = 1, line = 4)X_indices_solar <- 0:2
n_ensayos <- 2
n_total_solar <- sum(df_solar_tabla$ni)
media_obs_solar <- sum(X_indices_solar * df_solar_tabla$ni) / n_total_solar
prob_p_bin_solar <- media_obs_solar / n_ensayos
P_Binomial_Solar <- dbinom(X_indices_solar, size = n_ensayos, prob = prob_p_bin_solar) * 100
Correlacion_Solar_Bin <- cor(df_solar_tabla$hi, P_Binomial_Solar) * 100
Correlacion_Solar_Bin ## [1] 99.79828
Fo_Solar <- df_solar_tabla$hi
Fe_Solar <- P_Binomial_Solar
test_correlacion_solar <- cor.test(Fo_Solar, Fe_Solar)
r_valor_solar <- round(test_correlacion_solar$estimate, 4)
par(mar = c(5, 5, 4, 2))
plot(Fo_Solar, Fe_Solar,
main = "GR\u00c1FICO N\u00ba 3: CORRELACI\u00d3N DEL MODELO BINOMIAL (SOLAR)",
cex.main = 0.85,
xlab = "Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
pch = 19,
col = "#2E4053",
cex = 1.5)
abline(lm(Fe_Solar ~ Fo_Solar), col = "red", lwd = 2)
text(x = min(Fo_Solar), y = max(Fe_Solar),
labels = paste("r =", r_valor_solar),
pos = 4, font = 2, col = "#2E4053")x2_solar <- sum((Fo_Solar - Fe_Solar)^2 / Fe_Solar)
cat("Estad\u00edstico Chi-cuadrado (Binomial):", round(x2_solar, 4), "\n")## Estadístico Chi-cuadrado (Binomial): 0.5517
gl_solar <- length(Fo_Solar) - 1
vc_solar <- qchisq(0.95, gl_solar)
cat("Valor Cr\u00edtico (Tabla):", round(vc_solar, 4), "\n")## Valor Crítico (Tabla): 5.9915
## ¿Se acepta el modelo Binomial? (Calculado < Crítico): TRUE
tabla_resumen_Solar <- data.frame(
Variable = "Aptitud Solar",
Pearson = round(Correlacion_Solar_Bin, 2),
Chi2 = round(x2_solar, 4),
Umbral = round(vc_solar, 2),
Resultado = ifelse(x2_solar < vc_solar, "Modelo Aceptado", "Modelo Rechazado")
)
# 2. GENERACI\u00d3N DE LA TABLA GT
library(gt)
library(dplyr)
tabla_resumen_Solar %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (APTITUD SOLAR)**")
) %>%
cols_label(
Variable = "Variable",
Pearson = "Test Pearson (%)",
Chi2 = "Chi Cuadrado",
Umbral = "Umbral de Aceptaci\u00f3n",
Resultado = "Resultado Final"
) %>%
tab_source_note(
source_note = "Autor: Fernando Neira"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_style(
style = list(cell_text(color = "#1E8449", weight = "bold")),
locations = cells_body(columns = Resultado, rows = Resultado == "Modelo Aceptado")
) %>%
tab_options(
table.width = pct(95),
table.border.top.color = "#2E4053",
table.border.bottom.color = "#2E4053",
column_labels.border.bottom.color = "#2E4053",
data_row.padding = px(10)
)| TABLA Nº 2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (APTITUD SOLAR) | ||||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de Aceptación | Resultado Final |
|---|---|---|---|---|
| Aptitud Solar | 99.8 | 0.5517 | 5.99 | Modelo Aceptado |
| Autor: Fernando Neira | ||||
x_objetivo <- 0
n_modelo <- 2
p_exito <- prob_p_bin_solar #
prob_resultado <- dbinom(x_objetivo, size = n_modelo, prob = p_exito)
prob_porcentaje <- prob_resultado * 100
cat("La probabilidad calculada es:", round(prob_porcentaje, 2), "%\n")## La probabilidad calculada es: 3.59 %
Existe una probabilidad del 65.68% de que cualquier punto elegido al azar sea de Aptitud Alta. Este valor confirma que el proyecto tiene un riesgo bajo, ya que más de la mitad del territorio es optimo para la captación solar.
El éxito del modelo Binomial (\(r=0.99\)) confirma que la Aptitud Solar es predecible y óptima, con una clara mayoría de terrenos en los niveles más altos (7-9). Al aceptarse formalmente el modelo, se concluye que el proyecto es técnicamente viable y presenta un riesgo mínimo para la inversión en generación de energía solar.