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

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), чтобы получить нулевое значение для домохозяйств из одного человека.

Вы можете добраться туда, выполнив некоторые шаги 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).

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,]

Решение на базе 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

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. На помощь приходят договариваться(), группа по() и мутировать ().

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() 

Решение 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)

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