如何从参考标题中将数字添加到两列标题中?
How to add numbers to a two column tibble from a reference tibble?
这是一个困扰我一段时间的问题,我确信有解决方案,但我似乎没有找到解决它的方法。
我已经在我的代码中达到了这一点,我有一些类似于我在下面创建的玩具 tibbles...
为了这个标题
id_tibble <- tibble(
color = c("blue", "orange", "orange", "orange", "yellow", "black"),
animals = c("elephant", "tiger", "leon", "leopard", "hawk", "hawk")
)
我想添加两列“color_num”和“animals_num”,其中只有来自另一个 tibble 的“兼容”数字,看起来像这样
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),那么我将其分配给“蓝色”。主列中的第一个兼容编号(编号 2)应分配给“大象”,并在必要时重复。然后,由于 2 不再可用(在 available_numbers 向量中),我需要 select 来自“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 语句来满足更多条件并考虑动物和颜色列的重复值。
拜托,post 任何 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])]
}
}
}
我有一个 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
这是一个困扰我一段时间的问题,我确信有解决方案,但我似乎没有找到解决它的方法。
我已经在我的代码中达到了这一点,我有一些类似于我在下面创建的玩具 tibbles...
为了这个标题
id_tibble <- tibble(
color = c("blue", "orange", "orange", "orange", "yellow", "black"),
animals = c("elephant", "tiger", "leon", "leopard", "hawk", "hawk")
)
我想添加两列“color_num”和“animals_num”,其中只有来自另一个 tibble 的“兼容”数字,看起来像这样
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),那么我将其分配给“蓝色”。主列中的第一个兼容编号(编号 2)应分配给“大象”,并在必要时重复。然后,由于 2 不再可用(在 available_numbers 向量中),我需要 select 来自“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 语句来满足更多条件并考虑动物和颜色列的重复值。
拜托,post 任何 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])]
}
}
}
我有一个 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