6
6
randomizedLasso = function (X ,
7
7
y ,
8
8
lam ,
9
+ family = " gaussian" ,
9
10
noise_scale = NULL ,
10
11
ridge_term = NULL ,
11
12
noise_type = c(' gaussian' , ' laplace' ),
@@ -17,7 +18,6 @@ randomizedLasso = function(X,
17
18
kkt_stop = TRUE ,
18
19
parameter_stop = TRUE )
19
20
{
20
-
21
21
n = nrow(X ); p = ncol(X )
22
22
23
23
mean_diag = mean(apply(X ^ 2 , 2 , sum ))
@@ -86,7 +86,7 @@ randomizedLasso = function(X,
86
86
parameter_stop ) # param_stop
87
87
88
88
sign_soln = sign(result $ soln )
89
-
89
+
90
90
unpenalized = lam == 0
91
91
active = (! unpenalized ) & (sign_soln != 0 )
92
92
inactive = (! unpenalized ) & (sign_soln == 0 )
@@ -113,8 +113,21 @@ randomizedLasso = function(X,
113
113
I = inactive_set
114
114
X_E = X [,E ]
115
115
X_I = X [,I ]
116
- L_E = t(X ) %*% X [,E ]
117
-
116
+
117
+ if (family == " binomial" ){
118
+ unpen_reg = glm(y ~ X_E - 1 , family = " binomial" )
119
+ unpen_est = unpen_reg $ coefficients
120
+ pi_fn = function (beta ){
121
+ temp = X_E %*% as.matrix(beta )
122
+ return (as.vector(exp(temp )/ (1 + exp(temp )))) # n-dimensional
123
+ }
124
+ pi_vec = pi_fn(unpen_est )
125
+ W_E = diag(pi_vec * (1 - pi_vec ))
126
+ } else if (family == " gaussian" ){
127
+ W_E = diag(rep(1 ,n ))
128
+ }
129
+ L_E = t(X ) %*% W_E %*% X [,E ]
130
+
118
131
coef_term = L_E
119
132
120
133
signs_ = c(rep(1 , sum(unpenalized )), sign_soln [active ])
@@ -158,8 +171,12 @@ randomizedLasso = function(X,
158
171
offset_term = offset_term )
159
172
160
173
# density for sampling optimization variables
161
-
174
+
162
175
observed_raw = - t(X ) %*% y
176
+ if (family == " binomial" ){
177
+ beta_E = result $ soln [active_set ]
178
+ observed_raw = observed_raw + t(X )%*% pi_fn(beta_E )- L_E %*% beta_E
179
+ }
163
180
inactive_lam = lam [inactive_set ]
164
181
inactive_start = sum(unpenalized ) + sum(active )
165
182
active_start = sum(unpenalized )
@@ -333,6 +350,7 @@ conditional_density = function(noise_scale, lasso_soln) {
333
350
randomizedLassoInf = function (X ,
334
351
y ,
335
352
lam ,
353
+ family = " gaussian" ,
336
354
sampler = " A" ,
337
355
sigma = NULL ,
338
356
noise_scale = NULL ,
@@ -352,10 +370,11 @@ randomizedLassoInf = function(X,
352
370
353
371
n = nrow(X )
354
372
p = ncol(X )
355
-
373
+
356
374
lasso_soln = randomizedLasso(X ,
357
375
y ,
358
376
lam ,
377
+ family = family ,
359
378
noise_scale = noise_scale ,
360
379
ridge_term = ridge_term ,
361
380
max_iter = max_iter ,
@@ -410,17 +429,32 @@ randomizedLassoInf = function(X,
410
429
X_E = X [, active_set ]
411
430
X_minusE = X [, inactive_set ]
412
431
413
- # if no sigma given, use OLS estimate
414
-
432
+
433
+
434
+ if (family == " gaussian" ){
435
+ lm_y = lm(y ~ X_E - 1 )
436
+ sigma_resid = sqrt(sum(resid(lm_y )^ 2 ) / lm_y $ df.resid )
437
+ observed_target = lm_y $ coefficients
438
+ W_E = diag(rep(1 ,n ))
439
+ observed_internal = c(observed_target , t(X_minusE ) %*% (y - X_E %*% observed_target ))
440
+ } else if (family == " binomial" ){
441
+ glm_y = glm(y ~ X_E - 1 )
442
+ sigma_resid = sqrt(sum(resid(glm_y )^ 2 ) / glm_y $ df.resid )
443
+ observed_target = as.matrix(glm_y $ coefficients )
444
+ temp = X_E %*% observed_target
445
+ pi_vec = exp(temp )/ (1 + exp(temp ))
446
+ observed_internal = c(observed_target , t(X_minusE ) %*% (y - pi_vec ))
447
+ W_E = diag(as.vector(pi_vec * (1 - pi_vec )))
448
+ }
449
+
450
+ # if no sigma given, use the estimate
451
+
415
452
if (is.null(sigma )) {
416
- lm_y = lm(y ~ X_E - 1 )
417
- sigma = sqrt(sum(resid(lm_y )^ 2 ) / lm_y $ df.resid )
453
+ sigma = sigma_resid
418
454
}
419
-
420
- target_cov = solve(t(X_E ) %*% X_E )* sigma ^ 2
455
+
456
+ target_cov = solve(t(X_E ) %*% W_E %*% X_E )* sigma ^ 2
421
457
cov_target_internal = rbind(target_cov , matrix (0 , nrow = p - nactive , ncol = nactive ))
422
- observed_target = solve(t(X_E ) %*% X_E ) %*% t(X_E ) %*% y
423
- observed_internal = c(observed_target , t(X_minusE ) %*% (y - X_E %*% observed_target ))
424
458
internal_transform = lasso_soln $ internal_transform
425
459
opt_transform = lasso_soln $ optimization_transform
426
460
observed_raw = lasso_soln $ observed_raw
@@ -495,5 +529,10 @@ randomizedLassoInf = function(X,
495
529
return (list (active_set = active_set , pvalues = pvalues , ci = ci ))
496
530
}
497
531
532
+
533
+
534
+
535
+
536
+
498
537
499
538
0 commit comments