会员报表 - II.Rmd

---
title: "阿里彩票"
subtitle: "会员报表报告 (第II部)"
author: "雷欧 <img src='文艺坊图库/cd23-isqivxh1309422.jpg' height='14'>"
date: "`r lubridate::today('Asia/Tokyo')`"
output:
  html_document: 
    mathjax: https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js
    number_sections: yes
    toc: yes
    toc_depth: 4
    toc_float:
      collapsed: yes
      smooth_scroll: yes
    code_folding: hide
    css: CSSBackgrounds.css
---

# 主题

<img src='文艺坊图库/商场如战场.png' width='560'>

[[**主题曲**]{style="color:blue"}](https://github.com/englianhu/report/discussions)

🚄东方快车，🚄一带一路。

<audio controls loop autoplay src="文艺坊歌曲库/東方快車合唱團 Oriental Express - 紅紅青春敲呀敲 《黑松沙士》廣告主題曲.mp3" controls></audio>

<br>

# 设定

## SCSS 设置

<style>
pre {
  overflow-x: auto;
}
pre code {
  word-wrap: normal;
  white-space: pre;
}
.table-hover > tbody > tr:hover { 
  background-color: #8D918D;
}
</style>

```{r load-sass, class.source='bg-success', class.output='bg-primary'}
# install.packages('remotes', dependencies = TRUE, INSTALL_opts = '--no-lock')
library('BBmisc', 'rmsfuns')
#remotes::install_github("rstudio/sass")
lib('sass')

## https://support.rstudio.com/hc/en-us/articles/200532197
## https://community.rstudio.com/t/r-does-not-display-korean-chinese/30889/3?u=englianhu
#Sys.setlocale("LC_CTYPE", "en_US.UTF-8")
#Sys.setlocale("LC_CTYPE", "zh_CN.UTF-8")
#Sys.setlocale(category = "LC_CTYPE", "Chinese (Simplified)_China.936")
#Sys.setlocale(locale = "Chinese")
#Sys.setlocale(locale = "Japanese")
#Sys.setlocale(locale = "English")

# rmarkdown::render('/home/englianhu/Documents/owner/ryo-cn.Rmd',  encoding = 'UTF-8')
#Sys.setlocale("LC_CTYPE", "UTF-8")
#Sys.setlocale(locale = "UTF-8")
#Sys.setlocale(category = "LC_ALL", locale = "chs")
#Sys.setlocale(category = "LC_ALL", locale = "UTF-8")
#Sys.setlocale(category = "LC_ALL", locale = "Chinese")
#Sys.setlocale(category = "LC_ALL", locale = "zh_CN.UTF-8")
Sys.setlocale("LC_ALL", "en_US.UTF-8")
```

```{scss set-scss, class.source='bg-success', class.output='bg-primary'}
/* https://stackoverflow.com/a/66029010/3806250 */
h1 { color: #002C54; }
h2 { color: #2F496E; }
h3 { color: #375E97; }
h4 { color: #556DAC; }
h5 { color: #92AAC7; }

/* ----------------------------------------------------------------- */
/* https://gist.github.com/himynameisdave/c7a7ed14500d29e58149#file-broken-gradient-animation-less */
.hover01 {
  /* color: #FFD64D; */
  background: linear-gradient(155deg, #EDAE01 0%, #FFEB94 100%);
  transition: all 0.45s;
  &:hover{
    background: linear-gradient(155deg, #EDAE01 20%, #FFEB94 80%);
    }
  }

.hover02 {
  color: #FFD64D;
  background: linear-gradient(155deg, #002C54 0%, #4CB5F5 100%);
  transition: all 0.45s;
  &:hover{
    background: linear-gradient(155deg, #002C54 20%, #4CB5F5 80%);
    }
  }

.hover03 {
  color: #FFD64D;
  background: linear-gradient(155deg, #A10115 0%, #FF3C5C 100%);
  transition: all 0.45s;
  &:hover{
    background: linear-gradient(155deg, #A10115 20%, #FF3C5C 80%);
    }
  }
```

```{r gb-opts, class.source='hover01', class.output='hover02'}
## Set the timezone but not change the datetime
Sys.setenv(TZ = 'Asia/Shanghai')

## Setting to omit all warnings
## https://stackoverflow.com/a/36846793/3806250
## Set width
## options(knitr.table.format = 'html') will set all kableExtra tables to be 'html', otherwise need to set the parameter on every single table.
options(warn = -1, width = 999, knitr.table.format = 'html')#, digits.secs = 6)

## https://stackoverflow.com/questions/39417003/long-vectors-not-supported-yet-abnor-in-rmd-but-not-in-r-script
## https://yihui.org/knitr/options
knitr::opts_chunk$set(
  class.source = 'hover01', class.output = 'hover02', class.error = 'hover03', 
  message = FALSE, warning = FALSE, error = TRUE, 
  autodep = TRUE, aniopts = 'loop', 
  progress = TRUE, verbose = TRUE, 
  cache = FALSE, cache.lazy = FALSE, result = 'asis')
```

<br><br>

## 设置

```{r libs, eval=FALSE}
## Setup Options, Loading Required Libraries and Preparing Environment
## Loading the packages and setting adjustment
source('函数/libs.R')
```

读取程序包

```{r load-pkgs}
## Setup Options, Loading Required Libraries and Preparing Environment
## 3210448065@qq.com
## leiou123

## 2849108450@qq.com
## leiou123
## https://rstudio.cloud/project/1198888

## Loading the package 'BBmisc'
if(suppressMessages(!require('BBmisc'))){
  install.packages('BBmisc', dependencies = TRUE, INSTALL_opts = '--no-lock')
  suppressMessages(library('BBmisc'))
}
if (suppressMessages(!require('rmsfuns'))) {
  install.packages('rmsfuns', dependencies = TRUE, INSTALL_opts = '--no-lock')
  suppressMessages(library('rmsfuns'))
}

if(!require('REmap')) devtools::install_github('lchiffon/REmap')

## Loading multiple packages at once
#pkgs <- c('readr', 'plyr', 'dplyr', 'magrittr', 'tidyverse', 'devtools', 'zoo', 'lubridate', 'stringr', 'rvest', 'markdown', 'googleVis', 'knitr', 'rmarkdown', 'htmltools', 'knitr', 'kableExtra', 'formattable', 'echarts4r', 'radarchart', 'MASS', 'htmlwidgets', 'maps', 'REmap', 'ggmap', 'vembedr')

pkgs <- c('plyr', 'dplyr', 'magrittr', 'stringr', 'knitr', 'kableExtra', 'lubridate', 'broom', 'purrr', 'readxl', 'tibble', 'DT')

suppressAll(lib(pkgs))
load_pkg(pkgs)
rm(pkgs)

## Set the googleVis options first to change the behaviour of plot.gvis, so that 
##  only the chart component of the HTML file is written into the output file.
op <- options(gvis.plot.tag = 'chart')

## <audio src='music/bigmoney.mp3' autoplay controls loop></audio>
```

```{r set-prefer}
conflict_prefer('filter', 'dplyr')
conflict_prefer('select', 'dplyr')
conflict_prefer('mutate', 'dplyr')
conflict_prefer('rename', 'dplyr')
```

<br><br>

# 数据

读取样本数据。

```{r warning = FALSE}
## 读取数据
fls <- suppressWarnings(list.files('文艺数据库/会员报表'))
smp <- fls %>% llply(., function(x) {
    dtt <- x %>% str_replace_all('.xls', '') %>% ymd
    smpp <- read_excel(paste0('文艺数据库/会员报表/', x))
    data.frame('日期' = dtt, smpp)
}) %>% bind_rows %>% 
    as_tibble %>% 
    mutate('用户账号' = factor(用户账号), 
           '等级' = factor(等级), 
           '上级代理' = factor(上级代理), 
           '盈率' = as.numeric(percent(盈率))) %>% 
    mutate_if(is.character, as.numeric)
rm(fls)

#smp %>% datatable(
#    caption = "会员报表数据", 
#    escape = FALSE, filter = 'top', rownames = FALSE, 
#    extensions = list('ColReorder' = NULL, 'RowReorder' = NULL, 
#                      'Buttons' = NULL, 'Responsive' = NULL), 
#    options = list(dom = 'BRrltpi', autowidth = TRUE,  scrollX = TRUE, 
#                   lengthMenu = list(c(10, 50, 100, 500, -1), 
#                                     c('10', '50', '100', '500', 'All')), 
#                   ColReorder = TRUE, rowReorder = TRUE, 
#                   buttons = list('copy', 'print', 
#                                  list(extend = 'collection', 
#                                       buttons = c('csv', 'excel', 'pdf'), 
#                                       text = 'Download'), I('colvis'))))

smp %>% as_tibble
```

上图显示从`#r smp$'日期' %>% range %>% .[1]`到`#r smp$'日期' %>% range %>% .[2]`的报表数据。

<br>
<br>

# 统计模型

<br>

## 投注人数

```{r warning = FALSE, eval = FALSE, results = 'asis'}

```

<br>
<br>

# 绘图

<br>

## 投注人数

```{r warning = FALSE, eval = FALSE, results = 'asis'}
pl1 <- smp %>% 
  highchart() %>% 
  hc_chart('line', hcaes(x = 日期, y = 投注人数, group = 彩种名称)) %>% 
  hc_title(text = '用户账号') %>%
  hc_subtitle(text = '投注人数')

tagList(pl1)
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(投注人数, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '投注人数', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '投注人数') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    #selectedMode = 'multiple', #https://echarts.apache.org/en/option.html#legend
    #selected = list('彩种'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`#r smp$'日期' %>% range %>% .[1]`到`#r smp$'日期' %>% range %>% .[2]`的**投注人数**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>

## 投注金额

```{r warning = FALSE, eval = FALSE, results = 'asis'}
smp %>% 
    hchart('line', hcaes(x = 日期, y = 投注金额, group = 彩种名称)) %>% 
    hc_title(text = '彩种') %>%
    hc_subtitle(text = '投注金额')
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(投注金额, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '投注金额', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '投注金额') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`#r smp$'日期' %>% range %>% .[1]`到`#r smp$'日期' %>% range %>% .[2]`的**投注金额**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>

## 中奖金额

```{r warning = FALSE, eval = FALSE, results = 'asis'}
smp %>% 
    hchart('line', hcaes(x = 日期, y = 投注金额, group = 彩种名称)) %>% 
    hc_title(text = '彩种') %>%
    hc_subtitle(text = '中奖金额')
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(中奖金额, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '中奖金额', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '中奖金额') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`r smp$'日期' %>% range %>% .[1]`到`r smp$'日期' %>% range %>% .[2]`的**中奖金额**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>

## 撤单金额

```{r warning = FALSE, eval = FALSE, results = 'asis'}
smp %>% 
    hchart('line', hcaes(x = 日期, y = 投注金额, group = 彩种名称)) %>% 
    hc_title(text = '彩种') %>%
    hc_subtitle(text = '撤单金额')
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(撤单金额, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '撤单金额', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '撤单金额') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`r smp$'日期' %>% range %>% .[1]`到`r smp$'日期' %>% range %>% .[2]`的**撤单金额**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>

## 返点金额

```{r warning = FALSE, eval = FALSE, results = 'asis'}
smp %>% 
    hchart('line', hcaes(x = 日期, y = 投注金额, group = 彩种名称)) %>% 
    hc_title(text = '彩种') %>%
    hc_subtitle(text = '返点金额')
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(返点金额, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '返点金额', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '返点金额') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`r smp$'日期' %>% range %>% .[1]`到`r smp$'日期' %>% range %>% .[2]`的**返点金额**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>

## 盈利

```{r warning = FALSE, eval = FALSE, results = 'asis'}
smp %>% 
    hchart('line', hcaes(x = 日期, y = 投注金额, group = 彩种名称)) %>% 
    hc_title(text = '彩种') %>%
    hc_subtitle(text = '盈利')
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(盈利, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '盈利', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '盈利') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`r smp$'日期' %>% range %>% .[1]`到`r smp$'日期' %>% range %>% .[2]`的**盈利**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>

## 盈率

```{r warning = FALSE, eval = FALSE, results = 'asis'}
smp %>% 
    hchart('line', hcaes(x = 日期, y = 投注金额, group = 彩种名称)) %>% 
    hc_title(text = '彩种') %>%
    hc_subtitle(text = '盈率')
```

```{r}
smp %>% 
    group_by(彩种名称) %>% 
    e_charts(x = 日期) %>% 
    e_line(盈率, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = '彩种', subtext = '盈率', left = 'center') %>% 
  e_axis_labels(x = '日期', y = '盈率') %>%
  e_x_axis(日期, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = '截图')
```

上图显示从`r smp$'日期' %>% range %>% .[1]`到`r smp$'日期' %>% range %>% .[2]`的**盈率**，默认设置显示所有彩种，可以点击彩种筛选焦点彩种。

<br>
<br>

# 结论

<br>

## 总结

以上是将数据绘图，还需要通过统计模型预测，不过基于数据观测值太少^[[binary.com Interview Question I (Extention)](https://rpubs.com/englianhu/binary-Q1E)尝试分别使用`3个月`、`6个月`、`12个月`、`18个月`和`24个月`的数据，结果`12个月`的数据最为精准。]，所以暂时没有预测。


<br><br>

# 附录

## 文书明细

以下乃此文书的文件信息。

- 文集建立日：2022-05-31
- 文集最新更新日：`r today('Asia/Shanghai')`
- `r R.version.string`
- [**rmarkdown**](https://github.com/rstudio/rmarkdown) 程序包版本：`r packageVersion('rmarkdown')`
- 文集版本：0.2.1
- 文集作者：[®γσ, ξηg Lιαη Ημ](https://rpubs.com/englianhu/ryo-cn)
- 猫舍：[源代码](https://github.com/englianhu/report)
- 追加附属信息

```{r info}
#suppressMessages(require('formattable', quietly = TRUE))
#suppressMessages(require('knitr', quietly = TRUE))
#suppressMessages(require('kableExtra', quietly = TRUE))
#suppressMessages(require('magittr', quietly = TRUE))
#suppressMessages(require('devtools', quietly = TRUE))

sys1 <- session_info()$platform |> 
    unlist() |> 
    {\(.) data.frame(row.names = 1:length(.), 
                     Category = names(.), session_info = .)}()

sys2 <- data.frame(Sys.info()) |> 
    {\(.) data.frame(Category = row.names(.), Sys.info = .[,1])}()

#remarks, dim(sys1), dim(sys2)
if (nrow(sys1) == 11 && nrow(sys2) == 8) {
  sys2 <- sys2 |> 
    {\(.) rbind(., data.frame(
    Category = c('rmarkdown', 'rsconnect', 'Current time'), 
    Sys.info = c(as.character(getwd()), 
                 as.character(packageVersion('rsconnect')), 
                 paste(as.character(lubridate::now('Asia/Shanghai')), 'CST 🗺'))))}()
  
} else if (nrow(sys1) == 10 && nrow(sys2) == 8) {
  sys1 <- rbind(sys1, data.frame(Category = '', session_info = ''))
  
  sys2 <- sys2 |> 
    {\(.) rbind(., data.frame(
    Category = c('rmarkdown', 'rsconnect', 'Current time'), 
    Sys.info = c(as.character(getwd()), 
                 as.character(packageVersion('rsconnect')), 
                 paste(as.character(lubridate::now('Asia/Shanghai')), 'CST 🗺'))))}()
}

sys <- cbind(sys1, sys2) |> 
  {\(.) 
    kbl(., caption = 'Additional session information:')}() |> 
  {\(.) 
    kable_styling(., bootstrap_options = c('striped', 'hover', 'condensed', 'responsive'))}() |> 
  {\(.) 
    row_spec(., 0, background = 'DimGrey', color = 'yellow')}() |> 
  {\(.) 
    column_spec(., 1, background = 'CornflowerBlue', color = 'red')}() |> 
  {\(.) 
    column_spec(., 2, background = 'grey', color = 'black')}() |> 
  {\(.) 
    column_spec(., 3, background = 'CornflowerBlue', color = 'blue')}() |> 
  {\(.) 
    column_spec(., 4, background = 'grey', color = 'white')}() |> 
  {\(.) 
    row_spec(., 11, bold = TRUE, color = 'yellow', background = '#D7261E')}()

rm(sys1, sys2)
sys
```

## 参考文献

1) [How to investigate a 3-way interaction?](hhttps://stats.stackexchange.com/questions/47265/how-to-investigate-a-3-way-interaction/47501#47501)
2) [GitHub : Statistical Rethinking (2022 Edition)](https://github.com/englianhu/stat_rethinking_2022)
3) [GitHub : `rethinking` package](https://github.com/englianhu/rethinking) McElreath 2020. Statistical Rethinking, 2nd edition
4) [GitHub : Stan](https://github.com/stan-dev)
5) [GitHub : Repository for distributing (some) stan-dev R packages](https://github.com/stan-dev/r-packages)
6) [书栈网](https://www.bookstack.cn/user/englianhu)

<br><br>

---

[<img src="文艺坊图库/Scibrokes.png" height="14"/> Sςιβrοκεrs Trαdιηg®](http://www.scibrokes.com)<br>
<span style='color:RoyalBlue'>**[<img src="文艺坊图库/Scibrokes.png" height="14"/> 世博量化®](http://www.scibrokes.com)企业知识产权及版权所有，盗版必究。**</span>