########## EXAMPLE 1 ##########
### 1 continuous predictor
# generate data
set.seed(1)
n <- 100
x <- seq(0, 1, length.out = n)
fx <- 2 + 3 * x + sin(2 * pi * x)
y <- fx + rnorm(n, sd = 0.5)
# fit sm with 10 knots (tprk = TRUE)
sm.ssa <- sm(y ~ x, knots = 10)
# fit sm with 10 knots (tprk = FALSE)
sm.gam <- sm(y ~ x, knots = 10, tprk = FALSE)
# print both results (note: they are identical)
sm.ssa
sm.gam
# plot both results (note: they are identical)
plot(sm.ssa)
plot(sm.gam)
# summarize both results (note: they are identical)
summary(sm.ssa)
summary(sm.gam)
# compare true MSE values (note: they are identical)
mean( ( fx - sm.ssa$fit )^2 )
mean( ( fx - sm.gam$fit )^2 )
########## EXAMPLE 2 ##########
### 1 continuous and 1 nominal predictor
### additive model
# generate data
set.seed(1)
n <- 100
x <- seq(0, 1, length.out = n)
z <- factor(sample(letters[1:3], size = n, replace = TRUE))
fun <- function(x, z){
mu <- c(-2, 0, 2)
zi <- as.integer(z)
fx <- mu[zi] + 3 * x + sin(2 * pi * x)
}
fx <- fun(x, z)
y <- fx + rnorm(n, sd = 0.5)
# define marginal knots
probs <- seq(0, 0.9, by = 0.1)
knots <- list(x = quantile(x, probs = probs),
z = letters[1:3])
# fit sm with specified knots (tprk = TRUE)
sm.ssa <- sm(y ~ x + z, knots = knots)
# fit sm with specified knots (tprk = FALSE)
sm.gam <- sm(y ~ x + z, knots = knots, tprk = FALSE)
# print both results (note: they are identical)
sm.ssa
sm.gam
# plot both results (note: they are identical)
plot(sm.ssa)
plot(sm.gam)
# summarize both results (note: they are almost identical)
summary(sm.ssa)
summary(sm.gam)
# compare true MSE values (note: they are identical)
mean( ( fx - sm.ssa$fit )^2 )
mean( ( fx - sm.gam$fit )^2 )
########## EXAMPLE 3 ##########
### 1 continuous and 1 nominal predictor
### interaction model
# generate data
set.seed(1)
n <- 100
x <- seq(0, 1, length.out = n)
z <- factor(sample(letters[1:3], size = n, replace = TRUE))
fun <- function(x, z){
mu <- c(-2, 0, 2)
zi <- as.integer(z)
fx <- mu[zi] + 3 * x + sin(2 * pi * x + mu[zi]*pi/4)
}
fx <- fun(x, z)
y <- fx + rnorm(n, sd = 0.5)
# define marginal knots
probs <- seq(0, 0.9, by = 0.1)
knots <- list(x = quantile(x, probs = probs),
z = letters[1:3])
# fit sm with specified knots (tprk = TRUE)
sm.ssa <- sm(y ~ x * z, knots = knots)
# fit sm with specified knots (tprk = FALSE)
sm.gam <- sm(y ~ x * z, knots = knots, tprk = FALSE)
# print both results (note: they are slightly different)
sm.ssa
sm.gam
# plot both results (note: they are slightly different)
plot(sm.ssa)
plot(sm.gam)
# summarize both results (note: they are slightly different)
summary(sm.ssa)
summary(sm.gam)
# compare true MSE values (note: they are slightly different)
mean( ( fx - sm.ssa$fit )^2 )
mean( ( fx - sm.gam$fit )^2 )
########## EXAMPLE 4 ##########
### 4 continuous predictors
### additive model
# generate data
set.seed(1)
n <- 100
fun <- function(x){
sin(pi*x[,1]) + sin(2*pi*x[,2]) + sin(3*pi*x[,3]) + sin(4*pi*x[,4])
}
data <- as.data.frame(replicate(4, runif(n)))
colnames(data) <- c("x1v", "x2v", "x3v", "x4v")
fx <- fun(data)
y <- fx + rnorm(n)
# define marginal knots
knots <- list(x1v = quantile(data$x1v, probs = seq(0, 1, length.out = 10)),
x2v = quantile(data$x2v, probs = seq(0, 1, length.out = 10)),
x3v = quantile(data$x3v, probs = seq(0, 1, length.out = 10)),
x4v = quantile(data$x4v, probs = seq(0, 1, length.out = 10)))
# define ssa knot indices
knots.indx <- c(bin.sample(data$x1v, nbin = 10, index.return = TRUE)$ix,
bin.sample(data$x2v, nbin = 10, index.return = TRUE)$ix,
bin.sample(data$x3v, nbin = 10, index.return = TRUE)$ix,
bin.sample(data$x4v, nbin = 10, index.return = TRUE)$ix)
# fit sm with specified knots (tprk = TRUE)
sm.ssa <- sm(y ~ x1v + x2v + x3v + x4v, data = data, knots = knots.indx)
# fit sm with specified knots (tprk = FALSE)
sm.gam <- sm(y ~ x1v + x2v + x3v + x4v, data = data, knots = knots, tprk = FALSE)
# print both results (note: they are slightly different)
sm.ssa
sm.gam
# plot both results (note: they are slightly different)
plot(sm.ssa)
plot(sm.gam)
# summarize both results (note: they are slightly different)
summary(sm.ssa)
summary(sm.gam)
# compare true MSE values (note: they are slightly different)
mean( ( fx - sm.ssa$fit )^2 )
mean( ( fx - sm.gam$fit )^2 )
Run the code above in your browser using DataLab