Suavização de Curvas - Média Móvel - Filtro Passa-Baixo

Tópico 1 - Importar arquivos

Importação dos arquivos armazenados em máquina local

library(readr)
dados <- read.csv("C:/Espectrorradiometria_R/01_Dados_Processados/curvas_medias.csv", sep=",")
head(dados)

Plotagem das curvas usando o pacote ggplot2

“plotar” : Função genérica para gráfico de linhas utilizando o ggplot2

Argumentos:

• dados: Dados de interesse (na estrutura de pilha). Para construir os gráficos utilizando o ggplot2 é necessário fazer o stack dos dados, ou seja, é nescessário que os dados estejam na estrutura de pilha.
• titulo: Titulo principal do gráfico.

plotar = function(dados, titulo)  {
  library(ggplot2)
  library("reshape2") #Pacote para manipular formato de dados no R
  pilha=melt(dados, id = "Wavelength")
    ggplot(pilha, aes(x=pilha[[1]],y=pilha[[3]],group=pilha[[2]]))+
    geom_line(aes(color=pilha[[2]])) + 
      theme_classic()+
      ggtitle (titulo)+
      scale_color_discrete(name = "Forest Species")+
      ylab ("Reflectance factor") +
      xlab ("Wavelength (nm)") +
      ylim(0,0.65)+
      xlim(400,2000)}

Aplicando a função aos dados e armazenando o gráfico no objeto “plot1”

plot1 = plotar(dados, "Dados Brutos")
plot1

Tópico 2 - Suavização por média móvel

Nesse tópico será utilizada a função “rollapply” do pacote “zoo” que computa a média móvel

library(zoo) 

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

mm_20=data.frame(rollapply(dados, width = 20, by = 1, FUN = mean, na.rm = TRUE, align = "left"))
mm_30=data.frame(rollapply(dados, width = 30, by = 1, FUN = mean, na.rm = TRUE, align = "left"))

Tópico 3 - Suavização pelo filtro passa baixo

Método loess

A função low_pass_loass foi contruída para aplicar o filtro passa baixo utilizando o algoritmo LOESS - Local Polynomial Regression Fitting (https://www.rdocumentation.org/packages/stats/versions/3.6.2/topics/loess).

Argumentos:

• dados: Planilha de dados contendo as curvas espectrais. Na planilha de entrada, cada coluna deve representar uma categoria/alvo de interesse
• lambda: Informar a coluna que contém os comprimentos de onda.
• fator: magnitude/intensidade do filtro

low_pass_loess = function (dados, lambda, fator){
  itera = lapply(2:dim(dados)[2], function(i) { 
    predict(loess( y~x , data = data.frame(x = lambda, y = dados[,i]),span = fator), lambda)})
     filtrado = data.frame (dados[,1], as.data.frame(itera))
       names(filtrado)=names(dados)
         return(filtrado)}

lploess_005=low_pass_loess(dados, dados$Wavelength, 0.05)
lploess_010=low_pass_loess(dados, dados$Wavelength, 0.1)

Método spline

A função low_pass_spline foi contruída para aplicar o filtro passa baixo utilizando o algoritmo Spline - Fits a cubic smoothing spline to the supplied data (https://www.rdocumentation.org/packages/stats/versions/3.6.2/topics/smooth.spline).

Argumentos:

• dados: Planilha de dados contendo as curvas espectrais. Na planilha de entrada, cada coluna deve representar uma categoria/alvo de interesse
• lambda: Informar a coluna que contém os comprimentos de onda.
• spar: magnitude/intensidade do filtro

low_pass_spline = function (dados, lambda, spar){
  itera = lapply(2:dim(dados)[2], function(i) {
    predict(smooth.spline(lambda,dados[,i], spar = spar), lambda)[[2]]})
     filtrado= data.frame (dados[,1], as.data.frame(itera))
      names(filtrado)=names(dados)
       return(filtrado)}

lpspline_01=low_pass_spline(dados, dados$Wavelength, 0.1)
lpspline_05=low_pass_spline(dados, dados$Wavelength, 0.5)

Tópico 4 - Plotagem dos resultados

• Aplicando a função nos dados e armazenando os plots em objetos

p1=plotar(dados, "Dados Brutos")
p2=plotar(mm_20, "Média Móvel - Janela 20")
p3=plotar(mm_20, "Média Móvel - Janela 30")
p4=plotar(lploess_005, "Passa-Baixo Loess - Limiar 0.05")
p5=plotar(lploess_010, "Passa-Baixo Loess - Limiar 0.1")
p6=plotar(lpspline_01, "Passa-Baixo Spline - Limiar 0.1")
p7=plotar(lpspline_05, "Passa-Baixo Spline  - Limiar 0.5")

• Pacotes para agrupar gráficos ggplot em figura única

library(ggpubr)

## Carregando pacotes exigidos: ggplot2

library(gridExtra)

ggarrange(p1,p2,p3,p4,p5,p6,p7, 
          labels = c("A", "B","C","D","E","F","G"), 
          common.legend = TRUE, 
          legend = "bottom",
          ncol = 3, nrow = 3)

ggarrange(p1,p3,p4,p7, 
          labels = c("A","B","C","D"), 
          common.legend = TRUE, 
          legend = "bottom")