Подбор домашних партнеров без петли

Question

Я стараюсь не использовать loop в моей попытке перекодировать переменную идентификацию партнеров по дому.

hldid обозначает домохозяйство, а persid лицо в домохозяйстве.Переменная partner указывает persid партнера, а child указывает, является ли строка дочерней.

В переменной partner отсутствует значение persid для обоих партнеров.

Например, для hldid == 1, persid == 1 имеет значение 0 для partner, тогда как оно должно быть 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

A loop решение с использованием rcpp

Сценарий 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)

Существует тольконебольшая проблема с первым случаем (если вы знаете, как это исправить)

Answer 2

1.Создайте свой тестовый файл data.frame

 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.range () , 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 3

Решение Base R сложнее, чем решение Jaap data.table .

Я работаю с копией.

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

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 5

Вы можете пройти через несколько шагов 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)

Это даст вам главу домохозяйства вместе с партнером.Идентификатор совпал, но вам нужно будет присоединить его к исходным данным (я не уверен, что эквивалент SQL update в dplyr lingo).

Answer 6

Возможное решение:

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) для получения баллов по детям.
• Умножьте это на (.N != 1), чтобы получить нулевое значение для домохозяйств из одного человека.