I am using library(ygdashboard) from here for build a Right Side control bar in Shiny Apps. Which most like AdminLTE.io template. In AdminLTE.io Right Side Control Bar there is an option,by enabling it the content part will adjust the width and display accordingly.
Can any body help me out here?? My Try:
Mycode: 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()
)
Server.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 (from the link)
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", "")
)
)
}
