Commit ab2467ff authored by luroth's avatar luroth
Browse files

spline fitting optimized

parent d0d543bc
...@@ -67,18 +67,21 @@ fit_scam_spline_weights <- function(x, y, w, k = NA, bs = "mpi", label = NULL, o ...@@ -67,18 +67,21 @@ fit_scam_spline_weights <- function(x, y, w, k = NA, bs = "mpi", label = NULL, o
spline <- NULL spline <- NULL
try( try(
spline <- R.utils::withTimeout(scam(y ~ s(as.numeric(x), k = k, bs = bs), optimizer = optimizer, weights = w), timeout=0.5) spline <- R.utils::withTimeout(scam(y ~ s(as.numeric(x), k = k, bs = bs), optimizer = optimizer, weights = w), timeout=0.3)
) )
if (is.null(spline)) { if (is.null(spline)) {
print("decreasing k") print("decreasing k")
try( try(
spline <- R.utils::withTimeout(scam(y ~ s(as.numeric(x), k = k - 1, bs = bs), weights = w), timeout=1) spline <- R.utils::withTimeout(scam(y ~ s(as.numeric(x), k = k - 1, bs = bs), weights = w), timeout=0.5)
) )
if (is.null(spline)) { if (is.null(spline)) {
print("2. time decreasing k") print("2. time decreasing k")
try( try(
spline <- R.utils::withTimeout(scam(y ~ s(as.numeric(x), k = k - 2, bs = bs)), timeout=10) spline <- R.utils::withTimeout(scam(y ~ s(as.numeric(x), k = k - 2, bs = bs), weights = w), timeout=1)
) )
if (is.null(spline)) {
spline <- scam(y ~ s(as.numeric(x), k = k - 1, bs = bs))
}
} }
} }
return(spline) return(spline)
...@@ -109,7 +112,6 @@ predict_scam_spline <- function(spline, x_, deriv = NULL, se = FALSE) ...@@ -109,7 +112,6 @@ predict_scam_spline <- function(spline, x_, deriv = NULL, se = FALSE)
predict_scam_spline_posteriors <- function(spline, x_) predict_scam_spline_posteriors <- function(spline, x_)
{ {
# Design matrix # Design matrix
lp <- predict.scam(spline, newdata = x_, type = "lpmatrix") lp <- predict.scam(spline, newdata = x_, type = "lpmatrix")
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment