匹配无循环的家庭伙伴

Question

我试图避免使用loop 来重新编码家庭伴侣的变量标识。

hldid 表示家庭，persid 表示家庭中的人。 变量partner 表示伙伴的persid，child 表示该行是否为子行。

变量partner 中缺少的是两个合作伙伴的persid。

例如对于hldid == 1，persid == 1 对于partner 的值为0，而它应该是2。

这是数据的样子：

> test
   hldid persid age sex relresp partner child
1      1      1  26   2       0       0     0
2      1      2  26   1       1       1     0
3      2      1  59   2       0       0     0
4      2      2  64   1       1       1     0
5      3      1  76   2       0       0     0
6      4      1  65   2       0       0     0
7      4      2  64   1       1       1     0
8      5      1  52   2       0       0     0
9      5      2  51   1       1       1     0
10     5      3  20   2      21       0     1
11     5      4  14   2      21       0     1
12     7      1  69   1       0       0     0
13     7      2  70   2       1       1     0

我设法创建了一个非常丑陋的循环，但是对于整个数据集来说它太慢了。

test$partnerREC = test$partner

for(i in 1:13){
  for(j in 1:13){

    if(
      test$hldid[i] == test$hldid[i+1] & # verify if household is the same 
      (test$persid[i] == test$partner[j])
    )

    {
      test$partnerREC[i] = test$persid[j] # put the persid for each partner
    }
  }
}

> test
   hldid persid age sex relresp partner child partnerREC
1      1      1  26   2       0       0     0          2
2      1      2  26   1       1       1     0          1
3      2      1  59   2       0       0     0          2
4      2      2  64   1       1       1     0          1
5      3      1  76   2       0       0     0          0
6      4      1  65   2       0       0     0          2
7      4      2  64   1       1       1     0          1
8      5      1  52   2       0       0     0          2
9      5      2  51   1       1       1     0          1
10     5      3  20   2      21       0     1          0
11     5      4  14   2      21       0     1          0
12     7      1  69   1       0       0     0          2
13     7      2  70   2       1       1     0          1 

知道如何使用data.table 来解决这个问题吗？

test = structure(list(hldid = c(1, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 7, 
7), persid = c(1, 2, 1, 2, 1, 1, 2, 1, 2, 3, 4, 1, 2), age = c(26, 
26, 59, 64, 76, 65, 64, 52, 51, 20, 14, 69, 70), sex = c(2, 1, 
2, 1, 2, 2, 1, 2, 1, 2, 2, 1, 2), relresp = c(0, 1, 0, 1, 0, 
0, 1, 0, 1, 21, 21, 0, 1), partner = c(0, 1, 0, 1, 0, 0, 1, 0, 
1, 0, 0, 0, 1), child = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 
0)), class = "data.frame", row.names = c(NA, -13L))

Answer 1

一个可能的解决方案：

library(data.table)  # load the package
setDT(test)          # convert 'test' to a 'data.table'

test[, partnerREC := persid[c(pmin(2,.N):1,rep(0,(pmax(.N,2)-2)))] *
                       (persid %in% 1:2) *
                       (.N != 1)
     , by = hldid][]

给出：

> test
    hldid persid age sex relresp partner child partnerREC
 1:     1      1  26   2       0       0     0          2
 2:     1      2  26   1       1       1     0          1
 3:     2      1  59   2       0       0     0          2
 4:     2      2  64   1       1       1     0          1
 5:     3      1  76   2       0       0     0          0
 6:     4      1  65   2       0       0     0          2
 7:     4      2  64   1       1       1     0          1
 8:     5      1  52   2       0       0     0          2
 9:     5      2  51   1       1       1     0          1
10:     5      3  20   2      21       0     1          0
11:     5      4  14   2      21       0     1          0
12:     7      1  69   1       0       0     0          2
13:     7      2  70   2       1       1     0          1

此解决方案基于以下假设（源自示例数据），即只有“persid”1 和 2 是合作伙伴，任何更高的都是孩子。

这是做什么的：

