R-039の解答で、売上日数18日が1件足りない

[zettsu-t]

R-039の解答で、売上日数18日以上が21件ありますが、dplyr::slice(1:20)を用いているために1件除かれます。題意とは異なるかもしれませんが、代わりにdplyr::top_n(20)を使う方が適切ではないでしょうか。

以下にdplyr::top_n(20)を用いたコードとテストを示します。

必要なパッケージを読み込みます

library(tidyverse)
library(dplyr)
library(stringr)
library(readr)
library(assertthat)

カレントディレクトリを、 docker/work/answer とします。それ以外の場合は、相対パスを適宜変更してください。

df_receipt <- readr::read_csv('../data/receipt.csv')

結果を全行出力します

old_options <- options(tibble.print_max=99)

公式解答集の解答

df_sum <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(sum_amount=sum(amount)) %>%
    arrange(desc(sum_amount)) %>%
    slice(1:20)

df_cnt <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(come_days=n_distinct(sales_ymd)) %>%
    arrange(desc(come_days), customer_id) %>%
    slice(1:20)

df_original <- full_join(df_sum, df_cnt, by = "customer_id")

あとで結果を比較するためソートします

df_original <- df_original %>%
    arrange(desc(come_days), customer_id, desc(sum_amount))

come_daysが23..18まであるのが分かります

print(df_original)

A tibble: 34 x 3
customer_id sum_amount come_days

1 CS040214000008 NA 23
2 CS010214000010 18585 22
3 CS015415000185 20153 22
4 CS010214000002 NA 21
5 CS028415000007 19127 21
6 CS016415000141 18372 20
7 CS017415000097 23086 20
8 CS014214000023 NA 19
9 CS021514000045 NA 19
10 CS021515000172 NA 19
11 CS022515000226 NA 19
12 CS031414000051 19202 19
13 CS039414000052 NA 19
14 CS007515000107 NA 18
15 CS014415000077 NA 18
16 CS021515000056 NA 18
17 CS021515000211 NA 18
18 CS022515000028 NA 18
19 CS030214000008 NA 18
20 CS031414000073 NA 18
21 CS001605000009 18925 NA
22 CS006515000023 18372 NA
23 CS007514000094 15735 NA
24 CS009414000059 15492 NA
25 CS011414000106 18338 NA
26 CS011415000006 16094 NA
27 CS015515000034 15300 NA
28 CS016415000101 16348 NA
29 CS021515000089 17580 NA
30 CS030415000034 15468 NA
31 CS032414000072 16563 NA
32 CS034415000047 16083 NA
33 CS035414000024 17615 NA
34 CS038415000104 17847 NA

print(df_original$come_days)

[1] 23 22 22 21 21 20 20 19 19 19 19 19 19 18 18 18 18 18 18 18 NA NA NA NA NA
[26] NA NA NA NA NA NA NA NA NA

df_cntを上位20件ではなく上位22件取ると、come_daysが21件あることが分かります。つまりdf_cntは、come_daysが18日の項目が1件落ちています。

df_cnt22 <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(come_days=n_distinct(sales_ymd)) %>%
    arrange(desc(come_days), customer_id) %>%
    slice(1:22)
print(df_cnt22)

A tibble: 22 x 2
customer_id come_days

1 CS040214000008 23
2 CS010214000010 22
3 CS015415000185 22
4 CS010214000002 21
5 CS028415000007 21
6 CS016415000141 20
7 CS017415000097 20
8 CS014214000023 19
9 CS021514000045 19
10 CS021515000172 19
11 CS022515000226 19
12 CS031414000051 19
13 CS039414000052 19
14 CS007515000107 18
15 CS014415000077 18
16 CS021515000056 18
17 CS021515000211 18
18 CS022515000028 18
19 CS030214000008 18
20 CS031414000073 18
21 CS032415000209 18
22 CS009414000059 17

dplyr::sliceの代わりに、dplyr::top_nを使うと、同順位を含めて20件以上取得します

df_cnt_with_ties <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(come_days=n_distinct(sales_ymd)) %>%
    arrange(desc(come_days), customer_id) %>%
    dplyr::top_n(20, come_days)
