5.3 综合运用
5.3.1 日报同环比计算
零售行业基本都存在日报，作为数据分析师大概率是需要出日报的，但根据所在部门情况会有所不同。很多人都已经在sql或exel中实现了，本案例不完全实现日报，主要是教大家为了实现同环比，怎么利用R做日期范围筛选。
首先我们看看R里面怎么做日期的同环比计算：
- 常用函数
round_date()函数根据要求周期回滚日期
floor_date(today(),unit = 'year')
#> [1] "2021-01-01"
floor_date(today(),unit = 'month')
#> [1] "2021-06-01"
floor_date(today(),unit = 'week')
#> [1] "2021-06-20"以上同系列函数从名字就能大概看出端倪，其中关键参数是unit，可选想如下: 1s,second,minute,5 mins,hour,dat,week,months,bimonth,quarter,season,halfyear,year。
round_date(
x,
unit = "second",
week_start = getOption("lubridate.week.start", 7)
)
floor_date(
x,
unit = "seconds",
week_start = getOption("lubridate.week.start", 7)
)
ceiling_date(
x,
unit = "seconds",
change_on_boundary = NULL,
week_start = getOption("lubridate.week.start", 7)
)change_on_boundary参数
ceiling_date(ymd_hms('2021-01-1 00:00:00'),'month')
#> [1] "2021-01-01 UTC"
ceiling_date(ymd_hms('2021-01-1 00:00:00'),'month',change_on_boundary = T)
#> [1] "2021-02-01 UTC"- 计算年同比
n <- 1
date <- today()
# current
current_start_date <- floor_date(date,unit = 'year')
current_start_date
#> [1] "2021-01-01"
date
#> [1] "2021-06-23"
# last year
last_start_date <- floor_date(date,unit = 'year') %m-% years(n)
last_start_date
#> [1] "2020-01-01"
last_end_date <- date %m-% years(n)
last_end_date
#> [1] "2020-06-23"以上,n表示间隔年数，大部分时候都是1。但特殊时候，比如2021年同比2020年2-4月(新冠疫情)基本没有同比意义，所以在此设置为参数。
- 计算月同比
rollback()函数返回上个月的最后一天或当前月的第一天
rollback(today())
#> [1] "2021-05-31"
rollback(today(),roll_to_first = TRUE)
#> [1] "2021-06-01"- 计算月环比
计算环比时，%m+%或%m-%可以很好解决月份天数不一的问题
as_date('2020-03-30') %m-% months(1)
#> [1] "2020-02-29"
# 环比月截止日
today()
#> [1] "2021-06-23"
today() %m-% months(1)
#> [1] "2021-05-23"经过以上计算，得到一对对时间周期，然后在订单或者其它数据中筛选即可获得同环比维度数据。
- 模拟计算
# 构造数据
bill_date <- as_date((as_date('2019-01-01'):as_date('2020-12-01')))
area <- sample(c('华东','华西','华南','华北'),size = length(bill_date),replace = TRUE)
category <- sample(c('品类A','品类B','品类C','品类D'),size = length(bill_date),replace = TRUE)
dt <- tibble::tibble(bill_date = bill_date ,money = sample(80:150,size = length(bill_date),replace = TRUE),area = area,category = category)
head(dt)
#> # A tibble: 6 x 4
#> bill_date money area category
#> <date> <int> <chr> <chr>
#> 1 2019-01-01 138 华东 品类C
#> 2 2019-01-02 80 华南 品类D
#> 3 2019-01-03 111 华北 品类B
#> 4 2019-01-04 97 华南 品类C
#> 5 2019-01-05 126 华东 品类D
#> 6 2019-01-06 149 华西 品类A- 自定义函数
library(dplyr,warn.conflicts = FALSE)
library(lubridate)
y_to_y <- function(.dt,date,n = 1,...){
date <- ymd(date)
if(is.na(date)){
stop('请输入正确日期格式，如20200101')
}
# current
current_start_date <- floor_date(date,unit = 'year')
# last year
last_start_date <- floor_date(date,unit = 'year') %m-% years(n)
last_end_date <- date %m-% years(n)
.dt %>% mutate( 类型 = case_when(between(bill_date,current_start_date,date) ~ "当前",
between(bill_date,last_start_date,last_end_date) ~ "同期",
TRUE ~ "其他")) %>%
filter(类型 != "其他") %>%
group_by(...) %>%
summarise(金额 = sum(money,na.rm = TRUE)) %>%
ungroup()
#%>% pivot_wider(names_from = '类型',values_from = '金额')
}y_to_y(dt,date = '20201001',n = 1,area,类型) %>%
tidyr::pivot_wider(id_cols = 'area',names_from = '类型',values_from = '金额') %>%
mutate(增长率 = 当前 / 同期)
#> `summarise()` has grouped output by 'area'. You can override using the `.groups` argument.
#> # A tibble: 4 x 4
#> area 当前 同期 增长率
#> <chr> <int> <int> <dbl>
#> 1 华北 7572 7674 0.987
#> 2 华东 8713 8344 1.04
#> 3 华南 6279 8150 0.770
#> 4 华西 8805 7161 1.23
y_to_y(dt,date = '20201001',n = 1,area,类型,category) %>%
tidyr::pivot_wider(id_cols = c('area','category'),names_from = '类型',values_from = '金额') %>%
mutate(增长率 = 当前 / 同期)
#> `summarise()` has grouped output by 'area', '类型'. You can override using the `.groups` argument.
#> # A tibble: 16 x 5
#> area category 当前 同期 增长率
#> <chr> <chr> <int> <int> <dbl>
#> 1 华北 品类A 1515 1268 1.19
#> 2 华北 品类B 1807 2600 0.695
#> 3 华北 品类C 1956 1837 1.06
#> 4 华北 品类D 2294 1969 1.17
#> 5 华东 品类A 1797 2400 0.749
#> 6 华东 品类B 2507 2064 1.21
#> # ... with 10 more rows5.3.2 清洗不同类型日期格式
如将c('2001/2/13 10:33','1/24/13 11:16')转换为相同格式的日期格式;
通过一个简单自定义函数解决，本质是区分不同类型日期后采用不同函数去解析日期格式
library(lubridate)
library(tidyverse)
date1 <- c('2001/2/13 10:33','1/24/13 11:16')
myfun <- function(x){
n_length <- length(x)
res <- vector(length = n_length)
for(i in 1:n_length){
n <- strsplit(x[i],'/') %>% `[[`(1) %>% `[[`(1)
if(str_length(n)==4){
res[i] <- ymd_hm(x[i],tz = 'Asia/Shanghai')
} else {
res[i] <- mdy_hm(x[i],tz = 'Asia/Shanghai')
}
}
as_datetime(res,tz = 'Asia/Shanghai')
}
myfun(date1)
#> [1] "2001-02-13 10:33:00 CST" "2013-01-24 11:16:00 CST"5.3.3 扫码后中奖时间匹配
假定有两张表，一张是用户扫码表，一张是用户中奖表，如下所示：
数据源视图
由于中奖时间和扫码时间不完全一致，导致没办法直接通过客户ID以及时间关联匹配找到客户每次中奖时的积分码,现在要求找到客户每次中奖时对应的积分码？
思路：通过观察数据，发现扫码后如果中奖，一般几秒钟内会有中奖记录，那我们就可以通过“每次中奖时间最近的一次扫码时间的积分码”就是该次中奖对应的积分码解决问题。这样我们通过简单编写自定义函数即可获取答案，即一个时间点从一串时间中找到离自己最近时间点。
testfun <- function(x,y){
result <- data.frame() #应采用列表存储结果向量化
n <- length(x)
for( i in 1:n){
res <- x[i]-y
res <- abs(res) %>% which.min() #本处不对，应该判断res大于0的部分中谁最小
kong <- data.frame(中奖时间 = x[i],扫的时间 = y[res])
result <- rbind(kong,result)
}
return(result)
}
res <- testfun(dt$时间,scan_dt$时间)改进代码
testfun <- function(x,y){
n <- length(x)
result <- list()
for( i in 1:n){
y <- y[x>y]
res <- x[i]-y
res <- res %>% which.min()
kong <- data.frame(中奖时间 = x[i],扫的时间 = y[res])
result[[i]] <- kong
}
return(result)
}
res <- testfun(dt$时间,scan_dt$时间)理论上不同用户可以在同一时间扫码且同时中奖，那上面的代码即不可以获取正确答案。但是我们只要通过按照用户ID切割数据框后稍微改造上面的自定义函数即可。
testfun <- function(dt){
x <- dt$中奖时间
y <- dt$扫的时间
n <- length(x)
result <- list()
for( i in 1:n){
y <- y[x>y]
res <- x[i]-y
res <- res %>% which.min()
kong <- data.frame(中奖时间 = x[i],扫的时间 = y[res])
result[[i]] <- kong
}
result <- dplyr::bind_rows(result)
return(result)
}
dtlist <- split(alldt,'客户ID')
purrr::map_dfr(dtlist,testfun)虽然可以通过寻找最近一次的扫码记录判断积分码，但是因为网络延迟或中途接电话等各种原因导致扫码时间和中奖时间相差并不是几秒，导致情景复杂，那我们就应该在设计系统时就设计好锁定对应关系，从根本上解决问题。