具有Shiny和数据库的企业级仪表板

image.png

在企业内部,仪表板应该具有最新信息,尽管有大量数据支持它,但在任何设备上都可以获得快速响应时间。最终用户可能希望单击图中的条形图或列将导致更详细的报告或构成该编号的实际记录列表。本文将介绍如何使用一组R软件包以及Shiny来满足这些要求。

代码

上图所示仪表板的工作示例如下:航班仪表板。该示例具有本文中讨论的所有功能,但数据库连接除外。仪表板的代码可在此Gist:app.R中找到

实际连接到数据库的仪表板代码可在此Gist:app.R中找到

shinydashboard

shinydashboard包有三个重要的优点:

  1. 提供开箱即用的框架,以在Shiny中创建仪表板。这节省了大量时间,因为开发人员不必使用“base”Shiny手动创建仪表板功能。

  2. 具有仪表板 - 友好标签结构。这允许开发人员快速入门。内dashboardPage()标签,在dashboardHeader(),dashboardSidebar()并且dashboardBody()可以添加到容易制定出一个新的仪表板。

  3. 它是移动就绪的。没有任何其他代码,仪表板布局将自动适应较小的屏幕。

快速举例

如果您是新手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/

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 151,511评论 1 330
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 64,495评论 1 273
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 101,595评论 0 225
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 42,558评论 0 190
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 50,715评论 3 270
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 39,672评论 1 192
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 31,112评论 2 291
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 29,837评论 0 181
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 33,417评论 0 228
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 29,928评论 2 232
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 31,316评论 1 242
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 27,773评论 2 234
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 32,253评论 3 220
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 25,827评论 0 8
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 26,440评论 0 180
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 34,523评论 2 249
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 34,583评论 2 249

推荐阅读更多精彩内容