sahirbhatnagar / ggmix

@@ -96,7 +96,9 @@
Loading
96 96
#' @param verbose display progress. Can be either 0,1 or 2. 0 will not display
97 97
#'   any progress, 2 will display very detailed progress and 1 is somewhere in
98 98
#'   between. Default: 0.
99 -
#'
99 +
#' @return list which includes the fitted object, lambda sequence, 
100 +
#'  solution path, variance-covariance parameters, degrees of freedom, 
101 +
#'  and singular values, vectors of kinship matrix
100 102
#' @examples
101 103
#' data(admixed)
102 104
#' fitlmm <- ggmix(x = admixed$xtrain, y = admixed$ytrain,

@@ -5,6 +5,7 @@
Loading
5 5
#' @seealso \code{\link{logliklasso}}, \code{\link{kkt_check}}, \code{\link{lmmlasso}}
6 6
#' @inheritParams logliklasso
7 7
#' @inheritParams kkt_check
8 +
#' @return returns the value of the function and gradient for the eta variance parameter
8 9
gr_eta_lasso_fullrank <- function(eta, sigma2, beta, eigenvalues, x, y, nt) {
9 10
  di <- 1 + eta * (eigenvalues - 1)
10 11

@@ -58,7 +58,7 @@
Loading
58 58
    lambda_max <- lamb$sequence[[1]]
59 59
    lamb$sequence[[1]] <- .Machine$double.xmax
60 60
    
61 -
    tuning_params_mat <- matrix(lamb$sequence, nrow = 1, ncol = nlambda, byrow = T)
61 +
    tuning_params_mat <- matrix(lamb$sequence, nrow = 1, ncol = nlambda, byrow = TRUE)
62 62
    dimnames(tuning_params_mat)[[1]] <- list("lambda")
63 63
    dimnames(tuning_params_mat)[[2]] <- paste0("s", seq_len(nlambda))
64 64
    lambda_names <- dimnames(tuning_params_mat)[[2]]
@@ -70,7 +70,7 @@
Loading
70 70
    lambda <- as.double(rev(sort(lambda)))
71 71
    lambda_max <- lambda[[1]]
72 72
    
73 -
    tuning_params_mat <- matrix(lambda, nrow = 1, ncol = nlambda, byrow = T)
73 +
    tuning_params_mat <- matrix(lambda, nrow = 1, ncol = nlambda, byrow = TRUE)
74 74
    dimnames(tuning_params_mat)[[1]] <- list("lambda")
75 75
    dimnames(tuning_params_mat)[[2]] <- paste0("s", seq_len(nlambda))
76 76
    lambda_names <- dimnames(tuning_params_mat)[[2]]
@@ -298,7 +298,7 @@
Loading
298 298
    n_design = n_design, # used by gic function
299 299
    p_design = p_design, # used by gic function
300 300
    lambda = out_print[, "Lambda"], # used by gic, predict functions
301 -
    coef = methods::as(coefficient_mat[, lambdas_fit, drop = F], "dgCMatrix"), #first row is intercept, last two rows are eta and sigma2
301 +
    coef = methods::as(coefficient_mat[, lambdas_fit, drop = FALSE], "dgCMatrix"), #first row is intercept, last two rows are eta and sigma2
302 302
    b0 = coefficient_mat["(Intercept)", lambdas_fit], # used by predict function
303 303
    beta = methods::as(coefficient_mat[colnames(ggmix_object[["x"]])[-1],
304 304
      lambdas_fit,

@@ -185,7 +185,7 @@
Loading
185 185
#' @details A coefficient profile plot is produced
186 186
#' @return A plot is produced and nothing is returned
187 187
#' @export
188 -
plot.ggmix_fit <- function(x,...,
188 +
plot.ggmix_fit <- function(x, ..., 
189 189
                           xvar = c("norm", "lambda", "dev"),
190 190
                           label = FALSE, sign.lambda = 1) {
191 191
  xvar <- match.arg(xvar)

@@ -29,7 +29,7 @@
Loading
29 29
                                 epsilon = 1e-14,
30 30
                                 tol.kkt = 1e-9,
31 31
                                 eta_init = 0.5,
32 -
                                 nlambda = 100, scale_x = F, center_y = F) {
32 +
                                 nlambda = 100, scale_x = FALSE, center_y = FALSE) {
33 33
  utx <- ggmix_object[["x"]]
34 34
  uty <- ggmix_object[["y"]]
35 35
  eigenvalues <- ggmix_object[["D"]]

@@ -102,7 +102,7 @@
Loading
102 102
  type <- match.arg(type)
103 103
104 104
  if (missing(newx)) {
105 -
    if (!match(type, c("coefficients", "nonzero","all"), FALSE)) {
105 +
    if (!match(type, c("coefficients", "nonzero", "all"), FALSE)) {
106 106
      stop("You need to supply a value for 'newx' when type is link or response or individual")
107 107
    }
108 108
  }
@@ -138,7 +138,7 @@
Loading
138 138
139 139
  if (type == "all") return(nall)
140 140
141 -
  nbeta <- nall[object[["cov_names"]], , drop = F]
141 +
  nbeta <- nall[object[["cov_names"]], , drop = FALSE]
142 142
143 143
  if (type == "coefficients") return(nbeta)
144 144

@@ -112,7 +112,7 @@
Loading
112 112
113 113
bi_lassofullrank <- function(eta, beta, eigenvalues, eigenvectors, x, y) {
114 114
  D_inv <- diag(1 / eigenvalues)
115 -
  p1 <- solve((diag(length(y)) + (1/eta) * (eigenvectors %*% D_inv %*% t(eigenvectors))))
115 +
  p1 <- solve((diag(length(y)) + (1 / eta) * (eigenvectors %*% D_inv %*% t(eigenvectors))))
116 116
  as.vector( p1 %*% (y - x %*% beta))
117 117
}
118 118

@@ -14,6 +14,7 @@
Loading
14 14
#' @param tol.kkt Tolerance for determining if an entry of the subgradient is
15 15
#'   zero
16 16
#' @rdname kkt_check
17 +
#' @return returns the values of the gradient for each of the parameters 
17 18
#' @note \code{grr_sigma2} and \code{grr_beta0} are functions for the gradient
18 19
#'   of sigma2 and beta0, respectively
19 20
kkt_check <- function(eta, sigma2, beta, eigenvalues, x, y, nt,
@@ -66,7 +67,7 @@
Loading
66 67
67 68
  # KKT for beta
68 69
  # g0 <- (1 / sum(wi_scaled)) * crossprod(x[,-1, drop = F] * wi_scaled, (y - x %*% beta ))
69 -
  g0 <- (1 / sum(wi)) * crossprod(x[, -1, drop = F] * wi, (y - x %*% beta))
70 +
  g0 <- (1 / sum(wi)) * crossprod(x[, -1, drop = FALSE] * wi, (y - x %*% beta))
70 71
71 72
  # this gives same result as g0
72 73
  # g1 <- colSums((1 / nt) * sweep(sweep(x[,-1], MARGIN = 1, wi_vec, '*'), MARGIN = 1, drop((y - x %*% beta)),'*'))

@@ -355,9 +355,9 @@
Loading
355 355
  y <- b0 + mu + P + E
356 356
357 357
  # partition the data into train/tune/test
358 -
  spec = c(train = train_tune_test[1], tune = train_tune_test[2], test = train_tune_test[3])
358 +
  spec <- c(train = train_tune_test[1], tune = train_tune_test[2], test = train_tune_test[3])
359 359
360 -
  g = sample(cut(
360 +
  g <- sample(cut(
361 361
    seq(nrow(Xdesign)),
362 362
    nrow(Xdesign)*cumsum(c(0,spec)),
363 363
    labels = names(spec)
@@ -406,7 +406,7 @@
Loading
406 406
              xtune_lasso = xtune_lasso,
407 407
              xtest_lasso = xtest_lasso,
408 408
409 -
              Xkinship = Xall[train_ind,snps_kinships, drop = F],
409 +
              Xkinship = Xall[train_ind,snps_kinships, drop = FALSE],
410 410
              kin_train = kin_train,
411 411
              kin_tune_train = kin_tune_train,
412 412
              kin_test_train = kin_test_train, # covaraince between train and test
Files Coverage
R 68.32%
Project Totals (13 files) 68.32%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
    patch:
10
      default:
11
        target: auto
12
        threshold: 1%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading