library(tidyverse)
library(cowplot)
library(broom)
library(modelr)
library(viridis)
library(lubridate)
library(hms)
library(knitr)
library(kableExtra)
library(patchwork)
library(VGAM)
library(nls.multstart)
knitr::opts_chunk$set(tidy.opts=list(width.cutoff=60),tidy=TRUE, echo = TRUE, message=FALSE, warning=FALSE, fig.align="center")
source("../tools/echem_processing_tools.R")
source("../tools/plotting_tools.R")
theme_set(theme_1())
Based on the explanation from this Dartmouth link under “Initial punctual release between two boundaries” I got the following equation for diffusion between two barriers at \(x = 0\) and \(x = L\) for a point source at \(x = a\).
\[ C(x,t) = \frac{M}{\sqrt{4 \pi D t}} \sum_{n = -\infty}^{\infty} \left[ \exp{ \left( \frac{-(x-2nL-a)^2}{4 D t} \right) } + \exp{ \left( \frac{-(x-2nL+a)^2}{4 D t} \right) } \right] \]
For our system, we will assume that the point source is at \(a = 0\), so we can evaluate and simplify:
\[ C(x,t) = \frac{M}{\sqrt{4 \pi D t}} \sum_{n = -\infty}^{\infty} \left[ \exp{ \left( \frac{-(x-2nL)^2}{4 D t} \right) } + \exp{ \left( \frac{-(x-2nL)^2}{4 D t} \right) } \right] \]
\[ C(x,t) = \frac{M}{\sqrt{4 \pi D t}} \sum_{n = -\infty}^{\infty} \left[ 2 \exp{ \left( \frac{-(x-2nL)^2}{4 D t} \right) } \right] \]
This expression looks a little nasty, but it’s pretty straightforward to write as a function. The function below will take in the parameters \(M_0\), \(L\), \(D\), and calculate the concentration \(C\) for a range of \(x\) and \(t\) values.
finite_point_x_t <- function(m0, L, D, x, t) {
sum = 0
for (n in seq(-100, 100, 1)) {
sum = sum + 2 * exp((-(x - 2 * n * L)^2)/(4 * D * t))
}
(m0/sqrt(4 * pi * D * t)) * sum
}
So this function will calculate the concentration gradient over time! Here I’m calculating the first 200 terms, which should be sufficient.
Now let’s generate some a grid of time \(t\) and space \(x\), and calculate the concentration gradient for some arbitrary parameters \(M_0 = 2\), \(L = 0.1\), and \(D = 5*10^{-5}\).
grid <- expand.grid(x = seq(0, 0.1, length = 101), t = seq(0,
2500, length = 25))
finite_point_data <- grid %>% mutate(c = finite_point_x_t(m0 = 2,
L = 0.1, D = 5e-06, x = x, t = t))
Ok, let’s see what our concentration gradients look like!
ggplot(finite_point_data, aes(x = x, y = c, color = t)) + geom_path(aes(group = t)) +
scale_color_viridis()
Cool, so this shows that the concentration starts out high at \(x = 0\) and slowly equilibrates to an almost flat gradient (at longer times it will be totally flat).
Ok, for our electrode system, we really only have a measurement at \(x = 0\), so let’s see what the concentration does over time at that point in space.
ggplot(finite_point_data %>% filter(x == 0), aes(x = t, y = c,
color = t)) + geom_point() + scale_color_viridis()
Great! This looks similar to our data. This is equivalent to evaluating the expression above at \(x = 0\), which gives:
\[ C(x,t) = \frac{M}{\sqrt{4 \pi D t}} \sum_{n = -\infty}^{\infty} \left[ 2 \exp{ \left( \frac{-(-2nL)^2}{4 D t} \right) } \right] \]
I’ll write a function to do just that math and regenerate our data for just \(x = 0\). Let’s add a little noise too, to make it more realistic and also allow us to do a nonlinear fit.
finite_point_x0 <- function(m0, L, D, t) {
sum = 0
for (n in seq(-100, 100, 1)) {
sum = sum + 2 * exp((-(-2 * n * L)^2)/(4 * D * t))
}
(m0/sqrt(4 * pi * D * t)) * sum
}
finite_point_x0_data <- grid %>% filter(x == 0) %>% mutate(c = finite_point_x0(m0 = 2,
L = 0.1, D = 5e-06, t = t)) %>% mutate(c_noise = rnorm(n = length((grid %>%
filter(x == 0))$t), mean = c, sd = 1))
So here’s what the concentration looks like at \(x = 0\) over time with a little noise added:
ggplot(finite_point_x0_data, aes(x = t, y = c_noise, color = t)) +
geom_point() + scale_color_viridis()
Ok, now let’s see if we can get the nonlinear least squares (nls) function to fit this data and give us back the parameters we used to generate the data.
suppressWarnings(fit_nls_multstart <- nls_multstart(formula = c_noise ~
finite_point_x0(m0 = 2, L, D, t = t), data = finite_point_x0_data,
start_lower = c(L = 0.01, D = 1e-08), start_upper = c(L = 10,
D = 1e-05), lower = c(L = 0, D = 0), supp_errors = "Y",
iter = 250, na.action = na.omit))
L_fit <- coef(fit_nls_multstart)[1]
D_fit <- coef(fit_nls_multstart)[2]
finite_point_x0_data_pred <- finite_point_x0_data %>% mutate(pred = finite_point_x0(m0 = 2,
L = L_fit, D = D_fit, t = t))
ggplot(finite_point_x0_data_pred %>% filter(t > 0), aes(x = t,
y = c_noise, color = t)) + geom_line(aes(y = pred), color = "black",
linetype = 2) + geom_point() + scale_color_viridis()
summary(fit_nls_multstart)
##
## Formula: c_noise ~ finite_point_x0(m0 = 2, L, D, t = t)
##
## Parameters:
## Estimate Std. Error t value Pr(>|t|)
## L 1.012e-01 1.499e-03 67.50 <2e-16 ***
## D 4.859e-06 1.521e-07 31.94 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.167 on 22 degrees of freedom
##
## Number of iterations to convergence: 11
## Achieved convergence tolerance: 1.49e-08
Wow, it actually works! Note that we asked the nls to find the values of D and L, but we provided \(M_0\). This is similar to the way I’m doing the analysis now, but it does depend on having an accurate guess for \(M_0\). Let’s see what estimate we get if \(M_0\) is off by 2x.
### m0 = 1 instead of m0 = 2
suppressWarnings(fit_nls_multstart <- nls_multstart(formula = c_noise ~
finite_point_x0(m0 = 1, L, D, t = t), data = finite_point_x0_data,
start_lower = c(L = 0.01, D = 1e-08), start_upper = c(L = 10,
D = 1e-05), lower = c(L = 0, D = 0), supp_errors = "Y",
iter = 250, na.action = na.omit))
L_fit <- coef(fit_nls_multstart)[1]
D_fit <- coef(fit_nls_multstart)[2]
finite_point_x0_data_pred <- finite_point_x0_data %>% mutate(pred = finite_point_x0(m0 = 1,
L = L_fit, D = D_fit, t = t))
ggplot(finite_point_x0_data_pred %>% filter(t > 0), aes(x = t,
y = c_noise, color = t)) + geom_line(aes(y = pred), color = "black",
linetype = 2) + geom_point() + scale_color_viridis()
summary(fit_nls_multstart)
##
## Formula: c_noise ~ finite_point_x0(m0 = 1, L, D, t = t)
##
## Parameters:
## Estimate Std. Error t value Pr(>|t|)
## L 5.061e-02 7.497e-04 67.50 <2e-16 ***
## D 1.215e-06 3.803e-08 31.94 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.167 on 22 degrees of freedom
##
## Number of iterations to convergence: 9
## Achieved convergence tolerance: 1.49e-08
So now the function still returns a nice looking best fit line, but the estimate of L is off 2x and the estimate of D is off almost 5x.
I think that we can continue to deal with this in the same way as before, by estimating D with a high and low estimate of \(I_0\) using the soak peak current and the first transfer SWV peak current.
Now, I need to re adapt this math to the SWV current, and try to fit some of our real data!