Аннулировать кавычки вне контекста квазиквотирования

Я определяю функцию для получения прогнозируемых значений регрессионной модели с данными опроса для разных подгрупп (субпопуляций). Использую функцию svyglm из пакета обзора.

Моя проблема связана с обработкой опции подмножества в функции svyglm. Поскольку он использует нестандартную оценку, что, как я понимаю, означает, что он не принимает имена столбцов в виде строки. Я пробовал просто использовать имя столбца без строк и цитирования (enquo) и отменять его (!!). Однако оба варианта не работают. Я также играл с Ensym () и expr (), но не получил никаких результатов.

Данные и библиотека

library(dplyr)
library(survey)
library(srvyr)
library(purrr)
library(rlang)

mtcars <- read.table("https://forge.scilab.org/index.php/p/rdataset/source/file/master/csv/datasets/mtcars.csv",
                     sep=",", header=TRUE)

mtcars_cplx <- mtcars %>% as_survey_design(id = cyl, weights = qsec)

carb <- c(1:8)
cyl <- c(4:8)
new_data <- expand.grid(carb, cyl)
colnames(new_data) <- c("carb", "cyl")

С quousure

Функция и ввод

subpop_pred <- function(formula, data, subpop, new_data) {
  
  subpop_quo <- enquo(subpop)
  subpop_txt <- data$variables %>% select(!!subpop_quo) %>% colnames()
  
  for(i in min(data$variables[subpop_txt]):max(data$variables[subpop_txt])){
    reg <- svyglm(formula, data, subset=!!subpop_quo==i)
    pred <- predict(reg, newdata=new_data)
    
    if(exists("reg_end")==TRUE){
      pred <- cbind(new_data, pred, confint(pred))
      pred[subpop_txt] <- i
      reg_end <- rbind(reg_end, pred)
    } else {
      reg_end <- cbind(new_data, pred, confint(pred))
      reg_end[subpop_txt] <- i
    }
  }
}

subpop_pred(mpg ~ carb + cyl + carb*cyl, 
            data=mtcars_cplx, 
            new_data=new_data,
            subpop=gear)

Выход / Ошибка

 Error: Base operators are not defined for quosures.
Do you need to unquote the quosure?

  # Bad:
  myquosure == rhs

  # Good:
  !!myquosure == rhs
Call `rlang::last_error()` to see a backtrace 
8. stop(cnd) 
7. abort(paste_line("Base operators are not defined for quosures.", 
    "Do you need to unquote the quosure?", "", "  # Bad:", bad, 
    "", "  # Good:", good, )) 
6. Ops.quosure(subpop_quo, i) 
5. eval(subset, model.frame(design), parent.frame()) 
4. eval(subset, model.frame(design), parent.frame()) 
3. svyglm.survey.design(formula, data, subset = !!subpop_quo == 
    i) 
2. svyglm(formula, data, subset = !!subpop_quo == i) 
1. subpop_pred(mpg ~ carb + cyl + carb * cyl, data = mtcars_cplx, 
    new_data = new_data, subpop = gear)

Без вопросов

Функция и ввод

subpop_pred <- function(formula, data, subpop, new_data) {
  
  subpop_quo <- enquo(subpop)
  subpop_txt <- data$variables %>% select(!!subpop_quo) %>% colnames()
  
  for(i in min(data$variables[subpop_txt]):max(data$variables[subpop_txt])){
    reg <- svyglm(formula, data, subset=subpop==i)
    pred <- predict(reg, newdata=new_data)
    
    if(exists("reg_end")==TRUE){
      pred <- cbind(new_data, pred, confint(pred))
      pred[subpop_txt] <- i
      reg_end <- rbind(reg_end, pred)
    } else {
      reg_end <- cbind(new_data, pred, confint(pred))
      reg_end[subpop_txt] <- i
    }
  }
}

subpop_pred(mpg ~ carb + cyl + carb*cyl, data=mtcars_cplx, new_data=new_data, subpop=gear)

Выход

Error in eval(subset, model.frame(design), parent.frame()) : 
  object 'gear' not found 
5. eval(subset, model.frame(design), parent.frame()) 
4. eval(subset, model.frame(design), parent.frame()) 
3. svyglm.survey.design(formula, data, subset = subpop == i) 
2. svyglm(formula, data, subset = subpop == i) 
1. subpop_pred(mpg ~ carb + cyl + carb * cyl, data = mtcars_cplx, 
    new_data = new_data, subpop = gear)

У вас есть идеи, как заставить эту функцию работать?


r dplyr survey quosure
person Stephan    schedule 14.06.2019    source источник
comment
Как насчет того, чтобы вручную разделить набор данных внутри функции и передать его в data аргумент svyglm() вместо использования аргумента subset? Вы можете использовать, например, filter(), поскольку похоже, что вы уже используете dplyr.   -  person aosmith    schedule 14.06.2019
comment
Похоже, что аргумент subset работает как функция subset(), с которой может быть сложно работать в функциях (по крайней мере, для меня :-D). Я мог форсировать вещи (тренируясь с lm()), используя subset = rlang::eval_tidy( expr( !!subpop_quo == i), data = data). Как только я начинаю спускаться в кроличью нору с expr() и друзьями, я понимаю, что делаю что-то не так. :-P Фильтрация вручную и передача ее в функцию модели кажутся мне более простой (т.е. dat = filter(data, !!subpop_quo == i)).   -  person aosmith    schedule 14.06.2019
comment
Спасибо, @aosmith, это сработало. Я всегда немного не решаюсь использовать filter (), так как не знаю, может ли какая-то информация быть потеряна. Например, в Stata необходимо использовать определенные команды опроса для фильтрации субпопуляций, чтобы получить правильную стандартную ошибку. Однако я буду экспериментировать с этим. К сожалению, я не могу проголосовать за вас, так как случайно удалил свой голос за ваш комментарий.   -  person Stephan    schedule 17.06.2019
comment
О, интересно о Стате. В R я всегда использовал аргумент subset взаимозаменяемо с subset(), но в svyglm это может быть иначе!   -  person aosmith    schedule 17.06.2019

Ответы (2)


arrow_upward
1
arrow_downward

Я мог бы заставить все работать с аргументом subset, смешав expr() и rlang::tidy_eval().

Модельная строка в вашей функции могла бы выглядеть так:

reg <- svyglm(formula, data = data, 
       subset = rlang::eval_tidy( expr( !!subpop_quo == i), data =  data) )

Я не знаю, насколько это надежно, и есть ли более простой подход к tidyeval. Работа над этим заставила меня понять, что с subset() функцией / аргументом сложно работать в функциях. :-П

person aosmith    schedule 17.06.2019

arrow_upward
0
arrow_downward

Не уверен, есть ли лучший способ сделать это, поскольку svyby(), похоже, не поддерживает svyglm(). Здесь quo_squash() используется для передачи выражений в subset(). Это можно расширить, чтобы делать прогнозы.

gears = unique(mtcars$gear)
lapply(gears, function(x) {
  subset(mtcars_cplx, !!quo_squash(gear == x)) %>% 
    svyglm(mpg ~ carb + cyl + carb*cyl, design = .)
})
person Charco Hui    schedule 17.06.2019