Regresión lineal

regresion_lineal <- function(x, y) {
  # Validar que los vectores tengan la misma longitud
  if (length(x) != length(y)) {
    stop("Los vectores x e y deben tener la misma longitud.")
  }
  
  # Cálculo de parámetros
  n <- length(x)
  x_mean <- mean(x)
  y_mean <- mean(y)
  
  # Pendiente y intercepto
  m <- sum((x - x_mean) * (y - y_mean)) / sum((x - x_mean)^2)
  b <- y_mean - m * x_mean
  
  # Mostrar la ecuación
  cat("La ecuación de la recta es: y =", m, "* x +", b, "\n")
  
  # Gráfico
  plot(x, y, 
       main = "Recta de Regresión", 
       xlab = "x", ylab = "y", 
       pch = 19, col = "blue")
  abline(a = b, b = m, col = "red", lwd = 2)
  
  # Retornar resultados como lista
  return(list(pendiente = m, intercepto = b))
}

Regresión no lineal

Exponencial

reg_exponencial <- function(x, y) {
  # Transformación logarítmica
  Y <- log(y)
  X <- x
  
  # Cálculo de parámetros mediante mínimos cuadrados
  X_mean <- mean(X)
  Y_mean <- mean(Y)
  
  b <- sum((X - X_mean) * (Y - Y_mean)) / sum((X - X_mean)^2)
  a <- exp(Y_mean - b * X_mean)
  
  # Mostrar modelo
  cat("Modelo exponencial: y =", a, "* e^(", b, "x )\n")
  
  # Gráfico
  plot(x, y, pch = 19, col = "blue",
       main = "Regresión Exponencial", xlab = "x", ylab = "y")
  curve(a * exp(b * x), add = TRUE, col = "red", lwd = 2)}

Polinómica (Modelo de potencias)

reg_polinomica <- function(x, y) {
  # Transformación logarítmica
  X <- log(x)
  Y <- log(y)
  
  # Mínimos cuadrados
  X_mean <- mean(X)
  Y_mean <- mean(Y)
  
  b <- sum((X - X_mean) * (Y - Y_mean)) / sum((X - X_mean)^2)
  a <- exp(Y_mean - b * X_mean)
  
  cat("Modelo de potencias: y =", a, "* x^(", b, ")\n")
  
  # Gráfico
  plot(x, y, pch = 19, col = "blue",
       main = "Regresión de Potencias", xlab = "x", ylab = "y")
  curve(a * x^b, add = TRUE, col = "red", lwd = 2)
}

Crecimiento

reg_crecimiento <- function(x, y) {
  # Transformaciones
  X <- 1 / x
  Y <- 1 / y
  
  # Mínimos cuadrados
  X_mean <- mean(X)
  Y_mean <- mean(Y)
  
  s <- sum((X - X_mean) * (Y - Y_mean)) / sum((X - X_mean)^2) # s = b/a
  i <- Y_mean - s * X_mean                                    # i = 1/a
  
  a <- 1 / i
  b <- s / i
  
  cat("Modelo de crecimiento: y = (", a, "x)/(x +", b, ")\n", sep = "")
  
  # Gráfico
  plot(x, y, pch = 19, col = "blue",
       main = "Modelo de Crecimiento", xlab = "x", ylab = "y")
  curve((a * x) / (x + b), add = TRUE, col = "red", lwd = 2)
}

Interpolación de Lagrange

metodo_lagrange <- function(x, y) {
  
  stopifnot(length(x) == length(y))
  n <- length(x)
  
  # L_k(x0)
  Lk <- function(x0, k) {
    num <- 1; den <- 1
    for (j in 1:n) {
      if (j != k) {
        num <- num * (x0 - x[j])
        den <- den * (x[k] - x[j])
      }
    }
    num / den
  }
  
  # P(x0)
  P <- function(x0) {
    suma <- 0
    for (k in 1:n) suma <- suma + y[k] * Lk(x0, k)
    suma
  }
  
  # -------------------------
  # Cálculo de coeficientes
  # -------------------------
  # Matriz de Vandermonde
  V <- outer(x, 0:(n-1), `^`)
  coef <- solve(V, y)  # coeficientes del polinomio
  
  # Función para imprimirlo bonito
  imprimir_pol <- function(coef) {
    cat("P(x) = ")
    for (i in 1:length(coef)) {
      c <- round(coef[i], 4)
      if (i == 1) {
        cat(c)
      } else if (i == 2) {
        cat(" +", c, "*x")
      } else {
        cat(" +", c, "*x^", i-1)
      }
    }
    cat("\n\n")
  }
  
  # Mostrar polinomio interpolador en consola
  imprimir_pol(coef)
  
  # -------------------------
  # Gráfico de interpolación
  # -------------------------
  xg <- seq(min(x), max(x), length.out = 400)
  yg <- sapply(xg, P)
  
  plot(x, y, pch = 19, col = "blue",
       xlab = "x", ylab = "f(x)",
       main = "Interpolación de Lagrange")
  lines(xg, yg, col = "red", lwd = 2)
  points(x, y, pch = 19, col = "blue")
}

