\(Variable\) \(de\) \(Estudio\): Curvatura del Terreno (m⁻¹).
Se determina que esta variable es Cuantitativa Continua. La curvatura condiciona directamente la estabilidad geomorfológica y el análisis detallado del relieve. Debido a la hiper-concentración de valores en el centro de la distribución global, se opta por una Estrategia de Refinamiento y Modelado Robusto:
\(Fase\) \(de\) \(Segmentación\): Se aisló el rango central comprendido entre -0.035 y 0.049, redistribuyendo los datos para revelar la variabilidad real de las formas del terreno (convexidad y concavidad) que quedaba oculta en la escala inicial.
\(Modelo\) \(Aceptado\): Distribución t-Student (Validado exitosamente mediante el Test de Pearson y la Prueba Chi-cuadrado. Su capacidad para manejar la alta densidad en el pico central de la muestra superó a otros modelos rígidos, asegurando una inferencia técnica robusta).
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("C:/Users/ASUS/OneDrive/Escritorio/ESTADÍSTICA/EXPO/ACTIVIDADES/Dataset_Mundial_Final.xls",
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 frecuencias de la curvatura se organizó mediante la regla de Sturges para definir los intervalos óptimos. Al ajustar el ancho de clase al rango total de los datos, se logró una clasificación sistemática y precisa de la variabilidad geométrica del terreno.
suppressPackageStartupMessages({
library(gt)
library(dplyr)
})
curvatura_global <- na.omit(Datos$curvature)
n_total <- length(curvatura_global)
K_curv <- floor(1 + 3.322 * log10(n_total))
min_abs <- min(curvatura_global)
max_abs <- max(curvatura_global)
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
ni_c <- as.vector(table(cut(curvatura_global, breaks = breaks_curv, right = FALSE, include.lowest = TRUE)))
hi_c <- (ni_c / n_total) * 100
df_temp <- data.frame(
Li = lim_inf_c,
Ls = lim_sup_c,
MC = MC_c,
ni = ni_c,
hi = hi_c
)
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 CURVATURA**"),
) %>%
cols_label(
Li = "Lim. Inf",
Ls = "Lim. Sup",
MC = "Marca Clase (Xi)",
ni = "ni",
hi = "hi (%)"
) %>%
fmt_number(columns = c(Li, Ls, MC), decimals = 4) %>%
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 CURVATURA | ||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) |
|---|---|---|---|---|
| −0.1730 | −0.1453 | −0.1592 | 3 | 0.01 |
| −0.1453 | −0.1176 | −0.1315 | 9 | 0.02 |
| −0.1176 | −0.0899 | −0.1038 | 47 | 0.08 |
| −0.0899 | −0.0622 | −0.0761 | 194 | 0.33 |
| −0.0622 | −0.0346 | −0.0484 | 914 | 1.55 |
| −0.0346 | −0.0069 | −0.0207 | 7952 | 13.48 |
| −0.0069 | 0.0208 | 0.0070 | 47601 | 80.71 |
| 0.0208 | 0.0485 | 0.0347 | 1672 | 2.83 |
| 0.0485 | 0.0762 | 0.0623 | 409 | 0.69 |
| 0.0762 | 0.1039 | 0.0900 | 123 | 0.21 |
| 0.1039 | 0.1316 | 0.1177 | 41 | 0.07 |
| 0.1316 | 0.1593 | 0.1454 | 11 | 0.02 |
| 0.1593 | 0.1869 | 0.1731 | 1 | 0.00 |
| 0.1869 | 0.2146 | 0.2008 | 0 | 0.00 |
| 0.2146 | 0.2423 | 0.2285 | 0 | 0.00 |
| 0.2423 | 0.2700 | 0.2562 | 1 | 0.00 |
La tabla de distribución de frecuencias para la curvatura se estructuró segmentando el rango de mayor densidad (-0.035 a 0.049). Este procedimiento permite aplicar la regla de Sturges sobre un subconjunto más homogéneo, incrementando la resolución estadística y eliminando la distorsión provocada por los valores extremos del terreno.
suppressPackageStartupMessages(library(gt))
suppressPackageStartupMessages(library(dplyr))
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))
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
ni_s <- as.vector(table(cut(curv_segmento, breaks = breaks_seg, right = FALSE, include.lowest = TRUE)))
hi_s <- (ni_s / sum(ni_s)) * 100
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),
stringsAsFactors = FALSE
)
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 (%)"
) %>%
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.width = pct(100),
table.border.top.color = "#D3D3D3",
table.border.bottom.color = "#D3D3D3",
column_labels.border.bottom.color = "#D3D3D3",
data_row.padding = px(6)
)| TABLA Nº 2: DISTRIBUCIÓN DE FRECUENCIAS DE CURVATURA | ||||
| Lim. Inf | Lim. Sup | Marca Clase (Xi) | ni | hi (%) |
|---|---|---|---|---|
| -0.035 | -0.030 | -0.032 | 490 | 0.85 |
| -0.030 | -0.024 | -0.027 | 570 | 0.99 |
| -0.024 | -0.019 | -0.022 | 844 | 1.47 |
| -0.019 | -0.014 | -0.017 | 1324 | 2.31 |
| -0.014 | -0.009 | -0.011 | 3119 | 5.44 |
| -0.009 | -0.004 | -0.006 | 6303 | 10.99 |
| -0.004 | 0.002 | -0.001 | 28845 | 50.30 |
| 0.002 | 0.007 | 0.004 | 9338 | 16.28 |
| 0.007 | 0.012 | 0.010 | 3169 | 5.53 |
| 0.012 | 0.018 | 0.015 | 1204 | 2.10 |
| 0.018 | 0.023 | 0.020 | 742 | 1.29 |
| 0.023 | 0.028 | 0.025 | 443 | 0.77 |
| 0.028 | 0.033 | 0.031 | 421 | 0.73 |
| 0.033 | 0.039 | 0.036 | 224 | 0.39 |
| 0.039 | 0.044 | 0.041 | 159 | 0.28 |
| 0.044 | 0.049 | 0.046 | 153 | 0.27 |
Este gráfico muestra visualmente cómo se distribuye la curvatura, permitiendo identificar rápidamente los rangos con mayor concentración de datos. Al complementar la tabla de frecuencias, el histograma revela el sesgo y la forma de la distribución, datos clave para validar que el modelo matemático elegido es el correcto.
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)
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)
h_curv_seg$counts <- (h_curv_seg$counts / n_total_global) * 100
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))
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 = "Datos Emp\u00edricos",
fill = "#B0C4DE",
border = "white",
bty = "n",
cex = 0.8)Se estratificó la curvatura enfocándose en el sector de mayor densidad (\(-0.035\) a \(0.049\)) para que el modelo t-Student se ajustara con mayor precisión al rango central. Los resultados, validados mediante pruebas de bondad de ajuste, aseguran una inferencia técnica robusta para el análisis geomorfológico del terreno.
suppressPackageStartupMessages(library(MASS))
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)
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"]
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)
h_curv_seg$counts <- (h_curv_seg$counts / n_total_global) * 100
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))
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)
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)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)
}
probs_t <- probs_t / sum(probs_t)
n_base <- 100
Fo_c <- as.vector(table(cut(curv_segmento, breaks = cortes_seg, right = FALSE))) * (n_base / n_seg)
Fe_c <- probs_t * n_base
chi_calc <- sum((Fo_c - Fe_c)^2 / Fe_c)
chi_crit <- qchisq(0.99, max(1, K_val - 1 - 3))
resultado_chi <- if(chi_calc < chi_crit) "APROBADO" else "RECHAZADO"
pearson_val <- cor(Fo_c, Fe_c) * 100
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 %
library(knitr)
suppressPackageStartupMessages(library(MASS))
curv_seg <- na.omit(Datos$curvature[Datos$curvature >= -0.035 & Datos$curvature <= 0.049])
n_seg <- length(curv_seg)
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"]
K_val <- floor(1 + 3.322 * log10(n_seg))
cortes_seg <- seq(-0.035, 0.049, length.out = K_val + 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)
}
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
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"
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
)
resumen_curvatura[nrow(resumen_curvatura) + 1, ] <- c("Autor: Fernando Neira", "", "", "", "", "")
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 |
| Autor: Fernando Neira |
Tras validar que el comportamiento de la curvatura del terreno se ajusta con precisión a un modelo de distribución t-Student, procedemos a proyectar los escenarios operativos y de diseño estructural para la implementación de los parques solares:
\(Pregunta\) \(1\) : ¿Cuál es la probabilidad de que el terreno presente una “Curvatura de Estabilidad Máxima” (entre \(-0.005\) y \(0.015\)), garantizando un anclaje óptimo para los seguidores solares?
\(Pregunta\) \(2\) : De un lote de 350 soportes, ¿cuántos se estima que caerán en el “Intervalo de Tolerancia Estándar” (entre \(-0.015\) y \(0.025\)), permitiendo usar pernos convencionales sin necesidad de nivelaciones especiales?
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)
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))
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)
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)
lines(x_curva, y_densidad, col = "#C0392B", lwd = 4)
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)
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)\(Respuesta\) \(1\): Hay un \(80.89\)% de probabilidad de que el terreno tenga una curvatura óptima. Esto garantiza que casi toda el área es apta para instalar los seguidores solares directamente, sin necesidad de realizar grandes trabajos de suelo o nivelación.
\(Respuesta\) \(2\): Se estima que \(327\) soportes (el \(93.45\)%) operarán dentro de la tolerancia estándar. Esto valida el diseño estructural y deja un margen mínimo para ajustes especiales en terrenos irregulares.
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)
})
curv_variable <- na.omit(Datos$curvature)
curv_variable <- curv_variable[curv_variable >= -0.035 & curv_variable <= 0.049]
x_bar_c <- mean(curv_variable)
sigma_c <- sd(curv_variable)
n_c <- length(curv_variable)
error_est_c <- sigma_c / sqrt(n_c)
margen_error_c <- 2 * error_est_c # Aproximación para el 95% de confianza
lim_inf_c <- x_bar_c - margen_error_c
lim_sup_c <- x_bar_c + margen_error_c
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)"
)
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
) %>%
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) |
La variable Curvatura fue modelada mediante una Distribución t-Student, reflejando alta precisión en el relieve del terreno. Con una media muestral de \(-0.00033\) \(m^{-1}\) y aplicando el Teorema del Límite Central, se estima que la media poblacional se sitúa entre [\(-0.00041\); \(-0.00026\)] \(m^{-1}\) con un \(95\%\) de confianza. Estos resultados permiten estandarizar el diseño de los soportes estructurales y optimizar los costos de nivelación de la planta solar (\(\mu = -0.00033 \pm 0.000075\)).