print(df_cnt_with_ties)

A tibble: 21 x 2
customer_id come_days

1 CS040214000008 23
2 CS010214000010 22
3 CS015415000185 22
4 CS010214000002 21
5 CS028415000007 21
6 CS016415000141 20
7 CS017415000097 20
8 CS014214000023 19
9 CS021514000045 19
10 CS021515000172 19
11 CS022515000226 19
12 CS031414000051 19
13 CS039414000052 19
14 CS007515000107 18
15 CS014415000077 18
16 CS021515000056 18
17 CS021515000211 18
18 CS022515000028 18
19 CS030214000008 18
20 CS031414000073 18
21 CS032415000209 18

amountも同様にして、このような答え(df_proposed)になります

df_sum_with_ties <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(sum_amount=sum(amount)) %>%
    arrange(desc(sum_amount)) %>%
    dplyr::top_n(20, sum_amount)

df_proposed <- full_join(df_sum_with_ties, df_cnt_with_ties, by="customer_id") %>%
    arrange(desc(come_days), customer_id, desc(sum_amount))
print(df_proposed)

A tibble: 35 x 3
customer_id sum_amount come_days

1 CS040214000008 NA 23
2 CS010214000010 18585 22
3 CS015415000185 20153 22
4 CS010214000002 NA 21
5 CS028415000007 19127 21
6 CS016415000141 18372 20
7 CS017415000097 23086 20
8 CS014214000023 NA 19
9 CS021514000045 NA 19
10 CS021515000172 NA 19
11 CS022515000226 NA 19
12 CS031414000051 19202 19
13 CS039414000052 NA 19
14 CS007515000107 NA 18
15 CS014415000077 NA 18
16 CS021515000056 NA 18
17 CS021515000211 NA 18
18 CS022515000028 NA 18
19 CS030214000008 NA 18
20 CS031414000073 NA 18
21 CS032415000209 NA 18
22 CS001605000009 18925 NA
23 CS006515000023 18372 NA
24 CS007514000094 15735 NA
25 CS009414000059 15492 NA
26 CS011414000106 18338 NA
27 CS011415000006 16094 NA
28 CS015515000034 15300 NA
29 CS016415000101 16348 NA
30 CS021515000089 17580 NA
31 CS030415000034 15468 NA
32 CS032414000072 16563 NA
33 CS034415000047 16083 NA
34 CS035414000024 17615 NA
35 CS038415000104 17847 NA

1件を除いて、結果が等しいことを確認します

print(df_proposed[21,])
df_checked <- df_proposed[-21,]
assertthat::assert_that(all(dim(df_checked) == dim(df_original)))
assertthat::assert_that(all(df_checked$customer_id == df_original$customer_id))
assertthat::assert_that(all(ifelse(is.na(df_checked$sum_amount), is.na(df_original$sum_amount),
                                   df_checked$sum_amount == df_original$sum_amount)))
assertthat::assert_that(all(ifelse(is.na(df_checked$come_days), is.na(df_original$come_days),
                                   df_checked$come_days == df_original$come_days)))

A tibble: 1 x 3
customer_id sum_amount come_days

1 CS032415000209 NA 18

以下のように解くと、解にNAが出ないようにできます

df_summarized <- df_receipt %>%
    dplyr::filter(!stringr::str_starts(customer_id, 'Z')) %>%
    dplyr::select(c('customer_id', 'sales_ymd', 'amount')) %>%
    dplyr::group_by(customer_id) %>%
    dplyr::summarize(sum_amount=sum(amount), come_days=n_distinct(unique(sales_ymd))) %>%
    dplyr::ungroup() %>%
    dplyr::select(c('customer_id', 'sum_amount', 'come_days'))

df_filled <- dplyr::full_join(df_summarized %>% dplyr::top_n(20, come_days),
    df_summarized %>% dplyr::top_n(20, sum_amount)) %>%
    arrange(desc(come_days), customer_id, desc(sum_amount))
print(df_filled)

A tibble: 35 x 3
customer_id sum_amount come_days

