Split groups into unique sets
Yes, I think it is better to use efficient base functions for this kind of task. I'm assuming your ids are sorted so that duplicates will always be next to each other, is that right? In that case, a first idea would be to use the duplicated function. Using your example, see that:

x &lt;- c(1, 1, 2, 2, 3, 4)
duplicated(x)
# [1] FALSE  TRUE FALSE  TRUE FALSE FALSE
1 + duplicated(x)
# [1] 1 2 1 2 1 1


However, this will not work in your more general case where there may be more than 2 duplicated households:

x &lt;- c(1, 1, 1, 2, 2, 2, 3, 3, 4, 5)
1 + duplicated(x)
# [1] 1 2 2 1 2 2 1 2 1 1


For the general case, I would use run length encoding functions:

rle(x)
# Run Length Encoding
#   lengths: int [1:5] 3 3 2 1 1
#   values : num [1:5] 1 2 3 4 5
sequence(rle(x)$lengths)
# [1] 1 2 3 1 2 3 1 2 1 1


So I would suggest you replace your assign_extra_id with the following:

assign_extra_id2 &lt;- function(x) sequence(rle(x)$lengths)


Update

Taking into account the added details (in the comments and updated question), maybe this function will do?

assign_extra_id3 &lt;- function(x) {
   resample &lt;- function(x, ...) x[sample.int(length(x), ...)]
   z &lt;- rle(rle(x)$lengths)
   s &lt;- sample(z$values[1])
   i &lt;- Map(function(l,v) rep(resample(s[1:v]),l), z$lengths, z$values)
   unlist(i, use.names = FALSE)
}


It's (still) a nice speedup:

# Unit: milliseconds
#        expr        min         lq       mean    median         uq       max neval
 # op_attempt 5013.47742 5051.44837 6198.35973 5535.9724 6951.75439 9843.3606    10
 # fd_attempt   54.48751   59.92706   73.31207   62.1226   82.82826  130.2046    10