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 .matdata <-readMat("C:/Users/sarar/Documents/Maestría Estadística/Datos Funcionales/Sugar Process Data/sugar_Process/data.mat")# Extraer variables principalesX <- data$XDimX <-as.integer(data$DimX)EmAx <-as.vector(data$EmAx) # Longitudes de onda de emisiónExAx <-as.vector(data$ExAx) # Longitudes de onda de excitacióny <- data$y # Variables de calidad (ceniza y color)time <- data$time # Códigos temporales# Reshape del array tridimensionalX <-array(X, dim = DimX)# Información básicacat("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ónondas <-lapply(1:7, function(i) X[, , i])nombres <-paste("Excitación", 1:7)# Configurar coloresn <-dim(X)[1]colors <-colorRampPalette(brewer.pal(9, "Set3"))(n)# Graficar todas las ondaspar(mfrow =c(3, 3), mar =c(4, 4, 3, 1))for (i in1:7) {# Determinar rango automáticamente ylim_max <-quantile(ondas[[i]], 0.99)# Gráficoplot(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 transparenciafor (j in1:nrow(ondas[[i]])) {lines(1:571, ondas[[i]][j, ], col =adjustcolor(colors[j], alpha =0.4), lwd =1) }# Media en negrolines(1:571, colMeans(ondas[[i]]), col ="black", lwd =2)}
3. Suavizado penalizado
# Configuraciónn_puntos <-571n_base <-50rango <-c(1, n_puntos)tiempo <-seq(rango[1], rango[2], length.out = n_puntos)# Base de B-splinesbasis <-create.bspline.basis(rangeval = rango, nbasis = n_base)# Valores de lambda a probarlambdas <-10^seq(-6, 3, length.out =20)# Procesar cada ondaresultados <-list()for (j in1:7) {cat("Procesando excitación", j, "... ") datos <- ondas[[j]] gcv_values <-numeric(length(lambdas))# Probar cada lambdafor (i inseq_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 )}