1 CS040214000008 13523 23
2 CS010214000010 18585 22
3 CS015415000185 20153 22
4 CS010214000002 13120 21
5 CS028415000007 19127 21
6 CS016415000141 18372 20
7 CS017415000097 23086 20
8 CS014214000023 8405 19
9 CS021514000045 9741 19
10 CS021515000172 13974 19
11 CS022515000226 8556 19
12 CS031414000051 19202 19
13 CS039414000052 11438 19
14 CS007515000107 11188 18
15 CS014415000077 14076 18
16 CS021515000056 12036 18
17 CS021515000211 10148 18
18 CS022515000028 13512 18
19 CS030214000008 10357 18
20 CS031414000073 9317 18
21 CS032415000209 10356 18
22 CS009414000059 15492 17
23 CS011414000106 18338 16
24 CS006515000023 18372 15
25 CS034415000047 16083 14
26 CS038415000104 17847 14
27 CS007514000094 15735 13
28 CS030415000034 15468 13
29 CS032414000072 16563 13
30 CS016415000101 16348 12
31 CS021515000089 17580 12
32 CS011415000006 16094 11
33 CS035414000024 17615 11
34 CS001605000009 18925 9
35 CS015515000034 15300 7

結果が等しいことを確認します

df_expected <- df_proposed %>% arrange(customer_id)
df_actual <- df_filled %>% arrange(customer_id)
assertthat::assert_that(all(dim(df_expected) == dim(df_actual)))
assertthat::assert_that(all(df_expected$customer_id == df_actual$customer_id))
assertthat::assert_that(all(ifelse(is.na(df_expected$sum_amount), TRUE,
                                   df_expected$sum_amount == df_actual$sum_amount)))
assertthat::assert_that(all(ifelse(is.na(df_expected$come_days), TRUE,
                                   df_expected$come_days == df_actual$come_days)))

[KazuhiroM]

コメントありがとうございます😊

一部、順位をだすことが目的の設問を除き、全体的に出力結果を制限するために、何位までではなく何件まで、という設問にしています。

ご指摘の設問だと、たしかに一件だけ漏れるという気持ち悪さがあるかと思いますがご了承下さいmm

しかし、同順位も出す方法としてこういうのもあるよ、というのは色んな方にとって参考になることだと思うので、このような提案をwiki的に残せないか検討してみます。

[zettsu-t]

回答ありがとうございます。趣旨を理解しましたので、このissueをcloseします。
私がこのissueに書いたコメントとコードは、ご自由に流用して構いません。お役に立てれば幸いです。

[KazuhiroM]

非常に実践的なコードですので、ぜひ皆さんが参考にできるよう、このリポジトリで紹介させていただきます！

ありがとうございますmm

[eitsupi]

別issueを作った方が良いのかも知れませんが、こちらのissueを拝見してdplyr::top_nを使う方法を知り調べた結果なので、こちらに投稿させてください。

tidyverse公式サイトのtop_nの項を見ると以下のように書かれており、後継としてdplyr::slice_maxが紹介されています。

top_n() has been superseded in favour of slice_min()/slice_max().

そしてこちらのdplyr::slice_maxでは、同一順位のある場合でも件数を固定して抜き出すように設定できます。
これを使って解答例の上位抽出部分を置き換えると、以下のようになります。

df_sum <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(sum_amount = sum(amount)) %>%
    slice_max(sum_amount, n = 20, with_ties = FALSE)

df_cnt <- df_receipt %>%
    filter(!grepl("^Z", customer_id)) %>%
    group_by(customer_id) %>%
    summarise(come_days = n_distinct(sales_ymd)) %>%
    slice_max(come_days, n = 20, with_ties = FALSE)

df_original <- full_join(df_sum, df_cnt, by = "customer_id")

こちらでは現行の解答例と結果は全く同じになりますが

• 同一順位があったとしても20件固定で抽出したいことを明示している
• with_ties = FALSEをwith_ties = TRUEに書き換えると同一順位を含める形に変更できる

という二点でより分かりやすく、使いやすくなると思うのですが、いかがでしょうか？

[KazuhiroM]

素敵なtipsだと思うので、近いうち参考コードとして載せさせていただきます。