adding lambda2 term for lasso loop
This commit is contained in:
parent
2e81ded14f
commit
2b7a52da12
@ -100,7 +100,9 @@ run_comparison <- function(bundled_data){
|
||||
run_comparison(bundled_data)
|
||||
## b. Repeat comparison using a graph with clusters
|
||||
source("Schrick-Noah_graphs.R")
|
||||
bundled_graph_data <- sim_graph_data()
|
||||
bundled_graph <- sim_graph_data()
|
||||
bundled_graph_data <- bundled_graph$bundled_graph_data
|
||||
g1 <- bundled_graph$g1
|
||||
|
||||
run_comparison(bundled_graph_data)
|
||||
|
||||
@ -125,25 +127,15 @@ plot.igraph(knn.graph.g,layout=layout_with_fr(knn.graph.g),
|
||||
main="Manhattan, knn-graph from simulated data
|
||||
with erdos-renyi graph structure")
|
||||
|
||||
### Bundled Data
|
||||
npdr.nbpairs.idx <- npdro::nearestNeighbors(t(bundled_data$train.X),
|
||||
# transpose does dist between predictors
|
||||
# without transpose does dist between samples
|
||||
#nbd.method="multisurf", k=0,
|
||||
nbd.method = "relieff",
|
||||
nbd.metric="manhattan",
|
||||
k=my.k)
|
||||
knn.graph <- graph_from_edgelist(as.matrix(npdr.nbpairs.idx),
|
||||
directed=F)
|
||||
knn.graph <- simplify(knn.graph)
|
||||
is_isomorphic_to(g1, knn.graph.g)
|
||||
plot(g1)
|
||||
|
||||
clusters <- cluster_louvain(knn.graph.g)
|
||||
plot(knn.graph.g, mark.groups=clusters)
|
||||
|
||||
### Plot network
|
||||
plot.igraph(knn.graph,layout=layout_with_fr(knn.graph),
|
||||
vertex.color="red",
|
||||
vertex.size=3,vertex.label=NA,
|
||||
main="Manhattan, knn-graph from simulated data")
|
||||
|
||||
## d. Add Laplace graph penalty
|
||||
Lhat <- laplacian_matrix(g1, normalized = TRUE)
|
||||
|
||||
### Find resulting beta coeffs
|
||||
|
||||
|
||||
@ -1,3 +1,6 @@
|
||||
if (!require("numbers")) install.packages("numbers")
|
||||
library(numbers)
|
||||
|
||||
penalized_loss <- function(X, y, beta, lam, alpha=0){
|
||||
# y needs to be 0/1
|
||||
# beta: regression coefficients
|
||||
@ -55,7 +58,7 @@ lasso_betas <- function(X,y,beta_init=NULL){
|
||||
}
|
||||
|
||||
# Adjust betas
|
||||
lasso_coeff <- function(X, y, lambda=0, tol=1e-8){
|
||||
lasso_coeff <- function(X, y, lambda=0.03125, tol=1e-2){
|
||||
unpen_beta <- lasso_betas(X, y, beta_init=numeric(101))
|
||||
old_loss <- unpen_beta$loss
|
||||
lasso_converged <- FALSE
|
||||
@ -79,6 +82,9 @@ lasso_coeff <- function(X, y, lambda=0, tol=1e-8){
|
||||
}
|
||||
unpen_beta <- lasso_betas(X,y,beta_init=beta_LS$par)
|
||||
lasso_converged <- abs(unpen_beta$loss - old_loss) < tol
|
||||
if(mod(loop_count, 25) == 0){
|
||||
cat("Loop:", loop_count, "Convergence:", abs(unpen_beta$loss - old_loss),"\n")
|
||||
}
|
||||
old_loss <- unpen_beta$loss
|
||||
loop_count <- loop_count + 1
|
||||
}
|
||||
|
||||
@ -39,5 +39,5 @@ sim_graph_data <- function(){
|
||||
|
||||
### Dataset with g1
|
||||
bundled_graph_data <- create_data(graph.structure=g1)
|
||||
return(bundled_graph_data)
|
||||
return(list(bundled_graph_data=bundled_graph_data,g1=g1))
|
||||
}
|
||||
Loading…
x
Reference in New Issue
Block a user