Как исправить ошибку целевой переменной при перекрестной проверке (кроссвалидации) в R?

Есть датафрейм с целевой переменной (target_var), набором независимых переменных (ind1, ind2, etc.), идентификаторами наблюдений (id) и демографическими данными (dem_var). Моя задача: получить коэффициенты значимости (beta) для каждой из независимых переменных в каждом демографическом разрезе (типе).

Для выполнения задачи использую написанную функцию, которая фильтрует по каждому из уникальных значений в столбце с демографическими данными и прогоняет кросс-валидацию. Однако возникает ошибка:

Error in elnet(xd, is.sparse, ix, jx, y, weights, offset, type.gaussian, : y is constant; gaussian glmnet fails at standardization step

Я понимаю, что ошибка возникает, когда в каком-то из разрезов стандартное отклонение моей целевой переменной равно нулю. Тогда я добавил в свою функцию строки кода, которые отфильтровывают разрезы с sd = 0. Однако это не исправляет ошибки.

Что я делаю не так и есть ли какие-то другие способы устранить эту ошибку?

Данные:

set.seed(30082021)
tibble(
  id = 1:3000,
  target_var = rep(c(1, -1, 0), 1000),
  dem_var = rep(c("type1", "type2", "type3",
                  "type4", "type5"), each = 600),
  ind1 = runif(3000, min = -0.1, max = 0.9),
  ind2 = runif(3000, min = -0.1, max = 0.9),
  ind3 = runif(3000, min = -0.1, max = 0.9),
  ind4 = runif(3000, min = -0.1, max = 0.9),
  ind5 = runif(3000, min = -0.1, max = 0.9),
  ind6 = runif(3000, min = -0.1, max = 0.9),
  ind7 = runif(3000, min = -0.1, max = 0.9),
  ind8 = runif(3000, min = -0.1, max = 0.9)
)

Функция:

library(glmnet)

section <- unique(data$dem_var)

cv_model_fn <- function(.data, .dem_var = section, ...) {
  
  .dem_var <- match.arg(.dem_var)
  
  .data<- .data %>%
    group_by(dem_var) %>%
    mutate(n = n_distinct(id)) %>%
    filter(n > 30) %>% 
    ungroup()
  
  for (i in 1:length(section)) {
    
    mm <- .data %>%
      filter(dem_var == section[i]) %>%
      select(starts_with("ind")) 
    
    mm_model <- model.matrix( ~ 0 + ., data = mm)
    
    nn <- .data %>% 
      group_by(dem_var) %>% 
      mutate(sd_var = sd(target_var, na.rm = TRUE)) %>% 
      ungroup() %>% 
      filter(sd_var > 0) %>% 
      select(-sd_var) %>% 
      filter(dem_var == section[i]) %>%
      select(target_var)
    
    gl <- cv.glmnet(
      x = mm_model,
      y = unlist(nn),
      offset = NULL,
      nfolds = 10,
      alpha = 0,
      family = "gaussian"
    )
    
    
    coef <-
      data.frame(
        ID = coef.glmnet(gl, s = "lambda.min") %>% as.matrix() %>% as.data.frame() %>%
          rownames_to_column(var = "question") %>% select(1),
        beta_coef = coef.glmnet(gl, s = "lambda.min") %>% as.matrix() %>% as.data.frame() %>%
          select(1),
        row.names = NULL
      )%>%
      mutate(dem_var = section[i])
    
  }
  
  return(coef)
}

Ответы (1 шт):

Автор решения: Ogurtsov

Функция работает, вот результат

> cv_model_fn(data)
     question    lambda.min dem_var
1 (Intercept) -9.157750e-38   type5
2        ind1  2.048330e-37   type5
3        ind2  1.084679e-37   type5
4        ind3 -4.866956e-38   type5
5        ind4  9.961977e-38   type5
6        ind5  5.977091e-38   type5
7        ind6 -5.294143e-39   type5
8        ind7 -7.698830e-38   type5
9        ind8 -1.115661e-37   type5
→ Ссылка