## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 7,
                      fig.height = 4.2, dpi = 110)
library(glmfsa)
set.seed(1)

## ----first--------------------------------------------------------------------
n <- 300; p <- 1000
x <- matrix(rnorm(n * p), n, p)
beta <- numeric(p); beta[c(10, 50, 100, 200, 300)] <- 1.5
y <- as.numeric(x %*% beta + rnorm(n))

fit <- fsa(x, y, family = "gaussian", k = 5)
fit
which(coef(fit)[-1] != 0)

## ----coefs--------------------------------------------------------------------
round(coef(fit)[c(1, 1 + c(10, 50, 100, 200, 300)), ], 3)

## ----trace, fig.height = 4.5--------------------------------------------------
tr <- fsa(x, y, k = 5, niter = 200, keep_trace = TRUE)
plot_trace(tr, highlight = c(10, 50, 100, 200, 300))

## ----path---------------------------------------------------------------------
path <- fsa(x, y, k = c(50, 30, 20, 12, 8, 5, 3, 2, 1))
path
plot(path, label = TRUE)

## ----cv, fig.height = 4.2-----------------------------------------------------
cvfit <- cv.fsa(x, y, k = c(30, 20, 12, 8, 5, 3, 2, 1), nfolds = 5)
cvfit
plot(cvfit)

## ----cvpred-------------------------------------------------------------------
head(predict(cvfit, newx = x, k = "k.1se"))

## ----sched, fig.height = 4.2--------------------------------------------------
plot_schedule(M = 1000, k = 10, niter = 500, mu = c(0, 1, 10, 100, 300, 1000))

## ----eta----------------------------------------------------------------------
xc <- matrix(rnorm(n * 300), n, 300) + rnorm(n)   # every column shares a factor
bc <- numeric(300); bc[c(10, 60, 150, 220, 280)] <- 1
yc <- as.numeric(xc %*% bc + rnorm(n) * 0.5)

fc <- fsa(xc, yc, k = 5, eta = 1)        # asked for 1 ...
fc$eta_final                             # ... capped to what is actually safe
sort(fc$selected[[1]])

## ----losses, fig.height = 4---------------------------------------------------
u <- seq(-20, 3, length.out = 400)
L <- sapply(c("logistic", "lorenz", "svm", "hinge"),
            function(l) fsa_losses(u, l))
matplot(u, L, type = "l", lty = c(1, 1, 2, 1), lwd = 2,
        col = hcl.colors(4, "Dark 3"), xlab = "margin", ylab = "loss")
legend("topright", colnames(L), lty = c(1, 1, 2, 1), lwd = 2, bty = "n",
       col = hcl.colors(4, "Dark 3"))

## ----noisy--------------------------------------------------------------------
yb <- as.integer(x %*% beta > 0)
flip <- sample(n, 0.15 * n); yb[flip] <- 1 - yb[flip]   # 15% wrong labels
sapply(c("logistic", "lorenz"), function(l) {
  s <- fsa(x, factor(yb), family = "binomial", loss = l, k = 5)$selected[[1]]
  length(intersect(s, c(10, 50, 100, 200, 300)))
})

## ----ridge--------------------------------------------------------------------
data(dexter)                      # 300 observations, 20,000 features
set.seed(11)
cv <- cv.fsa(dexter$x, dexter$y, family = "binomial", loss = "lorenz",
             k = c(20, 10, 5), s = c(0, 1e-2, 1), nfolds = 5,
             type.measure = "class")
c(k = cv$k.min, s = cv$s.min)

## ----sparse-------------------------------------------------------------------
xs <- Matrix::rsparsematrix(500, 2000, density = 0.01)
bs <- numeric(2000); bs[c(7, 300, 1500)] <- 4
ys <- as.numeric(xs %*% bs + rnorm(500) * 0.2)
sort(fsa(xs, ys, k = 3)$selected[[1]])