Suavizado

Author

Joan Bofill y Sara Reina

Fluorescencia

La fluorescencia es la emisión de luz que ocurre cuando ciertas moléculas absorben energía al ser iluminadas con una fuente externa (excitación) y, al relajarse y volver a su estado de menor energía, reemiten parte de esa energía en forma de luz.

En estos datos, la muestra es azúcar disuelta en agua. El equipo ilumina la muestra con una longitud de onda específica, lo que causa la excitación de las moléculas. Esa luz activa moléculas presentes en la solución, que pasan momentáneamente a un estado de mayor energía. Después, al volver a su estado normal, la muestra emite luz a otras longitudes de onda (la emisión), que en el experimento se registra entre 275 y 560 nm.

Lo clave es que la luz emitida suele aparecer a longitudes de onda más grandes que la luz con la que se excitó la muestra (es decir, con menor energía). Esto ocurre porque parte de la energía absorbida se pierde en forma de calor u otros procesos internos antes de emitir luz. Esto es útil en el caso del azucar porque la fluorescencia no suele provenir del azúcar puro, sino de trazas de compuestos asociados al proceso (impurezas orgánicas, subproductos, colorantes naturales, etc.).

Ajuste de Curvas Espectrométricas

Contexto

  • 268 muestras tomadas cada 8 horas durante 3 meses
  • Datos de fluorescencia: Espectros de emisión (275-560 nm) medidos a 7 longitudes de onda de excitación
  • Variables de calidad: Contenido de ceniza y color del azúcar
  • Objetivo: Modelar la relación entre espectros de fluorescencia y calidad del azúcar

Estructura de los datos:

Los datos de fluorescencia forman un arreglo tridimensional: - Modo 1: 268 muestras (tiempo) - Modo 2: 571 longitudes de onda de emisión (0.5 nm intervalos) - Modo 3: 7 longitudes de onda de excitación (230, 240, 255, 290, 305, 325, 340 nm)

Lectura de datos

library(R.matlab)
Warning: package 'R.matlab' was built under R version 4.5.2
R.matlab v3.7.0 (2022-08-25 21:52:34 UTC) successfully loaded. See ?R.matlab for help.

Adjuntando el paquete: 'R.matlab'
The following objects are masked from 'package:base':

    getOption, isOpen
library(RColorBrewer)
Warning: package 'RColorBrewer' was built under R version 4.5.2
library(fda)
Warning: package 'fda' was built under R version 4.5.2
Cargando paquete requerido: splines
Cargando paquete requerido: fds
Cargando paquete requerido: rainbow
Cargando paquete requerido: MASS
Cargando paquete requerido: pcaPP
Cargando paquete requerido: RCurl
Cargando paquete requerido: deSolve

Adjuntando el paquete: 'fda'
The following object is masked from 'package:graphics':

    matplot
The following object is masked from 'package:datasets':

    gait
library(fda.usc)
Cargando paquete requerido: mgcv
Cargando paquete requerido: nlme
This is mgcv 1.9-3. For overview type 'help("mgcv-package")'.
Cargando paquete requerido: knitr
 fda.usc is running sequentially usign foreach package
 Please, execute ops.fda.usc() once to run in local parallel mode
 Deprecated functions: min.basis, min.np, anova.hetero, anova.onefactor, anova.RPm
 New functions: optim.basis, optim.np, fanova.hetero, fanova.onefactor, fanova.RPm
----------------------------------------------------------------------------------
# Cargar el archivo .mat
data <- readMat("C:/Users/sarar/Documents/Maestría Estadística/Datos Funcionales/Sugar Process Data/sugar_Process/data.mat")

# Extraer variables principales
X <- data$X
DimX <- as.integer(data$DimX)
EmAx <- as.vector(data$EmAx)  # Longitudes de onda de emisión
ExAx <- as.vector(data$ExAx)  # Longitudes de onda de excitación
y <- data$y                    # Variables de calidad (ceniza y color)
time <- data$time              # Códigos temporales

# Reshape del array tridimensional
X <- array(X, dim = DimX)

# Información básica
cat("Dimensiones de X:", dim(X), "\n")
Dimensiones de X: 268 571 7 
cat("Longitudes de onda de excitación (nm):", ExAx, "\n")
Longitudes de onda de excitación (nm): 230 240 255 290 305 325 340 
cat("Rango de emisión (nm):", range(EmAx), "\n")
Rango de emisión (nm): 275 560 

2. Visualización de datos crudos

# Extraer cada onda de excitación
ondas <- lapply(1:7, function(i) X[, , i])
nombres <- paste("Excitación", 1:7)

# Configurar colores
n <- dim(X)[1]
colors <- colorRampPalette(brewer.pal(9, "Set3"))(n)

# Graficar todas las ondas
par(mfrow = c(3, 3), mar = c(4, 4, 3, 1))

