## Monotone increasing P-splines example
## simulating data...
require(scam)
set.seed(12)
n <- 100
x <- runif(n)*4-1
f <- 4*exp(4*x)/(1+exp(4*x))
y <- rpois(n,exp(f))
dat <- data.frame(x=x,y=y)
## fit model ...
b <- scam(y~s(x,k=15,bs="mpi"),family=poisson(link="log"),
data=dat)
## fit unconstrained model...
b1 <- scam(y~s(x,k=15,bs="ps"),family=poisson(link="log"),
data=dat)
## plot results ...
plot(x,y,xlab="x",ylab="y")
x1 <- sort(x,index=TRUE)
lines(x1$x,exp(f)[x1$ix]) ## the true function
lines(x1$x,b$fitted.values[x1$ix],col=2) ## monotone fit
lines(x1$x,b1$fitted.values[x1$ix],col=3) ## unconstrained fit
## example with supplied knots...
knots <- list(x=c (-1.5, -1.2, -.99, -.97, -.7, -.5, -.3, 0, 0.7,
0.9,1.1, 1.22,1.5,2.2,2.77,2.93,2.99, 3.2,3.6))
b2 <- scam(y~s(x,k=15,bs="mpi"),knots=knots,
family=poisson(link="log"), data=dat)
summary(b2)
plot(b2,shade=TRUE)
if (FALSE) {
## example with two terms...
set.seed(0)
n <- 200
x1 <- runif(n)*6-3
f1 <- 3*exp(-x1^2) # unconstrained term
x2 <- runif(n)*4-1;
f2 <- exp(4*x2)/(1+exp(4*x2)) # monotone increasing smooth
f <- f1+f2
y <- f+rnorm(n)*.7
dat <- data.frame(x1=x1,x2=x2,y=y)
knots <- list(x1=c(-4,-3.5,-2.99,-2.7,-2.5,-1.9,-1.1,-.9,-.3,0.3,.8,1.2,1.9,2.3,
2.7,2.99,3.5,4.1,4.5), x2=c(-1.5,-1.2,-1.1, -.89,-.69,-.5,-.3,0,0.7,
0.9,1.1,1.22,1.5,2.2,2.77,2.99,3.1, 3.2,3.6))
b3 <- scam(y~s(x1,k=15)+s(x2,bs="mpi", k=15),
knots=knots,data=dat)
summary(b3)
plot(b3,pages=1,shade=TRUE)
## setting knots for f(x2) only...
knots <- list(x2=c(-1.5,-1.2,-1.1, -.89,-.69,-.5,-.3,
0,0.7,0.9,1.1,1.22,1.5,2.2,2.77,2.99,3.1, 3.2,3.6))
b4 <- scam(y~s(x1,k=15,bs="bs")+s(x2,bs="mpi",k=15),
knots=knots,data=dat)
summary(b4)
plot(b4,pages=1,shade=TRUE)
## 'by' factor example...
set.seed(10)
n <- 400
x <- runif(n, 0, 1)
## all three smooths are increasing...
f1 <- log(x *5)
f2 <- exp(2*x) - 4
f3 <- 5* sin(x)
e <- rnorm(n, 0, 2)
fac <- as.factor(sample(1:3,n,replace=TRUE))
fac.1 <- as.numeric(fac==1)
fac.2 <- as.numeric(fac==2)
fac.3 <- as.numeric(fac==3)
y <- f1*fac.1 + f2*fac.2 + f3*fac.3 + e
dat <- data.frame(y=y,x=x,fac=fac,f1=f1,f2=f2,f3=f3)
b5 <- scam(y ~ fac+s(x,by=fac,bs="mpi"),data=dat)
plot(b5,pages=1,scale=0,shade=TRUE)
summary(b5)
vis.scam(b5,theta=50,color="terrain")
## comparing with unconstrained fit...
b6 <- scam(y ~ fac+s(x,by=fac),data=dat)
x11()
plot(b6,pages=1,scale=0,shade=TRUE)
summary(b6)
vis.scam(b6,theta=50,color="terrain")
## Note that since in scam() as in mgcv::gam() when using factor 'by' variables, 'centering'
## constraints are applied to the smooths, which usually means that the 'by'
## factor variable should be included as a parametric term, as well.
## numeric 'by' variable example...
set.seed(3)
n <- 200
x <- sort(runif(n,-1,2))
z <- runif(n,-2,3)
f <- exp(1.3*x)-5
y <- f*z + rnorm(n)*2
dat <- data.frame(x=x,y=y,z=z)
b <- scam(y~s(x,by=z,bs="mpiBy"),data=dat)
plot(b,shade=TRUE)
summary(b)
## unconstrained fit...
b1 <- scam(y~s(x,k=15,by=z),data=dat)
plot(b1,shade=TRUE)
summary(b1)
}
Run the code above in your browser using DataLab