ANÁLISIS INFERENCIAL DE APTITUD SOLAR
Modelo Híbrido: Log-Normal Reflejado y Normal
FERNANDO NEIRA
2026-02-20
1 IDENTIFICACIÓN Y JUSTIFICACIÓN DE LA VARIABLE
Aptitud Solar se define como una variable cuantitativa continua, ya que se expresa mediante valores numéricos reales que pueden adoptar cualquier cifra decimal dentro de un intervalo determinado. Esta continuidad permite medir con precisión el nivel de viabilidad para la generación de energía, reflejando el potencial solar exacto de cada ubicación evaluada.
2 CARGA DE DATOS Y LIBRERÍAS
Importamos el archivo “Dataset_Mundial_Final.csv” desde una ruta local y lo almacenamos en el objeto datos, usando comas como separador para estructurar correctamente la información de las columnas.
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(readxl)
# 2. Cargar el archivo y almacenarlo en la variable 'Datos'
# Usamos la ruta que ya validamos en tu equipo
Datos <- read_excel("C:/Users/ASUS/OneDrive/Escritorio/ESTADÍSTICA/EXPO/ACTIVIDADES/Dataset_Mundial_Final.xls",
sheet = "Dataset_Mundial_Final")
# 3. Verificar que se almacenó correctamente
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
4 TABLA DE DISTRIBUCIÓN DE FRECUENCIA
La tabla de distribución de frecuencias correspondiente a la aptitud solar (solar_aptitude) se elaboró aplicando la regla de Sturges para determinar el número óptimo de agrupaciones. Además, el tamaño o ancho de estas clases se definió a partir del recorrido total que presentan los valores en la muestra.
# 1. CARGAR LIBRERIAS
library(gt)
library(dplyr)
# 2. CALCULOS DE FRECUENCIAS (Asegurando que n_total existe)
n_total <- length(solar_aptitude)
K_raw <- floor(1 + 3.322 * log10(n_total))
min_val <- min(solar_aptitude)
max_val <- max(solar_aptitude)
# Definicion de limites
breaks_raw <- seq(min_val, max_val, length.out = K_raw + 1)
lim_inf_raw <- breaks_raw[1:K_raw]
lim_sup_raw <- breaks_raw[2:(K_raw+1)]
MC_raw <- (lim_inf_raw + lim_sup_raw) / 2
# Frecuencias
ni_raw <- as.vector(table(cut(solar_aptitude, breaks = breaks_raw, right = FALSE, include.lowest = TRUE)))
hi_raw <- (ni_raw / sum(ni_raw)) * 100
# 3. CONSTRUCCION DEL DATAFRAME
df_tabla_raw <- data.frame(
Li = sprintf("%.2f", lim_inf_raw),
Ls = sprintf("%.2f", lim_sup_raw),
MC = sprintf("%.2f", MC_raw),
ni = as.character(ni_raw),
hi = sprintf("%.2f", hi_raw),
stringsAsFactors = FALSE
)
# Fila de totales
totales_raw <- c("TOTAL", "-", "-", as.character(sum(ni_raw)), sprintf("%.2f", sum(hi_raw)))
df_final_raw <- rbind(df_tabla_raw, totales_raw)
# 4. GENERACION DE LA TABLA GT (SIN EL ERROR DE CORCHETES)
df_final_raw %>%
gt() %>%
tab_header(
title = md("**TABLA No. 1: DISTRIBUCIÓN DE FRECUENCIAS DE APTITUD SOLAR**")
) %>%
tab_source_note(source_note = "Fuente: Dataset Mundial Final") %>%
cols_label(
Li = "Lim. Inf",
Ls = "Lim. Sup",
MC = "Marca Clase (Xi)",
ni = "ni",
hi = "hi (%)"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "white"), cell_text(color = "#2E4053", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#F0F0F0"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_options(
table.border.top.color = "#D3D3D3",
table.border.bottom.color = "#D3D3D3",
column_labels.border.bottom.color = "#D3D3D3",
data_row.padding = px(6)
)| TABLA No. 1: DISTRIBUCIÓN DE FRECUENCIAS DE APTITUD SOLAR | ||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) |
|---|---|---|---|---|
| 0.01 | 0.07 | 0.04 | 21 | 0.04 |
| 0.07 | 0.13 | 0.10 | 100 | 0.17 |
| 0.13 | 0.18 | 0.15 | 193 | 0.33 |
| 0.18 | 0.24 | 0.21 | 273 | 0.46 |
| 0.24 | 0.30 | 0.27 | 358 | 0.61 |
| 0.30 | 0.36 | 0.33 | 526 | 0.89 |
| 0.36 | 0.42 | 0.39 | 477 | 0.81 |
| 0.42 | 0.48 | 0.45 | 1935 | 3.28 |
| 0.48 | 0.53 | 0.50 | 2823 | 4.79 |
| 0.53 | 0.59 | 0.56 | 5512 | 9.36 |
| 0.59 | 0.65 | 0.62 | 8692 | 14.75 |
| 0.65 | 0.71 | 0.68 | 10756 | 18.26 |
| 0.71 | 0.77 | 0.74 | 11319 | 19.21 |
| 0.77 | 0.83 | 0.80 | 7938 | 13.47 |
| 0.83 | 0.88 | 0.85 | 5514 | 9.36 |
| 0.88 | 0.94 | 0.91 | 2477 | 4.20 |
| TOTAL | - | - | 58914 | 100.00 |
| Fuente: Dataset Mundial Final | ||||
5 ANÁLISIS GRÁFICO
El análisis gráfico se realiza para visualizar de manera clara y rápida cómo se distribuyen los datos de la aptitud solar (solar_aptitude). Esta representación permite identificar de forma intuitiva dónde se concentra la mayor parte de los valores y la forma general de la distribución, complementando la información numérica obtenida en la tabla de frecuencias.
5.1 HISTOGRAMA DE FRECUENCIA
# 1. DEFINICION DE VARIABLES
col_gris <- "#B0C4DE"
# Creacion de cortes usando la regla de Sturges
breaks_general <- pretty(solar_aptitude, n = nclass.Sturges(solar_aptitude))
# 2. PREPARACION DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_base <- hist(solar_aptitude, breaks = breaks_general, plot = FALSE)
# 3. GRAFICO (LIMPIO DE CARACTERES ESPECIALES)
# Cambiamos "Nº" por "No." y "DistribuciOn" por "Distribucion"
plot(h_base,
main = "Gráfica No. 1: Distribución General de Aptitud Solar",
xlab = "Aptitud Solar",
ylab = "Frecuencia Absoluta",
col = col_gris, border = "white", axes = FALSE,
ylim = c(0, max(h_base$counts) * 1.1))
# 4. EJES Y DETALLES ESTÉTICOS
axis(2, las = 2)
axis(1, at = breaks_general, labels = breaks_general, las = 2, cex.axis = 0.8)
# Cuadricula de fondo
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
6 SEGMENTACIÓN
6.1 JUSTIFICACIÓN DE LA SEGMENTACIÓN
Al observar el comportamiento de la distribución general en la gráfica, se evidencia una fluctuación importante en las frecuencias que dificulta el ajuste preciso de un único modelo estadístico para toda la muestra. Por ello, se determinó segmentar operativamente los datos estableciendo un punto de corte exacto en 0.40, lo que permite dividir la información en dos grupos lógicos: uno de aptitud básica a media (valores menores o iguales a 0.40) y otro de aptitud óptima (valores mayores a 0.40). Esta división facilita que las pruebas de bondad de ajuste y los modelos matemáticos posteriores se adapten con mayor exactitud a la dispersión real de cada subconjunto, optimizando el análisis sin distorsionar la naturaleza original de la variable.
# 1. DEFINICION DE VARIABLES Y COLORES
col_gris <- "#B0C4DE"
col_rojo <- "#C0392B"
Punto_Corte <- 0.40
# Creacion de cortes usando la regla de Sturges
breaks_general <- pretty(solar_aptitude, n = nclass.Sturges(solar_aptitude))
# 2. GENERACION DEL HISTOGRAMA BASE
par(mar = c(6, 5, 4, 2))
h_base <- hist(solar_aptitude, breaks = breaks_general, plot = FALSE)
# 3. GRAFICO (SIN ACENTOS NI CARACTERES ESPECIALES)
plot(h_base,
main = "Gráfica No. 2: Distribución General de Aptitud Solar",
xlab = "Aptitud Solar",
ylab = "Frecuencia Absoluta",
col = col_gris, border = "white", axes = FALSE,
ylim = c(0, max(h_base$counts) * 1.1))
# 4. EJES Y CUADRICULA
axis(2, las = 2)
axis(1, at = breaks_general, labels = breaks_general, las = 2, cex.axis = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 5. LINEA DE CORTE Y LEYENDA
abline(v = Punto_Corte, col = col_rojo, lwd = 3, lty = 2)
# Quitamos el acento en "Punto de Corte" para maxima seguridad
legend("topright", legend = paste("Punto de Corte:", Punto_Corte),
col = col_rojo, lty = 2, lwd = 3, bty = "n")
6.2 PRIMER SEGMENTO
# 1. PREPARACION DE DATOS
aptitud_basica <- solar_aptitude[solar_aptitude <= 0.40]
col_sugerido <- "#B0C4DE"
# Creacion de cortes (Sturges)
breaks_basica <- pretty(aptitud_basica, n = nclass.Sturges(aptitud_basica))
# 2. GENERACION DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_basica <- hist(aptitud_basica, breaks = breaks_basica, plot = FALSE)
# Limpiamos el titulo de acentos y simbolos raros
plot(h_basica,
main = "Gráfica No. 3: Distribución de Aptitud Basica (<= 0.40)",
xlab = "Aptitud Solar",
ylab = "Frecuencia Absoluta",
col = col_sugerido, border = "white", axes = FALSE,
ylim = c(0, max(h_basica$counts) * 1.1))
# 3. EJES Y DETALLES
axis(2, las = 2)
axis(1, at = breaks_basica, labels = breaks_basica, las = 2, cex.axis = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
6.3 SEGUNDO SEGMENTO
# 1. PREPARACION DE DATOS
aptitud_optima <- solar_aptitude[solar_aptitude > 0.40]
col_sugerido <- "#B0C4DE"
# Creacion de cortes usando la regla de Sturges
breaks_optima <- pretty(aptitud_optima, n = nclass.Sturges(aptitud_optima))
# 2. GENERACION DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_optima <- hist(aptitud_optima, breaks = breaks_optima, plot = FALSE)
# Limpiamos el titulo y etiquetas de acentos para evitar errores en el knit
plot(h_optima,
main = "Gráfica No. 4: Distribución de Aptitud Optima (> 0.40)",
xlab = "Aptitud Solar",
ylab = "Frecuencia Absoluta",
col = col_sugerido, border = "white", axes = FALSE,
ylim = c(0, max(h_optima$counts) * 1.1))
# 3. EJES Y DETALLES
axis(2, las = 2)
axis(1, at = breaks_optima, labels = breaks_optima, las = 2, cex.axis = 0.8)
# Cuadricula de fondo
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
7 JUSTIFICACIÓN Y ESTRATIFICACIÓN DEL MODELO
Para garantizar la precisión del estudio, se ha estratificado la muestra en dos subconjuntos definidos por el umbral de 0.40. Este procedimiento permite examinar de forma independiente el comportamiento de los datos en cada rango, identificando el modelo teórico que mejor se adapta a la distribución particular de cada grupo. A continuación, se detalla el análisis exhaustivo de cada segmento, donde se evalúan las conjeturas propuestas y se valida su ajuste mediante pruebas estadísticas de bondad de ajuste, asegurando que la inferencia final sea robusta y técnicamente sólida.
7.1 ANÁLISIS DEL PRIMER SEGMENTO
Al observar el histograma, se nota que las barras escalan en altura conforme se acercan al límite de 0.40. Esta pendiente positiva indica una acumulación de datos asimétrica hacia la derecha, lo que visualmente sugiere que el modelo más apto para seguir este ritmo de crecimiento es el Log-Normal Reflejado.
##
## Adjuntando el paquete: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectcol_sugerido <- "#B0C4DE"
breaks_basica <- pretty(aptitud_basica, n = nclass.Sturges(aptitud_basica))
# 2. MODELADO REFLEJADO (SILENCIO TOTAL - SIN CHARACTER(0))
datos_reflejados <- 0.40 - aptitud_basica + 0.001
# Envolvemos en invisible() para que no aparezca el character(0) en el knit
invisible(capture.output(
ajuste_ln_ref <- fitdistr(datos_reflejados, "lognormal")
))
meanlog_ref <- ajuste_ln_ref$estimate["meanlog"]
sdlog_ref <- ajuste_ln_ref$estimate["sdlog"]
# 3. PREPARAR Y DIBUJAR HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_basica <- hist(aptitud_basica, breaks = breaks_basica, plot = FALSE)
plot(h_basica, freq = FALSE,
main = "Gráfica No. 5: Modelo de probabilidad Log-Normal Reflejado",
xlab = "Aptitud Solar", ylab = "Densidad",
col = col_sugerido, border = "white", axes = FALSE,
ylim = c(0, max(h_basica$density) * 1.3))
axis(2, las = 2); axis(1, at = breaks_basica, labels = breaks_basica, las = 2, cex.axis = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 4. SUPERPONER CURVA
curve(dlnorm(0.40 - x + 0.001, meanlog = meanlog_ref, sdlog = sdlog_ref),
from = min(aptitud_basica), to = 0.40,
col = "#C0392B", lwd = 3, add = TRUE)
legend("topleft", legend = c("Datos Reales", "Modelo Log-Normal Reflejado"),
fill = c(col_sugerido, NA), border = c("white", NA),
col = c(NA, "#C0392B"), lty = c(NA, 1), lwd = c(NA, 3), bty = "n")
7.1.1 TEST DE PEARSON Y CHI-CUADRADO
# --- TEST PARA SEGMENTO 1 (Log-Normal Reflejado) ---
n1 <- length(aptitud_basica)
K1 <- length(breaks_basica) - 1
probs1 <- numeric(K1)
# Cálculo de probabilidades teóricas (Lógica Reflejada)
# El límite inferior del intervalo original se convierte en el superior del reflejado
for(i in 1:K1) {
lim_inf_ref <- 0.40 - breaks_basica[i+1] + 0.001
lim_sup_ref <- 0.40 - breaks_basica[i] + 0.001
probs1[i] <- plnorm(lim_sup_ref, meanlog_ref, sdlog_ref) -
plnorm(lim_inf_ref, meanlog_ref, sdlog_ref)
}
# Normalización para asegurar que sumen 1
probs1 <- probs1 / sum(probs1)
n_base <- 100
# Frecuencias Observadas (Fo) y Esperadas (Fe) escaladas a 100
Fo1 <- as.vector(table(cut(aptitud_basica, breaks = breaks_basica))) * (n_base / n1)
Fe1 <- probs1 * n_base
# Cálculo de Chi-cuadrado
chi1 <- sum((Fo1 - Fe1)^2 / Fe1)
# Grados de libertad: K - 1 - 2 (por parámetros: meanlog y sdlog)
# Usamos un nivel de confianza del 99% (0.99)
crit1 <- qchisq(0.99, K1 - 1 - 2)
# Verificación de seguridad para el valor crítico
if(is.na(crit1) | crit1 <= 0) crit1 <- 3.84
# Resultado y correlación de Pearson
res1 <- if(chi1 < crit1) "APROBADO" else "RECHAZADO"
pear1 <- cor(Fo1, Fe1) * 100
# Mostrar resultados en consola
cat("SEGMENTO 1 (Aptitud Básica - Log-Normal Reflejado):\n")## SEGMENTO 1 (Aptitud Básica - Log-Normal Reflejado):## Resultado Chi-cuadrado: APROBADO## Chi-calculado: 13,4 | Chi-crítico: 15,09## Correlación de Pearson: 93,44 %7.2 ANÁLISIS DEL SEGUNDO SEGMENTO
En esta gráfica, las barras presentan una distribución equilibrada, concentrando la mayoría de los datos en el centro y descendiendo suavemente hacia los extremos. Esta simetría en forma de campana permite deducir que el modelo Normal es el que mejor se ajustará para representar la tendencia central de este grupo.
# 1. CARGAR LIBRERIA Y VARIABLES
library(MASS)
col_sugerido <- "#B0C4DE"
breaks_optima <- pretty(aptitud_optima, n = nclass.Sturges(aptitud_optima))
media_est <- mean(aptitud_optima)
desv_est <- sd(aptitud_optima)
# 2. PREPARAR Y DIBUJAR HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_optima <- hist(aptitud_optima, breaks = breaks_optima, plot = FALSE)
plot(h_optima, freq = FALSE,
main = "Gráfica No. 6: Modelo de probabilidad Normal",
xlab = "Aptitud Solar",
ylab = "Densidad",
col = col_sugerido, border = "white", axes = FALSE,
ylim = c(0, max(h_optima$density) * 1.3))
axis(2, las = 2); axis(1, at = breaks_optima, labels = breaks_optima, las = 2, cex.axis = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 3. SUPERPONER CURVA
curve(dnorm(x, mean = media_est, sd = desv_est),
from = min(aptitud_optima), to = max(aptitud_optima),
col = "#E74C3C", lwd = 3, add = TRUE)
legend("topright", legend = c("Datos Reales", "Modelo Normal"),
fill = c(col_sugerido, NA), border = c("white", NA),
col = c(NA, "#E74C3C"), lty = c(NA, 1), lwd = c(NA, 3), bty = "n")
7.2.1 TEST DE PEARSON Y CHI-CUADRADO
# --- TEST PARA SEGMENTO 2 (Normal) ---
n2 <- length(aptitud_optima)
K2 <- length(breaks_optima) - 1
probs2 <- numeric(K2)
# Cálculo de probabilidades teóricas (Normal)
for(i in 1:K2) {
probs2[i] <- pnorm(breaks_optima[i+1], media_est, desv_est) -
pnorm(breaks_optima[i], media_est, desv_est)
}
probs2 <- probs2 / sum(probs2)
# Fo y Fe para el segmento 2
Fo2 <- as.vector(table(cut(aptitud_optima, breaks = breaks_optima))) * (n_base / n2)
Fe2 <- probs2 * n_base
# Chi-cuadrado
chi2 <- sum((Fo2 - Fe2)^2 / Fe2)
crit2 <- qchisq(0.99, K2 - 1 - 2)
if(crit2 <= 0) crit2 <- 3.84
res2 <- if(chi2 < crit2) "APROBADO" else "RECHAZADO"
pear2 <- cor(Fo2, Fe2) * 100
# Mostrar resultados
cat("SEGMENTO 2 (Óptima):\n")## SEGMENTO 2 (Óptima):## Resultado Chi-cuadrado: APROBADO## | Chi-calculado: 4,3 | Crítico: 20,09## Correlación de Pearson: 96,23 %8 MODELO HÍBRIDO
# 1. PREPARACIÓN Y PESOS
library(MASS)
aptitud_total <- c(aptitud_basica, aptitud_optima)
n_total <- length(aptitud_total)
peso1 <- length(aptitud_basica) / n_total
peso2 <- length(aptitud_optima) / n_total
# Definición de Colores (Zonas y Conjeturas)
color_barra_A <- "#AED6F1" # Azul claro (Zona Reflejada)
color_barra_B <- "#A9DFBF" # Verde claro (Zona Normal)
color_curva_A <- "#1B4F72" # Azul oscuro (Conjetura Log-Norm)
color_curva_B <- "#186A3B" # Verde oscuro (Conjetura Normal)
# 2. GENERACIÓN DEL HISTOGRAMA CON ZONAS DE COLOR
par(mar = c(6, 5, 4, 2))
h_total <- hist(aptitud_total,
breaks = pretty(aptitud_total, n = nclass.Sturges(aptitud_total)),
plot = FALSE)
# Creamos un vector de colores para las barras basado en el umbral 0.40
colores_zonas <- ifelse(h_total$breaks[-1] <= 0.40, color_barra_A, color_barra_B)
plot(h_total, freq = FALSE,
main = "Gráfica No. 7: Modelo Híbrido de Probabilidad de Aptitud Solar",
xlab = "Aptitud Solar", ylab = "Densidad",
col = colores_zonas, border = "white", axes = FALSE,
ylim = c(0, max(h_total$density) * 1.4))
axis(2, las = 2); axis(1, at = h_total$breaks, las = 2, cex.axis = 0.8)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 3. SUPERPOSICIÓN DE CONJETURAS (MODELOS)
# Curva Segmento A (Log-Normal Reflejado)
curve(dlnorm(0.40 - x + 0.001, meanlog = meanlog_ref, sdlog = sdlog_ref) * peso1,
from = min(aptitud_basica), to = 0.40,
col = color_curva_A, lwd = 4, add = TRUE)
# Curva Segmento B (Normal)
curve(dnorm(x, mean = media_est, sd = desv_est) * peso2,
from = 0.40, to = max(aptitud_optima),
col = color_curva_B, lwd = 4, add = TRUE)
# 4. LÍNEA DIVISORIA
abline(v = 0.40, col = "black", lty = "dashed", lwd = 2)
# 5. LEYENDA DETALLADA
legend("topright",
legend = c("Zona A (Aptitud <= 0.40)", "Zona B (Aptitud > 0.40)",
"Conjetura: Log-Normal Ref.", "Conjetura: Normal"),
fill = c(color_barra_A, color_barra_B, NA, NA),
border = c("white", "white", NA, NA),
col = c(NA, NA, color_curva_A, color_curva_B),
lty = c(NA, NA, 1, 1), lwd = c(NA, NA, 4, 4),
bty = "n", cex = 0.7)
9 TABLA DE RESUMEN DE BONDAD DE AJUSTE
# 1. CARGAR LIBRERIAS
library(MASS)
library(knitr)
# --- CALCULOS PARA LA TABLA (Segmento 1) ---
n1 <- length(aptitud_basica)
K1 <- length(breaks_basica) - 1
probs1 <- numeric(K1)
for(i in 1:K1) {
lim_inf_ref <- 0.40 - breaks_basica[i+1] + 0.001
lim_sup_ref <- 0.40 - breaks_basica[i] + 0.001
probs1[i] <- plnorm(lim_sup_ref, meanlog_ref, sdlog_ref) -
plnorm(lim_inf_ref, meanlog_ref, sdlog_ref)
}
probs1 <- probs1 / sum(probs1)
n_base <- 100
Fo1 <- as.vector(table(cut(aptitud_basica, breaks = breaks_basica))) * (n_base / n1)
Fe1 <- probs1 * n_base
chi1 <- sum((Fo1 - Fe1)^2 / Fe1)
crit1 <- qchisq(0.99, K1 - 1 - 2)
if(is.na(crit1) | crit1 <= 0) crit1 <- 3.84
res1 <- if(chi1 < crit1) "APROBADO" else "RECHAZADO"
pear1 <- cor(Fo1, Fe1) * 100
# --- CALCULOS PARA LA TABLA (Segmento 2) ---
n2 <- length(aptitud_optima)
K2 <- length(breaks_optima) - 1
probs2 <- numeric(K2)
for(i in 1:K2) {
probs2[i] <- pnorm(breaks_optima[i+1], media_est, desv_est) -
pnorm(breaks_optima[i], media_est, desv_est)
}
probs2 <- probs2 / sum(probs2)
Fo2 <- as.vector(table(cut(aptitud_optima, breaks = breaks_optima))) * (n_base / n2)
Fe2 <- probs2 * n_base
chi2 <- sum((Fo2 - Fe2)^2 / Fe2)
crit2 <- qchisq(0.99, K2 - 1 - 2)
if(is.na(crit2) | crit2 <= 0) crit2 <- 3.84
res2 <- if(chi2 < crit2) "APROBADO" else "RECHAZADO"
pear2 <- cor(Fo2, Fe2) * 100
# --- GENERACION DE LA TABLA RESUMEN ---
resumen_final <- data.frame(
"Segmento" = c("Basico (Log-Norm Ref)", "Optimo (Normal)"),
"Pearson (%)" = c(round(pear1, 2), round(pear2, 2)),
"Chi-Calc" = c(round(chi1, 2), round(chi2, 2)),
"Chi-Crit" = c(round(crit1, 2), round(crit2, 2)),
"Estado" = c(res1, res2)
)
kable(resumen_final,
format = "markdown",
align = "lcccc",
caption = "Tabla No. 2: Resumen de validacion de los modelos de probabilidad")| Segmento | Pearson…. | Chi.Calc | Chi.Crit | Estado |
|---|---|---|---|---|
| Basico (Log-Norm Ref) | 93,44 | 13,4 | 15,09 | APROBADO |
| Optimo (Normal) | 96,23 | 4,3 | 20,09 | APROBADO |
10 CÁLCULO DE PROBABILIDADES
Habiendo validado que el comportamiento de la aptitud solar se ajusta a un modelo híbrido estratificado, procedemos a proyectar escenarios operativos para la implementación de parques solares:
\(Pregunta\) \(1\) (\(Probabilidad\) \(de\) \(Éxito\)): Ante la evaluación de un nuevo emplazamiento, ¿cuál es la probabilidad de que este se encuentre en la “Zona de Rendimiento Estándar” (\(entre\) \(0.35\) \(y\) \(0.55\)), donde la infraestructura técnica alcanza su mayor eficiencia?
\(Pregunta\) \(2\) (\(Estimación\) \(de\) \(Recursos\)): Si se planifica la instalación de \(100\) nuevos sensores de medición el próximo año, ¿cuántos de estos se estima que detectarán una “Aptitud Básica” (\(menor\) \(a\) \(0.30\)), requiriendo equipos de mayor sensibilidad?
# --- 3. GENERACION DE LA GRAFICA (TOTALMENTE AUTOSUFICIENTE) ---
# 1. DEFINIR LOS VALORES QUE DABAN ERROR (x1, x2, limites)
x1 <- 0.35
x2 <- 0.55
limite_basico <- 0.30
# 2. CALCULAR EL PORCENTAJE PARA LA LEYENDA (Para que pct_ventana no de error)
p_v1 <- plnorm(0.40 - 0.35 + 0.001, meanlog_ref, sdlog_ref) - plnorm(0.40 - 0.40 + 0.001, meanlog_ref, sdlog_ref)
p_v2 <- pnorm(0.55, media_est, desv_est) - pnorm(0.40, media_est, desv_est)
pct_ventana <- round((p_v1 + p_v2) * 100, 2)
# 3. DEFINIR COLORES
col_ejes <- "#2E4053"
col_rojo <- "#C0392B"
col_azul_claro <- rgb(0.2, 0.6, 0.8, 0.5)
# 4. DEFINIR LA FUNCIÓN HIBRIDA
f_hibrida <- function(x) {
ifelse(x <= 0.40,
dlnorm(0.40 - x + 0.001, meanlog_ref, sdlog_ref) * peso1,
dnorm(x, mean = media_est, sd = desv_est) * peso2)
}
# 5. AJUSTES DE MARGEN Y ESPACIO
par(mar = c(5, 5, 4, 2))
y_max <- max(f_hibrida(seq(min(aptitud_total), max(aptitud_total), length.out=500)))
# 6. DIBUJAR LA CURVA (Con ylim ajustado para que la leyenda no estorbe)
curve(f_hibrida, from = min(aptitud_total), to = max(aptitud_total),
main = "Gráfica No. 8: Proyección de Riesgo y Operatividad (Híbrido)",
xlab = "Indice de Aptitud Solar", ylab = "Densidad de Probabilidad",
col = col_ejes, lwd = 3, n = 500,
ylim = c(0, y_max * 1.6))
# 7. SOMBREADO DE LA VENTANA (Usando x1 y x2 definidos arriba)
x_fill <- seq(x1, x2, length.out = 200)
y_fill <- f_hibrida(x_fill)
polygon(c(x1, x_fill, x2), c(0, y_fill, 0), col = col_azul_claro, border = NA)
# 8. LINEA DE LIMITE CRITICO (Usando limite_basico definido arriba)
abline(v = limite_basico, col = col_rojo, lwd = 3, lty = 2)
# 9. LEYENDA COMPACTA (cex = 0.55 para que sea pequeñita)
legend("topright",
legend = c("Modelo Hibrido Validado",
paste0("Ventana (", pct_ventana, "%)"),
paste0("Limite (< ", limite_basico, ")")),
col = c(col_ejes, col_azul_claro, col_rojo),
lwd = c(2, 6, 2),
lty = c(1, 1, 2),
pch = c(NA, 15, NA),
bty = "n",
cex = 0.55,
y.intersp = 0.7)
grid(col = "#D7DBDD", lty = "dotted")
\(Respuesta\) \(1\): Utilizando el modelo híbrido estratificado, se determinó que existe una probabilidad del \(41.09\) % de que cualquier nuevo punto de captación evaluado se encuentre dentro de la “Ventana de Eficiencia Estándar” (\(0.35\) - \(0.55\)). Este valor actúa como un indicador de viabilidad técnica, sugiriendo que una porción significativa del área de estudio posee condiciones de radiación estables para la infraestructura convencional.
\(Respuesta\) \(2\): Para la futura campaña de instalación de 100 sensores, se estima estadísticamente que \(43\) unidades presentarán características de “Aptitud Básica” (\(menores\) \(a\) \(0.30\)). Esto implica que aproximadamente el \(43.06\) % del presupuesto de adquisición de equipos deberá asignarse a sensores de alta sensibilidad (high-spec sensors), optimizados para registrar niveles bajos de radiación con precisión.
11 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}}\]
# 1. CARGAR LIBRERIAS
library(gt)
library(dplyr)
# 2. CALCULO DE ESTADISTICOS ARITMETICOS (SOBRE LA VARIABLE GLOBAL)
x_bar <- mean(solar_aptitude)
sigma_muestral <- sd(solar_aptitude)
n_tlc <- length(solar_aptitude)
# 3. CALCULO DEL ERROR ESTANDAR Y MARGEN AL 95%
error_est <- sigma_muestral / sqrt(n_tlc)
margen_error_95 <- 2 * error_est
# 4. INTERVALO DE CONFIANZA
lim_inf_tlc <- x_bar - margen_error_95
lim_sup_tlc <- x_bar + margen_error_95
# 5. CONSTRUCCION DE LA TABLA RESUMEN
tabla_tlc <- data.frame(
Parametro = "Aptitud Solar Promedio",
Lim_Inferior = lim_inf_tlc,
Media_Muestral = x_bar,
Lim_Superior = lim_sup_tlc,
Error_Estandar = paste0("+/- ", sprintf("%.4f", margen_error_95)),
Confianza = "95% (2*E)"
)
# 6. GENERACION DE LA TABLA VISUAL (ESTILO PROFESIONAL)
tabla_tlc %>%
gt() %>%
tab_header(
title = md("**ESTIMACION DE LA MEDIA POBLACIONAL**"),
subtitle = "Aplicacion del Teorema del Limite Central"
) %>%
cols_label(
Parametro = "Parametro",
Lim_Inferior = "Limite Inferior",
Media_Muestral = "Media Calculada",
Lim_Superior = "Limite Superior",
Error_Estandar = "Error Estimado"
) %>%
fmt_number(
columns = c(Lim_Inferior, Media_Muestral, Lim_Superior),
decimals = 4
) %>%
tab_style(
style = list(cell_fill(color = "#E8F8F5"), cell_text(color = "#145A32", weight = "bold")),
locations = cells_body(columns = Media_Muestral)
)| ESTIMACION DE LA MEDIA POBLACIONAL | |||||
| Aplicacion del Teorema del Limite Central | |||||
| Parametro | Limite Inferior | Media Calculada | Limite Superior | Error Estimado | Confianza |
|---|---|---|---|---|---|
| Aptitud Solar Promedio | 0.6816 | 0.6827 | 0.6838 | +/- 0.0011 | 95% (2*E) |