for (i in 1:7) {
  # Determinar rango automáticamente
  ylim_max <- quantile(ondas[[i]], 0.99)
  
  # Gráfico
  plot(1:571, ondas[[i]][1, ], type = "n",
       xlab = "Longitud de onda (índice)", 
       ylab = "Intensidad",
       main = nombres[i],
       ylim = c(0, ylim_max))
  grid(col = "gray90")
  
  # Todas las curvas con transparencia
  for (j in 1:nrow(ondas[[i]])) {
    lines(1:571, ondas[[i]][j, ], 
          col = adjustcolor(colors[j], alpha = 0.4), 
          lwd = 1)
  }
  
  # Media en negro
  lines(1:571, colMeans(ondas[[i]]), col = "black", lwd = 2)
}

3. Suavizado penalizado

# Configuración
n_puntos <- 571
n_base <- 50
rango <- c(1, n_puntos)
tiempo <- seq(rango[1], rango[2], length.out = n_puntos)

# Base de B-splines
basis <- create.bspline.basis(rangeval = rango, nbasis = n_base)

# Valores de lambda a probar
lambdas <- 10^seq(-6, 3, length.out = 20)

# Procesar cada onda
resultados <- list()

for (j in 1:7) {
  cat("Procesando excitación", j, "... ")
  
  datos <- ondas[[j]]
  gcv_values <- numeric(length(lambdas))
  
  # Probar cada lambda
  for (i in seq_along(lambdas)) {
    fdParObj <- fdPar(basis, Lfdobj = 2, lambda = lambdas[i])
    resultado <- smooth.basis(argvals = tiempo, 
                             y = t(datos), 
                             fdParobj = fdParObj)
    gcv_values[i] <- mean(resultado$gcv)
  }
  
  # Mejor lambda
  best_lambda <- lambdas[which.min(gcv_values)]
  cat("λ =", formatC(best_lambda, format = "e", digits = 2), "\n")
  
  # Suavizar con mejor lambda
  fdParObj_best <- fdPar(basis, Lfdobj = 2, lambda = best_lambda)
  resultado_best <- smooth.basis(argvals = tiempo, 
                                 y = t(datos), 
                                 fdParobj = fdParObj_best)
  
  # Guardar
  resultados[[j]] <- list(
    nombre = nombres[j],
    curvas = resultado_best$fd,
    gcv = gcv_values,
    lambda = best_lambda,
    datos_orig = datos
  )
}
Procesando excitación 1 ... λ = 1.27e+01 
Procesando excitación 2 ... λ = 4.28e+00 
Procesando excitación 3 ... λ = 4.28e+00 
Procesando excitación 4 ... λ = 1.44e+00 
Procesando excitación 5 ... λ = 1.13e+02 
Procesando excitación 6 ... λ = 1.13e+02 
Procesando excitación 7 ... λ = 3.79e+01 

4. Curvas GCV

par(mfrow = c(3, 3), mar = c(4, 4, 3, 1))

for (j in 1:7) {
  plot(log10(lambdas), resultados[[j]]$gcv, 
       type = "b", pch = 19, col = "steelblue",
       xlab = expression(log[10](lambda)), 
       ylab = "GCV promedio",
       main = resultados[[j]]$nombre)
  
  abline(v = log10(resultados[[j]]$lambda), 
         col = "red", lty = 2, lwd = 2)
  
  grid(col = "gray80")
  
  legend("topright", 
         legend = sprintf("λ = %.2e", resultados[[j]]$lambda),
         col = "red", lty = 2, bty = "n")
}

5. Comparación: Original vs Suavizado

par(mfrow = c(4, 2), mar = c(4, 4, 3, 1))

for (j in 1:7) {
  # Original
  ylim_max <- quantile(resultados[[j]]$datos_orig, 0.99)
  
  plot(1:571, resultados[[j]]$datos_orig[1, ], type = "n",
       xlab = "Longitud de onda", ylab = "Intensidad",
       main = paste(resultados[[j]]$nombre, "- Original"),
       ylim = c(0, ylim_max))
  grid(col = "gray90")
  
  for (i in 1:min(100, nrow(resultados[[j]]$datos_orig))) {
    lines(1:571, resultados[[j]]$datos_orig[i, ], 
          col = adjustcolor("gray", alpha = 0.3))
  }
  lines(1:571, colMeans(resultados[[j]]$datos_orig), 
        col = "blue", lwd = 2)
  
  # Suavizado
  plot(resultados[[j]]$curvas,
       xlab = "Longitud de onda", ylab = "Intensidad",
       main = paste(resultados[[j]]$nombre, "- Suavizado"),
       col = adjustcolor("red", alpha = 0.3),
       ylim = c(0, ylim_max))
  
  # Media suavizada
  media_suav <- mean.fd(resultados[[j]]$curvas)
  lines(media_suav, col = "darkred", lwd = 3)
}

6. Todas las curvas suavizadas juntas

par(mfrow = c(3, 3), mar = c(4, 4, 3, 1))

for (j in 1:7) {
  plot(resultados[[j]]$curvas,
       xlab = "Longitud de onda", 
       ylab = "Intensidad",
       main = resultados[[j]]$nombre,
       col = colors,
       lwd = 1.5)
  
  # Agregar media
  media_suav <- mean.fd(resultados[[j]]$curvas)
  lines(media_suav, col = "black", lwd = 3)
}

Referencias

R. Bro, Exploratory study of sugar production using fluorescence spectroscopy and multi-way analysis, Chemom. Intell. Lab. Syst., 1999, (46), 133-147.