tests/temp.R

In cobs: Constrained B-Splines (Sparse Matrix Based)

suppressMessages(library(cobs))

#### Example 1 of   He and Ng (1999) :
#### -------------------------------
if(!dev.interactive(orNone=TRUE)) pdf("temp.pdf", width=10)

data(globtemp)
str(globtemp)## time series T=113,  1880:1992

## require(ts)# later for plotting
## At the moment forget about all time-series stuff; use num.vectors:
str(year <- as.vector(time(globtemp)))
str(temp <- as.vector(globtemp))

## Codes for Figure 1a
a50 <- cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "increase",
            ic = "SIC") # = previous default 'ic'
summary(a50)
## As suggested in the warning message, we increase the number of knots to 9
a50 <- cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1,
            constraint = "increase", ic = "SIC") # = previous default 'ic'
summary(a50)
## Here, we use the same knots sequence chosen for the 50th percentile
a10 <- cobs(year, temp, nknots = length(a50$knots), knots = a50$knot,
            degree = 1, tau = 0.1, constraint = "increase", ic = "SIC")
summary(a10)
a90 <- cobs(year, temp, nknots = length(a50$knots), knots = a50$knot,
            degree = 1, tau = 0.9, constraint = "increase", ic = "SIC")
summary(a90)

which(hot.idx  <- temp >= a90$fit)
which(cold.idx <- temp <= a10$fit)
normal.idx <- !hot.idx & !cold.idx

(pa50 <- predict(a50,year,interval = "both"))
(pa10 <- predict(a10,year,interval = "both"))
(pa90 <- predict(a90,year,interval = "both"))

plot(year, temp, type = "n", ylab = "Temperature (C)", ylim = c(-.7,.6))
lines(pa50, col = 2)
lines(pa10, col = 3)
lines(pa90, col = 3)
points(year, temp, pch = c(1,3)[2 - normal.idx])

text(year[hot.idx], temp[hot.idx] + .03, labels = year[hot.idx])
text(year[cold.idx],temp[cold.idx]- .03, labels = year[cold.idx])

### Codes for Figure 1b. -- UNconstrained

## (Pin Ng. had these commented out)

a50 <- cobs(year, temp, knots.add = TRUE, degree = 1, constraint = "none",
            ic = "SIC")
## As suggested in the warning message, we increase the number of knots to 9
a50 <- cobs(year, temp, nknots = 9, knots.add = TRUE, degree = 1,
            constraint = "none", ic = "SIC")
summary(a50)
## Here, we use the same knots sequence chosen for the 50th percentile
(a10 <- cobs(year, temp, nknots = length(a50$knots), knots = a50$knot,
             degree = 1, tau = 0.1, constraint = "none", ic = "SIC"))
(a90 <- cobs(year, temp, nknots = length(a50$knots), knots = a50$knot,
             degree = 1, tau = 0.9, constraint = "none", ic = "SIC"))
which(hot.idx  <- temp >= a90$fit)
which(cold.idx <- temp <= a10$fit)
normal.idx <- (temp < a90$fit ) & (temp > a10$fit)

pa50 <- predict(a50,year,interval = "none")
pa10 <- predict(a10,year,interval = "none")
pa90 <- predict(a90,year,interval = "none")

plot(year, temp, type = "n",xlab = "Year", ylab = "Temperature (C)",
     ylim = c(-.7,.6))
lines(pa50, col = 2)
lines(pa10, col = 3)
lines(pa90, col = 3)
points(year[normal.idx],temp[normal.idx])
points(year[!normal.idx],temp[!normal.idx],pch = 3)
text(year[hot.idx], temp[hot.idx]  + .03, labels = year[hot.idx])
text(year[cold.idx],temp[cold.idx] - .03, labels = year[cold.idx])


cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons''