根据每行的频率查找排名答案

【问题标题】：Find rank based on frequency for each row根据每行的频率查找排名
【发布时间】：2018-01-04 01:23:11
【问题描述】：

我的数据包含时间变量和选择的品牌变量，如下所示。 time表示购物时间，choicebrand表示当时购买的品牌。

有了这些数据，我想在下表中创建第三列和第四列。在此处创建列有一些规则。第三（第四）列表示品牌 1（品牌 2）基于 5 天内被选择的频率的排名。如果 5 天内没有历史记录，则应为 NA。

例如，让我们看看第 5 行。第 5 行的 shoptime 是 2013-09-05 09:11:00 然后 5 天窗口是 2013-08-31 09:11:00 ~ 2013-09-05 09:11:00。在这个时间段内，先后有brand3、bradn3、brand2、和brand1（不包括第5行的chosenbrand）。 brand1（第三列）的排名，根据最常选择，排名第二，brand2 的排名也是第二。所以第 5 行的两列都应该是 2 和 2。

作为另一个例子，让我们看看下表中的最后一行。行的shoptime 是2013-09-09 09:32:00 然后5 天窗口是2013-09-04 09:32:00 ~ 2013-09-09 09:32:00。在这段时间内，有brand1、bradn2、brand6、brand2和brand2（不包括该行的chosenbrand）。 brand1（第三列）的排名，根据最常选择，排名第二，brand2 排名第一。所以行中的两列都应该是 2 和 1。

有什么简单的方法吗？

另外，如果我要个人做（如果每个客户都有多个购买历史），该怎么做？

数据如下，

   shoptime              chosenbrand  nth_most_freq_brand1 nth_most_freq_brand2 
  2013-09-01 08:35:00       brand3                 NA             NA  
  2013-09-02 08:54:00       brand3                 NA             NA          
  2013-09-03 09:07:00       brand2                 NA             NA          
  2013-09-04 09:08:00       brand1                 NA              2          
  2013-09-05 09:11:00       brand1                 2               2          
  2013-09-06 09:14:00       brand2                 1               2          
  2013-09-07 09:26:00       brand6                 1               1          
  2013-09-08 09:26:00       brand2                 1               2          
  2013-09-09 09:29:00       brand2                 2               1          
  2013-09-09 09:32:00       brand4                 2               1

这是数据代码

dat <- data.frame(shoptime = c("2013-09-01 08:35:00 UTC", "2013-09-02 08:54:00 UTC", "2013-09-03 09:07:00 UTC" ,"2013-09-04 09:08:00 UTC", "2013-09-05 09:11:00 UTC", "2013-09-06 09:14:00 UTC",
                           "2013-09-07 09:26:00 UTC", "2013-09-08 09:26:00 UTC" ,"2013-09-09 09:29:00 UTC", "2013-09-09 09:32:00 UTC"),
              chosenbrand = c("brand3", "brand3", "brand2", "brand1", "brand1", "brand2", "brand6", "brand2"  ,  "brand2"  ,   "brand4"   ),
              nth_most_freq_brand1 = NA,
              nth_most_freq_brand2 = NA,
              stringsAsFactors = FALSE)

【问题讨论】：

我应该使用 for 循环吗？这将需要很长时间，因为我的数据量很大......有什么解决方案吗？
如果我理解正确，OP 提出了一个几乎相同的问题How to create a rank variable under certain conditions?。
@Johnlegend2 我已经更新了我的答案并重新发布了它。如果我之前在您的帖子中的编辑有任何不便，我深表歉意。显然，我之前以错误的方式解释了您的问题。将来，如果有人错误地解释了您的帖子，从而修改了您的帖子，与您的意图相冲突。您绝对有权对其进行编辑并澄清您的帖子。

标签： r dplyr data.table plyr sapply

【解决方案1】：

OP 提出了一个非常相似的问题"How to create a rank variable under certain conditions?"。如果我理解正确，唯一的区别是

5 天而不是 36 小时的扩展时间范围（请注意，OP 指的是时间段，而不是日期段）
只考虑brand1 和brand2（而不是chosenbrands 的所有值）。

因此，my answer 可以在这里重用，并进行一些调整和改进：

library(data.table)
library(lubridate)

