29_R互動式網頁_加入KPI指標

 承上一篇的主題及程式碼，本篇規劃在右側上方加入KPI營運指標，但又發覺直方圖及拉桿似乎太佔位置了，所以在加入KPI營運指標前，將直方圖及拉感合成一頁並分為兩個頁籤，程式依然以ui.R程式為主

library(shiny)
library(shinydashboard)
shinyUI(
  dashboardPage(
    dashboardHeader(title = "This is header"),
    dashboardSidebar(
      
      sidebarMenu(
        sidebarSearchForm("searchText","buttonsearch","search"),#加入搜尋
      menuItem("儀表板",tabName = "dashboard",icon = icon("dashboard")),
        menuSubItem("財務儀表板",tabName = "finance"),
        menuSubItem("銷售儀表板",tabName = "sales"),
      menuItem("資料分析"),
      menuItem("原始資料")
    )),
    dashboardBody(
      tabItems(
        tabItem(tabName = "dashboard",
                fluidRow(
                  tabBox(
                  tabPanel(title = "財務直方圖",status = "primary",solidHeader = T,plotOutput("histogram")),#move here
                  tabPanel(title = "儀表板控制",status = "warning",solidHeader = T,
                      sliderInput("bins","Number of Breaks",1,100,50),
                      textInput("text_input","search opptunities",value = "123456"))#move here
                  )
                )),
                tabItem(tabName = "finance",
                        h1("財務儀表板")
                        ),
                tabItem(tabName = "sales",
                        h2("銷售儀表板"))
                )
      )
    )
  )

其實我們可以看到程式碼，我們改的地方主要為dishboardBody中fluidRow的程式加入tabBox()將直方圖及拉桿包起來，並將直方圖原先box改為tabPanel，同樣拉桿的程式碼前方加入tabPanel，此時可為一頁又分別為兩個頁籤，這樣的好處是若我在後續規劃有其他的統計圖，可在增加一個tabBox方便我的規畫所增加的內容，成果圖如下

現在dashBoard上方加入三個營運KPI分別為銷售金額、倉庫周轉率、核准訂單，所以會加入fliudRow()內含有兩個infoBox及一個infoBoxOutput進行呈現，程式碼如下

ui.R程式如下

library(shiny)

library(shinydashboard)

shinyUI(

  dashboardPage(

    dashboardHeader(title = "This is header"),

    dashboardSidebar(

      

      sidebarMenu(

        sidebarSearchForm("searchText","buttonsearch","search"),#加入搜尋

      menuItem("儀表板",tabName = "dashboard",icon = icon("dashboard")),

        menuSubItem("財務儀表板",tabName = "finance"),

        menuSubItem("銷售儀表板",tabName = "sales"),

      menuItem("資料分析"),

      menuItem("原始資料")

    )),

    dashboardBody(

      tabItems(

        tabItem(tabName = "dashboard",

                fluidRow(

                  infoBox("銷售總額美元",1000,icon = icon("thumbs-up")),

                  infoBox("倉庫周轉率%",paste0('20'),icon = icon("warning")),

                  infoBoxOutput("approved")

                ),

                fluidRow(

                  tabBox(

                  tabPanel(title = "財務直方圖",status = "primary",solidHeader = T,plotOutput("histogram")),#move here

                  tabPanel(title = "儀表板控制",status = "warning",solidHeader = T,

                      sliderInput("bins","Number of Breaks",1,100,50),

                      textInput("text_input","search opptunities",value = "123456"))#move here

                  ),

                  tabBox()

                )),

                tabItem(tabName = "finance",

                        h1("財務儀表板")

                        ),

                tabItem(tabName = "sales",

                        h2("銷售儀表板"))

                )

      )

    )

  )

server.R程式如下

library(shiny)

library(shinydashboard)

shinyServer(function(input,output){

  output$histogram <- renderPlot({

    hist(faithful$eruptions,breaks = input$bins)

  })

  output$approved <- renderInfoBox({

    infoBox("已批准訂單","10,000,000",icon = icon("bar-chart-o"))

  })

})

上述程式碼中我們可以發現在ui.R中的infoBoxOutput，相對在server.R中也相對應，成果圖如下