??大道至簡，讓簡單的歸于簡單，純碎的歸于純碎。這是我在簡書上的第一篇文章，希望在這個平臺上賓主雙方彼此都會愉快。
??閑著也是閑著，但缺著不能一直缺著，所以還是要補上這一篇，哪怕是有一點阻力。前面其它的系列文章可以參閱我的另一處文集。
??儀表板是數據的簡要表示，應用的場景不少，人們都喜歡這種形式，大屏上一刷，高大上的樣子。要做好事情當然要踏踏實實地干，分析建模的苦功在水下，人們看不到也看不懂。但要講好故事也要做好表面功夫，一個精美的儀表板往往能得到人們的認同，所以也不差那么幾百行代碼了。
??R markdown通過 flexdashboard包支持儀表板，它是R markdown的一個擴充。Shiny也通過 shinydashboard包提供儀表板的支持，本篇先介紹flexdashboard的一個實例，因為篇幅的關系，將在下一篇中再介紹shinydashboard的實現，以便比較一下。
??本篇不介紹flexdashboard包的具體用法，可參閱《 R Markdown: The Definitive Guide》一書的第5章 《Dashboards》。
??本例通過從Github上部署的服務（項目）讀取Rstudio CRAN上R軟件包的下載日志，監控下載流量的變化，實時監控是儀表板的典型用法，就像駕駛位上的儀表盤一樣。這里是延遲1周的備份下載日志，不過作為演示也足夠了。 項目源碼在github上，J.J.Allaire的作品，簡要精當（實際上是Rstudio三巨頭合作的示例，bubbles包與掃描日志的服務器端代碼是CTO Joe Cheng，shinySignals包是首席科學家Hadley Wickham）。
??更多的flexdashboard例子請看這里。
一、先看看運行效果，界面已經漢化了。
??這個儀表板有兩個維度的動態，一是數據每秒更新一次，二是調整左邊的兩個反應式輸入變量，會動態的改變右邊儀表板的顯示。
1、開始的時候，下載流量小于50次/秒時，流量表的顏色是綠色的。
2、調整左邊滑桿的值，大于30次/秒就提醒，流量表的顏色變成了橙色。
3、最近下載列表顯示的行數，由左邊的一個反應式數字輸入來調整。
這是調整前的，顯示50行。
這是調整后的，顯示10行。
二、flexdashboard的儀表板組件。
??這個例子很簡單，但已經具備了典型儀表板的所有要素。一個flexdashboard儀表板可以有7種組件，如上所見。
1、基于 HTML 小部件的交互式 JavaScript 數據可視化圖形。上面的泡泡圖就是一個htmlwidget bubbles，生成了一個單旋臂星系圖，更多的htmlwidget可以看 這里，提供了各種各樣豐富的可視化工具。
2、R 圖形，包括基礎、柵欄和網格圖形。上面例子中沒有，R markdown代碼塊中R繪圖的輸出，前面的系列文章中很多了。
3、表格，如上面的下載百分比列表與最近下載列表（本例中是Shiny渲染輸出）。
??前面的3種組件是R markdown文檔中通用的，后面的4中組件則是flexdashboard獨有的。
4、數值框（展示重要數據），如上圖中頂端藍色的下載總數與下載的用戶數兩個指標。
5、儀表盤，如上圖中的流量表。
6、文本注釋，如上圖中“數據每秒更新一次”的說明，它有特定的語法，用">"開頭。
7、導航欄（提供與儀表板相關的更多鏈接），如上圖中最右上角的“源碼”鏈接。
??左邊的反應式輸入變量，滑桿與數字，是Shiny的反應式組件，它們不是flexdashboard的組件。flexdashboard儀表板可以是一個動態的Shiny R markdown文檔，如本例所見，這提供了更好的交互性和動態。
三、儀表板源碼
??源碼有2個文件，一個儀表板R markdown文件和一個從服務器讀取數據的R函數文件。
1、dashboard.Rmd
??先看Rmd文件的YAML頭，輸出類型是flexdashboard::flex_dashboard，實質上是HTML頁面。然后設置了它的樣式主題是cosmo，宇宙。flexdashboard內置的主題有“default”, “bootstrap”, “cerulean”, “cosmo”, “darkly”, “flatly”, “journal”, “lumen”, “paper”, “readable”, “sandstone”, “simplex”, “spacelab”, “united”, “yeti”，如果想用其他更多的樣式主題，可以到Bootswatch上看看，上面各主題的具體顏色配置，也可以到該站上看看。比如要設置成spacelab主題，用下面代碼塊中注釋的部分代替即可。有關flexdashboard樣式主題的設置，可以參閱這篇文章。這些樣式的源碼在這里，也可以參考定義自己的樣式。
??上面的第7種flexdashboard組件，導航欄，在YAML頭中用navbar定義。
??它的runtime是shiny，這是一個交互式的Shiny R markdown文檔，要部署在Shiny Server上，當然筆記本上單機運行也可以。
---
title: "CRAN 下載監控"
output:
flexdashboard::flex_dashboard:
theme: cosmo
# theme:
# version: 4
# bootswatch: spacelab
orientation: rows
social: menu
navbar:
- { title: "源碼", href: "https://github.com/rstudio/flexdashboard/tree/main/examples/04_shiny-cran-downloads" }
runtime: shiny
---
??這里開始用markdown語法寫文章來講解R markdown源碼，所以源碼中代碼塊標志的三個反引號，中間一個加了個反斜杠，以免顯示混亂，讀者拷貝合并代碼塊時，要注意把額外的反斜杠去掉。
`\``{r setup, include=FALSE}
library(flexdashboard)
# 這個工具類R函數源碼從 CRAN上讀取R包下載日志的增量數據流，后面再介紹。
source("helpers.R")
# pkgStream是一個反應表達式，它代表了增量的R包下載日志數據流。
# 每秒更新一次并返回上次更新后的增量下載數據data frame。
# 通過invalidateLater()函數讓反應表達式1秒后自動失效來自動從服務器更新數據。
# 參閱 https://mastering-shiny.org/reactivity-objects.html#timed-invalidation-adv
pkgStream <- packageStream()
# pkgData 也是一個反應表達式，它累積了之前所有pkgStream返回的數據，
# 然后拋棄了所有超過maxAgeSecs秒的數據，這里包含的是5分鐘內的數據。
# 有需要的話，也可以把該參數變成反應式變量，動態調整。
maxAgeSecs <- 60 * 5
pkgData <- packageData(pkgStream, maxAgeSecs)
`\``
??Sidebar {.sidebar}是兼容shinydashboard的寫法，表示下面的Shiny反應式輸入組件安排在左邊，下面一排等號是分頁符，相當于一級標題"#"，要把Sidebar作為一個單獨的框架頁面。具體markdown語法請參閱《Markdown syntax》一節。這里在R代碼塊中定義了兩個Shiny反應式輸入組件sliderInput()與numericInput()。
??儀表板中的每個組件都可以包括標題和注釋部分。三級標題 "###" 后面的文本為標題；">" 開頭的文本是注釋。
Sidebar {.sidebar}
=======================================================================
### cran.rstudio.com
此例的數據流是延遲1周的cran.rstudio.com下載日志，產生下載日志數據流的服務器代碼在[jcheng5/cransim](https://github.com/jcheng5/cransim)。
`\``{r}
# 下載高流量顏色閥值
sliderInput("rateThreshold", "當流量超出時以不同顏色提醒:",
min = 0, max = 100, value = 50, step = 1
)
# 最近下載窗口顯示數量
numericInput("maxrows", "最近下載窗口顯示數量:", 50)
`\``
> 數據每秒鐘更新一次， 從服務器讀取增量的數據，即該時間間隔之間下載R包的流量數據。
??儀表板這一頁中，Row下面一行減號相當于二級標題"##Row"，用于在儀表板的布局中分行，它是個網格結構，具體布局可以參閱《Layout》一節，這里源碼中用等號行分頁減號行分行是為了在源碼中便于閱讀。在flexdashboard中，一級標題會作為整個儀表板的標題顯示，在本例中就是頂部“儀表板”Tab；三級標題會作為儀表板組件的標題顯示，二級標題是布局標題，它們不會顯示。這一行的網格中會安放流量表、總下載數、下載用戶數3個組件。
儀表板
=======================================================================
Row
-----------------------------------------------------------------------
### 下載數/秒 (過去 5 分鐘)
`\``{r}
# downloadRate 是一個計算儀表板運行期間下載流量的反應表達式
# 記住pkgData()存放的是5分鐘內R包下載日志的數據。
startTime <- as.numeric(Sys.time())
downloadRate <- reactive({
elapsed <- as.numeric(Sys.time()) - startTime
nrow(pkgData()) / min(maxAgeSecs, elapsed)
})
# 輸出下載流量指標。因為是在Shiny反應式編程環境中，要用render()函數封裝渲染。
# gauge()是flexdashboard的儀表htmlwidget，根據上面的反應式變量rateThreshold設置儀表的顏色。
renderGauge({
rate <- formatC(downloadRate(), digits = 1, format = "f")
gauge(rate, min = 0, max = 100, symbol="次", gaugeSectors(
#success = c(0, 33), warning = c(34, 66), danger = c(77, 100)
success = c(0, input$rateThreshold), warning = c(input$rateThreshold, 100)
))
})
`\``
### 總下載數 {.value-box}
`\``{r}
# dlCount 是一個反應表達式，
# 記錄了從 pkgStream收到的所有數據行數，跨越了5分鐘的時間窗口。
dlCount <- downloadCount(pkgStream)
# 輸出總下載數
renderValueBox({
valueBox(dlCount(), icon = "fa-download")
})
`\``
### 下載的用戶數 {.value-box}
`\``{r}
# usrCount 是一個反應表達式，
# 記錄了儀表板運行期間下載過R包的單個用戶計數。
usrCount <- userCount(pkgStream)
# 輸出下載的用戶數
renderValueBox({
valueBox(value = usrCount(), icon = "fa-users")
})
`\``
??這一行安放2個flexdashboard組件，過去5分鐘內下載最多的R包，它們所占百分比的列表和泡泡圖。這是render()泡泡圖，記住，反應式編程環境要用render()函數渲染輸出。
Row
-----------------------------------------------------------------------
### 下載最多的R包 (過去 5 分鐘) {data-width=700}
`\``{r}
# 泡泡圖HTML widget bubbles, https://github.com/jcheng5/bubbles。
renderBubbles({
if (nrow(pkgData()) == 0)
return()
order <- unique(pkgData()$package)
df <- pkgData() %>%
group_by(package) %>%
tally() %>%
arrange(desc(n), tolower(package)) %>%
# 只顯示前60，否則可視化效果不好。
head(60)
bubbles(df$n, df$package, key = df$package, color = rainbow(60, alpha=NULL)[sample(60)])
})
`\``
### 下載百分比 (過去 5 分鐘) {data-width=340}
`\``{r}
renderTable({
df <- pkgData() %>%
group_by(package) %>%
tally() %>%
arrange(desc(n), tolower(package)) %>%
mutate(percentage = n / nrow(pkgData()) * 100) %>%
select("Package" = package, "Percent" = percentage) %>%
as.data.frame() %>%
head(30)
# 列名改為中文，只顯示前30。
names(df)<- c("R包","百分比")
df
}, digits = 1)
`\``
??等號行分頁，這一頁只有一個Shiny輸出組件最近下載列表，不需要布局代碼，所以沒有二級標題。可以在儀表板頂端按“最近下載”Tab切換。
最近下載
=======================================================================
### 最近下載
`\``{r}
renderTable({
downloads <- tail(pkgData(), n = input$maxrows)
downloads <- downloads[,c("date", "time", "size", "r_version",
"r_arch", "r_os", "package")]
downloads[order(nrow(downloads):1),]
# 列名改為中文。
names(downloads)<-c("日期", "時間", "大小", "R版本",
"體系", "OS", "包名")
})
`\``
2、helpers.R
??用到的兩個包shinySignals、bubbles需要從Github安裝。
library(shiny)
# devtools::install_github("hadley/shinySignals")
library(shinySignals)
library(dplyr)
# devtools::install_github("jcheng5/bubbles")
library(bubbles)
# 這是一個空的 data frame 原型，用于存放服務器返回的下載日志數據。
prototype <- data.frame(date = character(), time = character(),
size = numeric(), r_version = character(), r_arch = character(),
r_os = character(), package = character(), version = character(),
country = character(), ip_id = character(), received = numeric())
??packageStream()連接服務器讀取cran.rstudio.com的下載日志stream，返回一個data frame stream。返回的是一個反應表達式，通過Shiny invalidateLater()機制每1000毫秒更新一次。產生下載日志數據流的服務器代碼在jcheng5/cransim，用go語言編寫，掃描下載日志歸檔文件并返回相應的增量數據。
packageStream <- function(session = getDefaultReactiveDomain()) {
# Connect to data source
sock <- socketConnection("cransim.rstudio.com", 6789, blocking = FALSE, open = "r")
# Clean up when session is over
session$onSessionEnded(function() {
close(sock)
})
# 通過一個定時失效的反應表達式得到日志中新的行。
newLines <- reactive({
invalidateLater(1000, session)
readLines(sock)
})
# 將日志行數據轉換為data frame，并以反應表達式返回。
reactive({
if (length(newLines()) == 0)
return()
read.csv(textConnection(newLines()), header=FALSE, stringsAsFactors=FALSE,
col.names = names(prototype)
) %>% mutate(received = as.numeric(Sys.time()))
})
}
??把反應表達式pkgStream返回的行，累積起來，然后按時間窗口（5分鐘）過濾。使用了上面packageStream()為數據添加的received時間標簽。可以用?shinySignals::reducePast看該函數的文檔，這應該是最難理解的一個函數了，會用即可。shinySignals包提供了Shiny反應機制反應訊號處理的擴展工具，文檔見其Github項目。
packageData <- function(pkgStream, timeWindow) {
shinySignals::reducePast(pkgStream, function(memo, value) {
rbind(memo, value) %>%
filter(received > as.numeric(Sys.time()) - timeWindow)
}, prototype)
}
??累計反應表達式pkgStream收到的行數。看懂了上面shinySignals::reducePast()的用法，這里也就看懂了。
downloadCount <- function(pkgStream) {
shinySignals::reducePast(pkgStream, function(memo, df) {
if (is.null(df))
return(memo)
memo + nrow(df)
}, 0)
}
??累計的單獨用戶計數。這個算法有點復雜，本篇的重點不在根據IP和日期確定跨日的兩條下載記錄是否為同一個用戶，可以先不管它，就當是個測試數據好了，有時間再仔細分析它的算法，所以把注解原文留下。
# Use a bloom filter to probabilistically track the number of unique
# users we have seen; using bloom filter means we will not have a
# perfectly accurate count, but the memory usage will be bounded.
userCount <- function(pkgStream) {
# These parameters estimate that with 5000 unique users added to
# the filter, we'll have a 1% chance of false positive on the next
# user to be queried.
bloomFilter <- BloomFilter$new(5000, 0.01)
total <- 0
reactive({
df <- pkgStream()
if (!is.null(df) && nrow(df) > 0) {
# ip_id is only unique on a per-day basis. To make them unique
# across days, include the date. And call unique() to make sure
# we don't double-count dupes in the current data frame.
ids <- paste(df$date, df$ip_id) %>% unique()
# Get indices of IDs we haven't seen before
newIds <- !sapply(ids, bloomFilter$has)
# Add the count of new IDs
total <<- total + length(newIds)
# Add the new IDs so we know for next time
sapply(ids[newIds], bloomFilter$set)
}
total
})
}
# Quick and dirty bloom filter. The hashing "functions" are based on choosing
# random sets of bytes out of a single MD5 hash. Seems to work well for normal
# values, but has not been extensively tested for weird situations like very
# small n or very large p.
library(digest)
library(bit)
BloomFilter <- setRefClass("BloomFilter",
fields = list(
.m = "integer",
.bits = "ANY",
.k = "integer",
.bytesNeeded = "integer",
.bytesToTake = "matrix"
),
methods = list(
# @param n - Set size
# @param p - Desired false positive probability (e.g. 0.01 for 1%)
initialize = function(n = 10000, p = 0.001) {
m = (as.numeric(n) * log(1 / p)) / (log(2)^2)
.m <<- as.integer(m)
.bits <<- bit(.m)
.k <<- max(1L, as.integer(round((as.numeric(.m)/n) * log(2))))
# This is how many *bytes* of data we need for *each* of the k indices we need to
# generate
.bytesNeeded <<- as.integer(ceiling(log2(.m) / 8))
.bytesToTake <<- sapply(rep_len(.bytesNeeded, .k), function(byteCount) {
# 16 is number of bytes an md5 hash has
sample.int(16, byteCount, replace = FALSE)
})
},
.hash = function(x) {
hash <- digest(x, "md5", serialize = FALSE, raw = TRUE)
sapply(1:.k, function(i) {
val <- rawToInt(hash[.bytesToTake[,i]])
# Scale down to fit into the desired range
as.integer(val * (as.numeric(.m) / 2^(.bytesNeeded*8)))
})
},
has = function(x) {
all(.bits[.hash(x)])
},
set = function(x) {
.bits[.hash(x)] <<- TRUE
}
)
)
rawToInt <- function(bytes) {
Reduce(function(left, right) {
bitwShiftL(left, 8) + right
}, as.integer(bytes), 0L)
}
