Commit aacc8e80 authored by Tom Reynkens's avatar 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!
Please register or to comment