1 ```#' Constructor functions for the different ggmix objects ``` 2 ```#' ``` 3 ```#' \code{new_fullrank_kinship}, \code{new_fullrank_K}, \code{new_fullrank_UD}, ``` 4 ```#' \code{new_lowrank_kinship}, \code{new_lowrank_K} and \code{new_lowrank_UD} ``` 5 ```#' create the ggmix objects from the provided data that are necessary to fit the ``` 6 ```#' penalized linear mixed model according to the user's parameters. ``` 7 ```#' ``` 8 ```#' @seealso \code{\link{ggmix}} ``` 9 ```#' @inheritParams ggmix ``` 10 ```#' @param n_zero_eigenvalues the number of desired or specified zero eigenvalues. ``` 11 ```#' This is only needed when \code{estimation="lowrank"}, and is calculated ``` 12 ```#' internally by the \code{\link{ggmix}} function. It is equal to the number ``` 13 ```#' of observations minus \code{n_nonzero_eigenvalues} ``` 14 ```#' ``` 15 ```#' @return A ggmix object, of the class that corresponds to the estimation ``` 16 ```#' method. These objects are lists that contain the data necessary for ``` 17 ```#' computation. These functions are not meant to be called directly by the ``` 18 ```#' user ``` 19 ```#' @name ggmix_data_object ``` 20 ```NULL ``` 21 22 ```#' @rdname ggmix_data_object ``` 23 ```new_fullrank_kinship <- function(x, y, kinship) { ``` 24 4 ``` phi_eigen <- eigen(kinship) ``` 25 4 ``` U_kinship <- phi_eigen\$vectors ``` 26 4 ``` Lambda <- phi_eigen\$values ``` 27 4 ``` if (any(Lambda < 1e-5)) { ``` 28 4 ``` Lambda[which(Lambda < 1e-5)] <- 1e-05 ``` 29 ``` } ``` 30 31 4 ``` x <- cbind("(Intercept)" = 1, x) ``` 32 4 ``` utx <- crossprod(U_kinship, x) ``` 33 4 ``` uty <- crossprod(U_kinship, y) ``` 34 35 4 ``` structure(list( ``` 36 4 ``` x = utx, ``` 37 4 ``` y = uty, ``` 38 4 ``` U = U_kinship, ``` 39 4 ``` D = Lambda ``` 40 ``` ), ``` 41 4 ``` class = c("fullrank") ``` 42 ``` ) ``` 43 ```} ``` 44 45 ```#' @rdname ggmix_data_object ``` 46 ```new_fullrank_K <- function(x, y, K) { ``` 47 4 ``` svdX <- svd(K) ``` 48 4 ``` U_K <- svdX\$u ``` 49 4 ``` Lambda <- svdX\$d^2 ``` 50 4 ``` if (any(Lambda < 1e-5)) { ``` 51 0 ``` Lambda[which(Lambda < 1e-5)] <- 1e-05 ``` 52 ``` } ``` 53 54 4 ``` x <- cbind("(Intercept)" = 1, x) ``` 55 4 ``` utx <- crossprod(U_K, x) ``` 56 4 ``` uty <- crossprod(U_K, y) ``` 57 58 4 ``` structure(list( ``` 59 4 ``` x = utx, ``` 60 4 ``` y = uty, ``` 61 4 ``` U = U_K, ``` 62 4 ``` D = Lambda ``` 63 ``` ), ``` 64 4 ``` class = c("fullrank") ``` 65 ``` ) ``` 66 ```} ``` 67 68 ```#' @rdname ggmix_data_object ``` 69 ```new_fullrank_UD <- function(x, y, U, D) { ``` 70 4 ``` x <- cbind("(Intercept)" = 1, x) ``` 71 4 ``` utx <- crossprod(U, x) ``` 72 4 ``` uty <- crossprod(U, y) ``` 73 74 4 ``` structure(list( ``` 75 4 ``` x = utx, ``` 76 4 ``` y = uty, ``` 77 4 ``` U = U, ``` 78 4 ``` D = D ``` 79 ``` ), ``` 80 4 ``` class = c("fullrank") ``` 81 ``` ) ``` 82 ```} ``` 83 84 85 ```#' @rdname ggmix_data_object ``` 86 ```new_lowrank_kinship <- function(x, y, kinship, ``` 87 ``` n_nonzero_eigenvalues, ``` 88 ``` n_zero_eigenvalues) { ``` 89 4 ``` phi_eigen <- RSpectra::eigs(kinship, k = n_nonzero_eigenvalues) ``` 90 4 ``` U_kinship <- phi_eigen\$vectors ``` 91 4 ``` Lambda <- phi_eigen\$values ``` 92 4 ``` if (any(Lambda < 1e-5)) { ``` 93 0 ``` Lambda[which(Lambda < 1e-5)] <- 1e-05 ``` 94 ``` } ``` 95 96 ``` # for lowrank gglasso, and lasso, we use the original X and Y ``` 97 ``` # because of the W matrix ``` 98 ``` # we should calculate the W matrix in the lasso and gglaso methods ``` 99 ``` # since it depends on sigma and eta ``` 100 101 4 ``` structure(list( ``` 102 4 ``` x = x, y = y, ``` 103 4 ``` U = U_kinship, ``` 104 4 ``` D = Lambda, ``` 105 4 ``` n_nonzero_eigenvalues = n_nonzero_eigenvalues, ``` 106 4 ``` n_zero_eigenvalues = n_zero_eigenvalues ``` 107 ``` ), ``` 108 4 ``` class = c("lowrank") ``` 109 ``` ) ``` 110 ```} ``` 111 112 ```#' @rdname ggmix_data_object ``` 113 ```new_lowrank_K <- function(x, y, K, ``` 114 ``` n_nonzero_eigenvalues, ``` 115 ``` n_zero_eigenvalues) { ``` 116 4 ``` svdX <- RSpectra::svds(K, k = n_nonzero_eigenvalues) ``` 117 4 ``` U_K <- svdX\$u ``` 118 4 ``` Lambda <- svdX\$d^2 ``` 119 4 ``` if (any(Lambda < 1e-5)) { ``` 120 0 ``` Lambda[which(Lambda < 1e-5)] <- 1e-05 ``` 121 ``` } ``` 122 123 4 ``` structure(list( ``` 124 4 ``` x = x, y = y, ``` 125 4 ``` U = U_K, ``` 126 4 ``` D = Lambda, ``` 127 4 ``` n_nonzero_eigenvalues = n_nonzero_eigenvalues, ``` 128 4 ``` n_zero_eigenvalues = n_zero_eigenvalues ``` 129 ``` ), ``` 130 4 ``` class = c("lowrank") ``` 131 ``` ) ``` 132 ```} ``` 133 134 ```#' @rdname ggmix_data_object ``` 135 ```new_lowrank_UD <- function(x, y, U, D, ``` 136 ``` n_nonzero_eigenvalues, ``` 137 ``` n_zero_eigenvalues) { ``` 138 4 ``` structure(list( ``` 139 4 ``` x = x, y = y, ``` 140 4 ``` U = U, ``` 141 4 ``` D = D, ``` 142 4 ``` n_nonzero_eigenvalues = n_nonzero_eigenvalues, ``` 143 4 ``` n_zero_eigenvalues = n_zero_eigenvalues ``` 144 ``` ), ``` 145 4 ``` class = c("lowrank") ``` 146 ``` ) ``` 147 ```} ```

Read our documentation on viewing source code .