#r #group-by #tidyverse #tibble
Вопрос:
Вот вопрос, который беспокоит меня уже некоторое время, и я уверен, что для него есть решение, но, похоже, я не нахожу способа его решить.
Я достиг этой точки в своем коде, где у меня есть что-то похожее на игрушечные тибблы, которые я создал ниже…
К этому тибблу
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 будет минимальным числом из пула чисел (доступных номеров) (в данном случае от 1 до 32), то я назначаю его «синим». Первый совместимый номер из столбца main (номер 2) должен быть присвоен «слону» и при необходимости повторен. Затем, поскольку 2 больше недоступно (в векторе available_numbers) Мне нужно было бы выбрать следующий доступный номер, 3, из столбца «ключ» и присвоить ему «оранжевый». Совместимые номера до 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)
)
Спасибо вам за вашу помощь!
решение:
Вдохновленный циклом for, которым поделился @RonakShah, я встроил некоторые операторы 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] amp;amp; 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] amp;amp; 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] amp;amp; 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])]
}
}
}
Комментарии:
1. Как 5 повторяется в последней колонке ?
2. @RonakShah 5 присваивается «ястребу» по мере его повторения.
Ответ №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
Комментарии:
1. Привет @RonakShah Спасибо, что поделились своим циклом for, но в вашем ответе «ястребу» присваивается другой номер, когда он должен совпадать с приведенной выше строкой.