1. CARGA DE DATOS YLIBRERIAS

# CARGA DE DATOS Y LIBRERIAS

# librerias
library(dplyr)      # Manipulacion de datos
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gt)         # Creacion de tablas profesionales
library(knitr)      # Integracion de tablas en RMarkdown
# Datos
datos <- read.csv("C:/Users/arian/Downloads/texture.csv", 
                  header = TRUE, 
                  sep = ",",
                  dec = ".",
                  na.strings = c("NA", "", "-9999"),
                  stringsAsFactors = FALSE)

# Resumen general de la base de datos

resumen_bd <- data.frame(Descripcion = c("Numero de observaciones",
    "Numero de variables"),
  Valor = c(
    nrow(datos),
    ncol(datos)
  )
)


# Mostrar el resumen de la base de datos
resumen_bd %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°1. Resumen de la Base de Datos**")
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  tab_options(
    table.width = pct(60),
    column_labels.font.weight = "bold"
  )
Tabla N°1. Resumen de la Base de Datos
Descripcion Valor
Numero de observaciones 27784
Numero de variables 58

2. SELECCION DE VARIABLES

Para el desarrollo del modelo de regresion potencial se seleccionaron dos variables cuantitativas de la base de datos de sedimentos marinos. La variable independiente es MEAN, la media granulometrica de la muestra, y la variable dependiente es la mediana granulometrica presente en cada muestra (MEDIAN). Se eligieron porque presentan una asociacion positiva fuerte en escala logaritmica, compatible con un modelo potencial. El analisis describe como cambia MEDIAN conforme varia MEAN, sin interpretar la asociacion como una relacion causal.

# Seleccionar las variables del analisis

# Variable Independiente (X)
x <- as.numeric(datos$MEAN)
# Variable Dependiente (Y)
y <- as.numeric(datos$MEDIAN)     

# Crear una tabla resumen de las variables seleccionadas

tabla_variables <- data.frame(

  Rol = c("Variable Independiente (X)",
          "Variable Dependiente (Y)"),

  Variable = c("MEAN",
               "MEDIAN"),

  Descripcion = c("Medida granulometrica MEAN",
                  "Mediana granulometrica (phi)"))


# Mostrar la tabla de variables seleccionadas


tabla_variables %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2. Variables seleccionadas para el modelo de regresión potencial aplicado al análisis de sedimentos marinos recolectados en Estados Unidos.**")
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  tab_options(
    table.width = pct(80),
    column_labels.font.weight = "bold"
  )
Tabla N°2. Variables seleccionadas para el modelo de regresión potencial aplicado al análisis de sedimentos marinos recolectados en Estados Unidos.
Rol Variable Descripcion
Variable Independiente (X) MEAN Medida granulometrica MEAN
Variable Dependiente (Y) MEDIAN Mediana granulometrica (phi)

3. TABLA DE PARES DE VALORES

3.1 Construccion de la tabla de pares de valores

# Se construye una tabla unicamente con las dos variables del modelo:

TPV <- data.frame(
  x = as.numeric(datos$MEAN),    # X (Medida granulometrica MEAN)
  y = as.numeric(datos$MEDIAN)   # Y (Mediana granulometrica)
)

# Guardamos el numero inicial de registros
n_original <- nrow(TPV)

3.2 Identificacion y eliminacion de valores faltantes

# Se cuentan los valores faltantes en cada variable
na_x <- sum(is.na(TPV$x))   # NA en X (MEAN)
na_y <- sum(is.na(TPV$y))   # NA en Y (MEDIAN)

# Se identifica cuantas filas tienen al menos un valor faltante
n_filas_na <- sum(!complete.cases(TPV))

# Se eliminan las filas con valores faltantes
TPV_sin_na <- na.omit(TPV)

# Guardamos cuantos registros quedan despues de eliminar NA
n_sin_na <- nrow(TPV_sin_na)

3.3 Eliminacion de valores infinitos

# Se eliminan valores infinitos o no finitos, en caso de existir
TPV_sin_inf <- TPV_sin_na[
  is.finite(TPV_sin_na$x) &
  is.finite(TPV_sin_na$y),
]

# Guardamos cuantos registros quedan despues de eliminar infinitos
n_sin_inf <- nrow(TPV_sin_inf)

