nirsdata <- readRDS("ML_NIRS.Rdata")
head(nirsdata[1:12,1:20]) Subject Sex Age Word MemorySpan Peabody SPM.P.CPM.P RandW LW LWCW RWCW
1 Sub1 M 10.41 125 23 113 49 32 42 20 20
2 Sub1 M 10.41 125 23 113 49 32 42 20 20
3 Sub1 M 10.41 125 23 113 49 32 42 20 20
4 Sub1 M 10.41 125 23 113 49 32 42 20 20
5 Sub1 M 10.41 125 23 113 49 32 42 20 20
6 Sub1 M 10.41 125 23 113 49 32 42 20 20
Channel Time 1 Time 2 Time 3 Time 4 Time 5
1 Channel_1 1.67935e-05 1.66073e-05 1.64011e-05 1.61742e-05 1.59262e-05
2 Channel_2 1.21074e-05 1.20908e-05 1.20587e-05 1.20123e-05 1.19528e-05
3 Channel_3 5.22465e-06 5.05071e-06 4.86925e-06 4.68050e-06 4.48468e-06
4 Channel_4 3.49818e-06 3.21022e-06 2.91707e-06 2.61919e-06 2.31705e-06
5 Channel_5 9.26550e-06 9.44055e-06 9.61213e-06 9.77847e-06 9.93765e-06
6 Channel_6 3.22096e-05 3.22045e-05 3.21420e-05 3.20224e-05 3.18462e-05
Time 6 Time 7 Time 8
1 1.56564e-05 1.53643e-05 1.50493e-05
2 1.18811e-05 1.17987e-05 1.17066e-05
3 4.28206e-06 4.07291e-06 3.85755e-06
4 2.01112e-06 1.70187e-06 1.38978e-06
5 1.00877e-05 1.02264e-05 1.03516e-05
6 3.16138e-05 3.13259e-05 3.09833e-05library(glmnet)Loading required package: MatrixLoading required package: foreachLoaded glmnet 2.0-5CV lasso for memoryspan
# channel 1
C1 <- subset(nirsdata,Channel=="Channel_1")
C1 <- C1[,-c(4,6,7,8,9,10,11,12)]
head(C1[1:12]) Subject Sex Age MemorySpan Time 1 Time 2 Time 3
1 Sub1 M 10.41 23 1.67935e-05 1.66073e-05 1.64011e-05
9 Sub10 M 9.95 22 1.63268e-05 1.59217e-05 1.55195e-05
17 Sub11 M 10.22 10 -1.03701e-06 -9.47723e-07 -8.43826e-07
25 Sub12 M 9.68 17 2.70722e-06 2.67073e-06 2.63432e-06
33 Sub13 F 10.35 17 5.24157e-06 5.15493e-06 5.05612e-06
41 Sub14 F 10.37 18 -3.98872e-06 -3.82578e-06 -3.65194e-06
Time 4 Time 5 Time 6 Time 7 Time 8
1 1.61742e-05 1.59262e-05 1.56564e-05 1.53643e-05 1.50493e-05
9 1.51220e-05 1.47310e-05 1.43478e-05 1.39738e-05 1.36103e-05
17 -7.26176e-07 -5.95719e-07 -4.53488e-07 -3.00598e-07 -1.38233e-07
25 2.59816e-06 2.56237e-06 2.52706e-06 2.49225e-06 2.45795e-06
33 4.94578e-06 4.82456e-06 4.69319e-06 4.55243e-06 4.40308e-06
41 -3.46693e-06 -3.27048e-06 -3.06234e-06 -2.84229e-06 -2.61016e-06ytra1 <- C1$MemorySpan
xtra1 <- model.matrix(MemorySpan ~. , C1)[,-1]
rst_cv1 <- cv.glmnet(xtra1, ytra1, alpha = 0,family = "gaussian",
nfolds = 10,type.measure = "deviance")Warning: Option grouped=FALSE enforced in cv.glmnet, since < 3 observations
per foldyhat1_ridge <- predict(rst_cv1,newx = xtra1,type="response")
mse1_ridge <- mean((ytra1 - yhat1_ridge)^2)
rs1 <- 1-mse1_ridge/var(ytra1)
rs1[1] 0.05# channel 2
C7 <- subset(nirsdata,Channel=="Channel_7")
C7 <- C7[,-c(1,4,6,7,8,9,10,11,12)]
head(C7[1:12]) Sex Age MemorySpan Time 1 Time 2 Time 3
7 M 10.41 23 8.80695e-06 8.65236e-06 8.48920e-06
15 M 9.95 22 1.34952e-06 1.14803e-06 9.45776e-07
23 M 10.22 10 -3.39980e-06 -3.08485e-06 -2.75288e-06
31 M 9.68 17 8.10154e-07 9.24638e-07 1.03281e-06
39 F 10.35 17 4.18387e-06 3.81097e-06 3.41042e-06
47 F 10.37 18 -8.28087e-07 -7.25885e-07 -6.10333e-07
Time 4 Time 5 Time 6 Time 7 Time 8
7 8.31747e-06 8.13719e-06 7.94834e-06 7.75093e-06 7.54493e-06
15 7.43509e-07 5.41947e-07 3.41789e-07 1.43717e-07 -5.16075e-08
23 -2.40500e-06 -2.04240e-06 -1.66637e-06 -1.27826e-06 -8.79516e-07
31 1.13478e-06 1.23066e-06 1.32059e-06 1.40470e-06 1.48315e-06
39 2.98381e-06 2.53282e-06 2.05922e-06 1.56481e-06 1.05149e-06
47 -4.81117e-07 -3.37964e-07 -1.80641e-07 -8.95639e-09 1.77237e-07
Time 9
7 7.33033e-06
15 -2.43538e-07
23 -4.71615e-07
31 1.55609e-06
39 5.21150e-07
47 3.78040e-07ytra7 <- C7$MemorySpan
xtra7 <- model.matrix(MemorySpan ~. , C7)[,-1]
rst_cv7 <- cv.glmnet(xtra7, ytra7, alpha = 1, nfolds = 5,type.measure = "mse")
yhat7_ridge <- predict(rst_cv7,newx = xtra7,type="response")
mse7_ridge <- mean((ytra7 - yhat7_ridge)^2)
rs7 <- 1-mse7_ridge/var(ytra7)
rs7[1] 0.05