setDT(dat)[, shoptime := as_datetime(shoptime)]
setorder(dat, shoptime) # not required, just for convenience of observers
selected_brands <- c("brand1", "brand2")
result <- dat[
  .(lb = shoptime - hours(5 * 24), ub = shoptime), 
  on = .(shoptime >= lb, shoptime < ub), 
  nomatch = 0L, by = .EACHI, 
  .SD[, .N, by = chosenbrand][, rank := frank(-N, ties.method="dense")]][
    chosenbrand %in% selected_brands, 
    dcast(unique(.SD[, -1]), shoptime ~ paste0("nth_most_freq_", chosenbrand), 
          value.var = "rank")][
      dat, on = "shoptime"]
# change column order to make it look more similar to the expected answer
setcolorder(result, c(1, 4, 2:3)) 
result

               shoptime chosenbrand nth_most_freq_brand1 nth_most_freq_brand2
 1: 2013-09-01 08:35:00      brand3                   NA                   NA
 2: 2013-09-02 08:54:00      brand3                   NA                   NA
 3: 2013-09-03 09:07:00      brand2                   NA                   NA
 4: 2013-09-04 09:08:00      brand1                   NA                    2
 5: 2013-09-05 09:11:00      brand1                    2                    2
 6: 2013-09-06 09:14:00      brand2                    1                    2
 7: 2013-09-07 09:26:00      brand6                    1                    1
 8: 2013-09-08 09:26:00      brand2                    1                    2
 9: 2013-09-09 09:29:00      brand2                    2                    1
10: 2013-09-09 09:32:00      brand4                    2                    1

回答OP的第二个问题

OP 又问了一个问题：

另外，如果我要个人做（如果每个客户都有多个购买历史），该怎么做？

很遗憾，OP 没有为此案例提供示例数据集。因此，我们需要根据提供的数据集为两个客户组成一个数据集：

dat <- data.frame(shoptime = c("2013-09-01 08:35:00 UTC", "2013-09-02 08:54:00 UTC", "2013-09-03 09:07:00 UTC" ,"2013-09-04 09:08:00 UTC", "2013-09-05 09:11:00 UTC", "2013-09-06 09:14:00 UTC",
                               "2013-09-07 09:26:00 UTC", "2013-09-08 09:26:00 UTC" ,"2013-09-09 09:29:00 UTC", "2013-09-09 09:32:00 UTC"),
                  chosenbrand = c("brand3", "brand3", "brand2", "brand1", "brand1", "brand2", "brand6", "brand2"  ,  "brand2"  ,   "brand4"   ),
                  stringsAsFactors = FALSE)

dat <- rbindlist(list(dat, dat[c(FALSE, TRUE), ]), idcol = "customer")
dat

    customer                shoptime chosenbrand
 1:        1 2013-09-01 08:35:00 UTC      brand3
 2:        1 2013-09-02 08:54:00 UTC      brand3
 3:        1 2013-09-03 09:07:00 UTC      brand2
 4:        1 2013-09-04 09:08:00 UTC      brand1
 5:        1 2013-09-05 09:11:00 UTC      brand1
 6:        1 2013-09-06 09:14:00 UTC      brand2
 7:        1 2013-09-07 09:26:00 UTC      brand6
 8:        1 2013-09-08 09:26:00 UTC      brand2
 9:        1 2013-09-09 09:29:00 UTC      brand2
10:        1 2013-09-09 09:32:00 UTC      brand4
11:        2 2013-09-02 08:54:00 UTC      brand3
12:        2 2013-09-04 09:08:00 UTC      brand1
13:        2 2013-09-06 09:14:00 UTC      brand2
14:        2 2013-09-08 09:26:00 UTC      brand2
15:        2 2013-09-09 09:32:00 UTC      brand4

现在，我们可以修改现有解决方案以考虑不同的客户：

setDT(dat)[, shoptime := as_datetime(shoptime)]
setorder(dat, customer, shoptime) # not required, just for convenience of observers
selected_brands <- c("brand1", "brand2")
result <- dat[
  .(customer = customer, lb = shoptime - hours(5 * 24), ub = shoptime), 
  on = .(customer, shoptime >= lb, shoptime < ub), 
  nomatch = 0L, by = .EACHI, 
  .SD[, .N, by = chosenbrand][, rank := frank(-N, ties.method="dense")]][
    chosenbrand %in% selected_brands, 
    dcast(unique(.SD[, -2]), customer + shoptime ~ paste0("nth_most_freq_", chosenbrand), 
          value.var = "rank")][
            dat, on = .(customer, shoptime)]