# Registros eliminados por valores infinitos
n_inf_eliminados <- n_sin_na - n_sin_inf

3.4 Eliminacion de valores inconsistentes

#-----------------------------------------------------------------------------
# Eliminar valores inconsistentes
#-----------------------------------------------------------------------------

# MEAN es la media granulometrica y debe ser mayor que cero para aplicar la transformacion logaritmica.

# MEDIAN es la variable dependiente y debe ser mayor que cero para aplicar
# la transformacion logaritmica.

TPV_limpia <- TPV_sin_inf %>%
  filter(
    x > 0,
    y > 0
  )

n_sin_inconsistencias <- nrow(TPV_limpia)
n_inconsistentes <- n_sin_inf - n_sin_inconsistencias

3.5 Ordenamiento de los datos

# Se ordenan los datos de menor a mayor segun la variable independiente X.

TPV_limpia <- TPV_limpia %>%
  arrange(x)

3.6 Agrupacion: una X debe tener una sola Y

# Como para cada valor de X debe existir una sola Y, se agrupan los datos por cada valor de x.

TPV_agrupada <- TPV_limpia %>%
  group_by(x) %>%
  summarise(
    y = mean(y, na.rm = TRUE),
    .groups = "drop"
  )

# Guardamos cuantos registros quedan despues de agrupar
n_agrupados <- nrow(TPV_agrupada)

# Registros reducidos por agrupacion
n_reducidos_agrupacion <- n_sin_inconsistencias - n_agrupados

3.7 Eliminacion de valores atipicos mediante el metodo IQR

# Se calcula el primer cuartil, tercer cuartil y rango intercuartilico
# de la variable dependiente Y.

Q1_y <- quantile(TPV_agrupada$y, 0.25, na.rm = TRUE)
Q3_y <- quantile(TPV_agrupada$y, 0.75, na.rm = TRUE)

IQR_y <- Q3_y - Q1_y

# Limites para detectar valores atipicos
LI_y <- Q1_y - 1.5 * IQR_y
LS_y <- Q3_y + 1.5 * IQR_y

# Se eliminan los registros cuyo valor de Y este fuera de los limites
TPV_final <- TPV_agrupada %>%
  filter(
    y >= LI_y,
    y <= LS_y
  )

# Guardamos el numero final de registros
n_final <- nrow(TPV_final)

# Registros eliminados por valores atipicos
n_outliers <- n_agrupados - n_final

3.8 Resumen del tratamiento de datos

# Se construye una tabla resumen para documentar todo el proceso de depuracion.

tabla_depuracion <- data.frame(
  Etapa = c(
    "Base de datos original",
    "Filas con valores faltantes eliminadas",
    "Valores infinitos eliminados",
    "Valores inconsistentes eliminados",
    "Registros reducidos por agrupacion",
    "Valores atipicos eliminados por IQR",
    "Base final utilizada en la regresion"
  ),
  Registros = c(
    n_original,
    n_filas_na,
    n_inf_eliminados,
    n_inconsistentes,
    n_reducidos_agrupacion,
    n_outliers,
    n_final
  )
)