Ejemplos:

Ejemplo 1 - Regresión lineal

Durante una prueba de ejercicio en cicloergómetro, se mide la frecuencia cardíaca (lat/min) en función del consumo de oxígeno VO₂ (L/min):

VO₂ (L/min) Frecuencia cardíaca (lat/min)
0.8 105
1.2 125
1.6 142
2.0 160
2.4 175

Objetivo: Modelar la respuesta lineal del corazón al esfuerzo físico en un atleta sano.

x <- c(0.8,1.2,1.6,2.0,2.4)
y <- c(105,125,142,160,175)
regresion_lineal(x,y)
## La ecuación de la recta es: y = 43.75 * x + 71.4

## $pendiente
## [1] 43.75
## 
## $intercepto
## [1] 71.4

Ejemplo 2 - Regresión exponencial

En un reactor de hidrólisis, la concentración de un reactivo (mol/L) disminuye con el tiempo siguiendo una cinética exponencial:

Tiempo (min) Concentración (mol/L)
0 0.50
5 0.38
10 0.29
15 0.22
20 0.17

Objetivo: Encontrar el modelo exponencial de degradación

x <- c(0,5,10,15,20)
y <- c(0.50,0.38,0.29,0.22,0.17)
reg_exponencial(x,y)
## Modelo exponencial: y = 0.4985231 * e^( -0.05408326 x )

regresion_lineal(x,y)
## La ecuación de la recta es: y = -0.0164 * x + 0.476

## $pendiente
## [1] -0.0164
## 
## $intercepto
## [1] 0.476

Ejemplo 3 - Regresión polinómica

Se analiza cómo disminuye la VFG (mL/min) (Función de los riñones) con la edad del paciente.

Edad (años) VFG (mL/min)
20 125
30 118
40 105
50 92
60 80

Ajustar un modelo de potencias para estimar deterioro renal con la edad.

x <- c(20,30,40,50,60)
y <- c(125,118,105,92,80)
reg_polinomica(x,y)
## Modelo de potencias: y = 438.806 * x^( -0.4014726 )

Ejemplo 4 - Modelo de crecimiento

Crecimiento de una población de bacterias en un biorreactor por lote, medida como concentración celular (millones de células por mL) a lo largo del tiempo (h). Al inicio crece rápido y luego se satura por limitación de nutrientes.

Tiempo (h) Población (10^6 cel/mL)
1 0.20
2 0.45
3 0.85
4 1.20
6 1.80
8 2.20
10 2.45
12 2.60

Ajustar el modelo de crecimiento.

x<-c(1,2,3,4,6,8,10,12) 
y <- c(0.20, 0.45, 0.85, 1.20, 1.80, 2.20, 2.45, 2.60)
reg_crecimiento(x,y)
## Modelo de crecimiento: y = (-3.905602x)/(x +-19.97314)

Ejemplo 5 - Interpolación de lagrange

Se toman pocos puntos del ECG alrededor del pico R para reconstruir la forma de la señal:

Tiempo (s) Voltaje (mV)
0.10 0.3
0.11 0.8
0.12 1.1
0.13 0.7

Objetivo: Interpolar el polinomio que permite una estimación más precisa del pico R y análisis clínico.

x <- c(0.10, 0.11, 0.12, 0.13)
y <- c(0.3, 0.8, 1.1, 0.7)
metodo_lagrange(x,y)
## P(x) = 94.3 + -2756.667 *x + 26500 *x^ 2 + -83333.33 *x^ 3