Vignette.R

stanfordchihuri — Apr 17, 2014, 6:47 PM

library(glmnet)
Loading required package: Matrix
Loading required package: lattice
Loaded glmnet 1.9-5
prestige<-c(0,1,1,1,0,0,1,1,1,0) #binary
sex<-c(1,0,1,1,1,1,0,1,1,0) #binary
edu<-c(3,2,3,1,0,0,1,3,3,2) #ordinal
sat<-c(0.88,0.29,0.45,0.76,0.99,0.85,0.84,0.67,0.91,0.29) #continuos
age<-c(22,56,14,27,33,17,14,7,37,26) #continous
fi_cream<-c("vanilla", "chocolate","strawberry","strawberry","strawberry","vanilla","vanilla","chocolate","vanilla","vanilla") #nominal
df<-data.frame(prestige,sex,edu,sat,fi_cream,age)
df #transform categorical var into factors 
   prestige sex edu  sat   fi_cream age
1         0   1   3 0.88    vanilla  22
2         1   0   2 0.29  chocolate  56
3         1   1   3 0.45 strawberry  14
4         1   1   1 0.76 strawberry  27
5         0   1   0 0.99 strawberry  33
6         0   1   0 0.85    vanilla  17
7         1   0   1 0.84    vanilla  14
8         1   1   3 0.67  chocolate   7
9         1   1   3 0.91    vanilla  37
10        0   0   2 0.29    vanilla  26
fi_cream<-as.factor(fi_cream)
sex<-as.factor(sex)
edu<-as.factor(edu)
xfactors<-model.matrix(prestige~sex+edu+fi_cream)[,-1]
xfactors
   sex1 edu1 edu2 edu3 fi_creamstrawberry fi_creamvanilla
1     1    0    0    1                  0               1
2     0    0    1    0                  0               0
3     1    0    0    1                  1               0
4     1    1    0    0                  1               0
5     1    0    0    0                  1               0
6     1    0    0    0                  0               1
7     0    1    0    0                  0               1
8     1    0    0    1                  0               0
9     1    0    0    1                  0               1
10    0    0    1    0                  0               1
x<-as.matrix(data.frame(age,sat,xfactors)) #create dummy variable matrix
x
   age  sat sex1 edu1 edu2 edu3 fi_creamstrawberry fi_creamvanilla
1   22 0.88    1    0    0    1                  0               1
2   56 0.29    0    0    1    0                  0               0
3   14 0.45    1    0    0    1                  1               0
4   27 0.76    1    1    0    0                  1               0
5   33 0.99    1    0    0    0                  1               0
6   17 0.85    1    0    0    0                  0               1
7   14 0.84    0    1    0    0                  0               1
8    7 0.67    1    0    0    1                  0               0
9   37 0.91    1    0    0    1                  0               1
10  26 0.29    0    0    1    0                  0               1
glmmod<-glmnet(x,y=as.factor(prestige), alpha=1, family='binomial')
glmmod

Call:  glmnet(x = x, y = as.factor(prestige), family = "binomial", alpha = 1) 

      Df     %Dev   Lambda
 [1,]  0 1.65e-16 2.00e-01
 [2,]  2 4.24e-02 1.82e-01
 [3,]  2 7.84e-02 1.66e-01
 [4,]  2 1.09e-01 1.51e-01
 [5,]  3 1.51e-01 1.38e-01
 [6,]  3 1.98e-01 1.26e-01
 [7,]  3 2.39e-01 1.14e-01
 [8,]  4 2.79e-01 1.04e-01
 [9,]  4 3.23e-01 9.50e-02
