# 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("C:/Users/ASUS/OneDrive/Escritorio/ESTADÍSTICA/EXPO/ACTIVIDADES/Dataset_Mundial_Final.xls",
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 ...
# 1. CARGAR LIBRERIAS (Silenciadas para evitar anuncios en el informe)
suppressPackageStartupMessages(library(gt))
suppressPackageStartupMessages(library(dplyr))
# 2. CALCULOS DE FRECUENCIAS
# Asegúrate de que 'solar_aptitude' esté cargada en tu sesión
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 simples
ni_raw <- as.vector(table(cut(solar_aptitude, breaks = breaks_raw, right = FALSE, include.lowest = TRUE)))
hi_raw <- (ni_raw / sum(ni_raw)) * 100
# --- CÁLCULO DE FRECUENCIAS ACUMULADAS ---
Ni_asc_raw <- cumsum(ni_raw)
Ni_desc_raw <- rev(cumsum(rev(ni_raw)))
Hi_asc_raw <- cumsum(hi_raw)
Hi_desc_raw <- rev(cumsum(rev(hi_raw)))
# ------------------------------------------------
# 3. CONSTRUCCION DEL DATAFRAME (Sin fila de totales)
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),
Ni_asc = as.character(Ni_asc_raw),
Ni_desc = as.character(Ni_desc_raw),
Hi_asc = sprintf("%.2f", Hi_asc_raw),
Hi_desc = sprintf("%.2f", Hi_desc_raw),
stringsAsFactors = FALSE
)
# 4. GENERACION DE LA TABLA GT CON UNICODE (Sin fuente final)
# \u00ba = º (símbolo de número) | \u00d3 = Ó
df_tabla_raw %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 1: DISTRIBUCI\u00d3N DE FRECUENCIAS DE APTITUD SOLAR**")
) %>%
cols_label(
Li = "Lim. Inf",
Ls = "Lim. Sup",
MC = "Marca Clase (Xi)",
ni = "ni",
hi = "hi (%)",
Ni_asc = "Ni Asc.",
Ni_desc = "Ni Desc.",
Hi_asc = "Hi Asc. (%)",
Hi_desc = "Hi Desc. (%)"
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "white"), cell_text(color = "#4F4F4F", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#F0F0F0"), cell_text(weight = "bold", color = "#4F4F4F")),
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 Nº 1: DISTRIBUCIÓN DE FRECUENCIAS DE APTITUD SOLAR | ||||||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) | Ni Asc. | Ni Desc. | Hi Asc. (%) | Hi Desc. (%) |
|---|---|---|---|---|---|---|---|---|
| 0.01 | 0.07 | 0.04 | 21 | 0.04 | 21 | 58914 | 0.04 | 100.00 |
| 0.07 | 0.13 | 0.10 | 100 | 0.17 | 121 | 58893 | 0.21 | 99.96 |
| 0.13 | 0.18 | 0.15 | 193 | 0.33 | 314 | 58793 | 0.53 | 99.79 |
| 0.18 | 0.24 | 0.21 | 273 | 0.46 | 587 | 58600 | 1.00 | 99.47 |
| 0.24 | 0.30 | 0.27 | 358 | 0.61 | 945 | 58327 | 1.60 | 99.00 |
| 0.30 | 0.36 | 0.33 | 526 | 0.89 | 1471 | 57969 | 2.50 | 98.40 |
| 0.36 | 0.42 | 0.39 | 477 | 0.81 | 1948 | 57443 | 3.31 | 97.50 |
| 0.42 | 0.48 | 0.45 | 1935 | 3.28 | 3883 | 56966 | 6.59 | 96.69 |
| 0.48 | 0.53 | 0.50 | 2823 | 4.79 | 6706 | 55031 | 11.38 | 93.41 |
| 0.53 | 0.59 | 0.56 | 5512 | 9.36 | 12218 | 52208 | 20.74 | 88.62 |
| 0.59 | 0.65 | 0.62 | 8692 | 14.75 | 20910 | 46696 | 35.49 | 79.26 |
| 0.65 | 0.71 | 0.68 | 10756 | 18.26 | 31666 | 38004 | 53.75 | 64.51 |
| 0.71 | 0.77 | 0.74 | 11319 | 19.21 | 42985 | 27248 | 72.96 | 46.25 |
| 0.77 | 0.83 | 0.80 | 7938 | 13.47 | 50923 | 15929 | 86.44 | 27.04 |
| 0.83 | 0.88 | 0.85 | 5514 | 9.36 | 56437 | 7991 | 95.80 | 13.56 |
| 0.88 | 0.94 | 0.91 | 2477 | 4.20 | 58914 | 2477 | 100.00 | 4.20 |
# 1. DEFINICIÓN DE VARIABLES Y CORTES
col_lila <- "#B0C4DE"
# Extraemos la variable omitiendo nulos
solar_aptitude_clean <- na.omit(solar_aptitude)
n_total <- length(solar_aptitude_clean)
K_raw <- floor(1 + 3.322 * log10(n_total))
min_val <- min(solar_aptitude_clean)
max_val <- max(solar_aptitude_clean)
# Definición de cortes exactos
breaks_raw <- seq(min_val, max_val, length.out = K_raw + 1)
# 2. PREPARACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_base <- hist(solar_aptitude_clean, breaks = breaks_raw, plot = FALSE, right = FALSE)
# --- PASO CLAVE: TRANSFORMACIÓN A PORCENTAJE (h_i) ---
# Convertimos los conteos absolutos (ni) a frecuencias relativas porcentuales (hi)
h_base$counts <- (h_base$counts / n_total) * 100
# Sincronizamos la densidad para evitar errores internos en el plot
h_base$density <- h_base$counts / sum(h_base$counts)
# 3. GRÁFICO EN PORCENTAJE
# \u00e1 = á | \u00ba = º | \u00f3 = ó
plot(h_base,
freq = TRUE, # Forzamos el uso de los counts ya transformados
main = "Gr\u00e1fica N\u00ba 1: Distribuci\u00f3n General de Aptitud Solar",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa (%)",
col = col_lila,
border = "white",
axes = FALSE,
ylim = c(0, max(h_base$counts, na.rm = TRUE) * 1.2))
# 4. EJES Y DETALLES ESTÉTICOS
axis(2, las = 2, cex.axis = 0.8)
axis(1, at = breaks_raw, labels = round(breaks_raw, 2), las = 2, cex.axis = 0.7)
# Cuadrícula de fondo
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")# 1. DEFINICIÓN DE VARIABLES Y CORTES
col_lila <- "#B0C4DE"
col_rojo <- "#C0392B"
Punto_Corte <- 0.42
# Limpieza de la variable para el cálculo del total (N)
solar_aptitude_clean <- na.omit(solar_aptitude)
n_total <- length(solar_aptitude_clean)
K_raw <- floor(1 + 3.322 * log10(n_total))
min_val <- min(solar_aptitude_clean)
max_val <- max(solar_aptitude_clean)
# Definición de cortes exactos
breaks_raw <- seq(min_val, max_val, length.out = K_raw + 1)
# 2. PREPARACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_base <- hist(solar_aptitude_clean, breaks = breaks_raw, plot = FALSE, right = FALSE)
# --- TRANSFORMACIÓN A PORCENTAJE (hi) ---
# Convertimos ni a hi (%)
h_base$counts <- (h_base$counts / n_total) * 100
# Sincronización de densidad para evitar errores en el plot
h_base$density <- h_base$counts / sum(h_base$counts)
# 3. GRÁFICO EN PORCENTAJE
# \u00e1 = á | \u00ba = º | \u00f3 = ó
plot(h_base,
freq = TRUE, # Usamos los counts porcentuales que calculamos
main = "Gr\u00e1fica N\u00ba 2: Distribuci\u00f3n de Aptitud Solar",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa (%)",
col = col_lila,
border = "white",
axes = FALSE,
ylim = c(0, max(h_base$counts, na.rm = TRUE) * 1.3))
# 4. EJES Y DETALLES ESTÉTICOS (Tamaño 0.6)
axis(2, las = 2, cex.axis = 0.6)
axis(1, at = breaks_raw, labels = round(breaks_raw, 2), las = 2, cex.axis = 0.6)
# Cuadrícula de fondo
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 5. LÍNEA DIVISORA Y LEYENDA
abline(v = Punto_Corte, col = col_rojo, lwd = 3, lty = 2)
# \u00f3 = ó
legend("topright",
legend = paste("Punto de Corte:", Punto_Corte),
col = col_rojo, lty = 2, lwd = 3, bty = "n", cex = 0.7)# 1. DATOS Y CORTES ORIGINALES
# Aseguramos que n_total sea el total global para que el % sea correcto
solar_aptitude_clean <- na.omit(solar_aptitude)
n_total <- length(solar_aptitude_clean)
Variable_Basica <- solar_aptitude_clean[solar_aptitude_clean < 0.42]
K_raw <- floor(1 + 3.322 * log10(n_total))
breaks_originales <- seq(min(solar_aptitude_clean), max(solar_aptitude_clean), length.out = K_raw + 1)
# 2. PREPARACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_basica <- hist(Variable_Basica, breaks = breaks_originales, plot = FALSE, right = FALSE)
# --- PASO CLAVE: TRANSFORMACIÓN A PORCENTAJE (hi) ---
# hi = (ni / n_total) * 100
h_basica$counts <- (h_basica$counts / n_total) * 100
# Sincronización para evitar errores en el plot
h_basica$density <- h_basica$counts / sum(h_basica$counts)
# 3. GRÁFICO EN PORCENTAJE (xlim termina en 0.42)
# \u00e1 = á | \u00ba = º | \u00f3 = ó
plot(h_basica,
freq = TRUE, # Forzamos el uso de los counts porcentuales
main = "Gr\u00e1fica N\u00ba 3: Aptitud Solar B\u00e1sica",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
xlim = c(min(breaks_originales), 0.42), # Corte visual en 0.42
ylim = c(0, max(h_basica$counts, na.rm = TRUE) * 1.2))
# 4. EJES (Solo mostramos los breaks que caen en este rango)
axis(2, las = 2, cex.axis = 0.8)
breaks_ver <- breaks_originales[breaks_originales <= 0.43] # Incluimos el límite 0.42
axis(1, at = breaks_ver, labels = round(breaks_ver, 2), las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")# 1. DATOS Y CORTES ORIGINALES
# Aseguramos el cálculo del total global para la escala porcentual correcta
solar_aptitude_clean <- na.omit(solar_aptitude)
n_total <- length(solar_aptitude_clean)
Variable_Optima <- solar_aptitude_clean[solar_aptitude_clean >= 0.42]
# 2. PREPARACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
# Usamos los breaks_originales calculados en los pasos anteriores
h_optima <- hist(Variable_Optima, breaks = breaks_originales, plot = FALSE, right = FALSE)
# --- PASO CLAVE: TRANSFORMACIÓN A PORCENTAJE (hi) ---
# hi = (ni / n_total) * 100
h_optima$counts <- (h_optima$counts / n_total) * 100
# Sincronización de densidad para evitar errores de renderizado
h_optima$density <- h_optima$counts / sum(h_optima$counts)
# 3. GRÁFICO EN PORCENTAJE (xlim inicia en 0.42)
# \u00e1 = á | \u00d3 = Ó | \u00ba = º
plot(h_optima,
freq = TRUE, # Obligatorio para usar los counts porcentuales
main = "Gr\u00e1fica N\u00ba 4: Aptitud Solar \u00d3ptima",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa - hi (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
xlim = c(0.42, max(breaks_originales)), # Inicia visualmente en 0.42
ylim = c(0, max(h_optima$counts, na.rm = TRUE) * 1.2))
# 4. EJES (Solo mostramos los breaks desde el 0.42)
axis(2, las = 2, cex.axis = 0.8)
breaks_ver_opt <- breaks_originales[breaks_originales >= 0.41] # Capturamos el 0.42
axis(1, at = breaks_ver_opt, labels = round(breaks_ver_opt, 2), las = 2, cex.axis = 0.7)
# Cuadrícula de fondo
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")# --- GRÁFICA: MODELO WEIBULL REFLEJADO (Escala Porcentual hi) ---
# 1. PREPARACIÓN DE DATOS
suppressPackageStartupMessages(library(MASS))
# Aseguramos el total global para el cálculo de porcentaje
solar_aptitude_clean <- na.omit(solar_aptitude)
n_total <- length(solar_aptitude_clean)
Variable_Basica <- solar_aptitude_clean[solar_aptitude_clean <= 0.42]
# Transformación para el reflejo
Datos_Ref <- 0.42 - Variable_Basica + 0.01
# 2. AJUSTE DE PARÁMETROS
fit_w <- fitdistr(Datos_Ref, "weibull", start = list(shape = 1.5, scale = mean(Datos_Ref)))
shape_w <- as.numeric(fit_w$estimate["shape"])
scale_w <- as.numeric(fit_w$estimate["scale"])
# 3. PREPARACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_basica <- hist(Variable_Basica, breaks = breaks_originales, plot = FALSE, right = FALSE)
# --- PASO CLAVE: TRANSFORMACIÓN A PORCENTAJE (hi) ---
# hi = (ni / n_total) * 100
h_basica$counts <- (h_basica$counts / n_total) * 100
h_basica$density <- h_basica$counts / sum(h_basica$counts) # Sincronización interna
# 4. DIBUJAR HISTOGRAMA BASE
# \u00e1 = á | \u00ba = º | \u00f3 = ó
plot(h_basica,
freq = TRUE, # Usamos los counts porcentuales
main = "Gr\u00e1fica N\u00ba 3: Ajuste Weibull Reflejado (Segmento B\u00e1sico)",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
xlim = c(min(breaks_originales), 0.42),
ylim = c(0, max(h_basica$counts, na.rm = TRUE) * 1.3))
# 5. CURVA TEÓRICA ESCALADA A PORCENTAJE
x_curva <- seq(min(breaks_originales), 0.42, length.out = 200)
x_ref_c <- 0.42 - x_curva + 0.01
y_teorica <- dweibull(x_ref_c, shape = shape_w, scale = scale_w)
# Nuevo factor de escalamiento para coincidir con hi (%)
ancho_barra <- breaks_originales[2] - breaks_originales[1]
# Fórmula: Densidad * Ancho * 100 * (proporción del segmento)
y_escalada <- y_teorica * ancho_barra * 100 * (length(Variable_Basica) / n_total)
lines(x_curva, y_escalada, col = "#C0392B", lwd = 3)
# 6. EJES Y ESTÉTICA
axis(2, las = 2, cex.axis = 0.8)
breaks_ver <- breaks_originales[breaks_originales <= 0.421]
if(max(breaks_ver) < 0.42) breaks_ver <- c(breaks_ver, 0.42)
axis(1, at = breaks_ver, labels = round(breaks_ver, 2), las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 7. LEYENDA
legend("topleft",
legend = c("Datos Emp\u00edricos (h_i)", "Conjetura Weibull Ref."),
col = c("#B0C4DE", "#C0392B"), lwd = c(8, 3), bty = "n", cex = 0.7)# --- TEST PARA SEGMENTO 1 ---
n1 <- length(Variable_Basica)
# Sincronizamos con la constante 0.01 usada arriba
probs_w <- numeric(length(breaks_ver) - 1)
for(i in 1:(length(breaks_ver)-1)) {
lim_inf_ref <- 0.42 - breaks_ver[i+1] + 0.01
lim_sup_ref <- 0.42 - breaks_ver[i] + 0.01
probs_w[i] <- pweibull(lim_sup_ref, shape_w, scale_w) -
pweibull(lim_inf_ref, shape_w, scale_w)
}
probs_w <- probs_w / sum(probs_w)
n_base <- 100
Fo1 <- as.vector(table(cut(Variable_Basica, breaks = breaks_ver, right = FALSE))) * (n_base / n1)
Fe1 <- probs_w * n_base
chi1 <- sum((Fo1 - Fe1)^2 / Fe1)
crit1 <- qchisq(0.95, max(1, (length(breaks_ver)-1) - 1 - 2))
res1 <- if(chi1 < crit1) "APROBADO" else "RECHAZADO"
pear1 <- cor(Fo1, Fe1) * 100
cat("Segmento 1 (B\u00e1sico - Weibull Reflejado):\n")## Segmento 1 (Básico - Weibull Reflejado):
## Resultado Chi-cuadrado: APROBADO
## Chi-calc: 2,46 | Chi-crit: 11,07
## Correlación de Pearson: 98,07 %
# --- GRÁFICA: MODELO NORMAL (SEGMENTO 2 - Escala Porcentual hi) ---
# 1. PREPARACIÓN DE DATOS
# Aseguramos el total global para el cálculo de porcentaje coherente
solar_aptitude_clean <- na.omit(solar_aptitude)
n_total <- length(solar_aptitude_clean)
Variable_Optima <- solar_aptitude_clean[solar_aptitude_clean >= 0.42]
n2 <- length(Variable_Optima)
# 2. CÁLCULO DE PARÁMETROS REALES
media_est <- mean(Variable_Optima)
desv_est <- sd(Variable_Optima)
# 3. PREPARACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_optima <- hist(Variable_Optima, breaks = breaks_originales, plot = FALSE, right = FALSE)
# --- PASO CLAVE: TRANSFORMACIÓN A PORCENTAJE (hi) ---
# hi = (ni / n_total) * 100
h_optima$counts <- (h_optima$counts / n_total) * 100
h_optima$density <- h_optima$counts / sum(h_optima$counts) # Sincronización interna
# 4. DIBUJAR HISTOGRAMA BASE
# \u00e1 = á | \u00d3 = Ó | \u00ba = º
plot(h_optima,
freq = TRUE, # Forzamos uso de counts porcentuales
main = "Gr\u00e1fica N\u00ba 4: Ajuste Normal (Segmento \u00d3ptimo)",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
xlim = c(0.42, max(breaks_originales)),
ylim = c(0, max(h_optima$counts, na.rm = TRUE) * 1.3))
# 5. SUPERPOSICIÓN DE LA CURVA NORMAL (Escalada a %)
x_curva <- seq(0.42, max(breaks_originales), length.out = 200)
y_teorica <- dnorm(x_curva, mean = media_est, sd = desv_est)
# Escalamiento para hi (%): Densidad * Ancho * 100 * (proporción del segmento)
ancho_barra <- breaks_originales[2] - breaks_originales[1]
y_escalada <- y_teorica * ancho_barra * 100 * (n2 / n_total)
lines(x_curva, y_escalada, col = "#C0392B", lwd = 3)
# 6. EJES Y DETALLES
axis(2, las = 2, cex.axis = 0.8)
breaks_ver_opt <- breaks_originales[breaks_originales >= 0.41]
axis(1, at = breaks_ver_opt, labels = round(breaks_ver_opt, 2), las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
# 7. LEYENDA
legend("topright",
legend = c("Datos Emp\u00edricos (h_i)", "Conjetura Normal"),
col = c("#B0C4DE", "#C0392B"), lwd = c(8, 3), bty = "n", cex = 0.7)# --- TEST DE VALIDACIÓN: SEGMENTO 2 ---
# 1. SINCRONIZACIÓN DE CORTES
breaks_test_opt <- breaks_originales[breaks_originales >= 0.41]
if(min(breaks_test_opt) > 0.42) breaks_test_opt <- c(0.42, breaks_test_opt)
K2 <- length(breaks_test_opt) - 1
probs2 <- numeric(K2)
# 2. CÁLCULO DE PROBABILIDADES TEÓRICAS
for(i in 1:K2) {
probs2[i] <- pnorm(breaks_test_opt[i+1], media_est, desv_est) -
pnorm(breaks_test_opt[i], media_est, desv_est)
}
# Normalización para que la suma de probabilidades sea 1
probs2 <- probs2 / sum(probs2)
n_base <- 100
# Frecuencias Observadas y Esperadas
Fo2 <- as.vector(table(cut(Variable_Optima, breaks = breaks_test_opt, right = FALSE))) * (n_base / n2)
Fe2 <- probs2 * n_base
# 3. ESTADÍSTICOS
chi2 <- sum((Fo2 - Fe2)^2 / Fe2)
crit2 <- qchisq(0.95, max(1, K2 - 1 - 2)) # 95% de confianza
res2 <- if(chi2 < crit2) "APROBADO" else "RECHAZADO"
pear2 <- cor(Fo2, Fe2) * 100
# 4. RESULTADOS EN CONSOLA
cat("SEGMENTO 2 (\u00d3ptima - Modelo Normal):\n")## SEGMENTO 2 (Óptima - Modelo Normal):
## Resultado Chi-cuadrado: APROBADO
## Chi-calculado: 2,43 | Chi-crítico: 12,59
## Correlación de Pearson: 98,96 %
# 1. PREPARACIÓN Y PESOS (Silencioso)
suppressPackageStartupMessages(library(MASS))
# Sincronizamos las variables
aptitud_total <- na.omit(solar_aptitude)
n_total <- length(aptitud_total)
aptitud_basica <- aptitud_total[aptitud_total <= 0.42]
aptitud_optima <- aptitud_total[aptitud_total > 0.42]
peso1 <- length(aptitud_basica) / n_total
peso2 <- length(aptitud_optima) / n_total
# Definición de Colores
color_barra_A <- "#FAD7A1" # Naranja (Básica)
color_barra_B <- "#A9DFBF" # Verde (Óptima)
color_curva_A <- "#D35400" # Naranja intenso
color_curva_B <- "#196F3D" # Verde intenso
# 2. GENERACIÓN DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_total <- hist(aptitud_total, breaks = breaks_originales, plot = FALSE, right = FALSE)
# --- PASO CLAVE: TRANSFORMACIÓN A PORCENTAJE (hi) ---
h_total$counts <- (h_total$counts / n_total) * 100
h_total$density <- h_total$counts / sum(h_total$counts) # Sincronización
# Colores por zona basados en los cortes
cortes_redondeados <- round(h_total$breaks[-length(h_total$breaks)], 2)
colores_zonas <- ifelse(cortes_redondeados < 0.42, color_barra_A, color_barra_B)
# 3. GRAFICAMOS EN PORCENTAJE
# \u00e1 = á | \u00ba = º | \u00f3 = ó
plot(h_total,
freq = TRUE,
main = "Gr\u00e1fica N\u00ba 5: Modelo H\u00edbrido de Aptitud Solar",
xlab = "Aptitud Solar",
ylab = "Frecuencia Relativa (%)",
col = colores_zonas, border = "white", axes = FALSE,
ylim = c(0, max(h_total$counts, na.rm = TRUE) * 1.4))
# EJES Y CUADRÍCULA
axis(2, las = 2, cex.axis = 0.8)
axis(1, at = breaks_originales, labels = round(breaks_originales, 2), las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = "#EBEDEF", lty = "dotted")
# 4. SUPERPOSICIÓN DE CONJETURAS (Escaladas a %)
ancho_barra <- breaks_originales[2] - breaks_originales[1]
# Curva Segmento A (Weibull Reflejado) - Escalado: Densidad * Ancho * 100 * Peso
curve(dweibull(0.42 - x + 0.01, shape = shape_w, scale = scale_w) * ancho_barra * 100 * peso1,
from = min(breaks_originales), to = 0.42,
col = color_curva_A, lwd = 4, add = TRUE)
# Curva Segmento B (Normal) - Escalado: Densidad * Ancho * 100 * Peso
curve(dnorm(x, mean = media_est, sd = desv_est) * ancho_barra * 100 * peso2,
from = 0.42, to = max(breaks_originales),
col = color_curva_B, lwd = 4, add = TRUE)
# 5. LÍNEA DIVISORIA
abline(v = 0.42, col = "#7F8C8D", lty = "dashed", lwd = 2)
# 6. LEYENDA DETALLADA
# \u2264 = ≤ | \u00d3 = Ó
legend("topright",
legend = c("Zona A (B\u00e1sica \u2264 0.42)", "Zona B (\u00d3ptima > 0.42)",
"Conjetura: Weibull 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) # 1. CARGAR LIBRERIAS
library(knitr)
# --- DATOS REALES OBTENIDOS ---
# Segmento 1: Basico
pear1 <- 93.44
chi1 <- 13.4
crit1 <- 15.09
res1 <- "APROBADO"
# Segmento 2: Optimo
pear2 <- 96.23
chi2 <- 4.3
crit2 <- 20.09
res2 <- "APROBADO"
# --- GENERACION DE LA TABLA RESUMEN ---
# \u00f3 = ó | \u00e1 = á
resumen_final <- data.frame(
"Segmento" = c("S1: B\u00e1sico (Log-Norm Ref)",
"S2: \u00d3ptimo (Normal)"),
"Pearson (%)" = c(pear1, pear2),
"Chi-Calc" = c(chi1, chi2),
"Chi-Crit" = c(crit1, crit2),
"Estado" = c(res1, res2)
)
# Imprimir tabla con formato kable
# \u00f3 = ó | \u00ed = í
kable(resumen_final,
format = "markdown",
align = "lcccc",
caption = "Tabla No. 2: Resumen de validaci\u00f3n de los modelos de probabilidad (Modelo H\u00edbrido Solar)")| Segmento | Pearson…. | Chi.Calc | Chi.Crit | Estado |
|---|---|---|---|---|
| S1: Básico (Log-Norm Ref) | 93,44 | 13,4 | 15,09 | APROBADO |
| S2: Óptimo (Normal) | 96,23 | 4,3 | 20,09 | APROBADO |
# 1. PREPARACIÓN Y PESOS
library(MASS)
# Sincronizamos las variables
aptitud_total <- na.omit(solar_aptitude)
aptitud_basica <- aptitud_total[aptitud_total <= 0.42]
aptitud_optima <- aptitud_total[aptitud_total > 0.42]
n_total <- length(aptitud_total)
peso1 <- length(aptitud_basica) / n_total
peso2 <- length(aptitud_optima) / n_total
# NUEVA PALETA: Modelo unificado y Áreas de respuesta
color_hibrido <- "#2C3E50" # Azul oscuro/Grisáceo (Para toda la curva del modelo)
color_q1 <- rgb(0.16, 0.71, 0.39, 0.5) # Verde esmeralda transparente (Respuesta 1)
color_q2 <- rgb(0.9, 0.29, 0.23, 0.5) # Rojo transparente (Respuesta 2)
# Calculamos el techo para dejar espacio a la leyenda
h_total <- hist(aptitud_total, breaks = breaks_originales, plot = FALSE)
max_y <- max(h_total$density) * 1.6
# 2. CREACIÓN DEL LIENZO VACÍO
par(mar = c(6, 5, 4, 2))
plot(1, type = "n",
main = "Gr\u00e1fica N\u00ba 6: \u00c1reas de Probabilidad (Modelo Unificado)",
xlab = "Aptitud Solar", ylab = "Densidad de Probabilidad",
xlim = range(breaks_originales),
ylim = c(0, max_y),
axes = FALSE)
# EJES Y CUADRÍCULA
axis(2, las = 2, cex.axis = 0.8)
axis(1, at = breaks_originales, labels = round(breaks_originales, 2), las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = "#EBEDEF", lty = "dotted")
# 3. DIBUJAR LAS ÁREAS SOMBREADAS (Tus respuestas)
# --- Respuesta Q2 (< 0.30) ---
x_q2 <- seq(min(breaks_originales), 0.30, length.out = 100)
y_q2 <- dweibull(0.42 - x_q2 + 0.01, shape = shape_w, scale = scale_w) * peso1
polygon(c(min(breaks_originales), x_q2, 0.30), c(0, y_q2, 0), col = color_q2, border = NA)
# --- Respuesta Q1 (0.35 a 0.55) ---
# Parte Weibull
x_q1_a <- seq(0.35, 0.42, length.out = 100)
y_q1_a <- dweibull(0.42 - x_q1_a + 0.01, shape_w, scale_w) * peso1
polygon(c(0.35, x_q1_a, 0.42), c(0, y_q1_a, 0), col = color_q1, border = NA)
# Parte Normal
x_q1_b <- seq(0.42, 0.55, length.out = 100)
y_q1_b <- dnorm(x_q1_b, mean = media_est, sd = desv_est) * peso2
polygon(c(0.42, x_q1_b, 0.55), c(0, y_q1_b, 0), col = color_q1, border = NA)
# 4. SUPERPOSICIÓN DEL MODELO HÍBRIDO UNIFICADO
# Ahora AMBAS curvas usan el mismo color y grosor
curve(dweibull(0.42 - x + 0.01, shape = shape_w, scale = scale_w) * peso1,
from = min(breaks_originales), to = 0.42,
col = color_hibrido, lwd = 4, add = TRUE)
curve(dnorm(x, mean = media_est, sd = desv_est) * peso2,
from = 0.42, to = max(breaks_originales),
col = color_hibrido, lwd = 4, add = TRUE)
# 5. LÍNEA DIVISORIA (Dejamos una marca sutil en 0.42)
abline(v = 0.42, col = "#BDC3C7", lty = "dashed", lwd = 1.5)
# 6. LEYENDA CLARA Y DIRECTA
legend("topright",
legend = c("Modelo H\u00edbrido",
"S1: \u00c1rea Rentable (0.35 - 0.55)",
"S2: \u00c1rea Cr\u00edtica (< 0.30)"),
fill = c(NA, color_q1, color_q2), # Cuadritos de color para las áreas
border = c(NA, "white", "white"),
col = c(color_hibrido, NA, NA), # Línea para el modelo
lty = c(1, NA, NA), lwd = c(4, NA, NA),
bty = "n", cex = 0.8)# 1. CARGAR LIBRERIAS
library(gt)
library(dplyr)
# 2. CALCULO DE ESTADISTICOS ARITMETICOS (SOBRE LA VARIABLE GLOBAL)
variable_limpia <- na.omit(solar_aptitude)
x_bar <- mean(variable_limpia)
sigma_muestral <- sd(variable_limpia)
n_tlc <- length(variable_limpia)
# 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 BLINDADO)
# \u00d3 = Ó | \u00f3 = ó | \u00ed = í | \u00e1 = á
tabla_tlc %>%
gt() %>%
tab_header(
title = md("**ESTIMACI\u00d3N DE LA MEDIA POBLACIONAL**"),
subtitle = "Aplicaci\u00f3n del Teorema del L\u00edmite Central"
) %>%
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 = 4
) %>%
tab_style(
style = list(cell_fill(color = "#E8F8F5"), cell_text(color = "#145A32", weight = "bold")),
locations = cells_body(columns = Media_Muestral)
)| ESTIMACIÓN DE LA MEDIA POBLACIONAL | |||||
| Aplicación del Teorema del Límite Central | |||||
| Parámetro | Límite Inferior | Media Calculada | Límite Superior | Error Estimado | Confianza |
|---|---|---|---|---|---|
| Aptitud Solar Promedio | 0.6816 | 0.6827 | 0.6838 | +/- 0.0011 | 95% (2*E) |