根据外部表中的逻辑规则重新编码多个变量。

Question

目标

给定数据ds，根据对象hrule中指定的协调规则，从ds$raw1和ds$raw2计算一个新变量ds$h1。

可重现的示例包含 10 个人对 2 个度量的响应，raw1 和 raw2：

>ds
   id raw1 raw2
1   1    1    1
2   2    1    0
3   3    0    1
4   4    0    0
5   5   NA    1
6   6   NA    0
7   7    1   NA
8   8    0   NA
9   9   NA   NA
10 10    1    1

这两个变量需要根据一些规则（定性开发）转换为一个单一的、协调的变量。协调变换的规则编码在对象hrule中：

>hrule
  raw1 raw2  h1
1    0    0   0
2    0    1   1
3    0   NA   0
4    1    0   1
5    1    1   1
6    1   NA   1
7   NA    0   0
8   NA    1   1
9   NA   NA   NA

因此，应该将第 1 行的规则解读为：

如果受访者在raw1 上提供0 的值，在raw2 上提供0 的值，那么h1 的值应该是0。

功能目标

开发一个函数，传递ds、hrule、变量名称、字符向量（c("raw1","raw2")）和协调变量的名称（"h1"）并输出一个新的协调变量（ds$h1 )。

起始码

(ds <- data.frame("id" = 1:10,
                  "raw1" = c(1,1,0,0,NA,NA,1 ,0 ,NA,1),
                  "raw2" = c(1,0,1,0,1 ,0 ,NA,NA,NA,1)))
(response_profile <- ds %>% dplyr::group_by(raw1, raw2) %>% dplyr::summarize(count=n()))
(hrule <- cbind(response_profile, "h1" = c(0,1,0,1,1,1,0,1,NA)))
new_function <- function(ds, hrule,
                         variable_names, # variable_names = c("raw1,"raw2"), the number will vary
                         harmony_name # harmony_name = "h1", there might be "h2"
){

}

提前感谢您的想法！

Answer 1

这是@Symbolix 建议的完整解决方案

rm(list=ls(all=TRUE)) #Clear the memory of variables from previous run. This is not called by knitr, because it's above the first chunk.
cat("\f")
library(magrittr)

(ds <- data.frame("id" = 1:10,
                  "raw1" = c(1,1,0,0,NA,NA,1 ,0 ,NA,1),
                  "raw2" = c(1,0,1,0,1 ,0 ,NA,NA,NA,1)))
response_profile <- ds %>% dplyr::group_by(raw1, raw2) %>% dplyr::summarize(count=n()) %>% dplyr::select(-count)
(hrule <- cbind(response_profile, 
                "h1" = c(0,1,0 ,1,1,1 ,0 ,1 ,NA), # at least one 1 to produce 1
                "h2"=  c(0,0,NA,0,1,NA,NA,NA,NA) # both must be 1
                )) 
recode_from_meta <- function(ds, hrule, variable_names, harmony_name){
d <- merge(ds, hrule[, c(variable_names, harmony_name)], by=variable_names, all.x=T)
}

> hrule
  raw1 raw2 h1 h2
1    0    0  0  0
2    0    1  1  0
3    0   NA  0 NA
4    1    0  1  0
5    1    1  1  1
6    1   NA  1 NA
7   NA    0  0 NA
8   NA    1  1 NA
9   NA   NA NA NA


> (d <- recode_from_meta(ds, hrule,variable_names=c("raw1", "raw2"), harmony_name="h1"))
   raw1 raw2 id h1
1     0    0  4  0
2     0    1  3  1
3     0   NA  8  0
4     1    0  2  1
5     1    1  1  1
6     1    1 10  1
7     1   NA  7  1
8    NA    0  6  0
9    NA    1  5  1
10   NA   NA  9 NA
> (d <- recode_from_meta(ds, hrule,variable_names=c("raw1", "raw2"), harmony_name="h2"))
   raw1 raw2 id h2
1     0    0  4  0
2     0    1  3  0
3     0   NA  8 NA
4     1    0  2  0
5     1    1  1  1
6     1    1 10  1
7     1   NA  7 NA
8    NA    0  6 NA
9    NA    1  5 NA
10   NA   NA  9 NA