Commit aacc8e80 by Tom Reynkens

### Rename beta.cand to beta

parent 0d01c7de
 Type: Package Package: smurf Title: Sparse Multi-Type Regularized Feature Modeling Version: 0.3.0.9008 Version: 0.3.0.9009 Date: 2018-09-19 Authors@R: c( person("Tom", "Reynkens", email = "tomreynkens@hotmail.com", role = c("aut", "cre"), ... ...
 ... ... @@ -7,7 +7,7 @@ # Compute total penalty based on penalty types # # beta.cand: Coefficient vector # beta: Coefficient vector # pen.cov: List with penalty type per predictor # n.par.cov: List with number of parameters to estimate per predictor # group.cov: List with group of each predictor which is only used for the Group Lasso penalty, 0 means no group ... ... @@ -15,12 +15,12 @@ # lambda: Penalty parameter # lambda1: The penalty parameter for the L_1-penalty in Sparse (Generalized) Fused Lasso or Sparse Graph-Guided Fused Lasso is lambda*lambda1 # lambda2: The penalty parameter for the L_2-penalty in Group (Generalized) Fused Lasso or Group Graph-Guided Fused Lasso is lambda*lambda2 .pen.tot <- function(beta.cand, pen.cov, n.par.cov, group.cov, pen.mat.cov, lambda, lambda1, lambda2) { .pen.tot <- function(beta, pen.cov, n.par.cov, group.cov, pen.mat.cov, lambda, lambda1, lambda2) { pen.tot <- 0 n.cov <- length(pen.cov) # Split beta per covariate beta.split <- split(beta.cand, rep(1:n.cov, n.par.cov)) beta.split <- split(beta, rep(1:n.cov, n.par.cov)) for (j in 1:n.cov) { beta <- beta.split[[j]] ... ...
 ... ... @@ -45,8 +45,7 @@ # Initialise values of beta for use later on beta.old <- start beta.new <- start beta.cand.list <- vector("list", length(pen.cov)) # Initialise counter for while-loop iter <- 0L ... ... @@ -72,7 +71,7 @@ if (is.nan(f.beta.cand)) f.beta.cand <- Inf # g function: total penalty g.beta.cand <- .pen.tot(beta.cand = start, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, g.beta.cand <- .pen.tot(beta = start, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) # Initialise new objective function ... ... @@ -130,7 +129,7 @@ if (is.nan(f.beta.cand)) f.beta.cand <- Inf # Compute g: total penalty g.beta.cand <- .pen.tot(beta.cand = beta.cand, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, g.beta.cand <- .pen.tot(beta = beta.cand, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) # Objective function ... ... @@ -170,8 +169,8 @@ if (is.nan(f.beta.cand)) f.beta.cand <- Inf # Compute g: total penalty g.beta.cand <- .pen.tot(beta.cand = beta.cand, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) g.beta.cand <- .pen.tot(beta = beta.cand, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) # Objective function obj.beta.cand <- f.beta.cand + g.beta.cand ... ...
 ... ... @@ -358,7 +358,7 @@ # Minus scaled log-likelihood of estimated model fbeta <- -.scaled.ll(y = y, n = n, mu = mu, wt = weights) # Total penalty of estimated model gbeta <- .pen.tot(beta.cand = beta.new, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, gbeta <- .pen.tot(beta = beta.new, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) # Deviance ... ... @@ -451,7 +451,7 @@ # Minus scaled log-likelihood of re-estimated model fbeta.reest <- -.scaled.ll(y = y, n = n, mu = mu.reest, wt = weights) # Total penalty of re-estimated model gbeta.reest <- .pen.tot(beta.cand = beta.reest.long, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, gbeta.reest <- .pen.tot(beta = beta.reest.long, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) # Deviance of re-estimated model ... ...
 ... ... @@ -145,7 +145,7 @@ test_that("Test PO and penalty functions", { # Run penalty with different groups and expect no error p1 <- function() { .pen.tot(beta.cand = beta.tilde, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, .pen.tot(beta = beta.tilde, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat.cov, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) } expect_error(p1(), ... ... @@ -219,7 +219,7 @@ test_that("Test PO and penalty with different groups", { # Run penalty with different groups and expect no error p1 <- function() { .pen.tot(beta.cand = beta.tilde, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, .pen.tot(beta = beta.tilde, pen.cov = pen.cov, n.par.cov = n.par.cov, group.cov = group.cov, pen.mat.cov = pen.mat.cov, lambda = lambda, lambda1 = lambda1, lambda2 = lambda2) } expect_error(p1(), ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!