implement fit_spline() model fitting for use with GA for knot selection

[beanumber]

@xuehens I'm using this issue to track the knot selection problem. I actually don't think it will be that hard to write a function that will implement this, since the fit_lmshift() function already uses the lm backend. All we should have to do is write the formula, but that should be easy because we can just use poly().

[beanumber]

This is done. Is this what you were looking for @xuehens?

library(tidychangepoint)

l <- log_gabin_population(CET)
fit_poly2 <- function(x, tau, ...) fit_lmshift(x, tau, deg_poly = 2)
attr(fit_poly2, "model_name") <- "poly2"

x <- segment(CET, method = "ga", model_fn = fit_meanshift, penalty_fn = BIC, population = l, popSize = 200, maxiter = 10)
#> method: ga
#> Seeding initial population with probability: 0.0162752602536624
y <- segment(CET, method = "ga", model_fn = fit_trendshift, penalty_fn = BIC, population = l, popSize = 200, maxiter = 10)
#> method: ga
#> Seeding initial population with probability: 0.0162752602536624
z <- segment(CET, method = "ga", model_fn = fit_poly2, penalty_fn = BIC, population = l, popSize = 200, maxiter = 10)
#> method: ga
#> Seeding initial population with probability: 0.0162752602536624

dplyr::bind_rows(glance(x), glance(y), glance(z))
#> # A tibble: 3 × 9
#>   pkg   version    algorithm params           num_cpts model    criteria fitness
#>   <chr> <pckg_vrs> <chr>     <list>              <int> <chr>    <chr>      <dbl>
#> 1 ga    3.2.4      Genetic   <named list [6]>        3 meanshi… BIC         658.
#> 2 ga    3.2.4      Genetic   <named list [6]>        2 trendsh… BIC         672.
#> 3 ga    3.2.4      Genetic   <named list [6]>        1 poly2    BIC         656.
#> # ℹ 1 more variable: elapsed_time <drtn>

plot(x)

plot(y)

plot(z)

^{Created on 2024-04-11 with reprex v2.1.0}