# Mostrar tabla resumen de depuracion
tabla_depuracion %>%
  gt() %>%
  cols_label(
    Etapa = "Etapa del tratamiento de datos",
    Registros = "Numero de registros"
  ) %>%
  tab_header(
    title = md("**Tabla N°3. Tratamiento de datos aplicado a los pares MEAN y MEDIAN (mediana granulometrica) en sedimentos marinos recolectados en Estados Unidos.**")
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  tab_options(
    table.width = pct(85),
    column_labels.font.weight = "bold"
  )
Tabla N°3. Tratamiento de datos aplicado a los pares MEAN y MEDIAN (mediana granulometrica) en sedimentos marinos recolectados en Estados Unidos.
Etapa del tratamiento de datos Numero de registros
Base de datos original 27784
Filas con valores faltantes eliminadas 2744
Valores infinitos eliminados 0
Valores inconsistentes eliminados 1516
Registros reducidos por agrupacion 22566
Valores atipicos eliminados por IQR 0
Base final utilizada en la regresion 958

3.9 Tabla final de pares de valores

# Se muestran unicamente los primeros 10 pares de valores depurados.
# Esta tabla sera la base para el diagrama de dispersion y la regresion potencial.

tabla_tpv_previa <- head(TPV_final, 15)

tabla_tpv_previa <- cbind(
  Nro = 1:nrow(tabla_tpv_previa),
  tabla_tpv_previa
)

# Mostrar tabla de pares de valores
tabla_tpv_previa %>%
  gt() %>%
  cols_label(
    Nro = "N°",
    x = "MEAN",
    y = "MEDIAN (phi)"
  ) %>%
  tab_header(
    title = md("**Tabla N°4. Pares de valores depurados de MEAN y MEDIAN utilizados para la regresion potencial en sedimentos marinos recolectados en Estados Unidos.**")
  ) %>%
  fmt_number(
    columns = c(x, y),
    decimals = 4
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  tab_options(
    table.width = pct(85),
    column_labels.font.weight = "bold"
  )
Tabla N°4. Pares de valores depurados de MEAN y MEDIAN utilizados para la regresion potencial en sedimentos marinos recolectados en Estados Unidos.
N° MEAN MEDIAN (phi)
1 0.0100 0.2683
2 0.0200 0.1220
3 0.0300 0.3400
4 0.0400 0.4900
5 0.0500 0.4409
6 0.0600 0.4088
7 0.0700 0.2171
8 0.0800 0.2600
9 0.0900 0.3421
10 0.1000 0.2173
11 0.1100 0.2400
12 0.1200 0.4382
13 0.1300 0.3269
14 0.1400 0.3892
15 0.1500 0.3210

3.10 Definicion final de las variables para el modelo

# A partir de la tabla final depurada, se definen las variables que seran usadas
# en las siguientes secciones del analisis.

x <- TPV_final$x   # X final: MEAN 
y <- TPV_final$y   # Y final: MEDIAN

4. DIAGRAMA DE DISPERSIÓN

El diagrama de dispersion permite visualizar el comportamiento conjunto de MEAN, variable independiente, y MEDIAN, mediana granulometrica y variable dependiente. Debido al elevado numero de observaciones, se emplea una muestra aleatoria solo para mejorar la visualizacion; el modelo se estima con la totalidad de los datos depurados. El grafico permite verificar si la relacion entre ambas variables es compatible con una regresion potencial.

#-----------------------------------------------------------------------------
# Seleccion de una muestra aleatoria para la visualizacion
#-----------------------------------------------------------------------------

# La regresion potencial no se realizara con esta muestra, sino con la totalidad de los datos depurados.

set.seed(2026)

indice_visual <- sample(
  1:length(x),
  min(3000, length(x))
)

#-----------------------------------------------------------------------------
# Configuracion grafica
#-----------------------------------------------------------------------------

par(oma = c(1,1,1,1))

#-----------------------------------------------------------------------------
# Construccion del diagrama de dispersion
#-----------------------------------------------------------------------------

plot(
  x[indice_visual],
  y[indice_visual],

  pch = 16,
  cex = 0.7,
  col = rgb(0,0,1,0.35),

  main = "Grafica N°1. Diagrama de dispersion entre MEAN y MEDIAN en sedimentos marinos recolectados en Estados Unidos",

  xlab = "MEAN",
  ylab = "MEDIAN (phi)"
)

grid()
box(which = "outer")

El diagrama de dispersion muestra una relacion positiva y curvilinea entre MEAN y MEDIAN. Al considerar exclusivamente observaciones positivas, la tendencia es compatible con un modelo potencial. El ajuste se realiza con los datos depurados para conservar la informacion disponible y evitar extrapolaciones fuera del rango observado.

5. CONJETURA DEL MODELO

El diagrama de dispersión permite plantear que, dentro del intervalo 4 ≤ MEAN ≤ 6, la relación entre el tamaño medio del grano (MEAN) y la mediana granulométrica (MEDIAN) presenta un comportamiento potencial. Por esta razón, se propone el modelo MEDIAN = a · MEAN^b, donde MEDIAN es la variable dependiente y MEAN la variable independiente.

6.REALIDAD Y MODELO

#-----------------------------------------------------------------------------
# Ajuste del modelo en el Intervalo de Trabajo
#-----------------------------------------------------------------------------
TPV_modeloA <- TPV_final %>%
  filter(
    x >= 4,
    x <= 6
  )

xA <- TPV_modeloA$x
yA <- TPV_modeloA$y


# El modelo utilizado tiene la forma:
#
#          Y = a * X^b
#
# donde:
#
# Y = MEDIAN 
# X = MEAN 
# a = Factor de escala
# b = Exponente del modelo
#
# Para ajustar el modelo se linealiza aplicando logaritmo natural:
#
#          ln(Y) = ln(a) + b * ln(X)

modelo_pot <- lm(log(yA) ~ log(xA))

#------------------------------------------------------------------------------
# Obtener parametros del modelo potencial
#------------------------------------------------------------------------------

ln_a <- coef(modelo_pot)[1]
b <- coef(modelo_pot)[2]
a <- exp(ln_a)

#------------------------------------------------------------------------------
# Crear una secuencia de valores de X
#------------------------------------------------------------------------------

x_modelo <- seq(
  min(xA),
  max(xA),
  length.out = 500
)

#------------------------------------------------------------------------------
# Calcular los valores estimados por el modelo potencial
#------------------------------------------------------------------------------

y_modelo <- a * x_modelo^b

#------------------------------------------------------------------------------
# Construccion del grafico
#------------------------------------------------------------------------------

par(oma = c(1,1,1,1))

plot(
  x[indice_visual],
  y[indice_visual],

  pch = 16,
  cex = 0.7,
  col = rgb(0,0,1,0.35),

  main =
"Grafica N°2. Modelo de regresion potencial entre MEAN y MEDIAN para 
describir la relacion granulometrica de los sedimentos marinos recolectados 
en Estados Unidos",

  xlab = "MEAN",
  ylab = "MEDIAN (phi)"
)

#------------------------------------------------------------------------------
# Superponer la curva del modelo potencial
#------------------------------------------------------------------------------

lines(
  x_modelo,
  y_modelo,
  col = "red",
  lwd = 3
)

grid()
box(which = "outer")

legend(
  "topright",
  legend = c(
    "Datos observados",
    "Modelo potencial"
  ),
  col = c(
    rgb(0,0,1,0.35),
    "red"
  ),
  pch = c(
    16,
    NA
  ),
  lty = c(
    NA,
    1
  ),
  lwd = c(
    NA,
    3
  ),
  bty = "n"
)

7 PARAMETROS DEL MODELO

Una vez seleccionado el modelo potencial, se estiman el factor de escala \(a\) y el exponente \(b\), los cuales determinan la posicion y la forma de la curva ajustada. Estos parametros permiten describir como varia la mediana granulometrica (MEDIAN) conforme cambia MEAN.

#------------------------------------------------------------------------------
# Obtener los coeficientes del modelo linealizado
#------------------------------------------------------------------------------

coeficientes <- coef(modelo_pot)

#------------------------------------------------------------------------------
# Parametros del modelo potencial
#------------------------------------------------------------------------------

ln_a <- coeficientes[1]
b <- coeficientes[2]
a <- exp(ln_a)

#------------------------------------------------------------------------------
# Mostrar los parametros obtenidos
#------------------------------------------------------------------------------

tabla_parametros <- data.frame(

  Parametro = c(
    "ln(a) - Intercepto del modelo linealizado",
    "a - Factor de escala del modelo potencial",
    "b - Exponente del modelo potencial"
  ),

  Valor = c(
    ln_a,
    a,
    b
  )

)

tabla_parametros %>%
  gt() %>%
  fmt_number(
    columns = Valor,
    decimals = 4
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  tab_header(
    title = md("**Tabla N°5. Parametros estimados del modelo de regresion potencial entre MEAN y MEDIAN en sedimentos marinos recolectados en Estados Unidos.**")
  )
Tabla N°5. Parametros estimados del modelo de regresion potencial entre MEAN y MEDIAN en sedimentos marinos recolectados en Estados Unidos.
Parametro Valor
ln(a) - Intercepto del modelo linealizado −0.6664
a - Factor de escala del modelo potencial 0.5135
b - Exponente del modelo potencial 1.3547

Ecuacion del modelo potencial

#------------------------------------------------------------------------------
# Esta seccion presenta:
# 1. El modelo teorico de regresion potencial.
# 2. La ecuacion ajustada con los parametros obtenidos mediante minimos cuadrados.
#------------------------------------------------------------------------------

plot.new()

plot.window(
  xlim = c(0,100),
  ylim = c(0,100)
)

#===============================================================================
# RECUADRO 1: MODELO TEORICO
#===============================================================================

rect(
  5, 58,
  95, 92,
  border = "#1F4E79",
  lwd = 3
)

text(
  50, 87,
  "MODELO TEORICO",
  cex = 1.5,
  font = 2,
  col = "#1F4E79"
)

text(
  50, 72,
  "MEDIAN = a * MEAN^b",
  cex = 1.35,
  font = 2,
  col = "#C0392B"
)

#===============================================================================
# RECUADRO 2: MODELO AJUSTADO
#===============================================================================

rect(
  5, 8,
  95, 48,
  border = "#1F4E79",
  lwd = 3
)

text(
  50, 43,
  "MODELO AJUSTADO",
  cex = 1.5,
  font = 2,
  col = "#1F4E79"
)

ecuacion <- paste0(
  "MEDIAN = ",
  round(a,4),
  " * MEAN^",
  round(b,4)
)

text(
  50,
  24,
  ecuacion,
  cex = 1.30,
  font = 2,
  col = "#C0392B"
)

text(
  50,
  4,
  "Modelo ajustado mediante linealizacion logaritmica y minimos cuadrados.",
  cex = 0.85,
  col = "gray40"
)

8. TEST DE PEARSON

En esta seccion se calculan el coeficiente de correlacion de Pearson entre ln(MEAN) y ln(MEDIAN), y el coeficiente de determinacion (R2). Estos indicadores permiten evaluar la intensidad de la relacion logaritmica y el porcentaje de variabilidad explicado por el modelo potencial linealizado.

#------------------------------------------------------------------------------
# Coeficiente de correlacion de Pearson
#------------------------------------------------------------------------------

# Debido a que el modelo seleccionado es potencial, la correlacion se calcula
# entre ln(MEAN) y ln(MEDIAN).

r <- cor(log(xA), log(yA))

#------------------------------------------------------------------------------
# Coeficiente de determinacion (R2)
#------------------------------------------------------------------------------

R2 <- summary(modelo_pot)$r.squared

#------------------------------------------------------------------------------
# Construccion de la tabla de indicadores
#------------------------------------------------------------------------------

tabla_tests <- data.frame(

  Indicador = c(
    "Coeficiente de correlacion de Pearson (r)",
    "Coeficiente de determinacion (R²)"
  ),

  Valor = c(
    round(r,4),
    round(R2,4)
  )

)

#------------------------------------------------------------------------------
# Mostrar la tabla de resultados
#------------------------------------------------------------------------------

tabla_tests %>%
  gt() %>%
  cols_label(
    Indicador = "Indicador estadistico",
    Valor = "Valor"
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  fmt_number(
    columns = Valor,
    decimals = 4
  ) %>%
  tab_header(
    title = md("**Tabla N°7. Indicadores estadisticos para evaluar la calidad del ajuste del modelo de regresion potencial entre el valor de MEAN y la mediana granulometrica (MEDIAN) en sedimentos marinos recolectados en Estados Unidos.**")
  ) %>%
  tab_options(
    table.width = pct(85),
    column_labels.font.weight = "bold"
  )
Tabla N°7. Indicadores estadisticos para evaluar la calidad del ajuste del modelo de regresion potencial entre el valor de MEAN y la mediana granulometrica (MEDIAN) en sedimentos marinos recolectados en Estados Unidos.
Indicador estadistico Valor
Coeficiente de correlacion de Pearson (r) 0.9839
Coeficiente de determinacion (R²) 0.9682

Interpretacion: El coeficiente de correlacion de Pearson obtenido (r = 0.9839) evidencia la intensidad y direccion de la relacion entre el logaritmo natural del valor de MEAN y el logaritmo natural dla mediana granulometrica (MEDIAN). Asimismo, el coeficiente de determinacion (R² = 0.9682) indica que el 96.82 % de la variabilidad observada en la mediana granulometrica es explicado por el modelo potencial ajustado, mientras que el 3.18 % restante se atribuye a otros factores no considerados en el analisis.

9 RESTRICCIONES DEL MODELO

Las restricciones del modelo se establecen a partir del dominio observado de la variable independiente MEAN, del dominio observado de la variable dependiente MEDIAN, del tramo seleccionado para el ajuste y de la transformacion logaritmica utilizada en la regresion potencial.

Dominio de X

La variable independiente \(X=\text{MEAN}\) corresponde al tamaño medio del grano expresado en unidades \(\Phi\). Aunque la escala granulometrica puede incluir otros valores, el modelo fue ajustado exclusivamente en el tramo comprendido entre 4 y 6. Para evitar extrapolaciones, su aplicacion debe restringirse al intervalo realmente utilizado.

dominio_x <- range(xA, na.rm = TRUE)
xmin <- dominio_x[1]
xmax <- dominio_x[2]

cat(
  "Dominio observado de X:",
  round(xmin, 4), "<= MEAN <=",
  round(xmax, 4), "Phi\n"
)
## Dominio observado de X: 4 <= MEAN <= 6 Phi

Por tanto, el dominio recomendado para realizar estimaciones es:

\[ D_X=[\,4,\;6\,]. \]

Dominio de Y

La variable dependiente \(Y=\text{MEDIAN}\) representa la mediana granulometrica expresada en unidades \(\Phi\). Su dominio observado se obtiene directamente de los valores empleados para ajustar el modelo potencial.

dominio_y <- range(yA, na.rm = TRUE)
ymin <- dominio_y[1]
ymax <- dominio_y[2]

cat(
  "Dominio observado de Y:",
  round(ymin, 4), "<= MEDIAN <=",
  round(ymax, 4), "Phi\n"
)
## Dominio observado de Y: 3.4364 <= MEDIAN <= 6.1611 Phi

En consecuencia:

\[ D_Y=[\,3.4364,\;6.1611\,]. \]

Pregunta de restriccion

La variable MEDIAN se expresa en la escala granulometrica \(\Phi\), definida a partir del logaritmo negativo del diametro del grano. Sin embargo, el modelo potencial fue estimado mediante la transformacion \(\ln(MEDIAN)\), por lo que solo admite valores positivos de MEDIAN y MEAN.

Por ello, se plantea la siguiente pregunta:

¿Existe algun valor positivo de MEAN dentro del tramo de 4 a 6 para el cual el modelo potencial prediga \(\text{MEDIAN}=0\Phi\)?

Calculo de la restriccion utilizando la ecuacion

El modelo potencial tiene la forma:

\[ \widehat{Y}=aX^b. \]

Como el factor de escala \(a\) es positivo y el dominio exige \(X>0\), la expresion \(aX^b\) tambien es positiva. Por tanto, el modelo no alcanza exactamente el valor \(\widehat{MEDIAN}=0\Phi\) dentro de su dominio.

y_extremo_inferior <- a * xmin^b
y_extremo_superior <- a * xmax^b

comprobacion_limites <- data.frame(
  MEAN = c(xmin, xmax),
  MEDIAN_estimada = c(
    y_extremo_inferior,
    y_extremo_superior
  )
)

comprobacion_limites %>%
  gt() %>%
  cols_label(
    MEAN = "MEAN",
    MEDIAN_estimada = "MEDIAN estimada"
  ) %>%
  fmt_number(
    columns = everything(),
    decimals = 4
  ) %>%
  cols_align(
    align = "center"
  ) %>%
  tab_header(
    title = md("**Tabla N.°7. Predicciones en los limites del dominio observado**")
  ) %>%
  tab_options(
    table.width = pct(70),
    heading.align = "center",
    column_labels.font.weight = "bold"
  )
Tabla N.°7. Predicciones en los limites del dominio observado
MEAN MEDIAN estimada
4.0000 3.3586
6.0000 5.8171

Las predicciones calculadas en los extremos del intervalo permanecen positivas. En consecuencia, la condicion \(\widehat{MEDIAN}=0\Phi\) no reduce el tramo observado; la restriccion principal consiste en utilizar el modelo unicamente entre MEAN = 4 y MEAN = 6.

Restriccion final del modelo

El intervalo definitivo se obtiene directamente del dominio empleado para ajustar la regresion. Dentro de este rango, las estimaciones corresponden a interpolaciones sustentadas por los datos analizados.

restriccion_final <- paste0(
  round(xmin, 4),
  " <= MEAN <= ",
  round(xmax, 4),
  " Phi"
)

plot.new()
plot.window(
  xlim = c(0, 100),
  ylim = c(0, 100)
)

rect(
  5, 18,
  95, 82,
  border = "#1F4E79",
  lwd = 3
)

text(
  50, 72,
  "RESTRICCION FINAL DEL MODELO",
  cex = 1.40,
  font = 2,
  col = "#1F4E79"
)

text(
  50, 51,
  restriccion_final,
  cex = 1.50,
  font = 2,
  col = "#C0392B"
)

text(
  50, 32,
  "Intervalo observado recomendado",
  cex = 0.95,
  col = "gray40"
)

text(
  50, 26,
  "para evitar extrapolaciones.",
  cex = 0.95,
  col = "gray40"
)

box()

10 ESTIMACION MEDIANTE EL MODELO

En esta seccion se utiliza el modelo potencial para estimar la mediana granulometrica (MEDIAN) correspondiente a un valor conocido de MEAN. Se selecciona MEAN = 5, valor incluido en el tramo de 4 a 6, por lo que la estimacion corresponde a una interpolacion.

#------------------------------------------------------------------------------
# Valor de la variable independiente para realizar la estimacion
#------------------------------------------------------------------------------

# Se desea estimar la mediana granulometrica (MEDIAN)
# para un valor de MEAN igual a 5.

x_estimacion <- 5

#------------------------------------------------------------------------------
# Calculo de la estimacion
#------------------------------------------------------------------------------

# Se utiliza la ecuacion del modelo potencial para estimar
# el valor esperado de la variable dependiente.

y_estimacion <- a * x_estimacion^b

#------------------------------------------------------------------------------
# Presentacion grafica del resultado
#------------------------------------------------------------------------------

plot.new()

plot.window(
  xlim = c(0,100),
  ylim = c(0,100)
)

rect(
  5,15,
  95,85,
  border = "#1F4E79",
  lwd = 3
)

text(
  50,
  80,
  "ESTIMACION DEL MODELO POTENCIAL",
  cex = 1.2,
  font = 2,
  col = "#1F4E79"
)

text(
  50,
  64,
  "Para una muestra de sedimento marino con",
  cex = 1.15
)

text(
  50,
  56,
  paste0(
    "un valor de MEAN igual a ",
    x_estimacion,
    ""
  ),
  cex = 1.15
)

text(
  50,
  48,
  "el modelo estima una mediana granulometrica (MEDIAN) de:",
  cex = 1.15
)

text(
  50,
  34,
  paste0(
    round(y_estimacion,4),
    " %"
  ),
  cex = 2,
  font = 2,
  col = "#C0392B"
)

text(
  50,
  20,
  "Estimacion obtenida mediante el modelo de regresion potencial ajustado.",
  cex = 0.85,
  col = "gray40"
)

Interpretacion: Para una muestra de sedimento marino con MEAN igual a 5, el modelo potencial estima una mediana granulometrica (MEDIAN) de 4.544 unidades phi. Como el valor de entrada pertenece al intervalo usado en el ajuste, la estimacion corresponde a una interpolacion.

El modelo permite estimar la mediana granulometrica de los sedimentos marinos a partir de MEAN y constituye una herramienta descriptiva para estudios granulometricos. La asociacion observada no debe interpretarse como evidencia de causalidad.

11 CONCLUSION

Entre el tamaño medio del grano (MEAN) y la mediana granulométrica (MEDIAN) existe una relación de tipo potencial, representada por el modelo MEDIAN (Φ) = 0.5135 · MEAN^1.3547, siendo Y = MEDIAN la variable dependiente y X = MEAN la variable independiente. El modelo presenta la restricción 4 ≤ X ≤ 6 Φ, correspondiente al dominio analizado. El modelo explica aproximadamente el 96.82 % de la variabilidad observada en la mediana granulométrica, mientras que el 3.18 % restante se atribuye a otros factores sedimentológicos no incluidos en el modelo. El exponente b = 1.3547, al ser mayor que uno, indica que la mediana granulométrica aumenta de manera más que proporcional conforme aumenta el tamaño medio del grano dentro del intervalo estudiado.