Add columns where identifiers fit multiple patterns - r

Question

A data frame df has one row per for every distinct value of its numeric vector id0 - but trailing zeros in cells for id0 indicate important groups along which the file must be transformed. Here are 12 observations of df:
row id0 id0_ntz
a 111000 3
b 111010 1
c 112345 0
d 111974 0
e 112090 1
f 114000 3
g 114099 0
h 555001 0
i 555012 0
j 461000 3
k 461020 1
l 111090 0
Let's call every value of id0 with three trailing zeros (i.e., where id0_ntz == 3) a "big id" and every value that doesn't fit this pattern a "little id." The 12 obs above include three big ids (row values a, f, and j). For each big id, I need to:
Find every other value of id0 that matches the first three digits of this ith big id
Add the value of id0 for each match to one of j discrete vectors called idj, where j is a suffix ranging from 1 to j that effectively counts the number of matching little ids nested in the ith big id.
If df only included the 12 rows shown above, the correct result would look like this:
row id0 id0_ntz id1 id2 id3
a 111000 3 111010 111974 111090
b 111010 1 NA NA NA
c 112345 0 NA NA NA
d 111974 0 NA NA NA
e 112090 1 NA NA NA
f 114000 3 114099 NA NA
g 114099 0 NA NA NA
h 555001 0 NA NA NA
i 555012 0 NA NA NA
j 461000 3 461020 NA NA
k 461020 1 NA NA NA
l 111090 0 NA NA NA
I'm open to any solution that solves this problem dynamically (i.e., is agnostic to the number of big ids, little ids, and resulting idj vectors).
P.S.: I need to do the same thing again where id0_ntz == 2, then 1, but an acceptable answer to this posted question only requires a solution that solves the problem where id0_ntz == 3.

Answer 1

This will serve your purpose
df <- read.table(text = 'row id0 id0_ntz
a 111000 3
b 111010 1
c 112345 0
d 111974 0
e 112090 1
f 114000 3
g 114099 0
h 555001 0
i 555012 0
j 461000 3
k 461020 1
l 111090 0', header = T)
df$id0 <- as.character(df$id0)
library(tidyverse)
df %>%
filter(id0_ntz == 3) %>%
mutate(big_id = substr(id0, 1, 3)) -> big_id
df %>% mutate(id0 = as.character(id0)) %>%
left_join(df %>% mutate(id = as.character(id0),
dummy = match(substr(id, 1, 3), big_id$big_id)) %>%
filter(!is.na(dummy)) %>%
group_by(dummy) %>%
mutate(d2 = paste0('id', row_number() - 1)) %>% select(-id0) %>%
pivot_wider(id_cols = dummy, names_from = d2, values_from = id),
by = c('id0')) %>%
select(-dummy)
#> row id0 id0_ntz id1 id2 id3
#> 1 a 111000 3 111010 111974 111090
#> 2 b 111010 1 <NA> <NA> <NA>
#> 3 c 112345 0 <NA> <NA> <NA>
#> 4 d 111974 0 <NA> <NA> <NA>
#> 5 e 112090 1 <NA> <NA> <NA>
#> 6 f 114000 3 114099 <NA> <NA>
#> 7 g 114099 0 <NA> <NA> <NA>
#> 8 h 555001 0 <NA> <NA> <NA>
#> 9 i 555012 0 <NA> <NA> <NA>
#> 10 j 461000 3 461020 <NA> <NA>
#> 11 k 461020 1 <NA> <NA> <NA>
#> 12 l 111090 0 <NA> <NA> <NA>
Created on 2021-05-28 by the reprex package (v2.0.0)

Answer 2

I'd use the approach below. Its quite short.
library(tidyverse)
df %>%
group_by(big_id = substr(id0, 1, 3)) %>%
mutate(id = ifelse(substr(id0, 4, 6) == "000",
list(setdiff(unique(id0),
paste0(big_id, "000"))),
list())) %>%
unnest_wider(col = id,
names_sep = "")
#> # A tibble: 12 x 7
#> # Groups: big_id [5]
#> row id0 id0_ntz big_id id1 id2 id3
#> <chr> <int> <int> <chr> <int> <int> <int>
#> 1 a 111000 3 111 111010 111974 111090
#> 2 b 111010 1 111 NA NA NA
#> 3 c 112345 0 112 NA NA NA
#> 4 d 111974 0 111 NA NA NA
#> 5 e 112090 1 112 NA NA NA
#> 6 f 114000 3 114 114099 NA NA
#> 7 g 114099 0 114 NA NA NA
#> 8 h 555001 0 555 NA NA NA
#> 9 i 555012 0 555 NA NA NA
#> 10 j 461000 3 461 461020 NA NA
#> 11 k 461020 1 461 NA NA NA
#> 12 l 111090 0 111 NA NA NA
Created on 2021-05-27 by the reprex package (v0.3.0)

Answer 3

library(tidyverse)
df <- read.table(text = 'row id0 id0_ntz
a 111000 3
b 111010 1
c 112345 0
d 111974 0
e 112090 1
f 114000 3
g 114099 0
h 555001 0
i 555012 0
j 461000 3
k 461020 1
l 111090 0', header = T)
df %>%
mutate(id = id0 %/% 1000 * 1000) %>%
group_by(id) %>%
mutate(row_id = row_number() - 1) %>%
ungroup() %>%
filter(row_id != 0) %>%
pivot_wider(id, names_from = row_id, values_from = id0, names_prefix = "id") %>%
right_join(df, by = c("id" = "id0")) %>%
rename(id0 = id) %>%
arrange(row)
#> # A tibble: 12 x 6
#> id0 id1 id2 id3 row id0_ntz
#> <dbl> <int> <int> <int> <chr> <int>
#> 1 111000 111010 111974 111090 a 3
#> 2 111010 NA NA NA b 1
#> 3 112345 NA NA NA c 0
#> 4 111974 NA NA NA d 0
#> 5 112090 NA NA NA e 1
#> 6 114000 114099 NA NA f 3
#> 7 114099 NA NA NA g 0
#> 8 555001 NA NA NA h 0
#> 9 555012 NA NA NA i 0
#> 10 461000 461020 NA NA j 3
#> 11 461020 NA NA NA k 1
#> 12 111090 NA NA NA l 0
Created on 2021-05-27 by the reprex package (v2.0.0)