在企業內部,儀表板應該具有最新信息,儘管有大量數據支持它,但在任何設備上都可以獲得快速響應時間。最終用戶可能希望單擊圖中的條形圖或列將導致更詳細的報告或構成該編號的實際記錄列表。本文將介紹如何使用一組R軟件包以及Shiny來滿足這些要求。
代碼
上圖所示儀表板的工作示例如下:航班儀表板。該示例具有本文中討論的所有功能,但數據庫連接除外。儀表板的代碼可在此Gist:app.R中找到
實際連接到數據庫的儀表板代碼可在此Gist:app.R中找到
shinydashboard
該shinydashboard包有三個重要的優點:
提供開箱即用的框架,以在Shiny中創建儀表板。這節省了大量時間,因爲開發人員不必使用“base”Shiny手動創建儀表板功能。
具有儀表板 - 友好標籤結構。這允許開發人員快速入門。內dashboardPage()標籤,在dashboardHeader(),dashboardSidebar()並且dashboardBody()可以添加到容易制定出一個新的儀表板。
它是移動就緒的。沒有任何其他代碼,儀表板佈局將自動適應較小的屏幕。
快速舉例
如果您是新手shinydashboard,請隨意複製並粘貼以下代碼,以查看您環境中非常簡單的儀表板:
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Quick Example"),
dashboardSidebar(textInput("text", "Text")),
dashboardBody(
valueBox(100, "Basic example"),
tableOutput("mtcars")
)
)
server <- function(input, output) {
output$mtcars <- renderTable(head(mtcars))
}
shinyApp(ui, server)
部署使用 config
在開發過程中使用的憑據與用於發佈的憑證不同是很常見的。對於數據庫,適應此目的的最佳方法是在兩個環境中設置具有相同別名的數據源名稱(DSN)。如果無法設置DSN,則config可以使用該程序包在不同環境中使用的憑據之間切換不可見。該RStudio連接產品支持使用的config包裝開箱。使用config代替Kerberos或DSN的另一個優點是使用的憑證不會出現在R代碼的純文本中。Make scripts可移植文章中提供了更詳細的說明。
此代碼段是一個config能夠讀取的示例YAML文件。它有一個用於本地開發的驅動程序名稱,以及在部署期間使用的其他名稱:
default:
mssql:
Driver: "SQL Server"
Server: "[server's path]"
Database: "[database name]"
UID: "[user id]"
PWD: "[pasword]"
Port: 1433
rsconnect:
mssql:
Driver: "SQLServer"
Server: "[server's path]"
Database: "[database name]"
UID: "[user id]"
PWD: "[pasword]"
Port: 1433
default開發時將自動使用該設置,並且RStudio Connect將rsconnect在執行此代碼時使用這些值:
dw <- config::get("mssql")
con <- DBI::dbConnect(odbc::odbc(),
Driver = dw$Driver,
Server = dw$Server,
UID = dw$UID,
PWD = dw$PWD,
Port = dw$Port,
Database = dw$Database)
purrr
Shiny輸入從表或查詢中檢索它們的值是很常見的。由於儀表板中的其他查詢將使用所選輸入進行相應過濾,因此傳遞給其他查詢所需的值通常是標識代碼,而不是下拉列表中顯示的標籤。要將鍵與值分開,可以使用包中的map()函數purrr。在下面的示例中,收集airlines表中的所有記錄,並創建名稱列表,map()然後將運營商代碼插入每個名稱節點。
# This code runs in ui
airline_list <- tbl(con, "airlines") %>%
collect %>%
split(.$name) %>% # Place here the field that will be used for the labels
map(~.$carrier) # Place here the field that will be used for keys
在selectInput()下拉菜單能夠讀取所產生的airline_list列表變量。
# This code runs in ui
selectInput(
inputId = "airline",
label = "Airline:",
choices = airline_list) # Use airline_list as the choices argument value
dplyr
儀表板通常具有公共數據主題,該主題源自公共數據集。可以構建基本查詢,因爲dplyr轉換爲封面下的SQL,並且由於“懶惰”,在從其請求某些內容之前不會評估查詢。
db_flights <- tbl(con, "flights") %>%
left_join(tbl(con, "airlines"), by = "carrier") %>%
rename(airline = name) %>%
left_join(tbl(con, "airports"), by = c("origin" = "faa")) %>%
rename(origin_name = name) %>%
select(-lat, -lon, -alt, -tz, -dst) %>%
left_join(tbl(con, "airports"), by = c("dest" = "faa")) %>%
rename(dest_name = name)
dplyr然後,該變量可用於多個Shiny輸出。第二個例子是用於構建下highcharter圖的代碼。
output$total_flights <- renderValueBox({
result <- db_flights %>% # Use the db_flights variable
filter(carrier == input$airline)
if(input$month != 99) result <- filter(result, month == input$month)
result <- result %>%
tally %>%
pull %>% # Use pull to get the total count as a vector
as.integer()
valueBox(value = prettyNum(result, big.mark = ","),
subtitle = "Number of Flights")
})
深入研究
“向下鑽取”操作的想法是最終用戶能夠看到構成儀表板中顯示的聚合結果的部分或全部數據。“向下鑽取”動作有兩個部分:
- 單擊顯示結果的儀表板元素。結果通常是彙總數據。
- 將顯示一個帶有其他報告的新屏幕。新報告可能是另一個顯示較低級別聚合的報告,也可能顯示構成結果的行列表。
單擊儀表板元素
以下是捕獲點擊事件的一種方法。我們的想法是在條形圖中顯示給定航空公司的頂級機場目的地。單擊一個條形時,所需的結果是繪圖激活向下鑽取。該highcharter示例中將使用該程序包。
要捕獲條形單擊事件highcharter,需要編寫一個小的JavaScript。在大多數情況下,可以使用以下示例,因此您可以將其原樣複製並粘貼到代碼中。變量名稱和輸入名稱(bar_clicked)將是唯一必須更改以匹配您的圖表的兩個語句。
js_bar_clicked <- JS("function(event) {Shiny.onInputChange('bar_clicked', [event.point.category]);}")
上面的命令在R中創建了一個新的JavaScript,可以跟蹤單擊一個欄的時間。以下是代碼的細分:
- JS - 表示以下函數是JavaScript
- function(event) - 創建一個新函數,並期望一個event變量。Highchart將傳遞的事件是單擊一個欄,因此event將包含有關該給定欄的信息。
- Shiny.onInputChange - JavaScript將用於與Shiny交互的函數
- bar_clicked - 是新Shiny輸入的名稱; 它的值將默認爲下一個項目
- [event.point.category] - 傳遞點擊的點的類別值
下一節將說明如何捕獲新變化input$bar_clicked,並執行“向下鑽取”的第二部分。
在renderHighchart()輸出函數中,包含JavaScript的變量作爲事件列表的一部分傳遞:events = list(click = js_bar_clicked))。因爲事件在hc_add_series()創建條形圖的內部,所以這樣的點擊事件與單擊條形圖相關聯。
output$top_airports <- renderHighchart({
# Reuse the dplyr db_flights variable as the base query
result <- db_flights %>%
filter(carrier == input$airline)
if(input$month != 99) result <- filter(result, month == input$month)
result <- result %>
group_by(dest_name) %>%
tally() %>%
arrange(desc(n)) %>%
collect %>%
head(10)
highchart() %>%
hc_add_series(
data = result$n,
type = "bar",
name = paste("No. of Flights"),
events = list(click = js_bar_clicked)) %>% # The JavaScript variable is called here
hc_xAxis(
categories = result$dest_name, # Value in event.point.category
tickmarkPlacement="on")})
使用appendTab()
計劃是每次最終用戶點擊欄時顯示新的向下鑽取報告。爲了防止不必要地拉出相同的數據,代碼將足夠智能,如果之前點擊了相同的欄,則只需將焦點切換到現有選項卡。
新的,非常酷的appendTab()函數用於動態創建一個新的Shiny選項卡,其中包含DataTable,其中包含選擇的前100行。名爲的簡單向量tab_list用於跟蹤所有現有詳細信息選項卡。該updateTabsetPanel()功能用於切換到新創建或以前創建的選項卡。
該observeEvent()函數是“捕獲”JavaScript執行的事件的函數,因爲它監視bar_clickedShiny輸入。評論將添加到下面的代碼中,以涵蓋如何使用這些功能的更多方面。
tab_list <- NULL
observeEvent(input$bar_clicked,{
airport <- input$bar_clicked[1] # Selects the first value sent in [event.point.category]
tab_title <- paste(input$airline, # tab_title is the tab's name and unique identifier
"-", airport ,
if(input$month != 99)
paste("-" , month.name[as.integer(input$month)]))
if(tab_title %in% tab_list == FALSE){ # Checks to see if the title already exists
details <- db_flights %>% # Reuses the db_flights dbplyr variable
filter(dest_name == airport, # Uses the [event.point.category] value for the filter
carrier == input$airline) # Matches the current airline filter
if(input$month != 99) # Matches the current month selection
details <- filter(details, month == input$month)
details <- details %>%
head(100) %>% # Select only the first 100 records
collect() # Brings the 100 records into the R environment
appendTab(inputId = "tabs", # Starts a new Shiny tab inside the tabsetPanel named "tabs"
tabPanel(
tab_title, # Sets the name & ID
DT::renderDataTable(details) # Renders the DataTable with the 100 newly collected rows
))
tab_list <<- c(tab_list, tab_title) # Adds the new tab to the list, important to use <<-
}
# Switches over to a panel that matched the name in tab_title.
# Notice that this function sits outside the if statement because
# it still needs to run to select a previously created tab
updateTabsetPanel(session, "tabs", selected = tab_title)
})
使用removeTab()和刪除所有選項卡purrr
動態創建新選項卡可能會使儀表板混亂。因此,actionLink()可以添加一個簡單的按鈕dashboardSidebar(),以刪除除主儀表板選項卡以外的所有選項卡。
# This code runs in ui
dashboardSidebar(
actionLink("remove", "Remove detail tabs"))
observeEvent()再次使用該函數來捕獲單擊鏈接的時間。在walk()從命令purrr然後被用於通過在每個選項卡的標題迭代tab_list向量,並且前進到執行閃亮removeTab()每個名稱命令。之後,重置選項卡列表變量。由於環境範圍,確保<<-在重置變量時使用double小於(),因此它知道重置在函數外部定義的變量observeEvent()。
# This code runs in server
observeEvent(input$remove,{
# Use purrr's walk command to cycle through each
# panel tabs and remove them
tab_list %>%
walk(~removeTab("tabs", .x))
tab_list <<- NULL
})
結論
此示例使用Shinydashboard創建企業儀表板,但也有其他技術。Flexdashboard是在R Markdown中構建類似企業儀表板的好方法。我們使用SQL Server填充此儀表板,但您可以使用任何數據庫。有關使用R的數據庫的更多信息,請參閱http://db.rstudio.com/。