# change column order to make it look more similar to the expected answer
setcolorder(result, c(1:2, 5, 3:4)) 
result

    customer            shoptime chosenbrand nth_most_freq_brand1 nth_most_freq_brand2
 1:        1 2013-09-01 08:35:00      brand3                   NA                   NA
 2:        1 2013-09-02 08:54:00      brand3                   NA                   NA
 3:        1 2013-09-03 09:07:00      brand2                   NA                   NA
 4:        1 2013-09-04 09:08:00      brand1                   NA                    2
 5:        1 2013-09-05 09:11:00      brand1                    2                    2
 6:        1 2013-09-06 09:14:00      brand2                    1                    2
 7:        1 2013-09-07 09:26:00      brand6                    1                    1
 8:        1 2013-09-08 09:26:00      brand2                    1                    2
 9:        1 2013-09-09 09:29:00      brand2                    2                    1
10:        1 2013-09-09 09:32:00      brand4                    2                    1
11:        2 2013-09-02 08:54:00      brand3                   NA                   NA
12:        2 2013-09-04 09:08:00      brand1                   NA                   NA
13:        2 2013-09-06 09:14:00      brand2                    1                   NA
14:        2 2013-09-08 09:26:00      brand2                    1                    1
15:        2 2013-09-09 09:32:00      brand4                   NA                    1

【讨论】：

谢谢你。顺便说一句，如果我想更改排名规则，使得观察结果具有相同的排名，最近购买的品牌排名更高，那么您也可以提供答案吗？
例如，在第 5 行。第 5 行的两列都应该是 2 和 3，而不是 2 和 2，因为品牌 1 比品牌 2 更新。
我想我可以使用“第一”的相反顺序，但似乎没有“最后”。你怎么做？抱歉我不熟悉data.table的包
不客气。这是一个有趣的观点。 rank()（来自基础 R）有一个 ties.method = "last" 参数，frank()（data.table 的快速实现）没有。所以，你可以试试rank(-N, ties.method = "last") 或.N - frank(N, ties.method = "first") + 1L 或rev(frank(rev(-x), ties.method = "first"))。

【解决方案2】：

使用tidyverse 和lubridate 的解决方案。

OP的第一个问题

library(tidyverse)
library(lubridate)

第 1 步：将 shoptime 列转换为日期时间对象

dat <- dat %>% mutate(shoptime = ymd_hms(shoptime))

第 2 步：为所有 shoptime 创建一个查找表。

complete 函数可以创建列之间的所有组合，因此我们可以创建shoptime 列（shoptime1）的副本并创建所有组合。然后我们可以使用filter(shoptime1 > shoptime - hours(5 * 24), shoptime1 < shoptime) 查找日期和时间是否在 5 天内。

dat2 <- dat %>%
  mutate(shoptime1 = shoptime) %>%
  select(contains("shoptime")) %>%
  complete(shoptime, shoptime1) %>%
  filter(shoptime1 > shoptime - hours(5 * 24), shoptime1 < shoptime)

第 3 步：将dat 与查找表合并，统计品牌，并对计数进行排名。

我们可以基于shoptime1和shoptime合并查找表dat2和dat。 count函数可以按组统计出现次数。之后，我们可以对shoptime 进行分组，并使用dense_rank 来创建每个组中每个品牌的排名。

dat3 <- dat2 %>%
  left_join(dat, by = c("shoptime1" = "shoptime")) %>%
  count(shoptime, chosenbrand) %>%
  group_by(shoptime) %>%
  mutate(rank = dense_rank(desc(n))) %>%
  select(-n) %>%
  spread(chosenbrand, rank) %>%
  select(shoptime, brand1, brand2)

第 4 步：将原始数据框与 dat3 数据框合并。

dat4 <- dat %>% left_join(dat3, by = "shoptime")

这是最终结果。

dat4
#               shoptime chosenbrand brand1 brand2
# 1  2013-09-01 08:35:00      brand3     NA     NA
# 2  2013-09-02 08:54:00      brand3     NA     NA
# 3  2013-09-03 09:07:00      brand2     NA     NA
# 4  2013-09-04 09:08:00      brand1     NA      2
# 5  2013-09-05 09:11:00      brand1      2      2
# 6  2013-09-06 09:14:00      brand2      1      2
# 7  2013-09-07 09:26:00      brand6      1      1
# 8  2013-09-08 09:26:00      brand2      1      2
# 9  2013-09-09 09:29:00      brand2      2      1
# 10 2013-09-09 09:32:00      brand4      2      1

