R/QTL_lasso.R

In Marie-PerrotDockes/ModQTL:

#' Description of the function
#' @export
QTLmod_lasso <- R6Class("QTLmod_lasso",
                        inherit = QTLmod,
                        public = list(
                          initialize = function(x, y){
                            super$initialize(x, y)
                          },
                          estime = function(lambda = NULL, standardize = FALSE, intercept = TRUE){

                          self$mod <-  private$y %>%
                              gather() %>%
                              group_by(key) %>%
                              nest(.key = Data) %>%
                              mutate(Data = map(Data, ~.$value)) %>%
                              mutate(Model = purrr::map(Data,
                                                        ~ glmnet(private$x, .,
                                                                 lambda = lambda,
                                                                 standardize = standardize,
                                                                 intercept = intercept)))
                            self$res <- self$mod  %>%
                              mutate( Beta = map(Model, ~.$beta), Intercept = map(Model,~.$a0)) %>%
                              select(-Model)


                          private$df <-self$res %>%
                            select(Beta) %>%
                            map( function(x){
                            x %>% as.matrix() %>%
                              as.data.frame() %>%
                              summarise_all(~sum(.!=0))
                          })
                          },

                          sel_cv = function(s = "lambda.min"){
                            if(is.null(private$cv) || (s != private$s)){
                              private$s <- s
                              self$cv <- private$y %>%
                                gather() %>%
                                group_by(key) %>%
                                nest(.key = Data) %>%
                                mutate(Data = map(Data, ~.$value)) %>%
                                mutate(Model = purrr::map(Data,
                                                          ~ cv.glmnet(private$x, .)))

                            }
                           self$cv <- self$cv %>%
                             mutate(Beta = map(Model, ~coef(.,private$s)[-1])) %>%
                              select(Beta, Data) %>% mutate(Beta = set_names(Beta, colnames(private$y)),
                                                            Data = set_names(Data, colnames(private$y))) %>%

                             summarise_all(~list(bind_rows(.))) %>% mutate(Beta = map(Beta, ~mutate(., Marker = colnames(private$x)))) %>%
                             mutate(Beta = map(Beta , ~gather(., key, value, -Marker)))

                          }
                        ))