• 按hldid分组
• 更改前两个人的顺序，但仅当家庭中有更多人时 persid[c(pmin(2,.N):1,rep(0,(pmax(.N,2)-2)))] 其中pmin 用于确保在一个家庭只有一个人时构造一个长度为 1 的向量。
• 将其与(persid %in% 1:2)相乘以获得儿童的zores。
• 将其与(.N != 1) 相乘，得到一个人的家庭的值为零。

Answer 2

df <- data.frame(matrix(data = NA, ncol = 7))
names(df) <- names(test)

for(id in unique(test$hldid)){
  t <- test[test$hldid==id,]
  t$partner[t$persid == t$partner[t$partner!=0]] <- t$persid[which(t$partner!=0)]

  df <- rbind(df, t)
}

df <- df[-1,]

Answer 3

基本 R 解决方案比 Jaap 的 data.table solution 更复杂。

我使用副本。

test2 <- test

运行问题中的代码后，运行以下代码。

test2$partnerREC <- test2$partner
sp <- split(test2, test2$hldid)
test2 <- lapply(sp, function(DF){
  i <- with(DF, which(persid %in% partner))
  j <- with(DF, which(partner %in% persid))
  #cat("i:", i, "\tj:", j, "\n")
  DF$partnerREC[i] <- DF$persid[j]
  DF
})
test2 <- do.call(rbind, test2)
row.names(test2) <- NULL

现在比较两个结果。

identical(test, test2)
#[1] TRUE

Answer 4

您可以通过一些dplyr 的步骤来加入自己的数据并在persid == partner 时更新合作伙伴的价值。

test2 <- left_join(test, test %>% select(hldid, persid, partner) %>% filter(partner != 0), by=c("hldid")) %>%
  filter(persid.x == partner.y) %>%
  mutate(partner.x = persid.y)

这将为您提供与其伴侣 ID 匹配的户主，但您必须将其重新加入原始数据（我不确定 dplyr 术语中的 SQL update 是否等效）。

Answer 5

1。创建您的测试数据框架

 library(tidyverse)

 test <- tribble(
            ~hldid, ~persid, ~age, ~sex, ~relresp, ~partner, ~child,
             1,      1,     26,   2,       0,       0,         0,
             1,      2,     26,   1,       1,       1,         0,
             2,      1,     59,   2,       0,       0,         0,
             2,      2,     64,   1,       1,       1,         0,
             3,      1,     76,   2,       0,       0,         0,
             4,      1,     65,   2,       0,       0,         0,
             4,      2,     64,   1,       1,       1,         0,
             5,      1,     52,   2,       0,       0,         0,
             5,      2,     51,   1,       1,       1,         0,
             5,      3,     20,   2,      21,       0,         1,
             5,      4,     14,   2,      21,       0,         1,
             7,      1,     69,   1,       0,       0,         0,
             7,      2,     70,   2,       1,       1,         0)

2。 arrange()、group_by()、mutate()来救援

test %>%
  # arrange the data in case the raw data did not 
  arrange(hldid, child, persid) %>%
  # group each household 
  group_by(hldid) %>%
  # match first and second household person as each other's partner
  mutate(partnerREC = ifelse(persid == first(persid), nth(persid, 2), first(persid))) %>%
  # correct partnerREC for child and single 
  mutate(partnerREC = ifelse(child == 1 | is.na(partnerREC), 0, partnerREC))
  # un-group it
  ungroup() 

Answer 6

使用rcpp 的loop 解决方案

获取rcpp 脚本

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
NumericVector HHgrid(CharacterVector hid, NumericVector persid, NumericVector partner, 
NumericVector partnerRec) {

  int nrows = hid.size();

  for (int i = 1; i < nrows - 1; i ++){
    for (int j = 0; j < nrows - 1; j++){

      if( (hid(i) == hid(i+1)) & ( persid(i) == partner(j) ) ){
        partnerRec(i) = persid(j); 
      }
    }
    Rcout << i << std::endl;     
  }
  return(partnerRec); 
}

并运行函数

HHgrid(hid = test$hldid, persid = test$persid, partner = test$partner, partnerRec = test$partnerRec)

第一种情况只是一个小问题（如果你知道如何解决它）