OP的第二个问题

由于 OP 没有提供示例数据集，我将使用示例数据集Uwe created。我的答案 1 只需稍作修改就可以解决这个问题。关键是在某些步骤中将customer 列视为分组变量。

这是创建示例数据集的代码。我只在最后添加了as.tibble，将data.table对象转换为tibble。

library(data.table)
dat <- data.frame(shoptime = c("2013-09-01 08:35:00 UTC", "2013-09-02 08:54:00 UTC", "2013-09-03 09:07:00 UTC" ,"2013-09-04 09:08:00 UTC", "2013-09-05 09:11:00 UTC", "2013-09-06 09:14:00 UTC",
                               "2013-09-07 09:26:00 UTC", "2013-09-08 09:26:00 UTC" ,"2013-09-09 09:29:00 UTC", "2013-09-09 09:32:00 UTC"),
                  chosenbrand = c("brand3", "brand3", "brand2", "brand1", "brand1", "brand2", "brand6", "brand2"  ,  "brand2"  ,   "brand4"   ),
                  stringsAsFactors = FALSE)

dat <- rbindlist(list(dat, dat[c(FALSE, TRUE), ]), idcol = "customer")
dat <- as.tibble(dat)

第 1 步：将shoptime 列转换为日期时间对象

dat <- dat %>% mutate(shoptime = ymd_hms(shoptime))

第 2 步：为所有 shoptime 创建一个查找表。

请注意，代码几乎与上一个相同，只是我们需要在应用complete 函数之前对customer 进行分组。

dat2 <- dat %>%
  mutate(shoptime1 = shoptime) %>%
  select(contains("shoptime"), customer) %>%
  group_by(customer) %>%
  complete(shoptime, shoptime1) %>%
  filter(shoptime1 > shoptime - hours(5 * 24), shoptime1 < shoptime)

第 3 步：将dat 与查找表合并，统计品牌，并对计数进行排名。

同样，我们在进行join操作并统计品牌时需要考虑customer列。

dat3 <- dat2 %>%
  left_join(dat, by = c("customer", "shoptime1" = "shoptime")) %>%
  count(customer, shoptime, chosenbrand) %>%
  group_by(customer, shoptime) %>%
  mutate(rank = dense_rank(-n)) %>%
  select(-n) %>%
  spread(chosenbrand, rank) %>%
  select(customer, shoptime, brand1, brand2)

第 4 步：将原始数据框与 dat3 数据框合并。

dat4 <- dat %>% left_join(dat3, by = c("customer", "shoptime"))

这是最终结果。我添加了as.data.frame 只是为了以更简单的格式打印输出。

dat4 %>% as.data.frame()
#    customer            shoptime chosenbrand brand1 brand2
# 1         1 2013-09-01 08:35:00      brand3     NA     NA
# 2         1 2013-09-02 08:54:00      brand3     NA     NA
# 3         1 2013-09-03 09:07:00      brand2     NA     NA
# 4         1 2013-09-04 09:08:00      brand1     NA      2
# 5         1 2013-09-05 09:11:00      brand1      2      2
# 6         1 2013-09-06 09:14:00      brand2      1      2
# 7         1 2013-09-07 09:26:00      brand6      1      1
# 8         1 2013-09-08 09:26:00      brand2      1      2
# 9         1 2013-09-09 09:29:00      brand2      2      1
# 10        1 2013-09-09 09:32:00      brand4      2      1
# 11        2 2013-09-02 08:54:00      brand3     NA     NA
# 12        2 2013-09-04 09:08:00      brand1     NA     NA
# 13        2 2013-09-06 09:14:00      brand2      1     NA
# 14        2 2013-09-08 09:26:00      brand2      1      1
# 15        2 2013-09-09 09:32:00      brand4     NA      1

【讨论】：

@Uwe 感谢您的评论和出色的回答。我已经根据tidyverse 框架更新了我的答案，因此它可以解决 OP 的问题并取消删除它。我根据您的代码在我的一个步骤中使用了hours(5 * 24)。我还使用您的示例数据集来展示如何在有客户时执行相同的操作。再次感谢您的努力。
出色的更新。我将删除引用您旧答案的评论。