如何从参考小标题向两列小标题添加数字？

Question

这是一个困扰我一段时间的问题，我确信有一个解决方案，但我似乎没有找到解决它的方法。

我在代码中已经达到了这一点，其中我有一些类似于我在下面创建的玩具小玩意儿...

到这个小标题

id_tibble <- tibble(
  color = c("blue", "orange", "orange", "orange", "yellow", "black"),
  animals = c("elephant", "tiger", "leon", "leopard", "hawk", "hawk")
  )

我想添加两列“color_num”和“animals_num”，其中只有来自另一个看起来像这样的小标题的“兼容”数字

compatible_numbers <- tibble(
  key = c(rep(1, 8), rep(2, 8), rep(3, 8), rep(4, 8), rep(5, 8), rep(6, 8), rep(7, 8)),
  main = c(seq(2, 9), seq(13, 20), seq(25,32), seq(3, 18, by =2), c(4, 6:12), seq(7, 14), seq(5, 26, by = 3))
  )

如果数字 1 是数字池 (available_numbers) 中的最小数字（在这种情况下，范围从 1 到 32），那么我将其分配给“蓝色”。列 main 中的第一个兼容编号（编号 2）应分配给“大象”，并在必要时重复。然后，由于 2 不再可用（在 available_numbers 向量中），我需要从“key”列中选择以下可用数字 3，并将其分配给“orange”。 3的兼容数字是25,26,27，它们将分配给“老虎”，“狮子”，“豹”等等......

available_numbers <- seq_len(max(compatible_numbers))[seq_len(max(compatible_numbers)) %in% c(compatible_numbers$key, compatible_numbers$main)]

期望的结果是下面的小标题

outcome_tibble <- tibble(
  color = c("blue", "orange", "orange", "orange", "yellow", "black"),
  animals = c("elephant", "tiger", "leon", "leopard", "hawk", "hawk"),
  color_num = c(1,3,3,3,4,6),
  animals_num = c(2,25, 26, 27, 5,5)
)

感谢您的帮助！

解决方案：

受@RonakShah 共享的 for 循环的启发，我构建了一些 if 语句来满足更多条件并考虑动物和颜色列的重复值。

如果您有任何 tidyverse 版本，请发布？

id_tibble$color_num <- NA
id_tibble$animals_num <- NA


for(i in 1:nrow(id_tibble)){
  if (i == 1){
    #assign the first available number
    id_tibble$color_num[i] <- available_numbers[1]
    all_num <- compatible_numbers$main[compatible_numbers$key == available_numbers[1]]
    #Keep only the ones which are available
    all_num <- intersect(all_num, available_numbers)
    #Remove the color_num value
    available_numbers <- available_numbers[-1]
    #assign the first available compatible number
    id_tibble$animals_num[i] <- all_num[1]
    #Remove the animal_num value
    available_numbers <- available_numbers[-1]
  } else{
    if(id_tibble$color[i] != id_tibble$color[i-1] && id_tibble$animals[i] != id_tibble$animals[i-1]){
      #assign the first available number
      id_tibble$color_num[i] <- available_numbers[1]
      all_num <- compatible_numbers$main[compatible_numbers$key == available_numbers[1]]
      #Keep only the ones which are available
      all_num <- intersect(all_num, available_numbers)
      #Remove the color_num value
      available_numbers <- available_numbers[-1]
      #assign the first available compatible number
      id_tibble$animals_num[i] <- all_num[1]
      #Remove the animal_num value
      available_numbers <- available_numbers[-which(available_numbers == all_num[1])]
    } else if(id_tibble$color[i] == id_tibble$color[i-1] && id_tibble$animals[i] != id_tibble$animals[i-1]){
      #assign the previous number
      id_tibble$color_num[i] <- id_tibble$color_num[i-1]
      all_num <- compatible_numbers$main[compatible_numbers$key == id_tibble$color_num[i-1]]
      #Keep only the ones which are available
      all_num <- intersect(all_num, available_numbers)
      #assign the first available compatible number
      id_tibble$animals_num[i] <- all_num[1]
      #Remove the animal_num value
      available_numbers <- available_numbers[-which(available_numbers == all_num[1])]
    } else if(id_tibble$color[i] != id_tibble$color[i-1] && id_tibble$animals[i] == id_tibble$animals[i-1]){
      #assign the previous number
      id_tibble$animals_num[i] <- id_tibble$animals_num[i-1]
      all_num <- compatible_numbers$main[compatible_numbers$key == id_tibble$animals_num[i-1]]
      #Keep only the ones which are available
      all_num <- intersect(all_num, available_numbers)
      #assign the first available compatible number
      id_tibble$color_num[i] <- all_num[1]
      #Remove the animal_num value
      available_numbers <- available_numbers[-which(available_numbers == all_num[1])]
    }
  }
}

Answer 1

我有一个 for 循环解决方案 -

id_tibble$color_num <- NA
id_tibble$animals_num <- NA

#run the loop only for unique values in color
for(uq in unique(id_tibble$color)) {
  #get row position for this color value
  i <- which(id_tibble$color == uq)
  #assign the first available number
  id_tibble$color_num[i] <- available_numbers[1]
  #Get corresponding values of the number
  all_num <- compatible_numbers$main[compatible_numbers$key == available_numbers[1]]
  #Keep only the ones which are available
  all_num <- intersect(all_num, available_numbers)
  #Remove the color_num value
  available_numbers <- available_numbers[-1]
  #assign the animals_num value
  id_tibble$animals_num[i] <- all_num[seq_along(i)]
  #Drop the values which are assigned in animals_num
  available_numbers <- setdiff(available_numbers, id_tibble$animals_num[i])
}

#  color  animals  color_num animals_num
#  <chr>  <chr>        <int>       <int>
#1 blue   elephant         1           2
#2 orange tiger            3          25
#3 orange leon             3          26
#4 orange leopard          3          27
#5 yellow hawk             4           5
#6 black  hawk             6           7