我在回答中添加了一些 cmets 和解释。我认为这种方法应该可行，但有几件事我不清楚：
-
您想要每个月的摘要，但您的玩具数据仅包含 2021 年 1 月的日期（我将一个条目更改为至少有两个月的使用时间）。
-
最终的输出格式应该是怎样的？您描述了一个月的data.frame 应该是什么样子，但是整个月的最终输出应该是什么样子？我选择了嵌套的tibble，每个月都有自己的摘要data.frame。
-
我假设以"(All)" 结尾的变量包含所有出现次数。不以"(All)" 结尾的变量包含该类别是唯一提到的情况的计数。这是正确的吗？
-
我不明白最终频率是如何计算的，尤其是LogCat。当将每个类别的计数除以 CustIDs 的总数时，我得出的数字与您的 PriceCode 示例输出相同。但是当查看LogCat 的频率时，DET (All) 似乎是100%（尽管我们有 3 个CustIDs），这表明所有(All) 变量都显示了一个相对频率，应该始终是100%。 DET 的计数为1，频率为50%。所以在这种情况下，它似乎是相对计数。但随后RTD (All) 的计数为1，频率为50%。这个频率与什么有关？如果CustIDs 当天TYPE != "Demo" 的总数是3。
除此之外，下面的代码虽然有点长，但应该可以工作，并且应该很容易调整到其他频率定义。
设置：
# The setup contains the initial data slightly adjusted so that it contains
# two different month
#
# we use the `tidyverse` library and some custom helper functions
# initial data: slightly changed so that it contains two different month
dat <- structure(
list(
CustID = c("C-1", "C-2",
"C-2", "C-2", "C-3", "C-3",
"C-3", "C-4", "C-5"),
DATE = c(
"2021-01-02 14:13:10",
"2021-01-02 13:17:07",
"2021-01-02 14:15:10",
"2021-01-02 16:14:08",
"2021-01-02 17:11:03",
"2021-01-02 12:14:24",
"2021-01-02 12:33:34",
"2021-01-02 10:43:55",
"2021-02-01 20:23:35" # I changed this to february to have two different month
),
TYPE = c("Demo",
"Pro", "Pro", "Pro", "Pro", "Pro", "Pro", "Pro", "Pro"),
LogCat = c(
NA,
"SPR,DET,RTD",
"SPR,DET,RTD",
"SPR,DET,RTD",
"DET",
"DET",
"DET",
NA,
" SPR, RTD "
),
PriceCode = c(NA, "KR", "SR", "DE", "KL", "ZT", "KR", "KR", "KR")
),
class = "data.frame",
row.names = c(NA,-9L)
)
# helper functions
# some additional helper functions to get the desired output format:
# adds `length` nrows of NA's to a data.frame
extend_df <- function(df, length) {
fill_df <- df[seq_len(length), ]
fill_df[,] <- NA
rbind(df, fill_df)
}
# cbind (column bind) two data.frames with different number of rows
# by appending NA with `extend_df()`
async_cbind <- function(df1, df2) {
df1_r <- nrow(df1)
df2_r <- nrow(df2)
if (df1_r < df2_r) {
df1 <- extend_df(df1, df2_r - df1_r)
return(cbind(df1, df2))
} else if (df1_r > df2_r) {
df2 <- extend_df(df2, df1_r - df2_r)
return(cbind(df1, df2))
} else {
cbind(df1, df2)
}
}
# split a data.frame by `cbind`ing each group
split_wide <- function(df, g) {
v <- as.character(substitute(g))
df_ls <- split(df[, -which(names(df) == v)], df[[v]])
out <- Reduce(async_cbind, df_ls)
names(out) <- make.names(names(out), unique = TRUE)
out
}
library(tidyverse)
获取第一部分的data.frame：
res1 <- dat %>%
# convert `TYPE` to `factor`
mutate(TYPE = as.factor(TYPE)) %>%
# `nest_by()` year and month with `substr` which gives us a nested `tibble`
# with one `tibble` per month
nest_by(month = paste(substr(DATE, 1, 4), substr(DATE, 6,7), sep = "-")) %>%
# lets take each nested `tibble` and nest it again by appending the same data
# but with `TYPE` set as `"Total"`
mutate(data = list(
tibble(dat = list(mutate(data, TYPE = "Total"), data)) %>%
# we continue `rowsie` and summarise the inner nested `tibbles` by `TYPE`
rowwise() %>%
mutate(dat = list(dat %>%
group_by(TYPE, .drop = FALSE) %>%
summarise(n = n_distinct(CustID)) %>%
# let's add the frequency counts
mutate(freq = prop.table(n)))) %>%
# and unnest
unnest(dat)))
这给了我们以下嵌套的 tibble ...
res1
#> # A tibble: 2 x 2
#> # Rowwise: month
#> month data
#> <chr> <list>
#> 1 2021-01 <tibble [3 × 3]>
#> 2 2021-02 <tibble [3 × 3]>
...data 列每个月包含一个 data.frame：
res1 %>% pull(data)
#> [[1]]
#> # A tibble: 3 x 3
#> TYPE n freq
#> <chr> <int> <dbl>
#> 1 Total 4 1
#> 2 Demo 1 0.25
#> 3 Pro 3 0.75
#>
#> [[2]]
#> # A tibble: 3 x 3
#> TYPE n freq
#> <chr> <int> <dbl>
#> 1 Total 1 1
#> 2 Demo 0 0
#> 3 Pro 1 1
获取第二部分的data.frame：
最好有不同格式的数据，这样PriceCode
包含多个逗号分隔的代码，类似于LogCat。
res2a <- dat %>%
# filter out all rows with `TYPE == "Demo"`
filter(TYPE != "Demo") %>%
# add month variable containing year and month as character string.
mutate(month = paste(substr(DATE, 1, 4), substr(DATE,6,7), sep = "-")) %>%
# group by `CustID` and `month`
group_by(CustID, month) %>%
# collapse `PriceCode` so that format is similar to `LogCat`
mutate(PriceCode = paste(PriceCode, collapse= ",")) %>%
# ungroup and drop `TYPE` and `DATE`
ungroup() %>%
select(!c(TYPE, DATE))
让我们看看第一步：
res2a
#> # A tibble: 8 x 4
#> CustID LogCat PriceCode month
#> <chr> <chr> <chr> <chr>
#> 1 C-2 "SPR,DET,RTD" KR,SR,DE 2021-01
#> 2 C-2 "SPR,DET,RTD" KR,SR,DE 2021-01
#> 3 C-2 "SPR,DET,RTD" KR,SR,DE 2021-01
#> 4 C-3 "DET" KL,ZT,KR 2021-01
#> 5 C-3 "DET" KL,ZT,KR 2021-01
#> 6 C-3 "DET" KL,ZT,KR 2021-01
#> 7 C-4 <NA> KR 2021-01
#> 8 C-5 " SPR, RTD " KR 2021-02
在下一步中，我们创建最终输出表所需的所有列：
# First, we need to create named vectors to loop over both columns `LogCat` and `PriceCode`
# alternatively we could use dplyover::crossover() (a package I maintain on GitHub)
logcat_cols <-
dat$LogCat[!is.na(dat$LogCat)] %>%
strsplit(",") %>%
unlist %>%
trimws %>%
unique %>%
set_names(., paste0("LogCat__", ., "(All)"))
pricecode_cols <-
dat$PriceCode[!is.na(dat$PriceCode)] %>%
strsplit(",") %>%
unlist %>%
trimws %>%
unique %>%
set_names(., paste0("PriceCode__", ., "(All)"))
res2b <- res2a %>%
mutate(
# we need to keep month and CustID
month = month,
CustID = CustID,
# this gives us one dummy column for each LogCat
map_dfc(logcat_cols, ~ as.integer(grepl(.x, LogCat))),
# this gives us one dummy column for each PriceCode
map_dfc(pricecode_cols, ~ as.integer(grepl(.x, PriceCode))),
# Lets create another set of dummy columns checking if the category was the only one mentioned
# we do this of LogCat ...
across(starts_with("LogCat") & ends_with("(All)"),
list("d" = ~ if_else(rowSums(select(cur_data(), starts_with("LogCat") & ends_with("(All)"))) == .x & .x == 1, 1, 0))),
# ... and for PriceCode, and for now lets append a `_d` as suffix to the variable name
across(starts_with("PriceCode") & ends_with("(All)"),
list("d" = ~ if_else(rowSums(select(cur_data(), starts_with("PriceCode") & ends_with("(All)"))) == .x & .x == 1, 1, 0))),
# Lets add some final columns for when LogCat PriceCode are NA
across(c(LogCat, PriceCode),
~ if_else(is.na(.x), 1, 0),
.names = "{col}__Blank"),
# lets drop the original columns, we don't need them anymore
.keep = "none") %>%
# we still need to delete the suffix `_d` from some columns
rename_with(~ gsub("\\(All\\)_d$", "", .x), ends_with("_d"))
让我们看看所有需要的列的数据：
res2b %>% glimpse
#> Rows: 8
#> Columns: 20
#> $ month <chr> "2021-01", "2021-01", "2021-01", "2021-01", "2021…
#> $ CustID <chr> "C-2", "C-2", "C-2", "C-3", "C-3", "C-3", "C-4", …
#> $ `LogCat__SPR(All)` <int> 1, 1, 1, 0, 0, 0, 0, 1
#> $ `LogCat__DET(All)` <int> 1, 1, 1, 1, 1, 1, 0, 0
#> $ `LogCat__RTD(All)` <int> 1, 1, 1, 0, 0, 0, 0, 1
#> $ `PriceCode__KR(All)` <int> 1, 1, 1, 1, 1, 1, 1, 1
#> $ `PriceCode__SR(All)` <int> 1, 1, 1, 0, 0, 0, 0, 0
#> $ `PriceCode__DE(All)` <int> 1, 1, 1, 0, 0, 0, 0, 0
#> $ `PriceCode__KL(All)` <int> 0, 0, 0, 1, 1, 1, 0, 0
#> $ `PriceCode__ZT(All)` <int> 0, 0, 0, 1, 1, 1, 0, 0
#> $ LogCat__SPR <dbl> 0, 0, 0, 0, 0, 0, 0, 0
#> $ LogCat__DET <dbl> 0, 0, 0, 1, 1, 1, 0, 0
#> $ LogCat__RTD <dbl> 0, 0, 0, 0, 0, 0, 0, 0
#> $ PriceCode__KR <dbl> 0, 0, 0, 0, 0, 0, 1, 1
#> $ PriceCode__SR <dbl> 0, 0, 0, 0, 0, 0, 0, 0
#> $ PriceCode__DE <dbl> 0, 0, 0, 0, 0, 0, 0, 0
#> $ PriceCode__KL <dbl> 0, 0, 0, 0, 0, 0, 0, 0
#> $ PriceCode__ZT <dbl> 0, 0, 0, 0, 0, 0, 0, 0
#> $ LogCat__Blank <dbl> 0, 0, 0, 0, 0, 0, 1, 0
#> $ PriceCode__Blank <dbl> 0, 0, 0, 0, 0, 0, 0, 0
在我们创建了我们想要使用的数据之后，我们必须做两件事
事情：（1）按月汇总数据并（2）将其转换为正确的输出格式
res2c <- res2b %>%
# lets nest by month
nest_by(month) %>%
mutate(
# lets add a count of how many CustIDs each month contains
total_count = n_distinct(data$CustID),
data = list(
data %>%
# we only keep distinct rows
distinct(.keep_all = TRUE) %>%
# bring the data in long format ...
pivot_longer(!CustID,
names_to = c("var", "key"),
names_sep = "__") %>%
# ... group by var and key created in the pivot_longer call
group_by(var, key) %>%
# and sum the values to get the final `count` variable
summarise(count = sum(value, na.rm = TRUE),
.groups = "drop") %>%
# NOTE SURE: is the frequency the count of each category divided by the total count?
mutate(freq = .data$count / .env$total_count) %>%
# lets sort "Blank" at the bottom
arrange(key == "Blank") %>%
# final we use our custom function to split the data.frame in two parts
split_wide(var) %>%
# and last but not least, we need one more row:
add_row(key = "Both Blank",
count = sum(subset(., key == "Blank")$count +
subset(., key.1 == "Blank")$count,
na.rm = TRUE))
))
我们的结果是一个嵌套的 tibble：
res2c
#> # A tibble: 2 x 3
#> # Rowwise: month
#> month data total_count
#> <chr> <list> <int>
#> 1 2021-01 <df[,6] [12 × 6]> 3
#> 2 2021-02 <df[,6] [12 × 6]> 1
每个月都有自己的data.frame 以所需的输出格式：
res2c %>% pull(data)
#> [[1]]
#> key count freq key.1 count.1 freq.1
#> 1 DET 1 0.3333333 DE 0 0.0000000
#> 2 DET(All) 2 0.6666667 DE(All) 1 0.3333333
#> 3 RTD 0 0.0000000 KL 0 0.0000000
#> 4 RTD(All) 1 0.3333333 KL(All) 1 0.3333333
#> 5 SPR 0 0.0000000 KR 1 0.3333333
#> 6 SPR(All) 1 0.3333333 KR(All) 3 1.0000000
#> 7 Blank 1 0.3333333 SR 0 0.0000000
#> 8 <NA> NA NA SR(All) 1 0.3333333
#> 9 <NA> NA NA ZT 0 0.0000000
#> 10 <NA> NA NA ZT(All) 1 0.3333333
#> 11 <NA> NA NA Blank 0 0.0000000
#> 12 Both Blank 0 NA <NA> NA NA
#>
#> [[2]]
#> key count freq key.1 count.1 freq.1
#> 1 DET 0 0 DE 0 0
#> 2 DET(All) 0 0 DE(All) 0 0
#> 3 RTD 0 0 KL 0 0
#> 4 RTD(All) 1 1 KL(All) 0 0
#> 5 SPR 0 0 KR 1 1
#> 6 SPR(All) 1 1 KR(All) 1 1
#> 7 Blank 0 0 SR 0 0
#> 8 <NA> NA NA SR(All) 0 0
#> 9 <NA> NA NA ZT 0 0
#> 10 <NA> NA NA ZT(All) 0 0
#> 11 <NA> NA NA Blank 0 0
#> 12 Both Blank 0 NA <NA> NA NA
由reprex package (v0.3.0) 于 2021 年 4 月 21 日创建