我正在使用此处 的库（ygdashboard）在 Shiny Apps 中构建右侧控制栏。其中最喜欢 AdminLTE.io 模板。在 AdminLTE.io 右侧控制栏中有一个选项，通过启用它，内容部分将相应地调整宽度和显示。
任何人都可以在这里帮助我吗？我的尝试：
我的代码：UI.R
library(shinydashboard)
library(shinyjs)
library(plotly)
library(shinyWidgets)
library(ygdashboard)
library(c3)
library(flexdashboard)
source("helper.R")
dashboardPage( skin = 'green',
dashboardHeader(title=" Test Stand Report",
tags$li(a(img(src = 'logo.jfif',
height = "30px"),
style = "padding-top:10px; padding-bottom:10px;"),
class = "dropdown")),
dashboardSidebar(sidebarMenu(id="tabs",
menuItem("DashBoard", tabName = "dashboard", icon = icon("dashboard", lib = "glyphicon")),
menuItem("Drill Report",icon = icon("link",lib = "glyphicon"),
menuSubItem("Test Stand",tabName = "test_stand",icon = icon("database")),
menuSubItem("Test Code",tabName = "test_code",icon = icon("folder-open",lib = "glyphicon")),
menuSubItem("Product Based",tabName = "product_based",icon = icon("database")),
menuSubItem("Time Shift",tabName = "time_shift",icon = icon("folder-open",lib = "glyphicon"))
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
column(3,
gaugeOutput("gauge1",width = "100%", height = "auto"),
uiOutput("infobox_1")
#gaugeOutput("gauge2",width = "100%", height = "auto")
),
column(3,
gaugeOutput("gauge3",width = "100%", height = "auto"),
uiOutput("infobox_2")
#gaugeOutput("gauge4",width = "100%", height = "100px")
),
column(3,
gaugeOutput("gauge5",width = "100%", height = "auto"),
uiOutput("infobox_3")
#gaugeOutput("gauge6",width = "100%", height = "auto")
),
column(3,
gaugeOutput("gauge7",width = "100%", height = "auto"),
uiOutput("infobox_4")
#gaugeOutput("gauge8",width = "100%", height = "auto")
)
),
fluidRow(
)
),
tabItem(tabName = "test_stand",
fluidRow(
column(3,
wellPanel(
uiOutput("test_stand_select")
)
),
column(3,uiOutput("count_test_code")),
column(3,uiOutput("count_vehicle_tested")),
column(3,uiOutput("count_vehicle_failed"))
),
fluidRow(
box(title = "Success Faliure Ratio",solidHeader = TRUE,width = 4,collapsible = TRUE,height = 'auto',status="success",
plotlyOutput("sucess_faliure_pie",height = '250px')
#tableOutput("sucess_faliure_pie")
),
box(title = "Success Faliure rate with Test_Code",solidHeader = TRUE,width = 8,collapsible = TRUE,height = 'auto',status="success",
#tableOutput("test_stand_test_code_rel")
plotlyOutput("test_stand_test_code_rel",height = '250px')
)
)
),
tabItem(tabName = 'test_code',
fluidRow(
)
)
)
),
dashboardFooter(mainText = "My footer", subText = "2018"),
dashboardControlbar()
)
服务器.R
library(shiny)
library(shinyjs)
library(RMySQL)
library(DT)
library(devtools)
library(woe)
library(sqldf)
library(plyr)
library(shinyalert)
source("helper.R")
shinyServer(function(input, output,session) {
######################### Date range Selection ################################
output$date_range<-renderUI({
if(input$tabs=="test_stand")
{
dateRangeInput("selected_date_range_test_stand", "Select Time Period:",
start = Sys.Date()-10,
end = Sys.Date(),
max=Sys.Date())
}
else if(input$tabs=="test_code")
{
dateRangeInput("selected_date_range_test_code", "Select Time Period:",
start = Sys.Date()-10,
end = Sys.Date(),
max=Sys.Date())
}
else if(input$tabs=="product_based")
{
dateRangeInput("selected_date_range_product_based", "Select Time Period:",
start = Sys.Date()-10,
end = Sys.Date(),
max=Sys.Date())
}
})
##########################report buttom ################################
output$action_btn<-renderUI({
if(input$tabs=="test_stand")
{
actionBttn("get_data_test_stand","Get Report")
}
else if(input$tabs=="test_code")
{
actionBttn("get_data_test_code","Get Report")
}
else if(input$tabs=="product_based")
{
actionBttn("get_data_product_based","Get Report")
}
})
#########################product group selection##################################
output$pg_list<-renderUI({
if(input$tabs=="test_stand")
{
selectInput("selected_pg_test_stand","Select your Product Group",choices = c("Back"="BHO","SKD"="SKD","ABC"="ABC"))
}
else if(input$tabs=="test_code")
{
selectInput("selected_pg_test_code","Select your Product Group",choices = c("Back"="BHO","SKD"="SKD","ABC"="ABC"))
}
else if(input$tabs=="product_based")
{
selectInput("selected_pg_product_based","Select your Product Group",choices = c("Back"="BHO","SKD"="SKD","ABC"="ABC"))
}
})
#############################top 8 gauge################################
output$gauge1<-renderGauge({
gauge(0.5,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 1')
})
output$infobox_1<-renderInfoBox({
infoBox("Total Test Stand Active",10 * 2,subtitle = "Subtitle", icon = icon("credit-card"),fill = TRUE,color = "yellow")
})
output$gauge3<-renderGauge({
gauge(0.7,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 3')
})
output$infobox_2<-renderInfoBox({
infoBox("Total Test Code Running ",10 * 2,subtitle = "Subtitle" ,icon = shiny::icon("bar-chart"),color = "fuchsia",width = 4,fill = TRUE)
})
output$gauge5<-renderGauge({
gauge(0.6,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 5')
})
output$infobox_3<-renderInfoBox({
infoBox(
"Total Vehicle Tested", "80%",subtitle = "Subtitle", icon = icon("list"),
color = "green", fill = TRUE
)
})
output$gauge7<-renderGauge({
gauge(0.3,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 7')
})
output$infobox_4<-renderInfoBox({
infoBox("Total Vehicle Passed ",10 * 2,subtitle = "Subtitle", icon = icon("check"),fill = TRUE, color = 'orange')
})
#############################test_stand value_box########################
})
Helper.R（来自链接）
dashboardControlbar <- function() {
withTags(
div(
id = "right_sidebar",
# Control Sidebar Open
aside(class = "control-sidebar control-sidebar-dark",
# # # # # # # #
#
# Navigation tabs
#
# # # # # # # #
ul(class = "nav nav-tabs nav-justified control-sidebar-tabs",
# first tabs
li(class = "active",
a(href = "#control-sidebar-first-tab", `data-toggle` = "tab",
i(class = "fa fa-sliders")
)
),
# second tabs
li(
a(href = "#control-sidebar-second-tab", `data-toggle` = "tab",
i(class = "fa fa-search")
)
),
# third tab
li(
a(href = "#control-sidebar-third-tab", `data-toggle` = "tab",
i(class = "fa fa-paint-brush")
)
)
),
# # # # # # # #
#
# Tab Panels
#
# # # # # # # #
div(class = "tab-content",
#########################
# First tab content #
#########################
div(class = "tab-pane active", id = "control-sidebar-first-tab",
h3(class = "control-sidebar-heading", "Controller"),
# write elements here
uiOutput("date_range"),
#textOutput("date_validate"),
uiOutput("pg_list"),
uiOutput("action_btn")
#actionBttn("get_data","Get Report")
),
#########################
# Second tab content #
#########################
div(class = "tab-pane", id = "control-sidebar-second-tab",
h3(class = "control-sidebar-heading", "Search"),
# write other elements here
selectInput("selected_search_topic","Select Content Type to Seacrh",choices = c("Test Stand","Test Code","Product")),
searchInput("searchtext","Enter your Search Topic Here", placeholder = "A placeholder",btnSearch = icon("search"),btnReset = icon("remove"))
),
#########################
# Third tab content #
#########################
div(class = "tab-pane", id = "control-sidebar-third-tab",
# third tab elements here
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")
)
)
)
),
# control-sidebar
# Add the sidebar background. This div must be placed
# immediately after the control sidebar
div(class = "control-sidebar-bg", "")
)
)
}