curve-shift.md

library(tidyverse)
library(mgcv)
#> Loading required package: nlme
#> 
#> Attaching package: 'nlme'
#> The following object is masked from 'package:dplyr':
#> 
#>     collapse
#> This is mgcv 1.8-41. For overview type 'help("mgcv-package")'.
library(gratia)

x <- 1:100

f <- function(x) {
  sin(x / 5) + sqrt(x)
}

shift1 <- 10
shift2 <- 15

data <- tibble(
  x = x,
  A = f(x),
  B = f(x + shift1),
  C = f(x + shift2)
) |> 
  pivot_longer(
    -x,
    names_to = "curve",
    values_to = "y"
  ) |> 
  mutate(across(where(is.character), as.factor))

data
#> # A tibble: 300 × 3
#>        x curve     y
#>    <int> <fct> <dbl>
#>  1     1 A      1.20
#>  2     1 B      4.13
#>  3     1 C      3.94
#>  4     2 A      1.80
#>  5     2 B      4.14
#>  6     2 C      3.87
#>  7     3 A      2.30
#>  8     3 B      4.12
#>  9     3 C      3.80
#> 10     4 A      2.72
#> # ℹ 290 more rows

data |> 
  ggplot() +
  aes(x, y, color = curve) +
  geom_line() +
  geom_point() +
  scale_color_viridis_d(end = 0.85) +
  labs(
    x = "X",
    y = "Y",
    title = "Can we recover the horizontal shift between curves A, B and C?",
    subtitle = "The curves are identical other than horizontal translation"
  ) +
  theme_minimal()

# is there a way to recover shift1 and shift2 using mgcv?

^{Created on 2024-02-21 with reprex v2.0.2}

As mentioned on Twitter, and admittedly not particularly satisfying, but if you just want the time shifts, you can wrap the gam inside an nls call. It seems to do a pretty ok job of estimating the shift. But you don't get the uncertainty of the time shifts incorporated into the gam's inferences.

library(minpack.lm)

shift_func <- function(data, B_shift, C_shift) {
  
  data <- data %>% 
    mutate(x_shifted = case_when(
      curve == "A" ~ x,
      curve == "B" ~ x + B_shift,
      curve == "C" ~ x + C_shift
    ))
  
  fit <- gam(y~s(x_shifted), data=data)
  
  as.numeric(predict(fit))

}

nlsLM(y ~ shift_func(data, B_shift, C_shift), data = data, 
      start = c(B_shift = 0, C_shift = 0),
      upper = c(B_shift = 50, C_shift = 50),
      lower = c(B_shift = -50, C_shift = -50))