В настоящее время я занимаюсь исследованием и собираю данные ранжированного выбора. В основном люди выбирают свои предпочтения в теме. Например, люди ранжируют свои предпочтения по фруктам: апельсин, манго, яблоко, авокадо.
Чистый фрейм данных выглядит так:
Fruits Color
1 orange;apple;banana;avocado blue;yellow;red;green
2 avocado;apple;banana;orange red;green;blue;yellow
3 apple;banana;orange;avocado yellow;red;green;blue
4 banana;orange;apple;avocado green;blue;red;yellow
5 apple;avocado;banana;orange yellow;blue;green;red
Первый человек поставил апельсин в качестве первого предпочтения, затем яблоко, банан и авокадо в качестве последнего предпочтения. и так далее
Подсчет очков: 1-е предпочтение = 4; 2-е предпочтение = 3; 3-е предпочтение = 2; 4-е предпочтение = 1
Желаемый результат
apple avocado banana orange blue green red yellow
1 3 1 2 4 4 1 2 3
2 3 4 2 1 2 3 4 1
3 4 1 3 2 1 2 3 4
4 2 1 4 3 3 4 2 1
5 4 3 2 1 3 2 1 4
Часть, которую я запутал, - это выяснить, как дать оценку для каждого столбца -> превратить строку, разделенную точкой с запятой, в столбец с числовым значением. Если я смогу передать это, я смогу создать желаемый выходной фрейм данных.
Я нашел pmr
пакет, но документации только несколько. Кроме того, этот пакет слишком заранее. Мне действительно не нужно это для текущего состояния, просто нужны простые оценки для каждого предпочтения
Пожалуйста, помогите мне на этапе подсчета очков
Вот подход, который работает с использованием нескольких вызовов lapply()
и vapply()
, но обобщается на большее количество столбцов.
library(tibble)
d <- tibble::tribble(
~Fruits, ~Color,
"orange;apple;banana;avocado", "blue;yellow;red;green",
"avocado;apple;banana;orange", "red;green;blue;yellow",
"apple;banana;orange;avocado", "yellow;red;green;blue",
"banana;orange;apple;avocado", "green;blue;red;yellow",
"apple;avocado;banana;orange", "yellow;blue;green;red"
)
x <- lapply(unname(d), \(col) {
l <- col %>% strsplit(";")
x <- l[[1]] %>% unique() %>% sort()
out <- lapply(x, \(x) {
vapply(l, FUN.VALUE = numeric(1), \(vec) which(rev(vec) == x))
})
names(out) <- x
as.data.frame(out)
})
do.call(cbind, x)
apple avocado banana orange blue green red yellow
1 3 1 2 4 4 1 2 3
2 3 4 2 1 2 3 4 1
3 4 1 3 2 1 2 3 4
4 2 1 4 3 3 4 2 1
5 4 3 2 1 3 2 1 4
Я проверил это, и он хорошо работает с большим количеством данных. Спасибо за помощь
Вот решение tidyverse, основанное на tidyr::separate_rows()
для разделения элементов и dplyr::n() + 1 - dplyr::row_number()
для получения обратных рангов по людям и категориям.
library(dplyr)
library(tidyr)
prefs %>%
mutate(id = row_number()) %>%
separate_rows(!id) %>%
pivot_longer(
!id,
names_to = "category",
values_to = "item"
) %>%
group_by(id, category) %>%
mutate(rank = n() + 1 - row_number()) %>%
ungroup() %>%
arrange(category) %>%
pivot_wider(
id_cols = id,
names_from = item,
values_from = rank
)
# A tibble: 5 × 9
id blue yellow red green orange apple banana avocado
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 4 3 2 1 4 3 2 1
2 2 2 1 4 3 1 3 2 4
3 3 1 4 3 2 2 4 3 1
4 4 3 1 2 4 3 2 4 1
5 5 3 4 1 2 1 4 2 3
Спасибо за ответ, сначала проверю. Как и в моем предыдущем комментарии, мне может потребоваться больше времени, чтобы вернуться, так как мой ноутбук не такой быстрый. О, и да, это yellow
появляется дважды из-за опечатки, лол, спасибо за упоминание
Ой, извините, я не знаю, что я могу редактировать. Я буду иметь это в виду. В любом случае, это работает хорошо, но поскольку я работаю с 32 столбцами и более чем 100 строками, этот способ кажется не очень эффективным. Но все же, спасибо за ответ, это помогает мне увидеть другую точку зрения.
Это
vapply
новое для меня, спасибо за новые знания. Я проверю и скоро вернусь. Поскольку я в настоящее время нахожусь у себя дома, потребуется некоторое время, чтобы проверить это, потому что мой ноутбук не очень быстрый.