[10,]  4 3.62e-01 8.66e-02
[11,]  4 3.96e-01 7.89e-02
[12,]  4 4.27e-01 7.19e-02
[13,]  5 4.64e-01 6.55e-02
[14,]  5 4.99e-01 5.97e-02
[15,]  5 5.31e-01 5.44e-02
[16,]  5 5.61e-01 4.95e-02
[17,]  5 5.89e-01 4.51e-02
[18,]  5 6.14e-01 4.11e-02
[19,]  6 6.39e-01 3.75e-02
[20,]  6 6.62e-01 3.41e-02
[21,]  6 6.83e-01 3.11e-02
[22,]  6 7.03e-01 2.83e-02
[23,]  6 7.21e-01 2.58e-02
[24,]  6 7.38e-01 2.35e-02
[25,]  6 7.55e-01 2.14e-02
[26,]  6 7.70e-01 1.95e-02
[27,]  6 7.84e-01 1.78e-02
[28,]  6 7.98e-01 1.62e-02
[29,]  6 8.11e-01 1.48e-02
[30,]  6 8.24e-01 1.35e-02
[31,]  6 8.36e-01 1.23e-02
[32,]  6 8.47e-01 1.12e-02
[33,]  6 8.59e-01 1.02e-02
[34,]  6 8.69e-01 9.28e-03
[35,]  6 8.80e-01 8.46e-03
[36,]  6 8.90e-01 7.71e-03
[37,]  6 9.00e-01 7.02e-03
[38,]  6 9.09e-01 6.40e-03
[39,]  6 9.17e-01 5.83e-03
[40,]  6 9.25e-01 5.31e-03
[41,]  6 9.32e-01 4.84e-03
[42,]  6 9.38e-01 4.41e-03
[43,]  6 9.44e-01 4.02e-03
[44,]  6 9.49e-01 3.66e-03
[45,]  6 9.54e-01 3.34e-03
[46,]  6 9.58e-01 3.04e-03
[47,]  6 9.62e-01 2.77e-03
[48,]  6 9.66e-01 2.52e-03
[49,]  6 9.69e-01 2.30e-03
[50,]  6 9.71e-01 2.10e-03
[51,]  6 9.74e-01 1.91e-03
[52,]  6 9.76e-01 1.74e-03
[53,]  6 9.79e-01 1.58e-03
[54,]  6 9.80e-01 1.44e-03
[55,]  6 9.82e-01 1.32e-03
[56,]  6 9.84e-01 1.20e-03
[57,]  6 9.85e-01 1.09e-03
[58,]  6 9.87e-01 9.95e-04
[59,]  6 9.88e-01 9.07e-04
[60,]  6 9.89e-01 8.26e-04
[61,]  6 9.90e-01 7.53e-04
[62,]  6 9.91e-01 6.86e-04
[63,]  6 9.92e-01 6.25e-04
[64,]  6 9.92e-01 5.70e-04
[65,]  6 9.93e-01 5.19e-04
[66,]  6 9.94e-01 4.73e-04
[67,]  6 9.94e-01 4.31e-04
[68,]  6 9.95e-01 3.93e-04
[69,]  6 9.95e-01 3.58e-04
[70,]  6 9.96e-01 3.26e-04
[71,]  6 9.96e-01 2.97e-04
[72,]  6 9.96e-01 2.71e-04
[73,]  6 9.97e-01 2.47e-04
[74,]  6 9.97e-01 2.25e-04
[75,]  6 9.97e-01 2.05e-04
[76,]  6 9.97e-01 1.87e-04
[77,]  6 9.98e-01 1.70e-04
[78,]  6 9.98e-01 1.55e-04
[79,]  6 9.98e-01 1.41e-04
[80,]  6 9.98e-01 1.29e-04
[81,]  6 9.98e-01 1.17e-04
[82,]  6 9.99e-01 1.07e-04
[83,]  6 9.99e-01 9.73e-05
[84,]  6 9.99e-01 8.86e-05
[85,]  6 9.99e-01 8.07e-05
[86,]  6 9.99e-01 7.36e-05
plot(glmmod,xvar="lambda")

plot of chunk unnamed-chunk-1

coef(glmmod)[,10]
       (Intercept)                age                sat 
            0.6053             0.0000            -0.5758 
              sex1               edu1               edu2 
            0.0000             2.0102             0.0000 
              edu3 fi_creamstrawberry    fi_creamvanilla 
            0.9613             0.0000            -1.0039 
cv.glmmod<-cv.glmnet(x,y=prestige,alpha=1)
Warning: Option grouped=FALSE enforced in cv.glmnet, since < 3
observations per fold
plot(cv.glmmod)

plot of chunk unnamed-chunk-1

f<-cv.glmmod$lambda.min
f
[1] 0.2