---
title: "Smoothing Methods"
author: "N. Frerebeau"
date: "`r Sys.Date()`"
output:
  markdown::html_format:
    options:
      toc: true
      number_sections: true
vignette: >
  %\VignetteIndexEntry{Smoothing Methods}
  %\VignetteEngine{knitr::knitr}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

```{r setup}
library(alkahest)
```

```{r raw, fig.width=7, fig.height=5, fig.cap="Simulated data."}
## Simulate data
set.seed(12345)
x <- seq(-4, 4, length = 100)
y <- dnorm(x)
z <- y + rnorm(100, mean = 0, sd = 0.01) # Add some noise

## Plot raw data
plot(x, z, type = "l", xlab = "", ylab = "", las = 1)
lines(x, y, type = "l", lty = 2, col = "red")
```

# Rectangular smoothing

```{r unweighted, fig.width=7, fig.height=6, fig.cap="Rectangular smoothing."}
unweighted <- smooth_rectangular(x, z, m = 3)

par(mar = c(3, 3, 1, 1) + 0.1, las = 1)
layout(matrix(c(1, 2), nrow = 2, ncol = 1), heights = c(2, 1))

plot(unweighted, type = "l", xlab = "", ylab = "") 
lines(x, y, type = "l", lty = 2, col = "red")

plot(x, y - unweighted$y, ylim = c(-0.03, 0.03), type = "l", xlab = "", ylab = "")
abline(h = 0, lty = 2)
```

# Triangular smoothing

```{r weighted, fig.width=7, fig.height=6, fig.cap="Triangular smoothing."}
weighted <- smooth_triangular(x, z, m = 5)

par(mar = c(3, 3, 1, 1) + 0.1, las = 1)
layout(matrix(c(1, 2), nrow = 2, ncol = 1), heights = c(2, 1))

plot(weighted, type = "l", xlab = "", ylab = "")
lines(x, y, type = "l", lty = 2, col = "red")

plot(x, y - weighted$y, ylim = c(-0.03, 0.03), type = "l", xlab = "", ylab = "")
abline(h = 0, lty = 2)
```

# Loess smoothing

```{r loess, fig.width=7, fig.height=6, fig.cap="Loess smoothing."}
loess <- smooth_loess(x, z, span = 0.2)

par(mar = c(3, 3, 1, 1) + 0.1, las = 1)
layout(matrix(c(1, 2), nrow = 2, ncol = 1), heights = c(2, 1))

plot(loess, type = "l", xlab = "", ylab = "")
lines(x, y, type = "l", lty = 2, col = "red")

plot(x, y - loess$y, ylim = c(-0.03, 0.03), type = "l", xlab = "", ylab = "")
abline(h = 0, lty = 2)
```

# Savitzky-Golay filter

```{r savitzky, fig.width=7, fig.height=6, fig.cap="Savitzky–Golay filter."}
savitzky <- smooth_savitzky(x, z, m = 21, p = 2)

par(mar = c(3, 3, 1, 1) + 0.1, las = 1)
layout(matrix(c(1, 2), nrow = 2, ncol = 1), heights = c(2, 1))

plot(savitzky, type = "l", xlab = "", ylab = "")
lines(x, y, type = "l", lty = 2, col = "red")

plot(x, y - savitzky$y, ylim = c(-0.03, 0.03), type = "l", xlab = "", ylab = "")
abline(h = 0, lty = 2)
```

# Whittaker smoothing

```{r whittaker, fig.width=7, fig.height=6, fig.cap="Whittaker smoothing."}
whittaker <- smooth_whittaker(x, z, lambda = 1000, d = 3, sparse = TRUE)

par(mar = c(3, 3, 1, 1) + 0.1, las = 1)
layout(matrix(c(1, 2), nrow = 2, ncol = 1), heights = c(2, 1))

plot(whittaker, type = "l", xlab = "", ylab = "")
lines(x, y, type = "l", lty = 2, col = "red")

plot(x, y - whittaker$y, ylim = c(-0.03, 0.03), type = "l", xlab = "", ylab = "")
abline(h = 0, lty = 2)
```