# 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)
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
# 2. PREPARACIÓN DE LA VARIABLE GLOBAL
curvatura_global <- na.omit(Datos$curvature)
n_total <- length(curvatura_global)
# 3. CÁLCULO DE INTERVALOS (Sturges)
K_curv <- floor(1 + 3.322 * log10(n_total))
min_abs <- min(curvatura_global)
max_abs <- max(curvatura_global)
# Definición de límites
breaks_curv <- seq(min_abs, max_abs, length.out = K_curv + 1)
lim_inf_c <- breaks_curv[1:K_curv]
lim_sup_c <- breaks_curv[2:(K_curv+1)]
MC_c <- (lim_inf_c + lim_sup_c) / 2
# Frecuencias simples
ni_c <- as.vector(table(cut(curvatura_global, breaks = breaks_curv, right = FALSE, include.lowest = TRUE)))
hi_c <- (ni_c / n_total) * 100
# Frecuencias acumuladas
Ni_asc_c <- cumsum(ni_c)
Ni_desc_c <- rev(cumsum(rev(ni_c)))
Hi_asc_c <- cumsum(hi_c)
Hi_desc_c <- rev(cumsum(rev(hi_c)))
# 4. CONSTRUCCIÓN DEL DATAFRAME COMPLETO
df_temp <- data.frame(
Li = lim_inf_c,
Ls = lim_sup_c,
MC = MC_c,
ni = ni_c,
hi = hi_c,
Ni_asc = Ni_asc_c,
Ni_desc = Ni_desc_c,
Hi_asc = Hi_asc_c,
Hi_desc = Hi_desc_c
)
# --- PASO CLAVE: FILTRAR FILAS VACÍAS EN LOS EXTREMOS ---
# Elimina repeticiones de 100% y filas en cero para mayor coherencia
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 (ESTILO NEUTRO)
df_tabla_final %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 1: DISTRIBUCI\u00d3N DE FRECUENCIAS DE CURVATURA**"),
) %>%
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. (%)"
) %>%
fmt_number(columns = c(Li, Ls, MC), decimals = 4) %>%
fmt_number(columns = c(hi, Hi_asc, Hi_desc), decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
# Estética Neutra y Académica
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 CURVATURA | ||||||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) | Ni Asc. | Ni Desc. | Hi Asc. (%) | Hi Desc. (%) |
|---|---|---|---|---|---|---|---|---|
| −0.1730 | −0.1453 | −0.1592 | 3 | 0.01 | 3 | 58978 | 0.01 | 100.00 |
| −0.1453 | −0.1176 | −0.1315 | 9 | 0.02 | 12 | 58975 | 0.02 | 99.99 |
| −0.1176 | −0.0899 | −0.1038 | 47 | 0.08 | 59 | 58966 | 0.10 | 99.98 |
| −0.0899 | −0.0622 | −0.0761 | 194 | 0.33 | 253 | 58919 | 0.43 | 99.90 |
| −0.0622 | −0.0346 | −0.0484 | 914 | 1.55 | 1167 | 58725 | 1.98 | 99.57 |
| −0.0346 | −0.0069 | −0.0207 | 7952 | 13.48 | 9119 | 57811 | 15.46 | 98.02 |
| −0.0069 | 0.0208 | 0.0070 | 47601 | 80.71 | 56720 | 49859 | 96.17 | 84.54 |
| 0.0208 | 0.0485 | 0.0347 | 1672 | 2.83 | 58392 | 2258 | 99.01 | 3.83 |
| 0.0485 | 0.0762 | 0.0623 | 409 | 0.69 | 58801 | 586 | 99.70 | 0.99 |
| 0.0762 | 0.1039 | 0.0900 | 123 | 0.21 | 58924 | 177 | 99.91 | 0.30 |
| 0.1039 | 0.1316 | 0.1177 | 41 | 0.07 | 58965 | 54 | 99.98 | 0.09 |
| 0.1316 | 0.1593 | 0.1454 | 11 | 0.02 | 58976 | 13 | 100.00 | 0.02 |
| 0.1593 | 0.1869 | 0.1731 | 1 | 0.00 | 58977 | 2 | 100.00 | 0.00 |
| 0.1869 | 0.2146 | 0.2008 | 0 | 0.00 | 58977 | 1 | 100.00 | 0.00 |
| 0.2146 | 0.2423 | 0.2285 | 0 | 0.00 | 58977 | 1 | 100.00 | 0.00 |
| 0.2423 | 0.2700 | 0.2562 | 1 | 0.00 | 58978 | 1 | 100.00 | 0.00 |
# 1. CARGAR LIBRERIAS
suppressPackageStartupMessages(library(gt))
suppressPackageStartupMessages(library(dplyr))
# 2. FILTRADO Y CÁLCULOS PARA EL SEGMENTO (-0.035 a 0.049)
# Filtramos la variable curvatura para el rango de mayor acumulación
curv_segmento <- na.omit(Datos$curvature[Datos$curvature >= -0.035 & Datos$curvature <= 0.049])
n_seg <- length(curv_segmento)
K_seg <- floor(1 + 3.322 * log10(n_seg)) # Regla de Sturges aplicada al segmento
# Definición de límites exactos
breaks_seg <- seq(-0.035, 0.049, length.out = K_seg + 1)
lim_inf_s <- breaks_seg[1:K_seg]
lim_sup_s <- breaks_seg[2:(K_seg+1)]
MC_s <- (lim_inf_s + lim_sup_s) / 2
# Frecuencias simples
ni_s <- as.vector(table(cut(curv_segmento, breaks = breaks_seg, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / sum(ni_s)) * 100
# Frecuencias acumuladas
Ni_asc_s <- cumsum(ni_s)
Ni_desc_s <- rev(cumsum(rev(ni_s)))
Hi_asc_s <- cumsum(hi_s)
Hi_desc_s <- rev(cumsum(rev(hi_s)))
# 3. CONSTRUCCION DEL DATAFRAME
df_tabla_seg <- data.frame(
Li = sprintf("%.3f", lim_inf_s),
Ls = sprintf("%.3f", lim_sup_s),
MC = sprintf("%.3f", MC_s),
ni = as.character(ni_s),
hi = sprintf("%.2f", hi_s),
Ni_asc = as.character(Ni_asc_s),
Ni_desc = as.character(Ni_desc_s),
Hi_asc = sprintf("%.2f", Hi_asc_s),
Hi_desc = sprintf("%.2f", Hi_desc_s),
stringsAsFactors = FALSE
)
# 4. GENERACION DE LA TABLA GT (Mismo estilo que Tabla 1)
# \u00ba = º | \u00d3 = Ó | \u00cd = Í
df_tabla_seg %>%
gt() %>%
tab_header(
title = md("**TABLA N\u00ba 2: DISTRIBUCI\u00d3N DE FRECUENCIAS DE CURVATURA**"),
) %>%
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()) %>%
# Estilos visuales idénticos a la Tabla 1
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.width = pct(100), # Forzar el ancho completo para que no se vea pequeña
table.border.top.color = "#D3D3D3",
table.border.bottom.color = "#D3D3D3",
column_labels.border.bottom.color = "#D3D3D3",
data_row.padding = px(6) # Mismo espaciado interno que la Tabla 1
)| TABLA Nº 2: DISTRIBUCIÓN DE FRECUENCIAS DE CURVATURA | ||||||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) | Ni Asc. | Ni Desc. | Hi Asc. (%) | Hi Desc. (%) |
|---|---|---|---|---|---|---|---|---|
| -0.035 | -0.030 | -0.032 | 490 | 0.85 | 490 | 57348 | 0.85 | 100.00 |
| -0.030 | -0.024 | -0.027 | 570 | 0.99 | 1060 | 56858 | 1.85 | 99.15 |
| -0.024 | -0.019 | -0.022 | 844 | 1.47 | 1904 | 56288 | 3.32 | 98.15 |
| -0.019 | -0.014 | -0.017 | 1324 | 2.31 | 3228 | 55444 | 5.63 | 96.68 |
| -0.014 | -0.009 | -0.011 | 3119 | 5.44 | 6347 | 54120 | 11.07 | 94.37 |
| -0.009 | -0.004 | -0.006 | 6303 | 10.99 | 12650 | 51001 | 22.06 | 88.93 |
| -0.004 | 0.002 | -0.001 | 28845 | 50.30 | 41495 | 44698 | 72.36 | 77.94 |
| 0.002 | 0.007 | 0.004 | 9338 | 16.28 | 50833 | 15853 | 88.64 | 27.64 |
| 0.007 | 0.012 | 0.010 | 3169 | 5.53 | 54002 | 6515 | 94.17 | 11.36 |
| 0.012 | 0.018 | 0.015 | 1204 | 2.10 | 55206 | 3346 | 96.26 | 5.83 |
| 0.018 | 0.023 | 0.020 | 742 | 1.29 | 55948 | 2142 | 97.56 | 3.74 |
| 0.023 | 0.028 | 0.025 | 443 | 0.77 | 56391 | 1400 | 98.33 | 2.44 |
| 0.028 | 0.033 | 0.031 | 421 | 0.73 | 56812 | 957 | 99.07 | 1.67 |
| 0.033 | 0.039 | 0.036 | 224 | 0.39 | 57036 | 536 | 99.46 | 0.93 |
| 0.039 | 0.044 | 0.041 | 159 | 0.28 | 57195 | 312 | 99.73 | 0.54 |
| 0.044 | 0.049 | 0.046 | 153 | 0.27 | 57348 | 153 | 100.00 | 0.27 |
# 1. PREPARACIÓN DE LOS DATOS Y FILTRADO
# Filtramos la variable curvatura para el rango de mayor acumulación
curv_completa <- na.omit(Datos$curvature)
n_total_global <- length(curv_completa)
# Definimos el segmento de interés
curv_segmento <- curv_completa[curv_completa >= -0.035 & curv_completa <= 0.049]
n_seg <- length(curv_segmento)
# 2. CÁLCULO DE INTERVALOS (Regla de Sturges aplicada al segmento)
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(-0.035, 0.049, length.out = K_sturges + 1)
# 3. CREACIÓN Y ESCALADO DEL HISTOGRAMA
par(mar = c(6, 5, 4, 2))
h_curv_seg <- hist(curv_segmento, breaks = cortes_seg, plot = FALSE, right = FALSE)
# hi = (ni / n_total_global) * 100 -> Porcentaje respecto al total mundial
h_curv_seg$counts <- (h_curv_seg$counts / n_total_global) * 100
# 4. DIBUJAR LA GRÁFICA (Solo Histograma)
# \u00ba = º | \u00f3 = ó
plot(h_curv_seg,
main = "Gr\u00e1fica N\u00ba 1: Distribuci\u00f3n de Frecuencias en Zona de Acumulaci\u00f3n",
xlab = "Curvatura del Terreno",
ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE",
border = "white",
axes = FALSE,
ylim = c(0, max(h_curv_seg$counts) * 1.2))
# 5. EJES Y DISEÑO PROFESIONAL
axis(2, las = 2, cex.axis = 0.7)
# Eje X con 3 decimales exactos para los cortes de Sturges
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.6)
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)# ==========================================================
# BLOQUE 1: AJUSTE DEL MODELO t-STUDENT (GRÁFICA)
# ==========================================================
suppressPackageStartupMessages(library(MASS))
# 1. Preparación y Filtrado
curv_completa <- na.omit(Datos$curvature)
n_total_global <- length(curv_completa)
curv_segmento <- curv_completa[curv_completa >= -0.035 & curv_completa <= 0.049]
n_seg <- length(curv_segmento)
# 2. Ajuste de la Conjetura (Silenciando NaNs de cálculo interno)
ajuste_t <- suppressWarnings(
fitdistr(curv_segmento, "t",
start = list(m = mean(curv_segmento), s = sd(curv_segmento), df = 5))
)
m_t <- ajuste_t$estimate["m"]
s_t <- ajuste_t$estimate["s"]
df_t <- ajuste_t$estimate["df"]
# 3. Preparación del Histograma (Regla de Sturges)
K_sturges <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(-0.035, 0.049, length.out = K_sturges + 1)
par(mar = c(6, 5, 4, 2))
h_curv_seg <- hist(curv_segmento, breaks = cortes_seg, plot = FALSE, right = FALSE)
# Transformación a Frecuencia Relativa hi (%)
h_curv_seg$counts <- (h_curv_seg$counts / n_total_global) * 100
# 4. Dibujar Gráfica
plot(h_curv_seg,
main = "Gr\u00e1fica N\u00ba 2: Distribuci\u00f3n de Frecuencias en Zona de Acumulaci\u00f3n",
xlab = "Curvatura del Terreno",
ylab = "Frecuencia Relativa (%)",
col = "#B0C4DE", border = "white", axes = FALSE,
ylim = c(0, max(h_curv_seg$counts) * 1.3))
# 5. Línea de la Conjetura t-Student (Roja)
x_curva <- seq(-0.035, 0.049, length.out = 300)
y_densidad <- (1/s_t) * dt((x_curva - m_t)/s_t, df = df_t)
ancho_barra <- cortes_seg[2] - cortes_seg[1]
y_curva_hi <- y_densidad * ancho_barra * 100 * (n_seg / n_total_global)
lines(x_curva, y_curva_hi, col = "#C0392B", lwd = 4)
# 6. Ejes y Estética
axis(2, las = 2, cex.axis = 0.7)
axis(1, at = cortes_seg, labels = sprintf("%.3f", cortes_seg), las = 2, cex.axis = 0.6)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
legend("topright",
legend = c("Datos Emp\u00edricos", "Conjetura t-Student"),
col = c("#B0C4DE", "#C0392B"), lwd = c(8, 4), bty = "n", cex = 0.8)# ==========================================================
# BLOQUE 2: TEST DE VALIDACIÓN (PEARSON Y CHI-CUADRADO)
# ==========================================================
# 1. Cálculo de Probabilidades Teóricas (t-Student)
K_val <- length(cortes_seg) - 1
probs_t <- numeric(K_val)
for(i in 1:K_val) {
probs_t[i] <- pt((cortes_seg[i+1] - m_t)/s_t, df = df_t) -
pt((cortes_seg[i] - m_t)/s_t, df = df_t)
}
# Normalización para base 100 (Sincronía con otros segmentos)
probs_t <- probs_t / sum(probs_t)
n_base <- 100
# Frecuencias Observadas vs Esperadas
Fo_c <- as.vector(table(cut(curv_segmento, breaks = cortes_seg, right = FALSE))) * (n_base / n_seg)
Fe_c <- probs_t * n_base
# 2. Estadísticos de Prueba
# Chi-cuadrado
chi_calc <- sum((Fo_c - Fe_c)^2 / Fe_c)
chi_crit <- qchisq(0.99, max(1, K_val - 1 - 3)) # Grados de Libertad (K - 1 - parámetros)
# Decisión
resultado_chi <- if(chi_calc < chi_crit) "APROBADO" else "RECHAZADO"
# Correlación de Pearson
pearson_val <- cor(Fo_c, Fe_c) * 100
# 3. Salida de Resultados
cat("\n--- RESULTADOS DE VALIDACI\u00d3N CURVATURA ---\n")##
## --- RESULTADOS DE VALIDACIÓN CURVATURA ---
## Modelo: t-Student | Rango: -0.035 a 0.049
## Prueba Chi-cuadrado: APROBADO
## Chi-calculado: 5,08 | Chi-crítico: 26,22
## Correlación de Pearson: 99,61 %
# 1. CARGAR LIBRERIAS
library(knitr)
suppressPackageStartupMessages(library(MASS))
# 2. CÁLCULOS TÉCNICOS (Para obtener los valores reales de la tabla)
curv_seg <- na.omit(Datos$curvature[Datos$curvature >= -0.035 & Datos$curvature <= 0.049])
n_seg <- length(curv_seg)
# Ajuste t-Student
ajuste_t <- suppressWarnings(
fitdistr(curv_seg, "t", start = list(m = mean(curv_seg), s = sd(curv_seg), df = 5))
)
m_t <- ajuste_t$estimate["m"]; s_t <- ajuste_t$estimate["s"]; df_t <- ajuste_t$estimate["df"]
# Intervalos y Frecuencias
K_val <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(-0.035, 0.049, length.out = K_val + 1)
# Probabilidades y Frecuencias base 100
probs_t <- numeric(K_val)
for(i in 1:K_val) {
probs_t[i] <- pt((cortes_seg[i+1] - m_t)/s_t, df = df_t) - pt((cortes_seg[i] - m_t)/s_t, df = df_t)
}
probs_t <- probs_t / sum(probs_t)
Fo_c <- as.vector(table(cut(curv_seg, breaks = cortes_seg, right = FALSE))) * (100 / n_seg)
Fe_c <- probs_t * 100
# Estadísticos finales
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 - 3))
res_c <- if(chi_c < crit_c) "APROBADO" else "RECHAZADO"
# 3. GENERACIÓN DE LA TABLA RESUMEN
# \u00f3 = ó | \u00ed = í
resumen_curvatura <- data.frame(
"Segmento" = "Zona de Acumulaci\u00f3n (-0.035 a 0.049)",
"Modelo" = "t-Student",
"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_curvatura,
format = "markdown",
align = "llcccc",
caption = "Tabla No. 3: Resumen de validaci\u00f3n del modelo de probabilidad (Variable Curvatura)")| Segmento | Modelo | Pearson…. | Chi.Calc | Chi.Crit | Estado |
|---|---|---|---|---|---|
| Zona de Acumulación (-0.035 a 0.049) | t-Student | 99,61 | 5,08 | 26,22 | APROBADO |
# ==========================================================
# BLOQUE: GRÁFICA DE RESPUESTA (INTERVALOS CENTRALES)
# ==========================================================
# 1. Definición del eje X y la curva (usando tus parámetros del Bloque 1)
x_curva <- seq(-0.035, 0.049, length.out = 1000)
y_densidad <- (1/s_t) * dt((x_curva - m_t)/s_t, df = df_t)
# 2. Configuración del área de dibujo
par(mar = c(6, 5, 4, 2))
plot(x_curva, y_densidad, type = "n",
main = "Gr\u00e1fica N\u00ba 3: An\u00e1lisis Probabil\u00edstico de Curvatura Terrestre",
xlab = "Curvatura",
ylab = "Densidad de Probabilidad",
axes = FALSE, ylim = c(0, max(y_densidad) * 1.1))
# 3. SOMBREADO PREGUNTA 2: Tolerancia Est\u00e1ndar (-0.015 a 0.025)
# Sombreamos primero el área más ancha (azul claro)
x_p2 <- seq(-0.015, 0.025, length.out = 300)
y_p2 <- (1/s_t) * dt((x_p2 - m_t)/s_t, df = df_t)
polygon(c(-0.015, x_p2, 0.025), c(0, y_p2, 0),
col = rgb(46, 134, 193, alpha = 80, maxColorValue = 255), border = NA)
# 4. SOMBREADO PREGUNTA 1: Estabilidad M\u00e1xima (-0.005 a 0.015)
# Sombreamos el área más estrecha y central (verde)
x_p1 <- seq(-0.005, 0.015, length.out = 200)
y_p1 <- (1/s_t) * dt((x_p1 - m_t)/s_t, df = df_t)
polygon(c(-0.005, x_p1, 0.015), c(0, y_p1, 0),
col = rgb(40, 180, 99, alpha = 160, maxColorValue = 255), border = NA)
# 5. Dibujar la línea de la Conjetura t-Student (Roja)
lines(x_curva, y_densidad, col = "#C0392B", lwd = 4)
# 6. Ejes y Detalles Técnicos
axis(1, at = seq(-0.035, 0.049, by = 0.01), las = 2, cex.axis = 0.7)
axis(2, las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = "#D7DBDD", lty = "dotted")
abline(v = m_t, col = "darkgray", lty = 3) # Línea en la media
# 7. Leyenda de Resultados
legend("topright",
legend = c("Modelo t-Student", "P1: Estabilidad M\u00e1xima", "P2: Tolerancia Est\u00e1ndar"),
fill = c(NA, rgb(40, 180, 99, alpha = 160, maxColorValue = 255), rgb(46, 134, 193, alpha = 80, maxColorValue = 255)),
border = NA, lty = c(1, NA, NA), col = c("#C0392B", NA, NA),
lwd = c(2, NA, NA), bty = "n", cex = 0.8)# ==========================================================
# BLOQUE: TEOREMA DEL LÍMITE CENTRAL (CURVATURA)
# ==========================================================
# 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 (-0.035 a 0.049)
curv_variable <- na.omit(Datos$curvature)
curv_variable <- curv_variable[curv_variable >= -0.035 & curv_variable <= 0.049]
# 3. CALCULO DE ESTADISTICOS ARITMETICOS
x_bar_c <- mean(curv_variable)
sigma_c <- sd(curv_variable)
n_c <- length(curv_variable)
# 4. CALCULO DEL ERROR ESTANDAR Y MARGEN AL 95%
# El TLC nos dice que el error disminuye con la raíz de n
error_est_c <- sigma_c / sqrt(n_c)
margen_error_c <- 2 * error_est_c # Aproximación para el 95% de confianza
# 5. INTERVALO DE CONFIANZA
lim_inf_c <- x_bar_c - margen_error_c
lim_sup_c <- x_bar_c + margen_error_c
# 6. CONSTRUCCION DE LA TABLA RESUMEN
tabla_tlc_c <- data.frame(
Parametro = "Curvatura Promedio (m\u207b\u00b9)",
Lim_Inferior = lim_inf_c,
Media_Muestral = x_bar_c,
Lim_Superior = lim_sup_c,
Error_Estandar = paste0("+/- ", sprintf("%.4f", margen_error_c)),
Confianza = "95% (2*E)"
)
# 7. GENERACION DE LA TABLA VISUAL
tabla_tlc_c %>%
gt() %>%
tab_header(
title = md("**ESTIMACI\u00d3N DE LA MEDIA POBLACIONAL**"),
subtitle = "Aplicaci\u00f3n del Teorema del L\u00edmite Central (Curvatura)"
) %>%
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 = 5 # Usamos 5 decimales por ser valores pequeños
) %>%
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 (Curvatura) | |||||
| Parámetro | Límite Inferior | Media Calculada | Límite Superior | Error Estimado | Confianza |
|---|---|---|---|---|---|
| Curvatura Promedio (m⁻¹) | −0.00041 | −0.00033 | −0.00026 | +/- 0.0001 | 95% (2*E) |