├── LICENSE ├── tools ├── .gitignore ├── package.json ├── README.md └── gulpfile.js ├── examples ├── bus │ ├── metrotransit-data │ │ ├── .gitignore │ │ ├── rds │ │ │ ├── shapes.rds │ │ │ └── trips.rds │ │ ├── metrotransit-data.Rproj │ │ └── 00-fetch-data.R │ ├── dependencies.R │ ├── DESCRIPTION │ ├── README.md │ ├── ui.R │ └── server.R ├── www │ └── jane_smith.jpg ├── sales │ ├── recommendation.csv │ └── app.R ├── minimal │ ├── app_no_sidebar.R │ ├── app.R │ ├── app_sidebar_options.R │ ├── app_no_header.R │ ├── app_external_menu_link.R │ ├── app_custom_classes.R │ ├── app_sidebar_condition_panel.R │ └── app_header_elements.R ├── from_readme.R ├── crandash │ ├── bloomfilter.R │ ├── ui.R │ ├── global.R │ └── server.R ├── themes │ └── app-darktheme.R └── app.R ├── .gitattributes ├── man ├── figures │ ├── compare.png │ └── hexsticker.png ├── semantic.dashboard.Rd ├── validate_tab_name.Rd ├── get_dashboard_dependencies.Rd ├── column.Rd ├── semantic_palette.Rd ├── icon.Rd ├── light_semantic_palette.Rd ├── menu_item_output.Rd ├── tab_items.Rd ├── sidebar_menu_output.Rd ├── tab_item.Rd ├── render_menu.Rd ├── message_item.Rd ├── task_item.Rd ├── sidebar_menu.Rd ├── dropdown_menu_output.Rd ├── notification_item.Rd ├── value_box_output.Rd ├── dropdown_menu.Rd ├── render_dropdown_menu.Rd ├── update_tab_items.Rd ├── render_value_box.Rd ├── value_box.Rd ├── dashboard_body.Rd ├── box.Rd ├── menu_item.Rd ├── tab_box.Rd ├── sidebar_user_panel.Rd ├── dashboard_page.Rd ├── dashboard_sidebar.Rd └── dashboard_header.Rd ├── tests ├── testthat.R └── testthat │ ├── test-validate_tab_name.R │ ├── test-names.R │ ├── test-column.R │ ├── test-utils.R │ ├── test-value_box.R │ └── test-dropdown_menu.R ├── vignettes ├── imgs │ └── dash1.png └── intro.Rmd ├── pkgdown ├── favicon │ ├── favicon.ico │ ├── favicon-16x16.png │ └── favicon-32x32.png ├── extra.css └── _pkgdown.yml ├── codecov.yml ├── inst ├── updateTabItems.js ├── semantic.dashboard.min.js ├── semantic.dashboard.js ├── semantic.dashboard.min.css └── semantic.dashboard.css ├── .lintr ├── styles ├── layout │ ├── _body.scss │ ├── _header.scss │ ├── _general.scss │ ├── _sidebar.scss │ └── _title.scss ├── main.scss ├── abstracts │ ├── _functions.scss │ └── _variables.scss └── generate_css.R ├── .Rbuildignore ├── .github ├── pull_request_template.md └── workflows │ ├── pkgdown.yml │ └── main.yml ├── semantic.dashboard.Rproj ├── R ├── column.R ├── deps.R ├── utils.R ├── tab.R ├── tab_box.R ├── sidebar_menu_output.R ├── dropdown_menu_output.R ├── constants.R ├── box.R ├── value_box.R ├── dropdown_menu.R ├── menu_item.R └── semantic_dashboard.R ├── .gitignore ├── development ├── dev.R ├── common_args.R └── README.md ├── DESCRIPTION ├── NAMESPACE ├── srcjs └── sidebar.js ├── CHANGELOG.md └── README.md /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: Appsilon Sp. z o.o. 3 | 4 | -------------------------------------------------------------------------------- /tools/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules 2 | node_modules/ 3 | node_modules*/ 4 | -------------------------------------------------------------------------------- /examples/bus/metrotransit-data/.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | /inst/semantic.dashboard.js -merge -diff 2 | *.min.js -merge -diff 3 | -------------------------------------------------------------------------------- /man/figures/compare.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/man/figures/compare.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(semantic.dashboard) 3 | 4 | test_check("semantic.dashboard") 5 | -------------------------------------------------------------------------------- /vignettes/imgs/dash1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/vignettes/imgs/dash1.png -------------------------------------------------------------------------------- /examples/www/jane_smith.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/examples/www/jane_smith.jpg -------------------------------------------------------------------------------- /man/figures/hexsticker.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/man/figures/hexsticker.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /examples/bus/metrotransit-data/rds/shapes.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/examples/bus/metrotransit-data/rds/shapes.rds -------------------------------------------------------------------------------- /examples/bus/metrotransit-data/rds/trips.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Appsilon/semantic.dashboard/HEAD/examples/bus/metrotransit-data/rds/trips.rds -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | patch: off 10 | -------------------------------------------------------------------------------- /examples/bus/dependencies.R: -------------------------------------------------------------------------------- 1 | # This is needed because the shinyapps dependency detection doesn't realize 2 | # that jsonlite::fromJSON needs httr when using URLs. 3 | library(httr) 4 | -------------------------------------------------------------------------------- /inst/updateTabItems.js: -------------------------------------------------------------------------------- 1 | /* update_tab_items */ 2 | Shiny.addCustomMessageHandler('update_tab', 3 | function(custom_tab) { 4 | $(`#uisidebar [data-value='${custom_tab}']`).click(); 5 | } 6 | ) 7 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: 2 | linters_with_defaults( 3 | line_length_linter = line_length_linter(100), 4 | object_name_linter = NULL 5 | ) 6 | exclusions: 7 | c( 8 | "vignettes" 9 | ) 10 | -------------------------------------------------------------------------------- /examples/bus/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | Type: Shiny 3 | Title: Bus dashboard example 4 | Author: RStudio, Inc. 5 | AuthorUrl: http://www.rstudio.com/ 6 | License: MIT 7 | Tags: 8 | DisplayMode: Normal 9 | -------------------------------------------------------------------------------- /styles/layout/_body.scss: -------------------------------------------------------------------------------- 1 | .dashboard-body { 2 | &.ui.grid { 3 | margin: 0; 4 | 5 | .tab-content { 6 | padding-left: 0; 7 | padding-right: 0; 8 | width: 100%; 9 | } 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /styles/main.scss: -------------------------------------------------------------------------------- 1 | @import 'abstracts/variables'; 2 | @import 'abstracts/functions'; 3 | 4 | @import 'layout/general'; 5 | @import 'layout/body'; 6 | @import 'layout/title'; 7 | @import 'layout/header'; 8 | @import 'layout/sidebar'; 9 | -------------------------------------------------------------------------------- /styles/abstracts/_functions.scss: -------------------------------------------------------------------------------- 1 | @function generate-size-selector($size) { 2 | @if $size == "" { 3 | @return ""; 4 | } 5 | @if str-index($size, " ") { 6 | @return "[class*='" + $size + "']"; 7 | } @else { 8 | @return "." + $size; 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /man/semantic.dashboard.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_dashboard.R 3 | \name{semantic.dashboard} 4 | \alias{semantic.dashboard} 5 | \title{semantic.dashboard} 6 | \description{ 7 | semantic.dashboard 8 | } 9 | \keyword{internal} 10 | -------------------------------------------------------------------------------- /tools/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "build": "gulp" 5 | }, 6 | "devDependencies": { 7 | "gulp": "^4.0.2", 8 | "gulp-eslint": "^6.0.0", 9 | "gulp-plumber": "^1.2.1", 10 | "gulp-terser": "^1.2.0", 11 | "gulp-concat": "^2.6.1" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^codecov\.yml$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | .github 5 | readme_rmd_template 6 | CHANGELOG\.md 7 | README\.Rmd 8 | README\.md 9 | build_readme\.R 10 | \.travis\.yml 11 | ^\.git.*$ 12 | docs 13 | \.circleci 14 | examples 15 | development 16 | ^tools$ 17 | ^srcjs$ 18 | ^styles$ 19 | pkgdown 20 | .lintr 21 | -------------------------------------------------------------------------------- /examples/sales/recommendation.csv: -------------------------------------------------------------------------------- 1 | Account,Product,Region,Revenue 2 | Axis Bank,FBB,North,2000 3 | HSBC,FBB,South,30000 4 | SBI,FBB,East,1000 5 | ICICI,FBB,West,1000 6 | Bandhan Bank,FBB,West,200 7 | Axis Bank,SIMO,North,200 8 | HSBC,SIMO,South,300 9 | SBI,SIMO,East,100 10 | ICICI,SIMO,West,100 11 | Bandhan Bank,SIMO,West,200 12 | -------------------------------------------------------------------------------- /.github/pull_request_template.md: -------------------------------------------------------------------------------- 1 | 7 | 8 | # Title 9 | 10 | Short description (with a reference to an issue). 11 | -------------------------------------------------------------------------------- /examples/bus/metrotransit-data/metrotransit-data.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | -------------------------------------------------------------------------------- /examples/minimal/app_no_sidebar.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | dashboardHeader(color = "blue"), 6 | dashboardSidebar(), 7 | dashboardBody(tabItems( 8 | tabItem(tabName = "tab1", p("Tab 1")), 9 | tabItem(tabName = "tab2", p("Tab 2")))) 10 | ) 11 | 12 | server <- function(input, output) { 13 | } 14 | 15 | shinyApp(ui, server) 16 | -------------------------------------------------------------------------------- /styles/generate_css.R: -------------------------------------------------------------------------------- 1 | sass::sass( 2 | sass::sass_file("styles/main.scss"), 3 | options = sass::sass_options(output_style = "compressed"), 4 | output = "inst/semantic.dashboard.min.css", 5 | cache = FALSE 6 | ) 7 | 8 | sass::sass( 9 | sass::sass_file("styles/main.scss"), 10 | options = sass::sass_options(output_style = "expanded"), 11 | output = "inst/semantic.dashboard.css", 12 | cache = FALSE 13 | ) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-validate_tab_name.R: -------------------------------------------------------------------------------- 1 | context("validate_tab_name") 2 | 3 | test_that("validate_tab_name stops on name containing dot character", { 4 | checked_value <- "wrong.name" 5 | expect_error(semantic.dashboard:::validate_tab_name(checked_value)) 6 | }) 7 | 8 | test_that("validate_tab_name should not stop on correct name", { 9 | checked_value <- "good_name" 10 | expect_silent(semantic.dashboard:::validate_tab_name(checked_value)) 11 | }) 12 | -------------------------------------------------------------------------------- /man/validate_tab_name.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/menu_item.R 3 | \name{validate_tab_name} 4 | \alias{validate_tab_name} 5 | \title{Valid tab name should not containt dot character '.'.} 6 | \usage{ 7 | validate_tab_name(name) 8 | } 9 | \arguments{ 10 | \item{name}{Tab name to validate.} 11 | } 12 | \description{ 13 | Valid tab name should not containt dot character '.'. 14 | } 15 | \keyword{internal} 16 | -------------------------------------------------------------------------------- /styles/layout/_header.scss: -------------------------------------------------------------------------------- 1 | .ui.top.menu.dashboard-header { 2 | justify-content: space-between; 3 | 4 | h1, h2, h3, h4, h5, h6 { 5 | margin: 0; 6 | } 7 | 8 | &:after { 9 | content: none; 10 | } 11 | 12 | .logo { 13 | height: 30px; 14 | margin: 5px; 15 | } 16 | 17 | .header-part { 18 | display: flex; 19 | align-items: center; 20 | } 21 | } 22 | 23 | body.no-margin .ui.top.menu.dashboard-header { 24 | border-radius: 0; 25 | } 26 | -------------------------------------------------------------------------------- /man/get_dashboard_dependencies.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/deps.R 3 | \name{get_dashboard_dependencies} 4 | \alias{get_dashboard_dependencies} 5 | \title{Get the semantic.dashboard dependencies} 6 | \usage{ 7 | get_dashboard_dependencies() 8 | } 9 | \value{ 10 | semantic.dashboard dependencies 11 | } 12 | \description{ 13 | To add dependencies in the future follow the \code{\link[htmltools]{htmlDependency}} 14 | help. 15 | } 16 | \keyword{internal} 17 | -------------------------------------------------------------------------------- /semantic.dashboard.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/column.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/column.R 3 | \name{column} 4 | \alias{column} 5 | \title{Create a column.} 6 | \usage{ 7 | column(width, ...) 8 | } 9 | \arguments{ 10 | \item{width}{Width of the column. Between 1 and 16.} 11 | 12 | \item{...}{UI elements to include within the column.} 13 | } 14 | \value{ 15 | A column that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 16 | } 17 | \description{ 18 | Create a column with additional UI elements. 19 | } 20 | -------------------------------------------------------------------------------- /examples/bus/README.md: -------------------------------------------------------------------------------- 1 | The script in the `metrotransit-data/` directory will fetch schedule data for the Twin Cities Metro Transit. This data is updated weekly. 2 | 3 | The 00-fetch-data.R script should be executed in the `metrotransit-data/` directory. It fetches the data and saves some of the tables as .rds files. The bus app will read in the .rds files for route information. 4 | 5 | Information about schedule data: http://datafinder.org/metadata/transit_schedule_google_feed.html 6 | 7 | Data format reference: https://developers.google.com/transit/gtfs/reference?csw=1 8 | -------------------------------------------------------------------------------- /styles/layout/_general.scss: -------------------------------------------------------------------------------- 1 | body { 2 | min-height: unset !important; 3 | display: flex; 4 | flex-direction: column; 5 | 6 | &:not(.no-margin) { 7 | padding: 10px; 8 | } 9 | } 10 | 11 | body.no-margin { 12 | & > .ui.top.menu { 13 | border-top: 0 14 | } 15 | 16 | & > .ui.segment.pushable { 17 | border: 0; 18 | } 19 | } 20 | 21 | body > .ui.segment.pushable.attached { 22 | display: flex; 23 | overflow: hidden; 24 | margin-bottom: 0; 25 | } 26 | 27 | body > .ui.segment.pushable > .pusher { 28 | overflow: auto; 29 | width: 100%; 30 | } 31 | -------------------------------------------------------------------------------- /examples/minimal/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | dashboardHeader(color = "blue"), 6 | dashboardSidebar(side = "left", size = "thin", color = "teal", 7 | sidebarMenu( 8 | menuItem(tabName = "tab1", "Tab 1"), 9 | menuItem(tabName = "tab2", "Tab 2"))), 10 | dashboardBody(tabItems( 11 | tabItem(tabName = "tab1", p("Tab 1")), 12 | tabItem(tabName = "tab2", p("Tab 2")))) 13 | ) 14 | 15 | 16 | server <- function(input, output) { 17 | } 18 | 19 | shinyApp(ui, server) 20 | -------------------------------------------------------------------------------- /examples/minimal/app_sidebar_options.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | dashboardHeader(color = "blue"), 6 | dashboardSidebar( 7 | visible = FALSE, 8 | closable = TRUE, 9 | pushable = TRUE, 10 | sidebarMenu( 11 | menuItem(tabName = "tab1", "Tab 1"), 12 | menuItem(tabName = "tab2", "Tab 2"))), 13 | dashboardBody(tabItems( 14 | tabItem(tabName = "tab1", p("Tab 1")), 15 | tabItem(tabName = "tab2", p("Tab 2")))) 16 | ) 17 | 18 | 19 | server <- function(input, output) { 20 | } 21 | 22 | shinyApp(ui, server) 23 | -------------------------------------------------------------------------------- /man/semantic_palette.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/constants.R 3 | \docType{data} 4 | \name{semantic_palette} 5 | \alias{semantic_palette} 6 | \title{Semantic colors 7 | https://github.com/Semantic-Org/Semantic-UI/blob/master/src/themes/default/globals/site.variables} 8 | \format{ 9 | An object of class \code{character} of length 13. 10 | } 11 | \usage{ 12 | semantic_palette 13 | } 14 | \description{ 15 | Semantic colors 16 | https://github.com/Semantic-Org/Semantic-UI/blob/master/src/themes/default/globals/site.variables 17 | } 18 | \keyword{datasets} 19 | -------------------------------------------------------------------------------- /examples/minimal/app_no_header.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | dashboardHeader(color = "blue", disable = TRUE), 6 | dashboardSidebar(side = "left", size = "thin", color = "teal", 7 | sidebarMenu( 8 | menuItem(tabName = "tab1", "Tab 1"), 9 | menuItem(tabName = "tab2", "Tab 2"))), 10 | dashboardBody(tabItems( 11 | tabItem(tabName = "tab1", p("Tab 1")), 12 | tabItem(tabName = "tab2", p("Tab 2")))) 13 | ) 14 | 15 | server <- function(input, output) { 16 | } 17 | 18 | shinyApp(ui, server) 19 | -------------------------------------------------------------------------------- /tests/testthat/test-names.R: -------------------------------------------------------------------------------- 1 | library(semantic.dashboard) 2 | library(shinydashboard) 3 | context("Function names") 4 | 5 | test_that("All functions from shinydashboard are implemented except functions known to be missing", { # nolint: line_length_linter 6 | to_be_implemented <- c( 7 | "menuItemOutput", "menuSubItem", "renderMenu", "sidebarMenuOutput", 8 | "sidebarSearchForm", "updateTabItems" 9 | ) 10 | not_implemented <- setdiff( 11 | setdiff(ls("package:shinydashboard"), ls("package:semantic.dashboard")), 12 | to_be_implemented 13 | ) 14 | expect_equal(length(not_implemented), 0) 15 | }) 16 | -------------------------------------------------------------------------------- /R/column.R: -------------------------------------------------------------------------------- 1 | #' Create a column. 2 | #' @description Create a column with additional UI elements. 3 | #' @param width Width of the column. Between 1 and 16. 4 | #' @param ... UI elements to include within the column. 5 | #' @return A column that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 6 | #' @export 7 | column <- function(width, ...) { 8 | if (!is.numeric(width) || (width < MIN_COLUMN_WIDTH) || (width > MAX_COLUMN_WIDTH)) { 9 | stop(paste("'width' must be between", MIN_COLUMN_WIDTH, "and", MAX_COLUMN_WIDTH)) 10 | } 11 | shiny::tags$div(class = paste(COLUMN_WIDTHS[width], "wide column"), ...) 12 | } 13 | -------------------------------------------------------------------------------- /man/icon.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/menu_item.R 3 | \name{icon} 4 | \alias{icon} 5 | \title{Create Semantic UI icon tag (alias for \code{icon} for compatibility with \code{shinydashboard})} 6 | \usage{ 7 | icon(type, ...) 8 | } 9 | \arguments{ 10 | \item{type}{A name of an icon. Look at http://semantic-ui.com/elements/icon.html for all 11 | possibilities.} 12 | 13 | \item{...}{Other arguments to be added as attributes of the tag (e.g. style, class etc.)} 14 | } 15 | \description{ 16 | This creates an icon tag using Semantic UI styles. 17 | } 18 | \examples{ 19 | icon("dog") 20 | } 21 | -------------------------------------------------------------------------------- /man/light_semantic_palette.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/constants.R 3 | \docType{data} 4 | \name{light_semantic_palette} 5 | \alias{light_semantic_palette} 6 | \title{Semantic light colors 7 | https://github.com/Semantic-Org/Semantic-UI/blob/master/src/themes/default/globals/site.variables} 8 | \format{ 9 | An object of class \code{character} of length 13. 10 | } 11 | \usage{ 12 | light_semantic_palette 13 | } 14 | \description{ 15 | Semantic light colors 16 | https://github.com/Semantic-Org/Semantic-UI/blob/master/src/themes/default/globals/site.variables 17 | } 18 | \keyword{datasets} 19 | -------------------------------------------------------------------------------- /tools/README.md: -------------------------------------------------------------------------------- 1 | This directory contains JavaScript build tools. 2 | 3 | ## Setup 4 | 5 | You need nodejs and npm package manager. 6 | 7 | Use npm for packages manager. 8 | 9 | This will automatically install packages and dependencies from package.json. 10 | ``` 11 | npm install 12 | ``` 13 | 14 | Before going to next step install gulp-cli 15 | ``` 16 | sudo npm i --global gulp-cli 17 | ``` 18 | 19 | ## Gulp 20 | Gulp is a toolkit for automating painful or time-consuming tasks in your development. 21 | 22 | ### Compile JavaScript 23 | To compile JavaScript just run 24 | 25 | ``` 26 | gulp 27 | ``` 28 | or 29 | ``` 30 | npm run build 31 | ``` 32 | -------------------------------------------------------------------------------- /R/deps.R: -------------------------------------------------------------------------------- 1 | #' Get the semantic.dashboard dependencies 2 | #' 3 | #' @description To add dependencies in the future follow the \code{\link[htmltools]{htmlDependency}} 4 | #' help. 5 | #' 6 | #' @return semantic.dashboard dependencies 7 | #' @keywords internal 8 | get_dashboard_dependencies <- function() { 9 | list( 10 | htmlDependency( 11 | "semantic.dashboard", 12 | as.character(utils::packageVersion("semantic.dashboard")), 13 | c(file = system.file(package = "semantic.dashboard")), 14 | script = c("semantic.dashboard.min.js", "updateTabItems.js"), 15 | stylesheet = "semantic.dashboard.min.css" 16 | ) 17 | ) 18 | } 19 | -------------------------------------------------------------------------------- /examples/minimal/app_external_menu_link.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | dashboardHeader(color = "blue"), 6 | dashboardSidebar(side = "left", size = "thin", color = "teal", 7 | sidebarMenu( 8 | menuItem(tabName = "tab1", "Tab 1"), 9 | menuItem("Visit-us", href = "https://www.appsilondatascience.com"), 10 | menuItem(tabName = "tab2", "Tab 2"))), 11 | dashboardBody(tabItems( 12 | tabItem(tabName = "tab1", p("Tab 1")), 13 | tabItem(tabName = "tab2", p("Tab 2")) 14 | )) 15 | ) 16 | 17 | server <- function(input, output) { 18 | } 19 | 20 | shinyApp(ui, server) 21 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | 3 | # History files 4 | .Rhistory 5 | .Rapp.history 6 | 7 | # Session Data files 8 | .RData 9 | 10 | # Example code in package build process 11 | *-Ex.R 12 | 13 | # Output files from R CMD build 14 | /*.tar.gz 15 | 16 | # Output files from R CMD check 17 | /*.Rcheck/ 18 | 19 | # RStudio files 20 | .Rproj.user/ 21 | 22 | # produced vignettes 23 | vignettes/*.html 24 | vignettes/*.pdf 25 | 26 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 27 | .httr-oauth 28 | 29 | # knitr and R markdown default cache directories 30 | /*_cache/ 31 | /cache/ 32 | 33 | # Temporary files created by R markdown 34 | *.utf8.md 35 | *.knit.md 36 | .Rproj.user 37 | 38 | /docs/ 39 | -------------------------------------------------------------------------------- /examples/minimal/app_custom_classes.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | class = "my_page", 6 | sidebar_and_body_container_class = "my_sidebar_and_body", 7 | dashboardHeader(class = "my_header"), 8 | dashboardSidebar( 9 | class="my_sidebar", 10 | visible = FALSE, 11 | closable = TRUE, 12 | pushable = TRUE, 13 | sidebarMenu( 14 | menuItem(tabName = "tab1", "Tab 1"), 15 | menuItem(tabName = "tab2", "Tab 2"))), 16 | dashboardBody(tabItems( 17 | tabItem(tabName = "tab1", p("Tab 1")), 18 | tabItem(tabName = "tab2", p("Tab 2"))), 19 | class="my_body") 20 | ) 21 | 22 | 23 | server <- function(input, output) { 24 | } 25 | 26 | shinyApp(ui, server) 27 | -------------------------------------------------------------------------------- /man/menu_item_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sidebar_menu_output.R 3 | \name{menu_item_output} 4 | \alias{menu_item_output} 5 | \alias{menuItemOutput} 6 | \title{Create a menu item output.} 7 | \usage{ 8 | menu_item_output(outputId) 9 | 10 | menuItemOutput(outputId) 11 | } 12 | \arguments{ 13 | \item{outputId}{Id of the output.} 14 | } 15 | \value{ 16 | A menu item that can be passed to \code{\link[semantic.dashboard]{sidebarMenu}} 17 | } 18 | \description{ 19 | UI-side function for dynamic manuItem. 20 | } 21 | \section{Functions}{ 22 | \itemize{ 23 | \item \code{menuItemOutput()}: Create a menu item output (alias for \code{menu_item_output} for 24 | compatibility with \code{shinydashboard}) 25 | 26 | }} 27 | -------------------------------------------------------------------------------- /inst/semantic.dashboard.min.js: -------------------------------------------------------------------------------- 1 | const initialize_sidebar=(i,t,e,n)=>{transitionLeftRight=e?"overlay":"uncover",$(document).on("shiny:sessioninitialized",(function(e){let o;$(".ui.sidebar").sidebar({context:$(".bottom.segment"),closable:i,dimPage:n,defaultTransition:{computer:{left:transitionLeftRight,right:transitionLeftRight,top:"overlay",bottom:"overlay"},mobile:{left:transitionLeftRight,right:transitionLeftRight,top:"overlay",bottom:"overlay"}}}),$("#toggle_menu").click((function(){$(window).resize()})),t&&$(".ui.sidebar").sidebar("attach events","#toggle_menu"),$("#uisidebar .item").tab({onVisible:function(i){o&&$(this).trigger("hidden"),$(window).resize(),$(this).trigger("shown"),o=this,prefix="shiny-tab-",Shiny.setInputValue("uisidebar",this.id.substring(prefix.length),{priority:"event"})}})}))}; -------------------------------------------------------------------------------- /man/tab_items.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tab.R 3 | \name{tab_items} 4 | \alias{tab_items} 5 | \alias{tabItems} 6 | \title{Create a panel with tabs.} 7 | \usage{ 8 | tab_items(...) 9 | 10 | tabItems(...) 11 | } 12 | \arguments{ 13 | \item{...}{Tabs.} 14 | } 15 | \value{ 16 | A panel with tabs that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 17 | } 18 | \description{ 19 | Create a panel with tabs. 20 | } 21 | \section{Functions}{ 22 | \itemize{ 23 | \item \code{tabItems()}: Create a panel with tabs (alias for \code{tab_items} for compatibility 24 | with \code{shinydashboard}) 25 | 26 | }} 27 | \examples{ 28 | tabItems( 29 | tabItem(tabName = "tab1", "Tab 1"), 30 | tabItem(tabName = "tab2", "Tab 2")) 31 | } 32 | -------------------------------------------------------------------------------- /man/sidebar_menu_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sidebar_menu_output.R 3 | \name{sidebar_menu_output} 4 | \alias{sidebar_menu_output} 5 | \alias{sidebarMenuOutput} 6 | \title{Create a sidebar menu output.} 7 | \usage{ 8 | sidebar_menu_output(outputId) 9 | 10 | sidebarMenuOutput(outputId) 11 | } 12 | \arguments{ 13 | \item{outputId}{Id of the output.} 14 | } 15 | \value{ 16 | A sidebar menu that can be passed to \code{\link[semantic.dashboard]{dashboardSidebar}} 17 | } 18 | \description{ 19 | UI-side function for dynamic sidebarMenu. 20 | } 21 | \section{Functions}{ 22 | \itemize{ 23 | \item \code{sidebarMenuOutput()}: Create a sidebar menu output (alias for \code{sidebar_menu 24 | output} for compatibility with \code{shinydashboard}) 25 | 26 | }} 27 | -------------------------------------------------------------------------------- /styles/abstracts/_variables.scss: -------------------------------------------------------------------------------- 1 | // Colors 2 | $red : #DB2828; 3 | $orange : #F2711C; 4 | $yellow : #FBBD08; 5 | $olive : #B5CC18; 6 | $green : #21BA45; 7 | $teal : #00B5AD; 8 | $blue : #2185D0; 9 | $violet : #6435C9; 10 | $purple : #A333C8; 11 | $pink : #E03997; 12 | $brown : #A5673F; 13 | $grey : #767676; 14 | $black : #1B1C1D; 15 | 16 | $colors-map: ("red": $red, "orange": $orange, "yellow": $yellow, "olive": $olive, 17 | "green": $green, "teal": $teal, "blue": $blue, "violet": $violet, 18 | "purple": $purple, "pink": $pink, "brown": $brown, "grey": $grey, "black": $black); 19 | 20 | // Sizes 21 | $sizes: ("thin": 150, "": 260, "wide": 350, "very thin": 60, "very wide": 475); 22 | -------------------------------------------------------------------------------- /examples/from_readme.R: -------------------------------------------------------------------------------- 1 | library(semantic.dashboard) 2 | 3 | ui <- dashboardPage( 4 | dashboardHeader(title = "Basic dashboard"), 5 | dashboardSidebar(sidebarMenu( 6 | menuItem(tabName = "home", text = "Home", icon = icon("home")), 7 | menuItem(tabName = "another", text = "Another Tab", icon = icon("heart")) 8 | )), 9 | dashboardBody( 10 | fluidRow( 11 | box(plotOutput("plot1", height = 250)), 12 | box( 13 | title = "Controls", 14 | sliderInput("slider", "Number of observations:", 1, 100, 50) 15 | ) 16 | ) 17 | ) 18 | ) 19 | 20 | server <- function(input, output) { 21 | set.seed(122) 22 | histdata <- rnorm(500) 23 | output$plot1 <- renderPlot({ 24 | data <- histdata[seq_len(input$slider)] 25 | hist(data) 26 | }) 27 | } 28 | 29 | shinyApp(ui, server) 30 | -------------------------------------------------------------------------------- /examples/minimal/app_sidebar_condition_panel.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage( 5 | dashboardHeader(), 6 | dashboardSidebar( 7 | sidebarMenu( id= "sidebar_tabs", 8 | menuItem("tab1", tabName = "tab1"), 9 | menuItem("tab2", tabName = "tab2"), 10 | conditionalPanel( 11 | condition = "input.sidebar_tabs == 'tab2'", 12 | div(class = "tab2-condition-panel", "tab2 div") 13 | ) 14 | ) 15 | ), 16 | dashboardBody( 17 | tabItems( 18 | tabItem(tabName = "tab1", p("Tab 1")), 19 | tabItem(tabName = "tab2", p("Tab 2")) 20 | ) 21 | ) 22 | ) 23 | 24 | server <- function(input, output) { 25 | observe({ 26 | print(input$sidebar_tabs) 27 | }) 28 | } 29 | 30 | shinyApp(ui, server) 31 | -------------------------------------------------------------------------------- /development/dev.R: -------------------------------------------------------------------------------- 1 | APP_TO_RUN <- "examples" 2 | # APP_TO_RUN <- "examples/from_readme.R" 3 | # APP_TO_RUN <- "examples/bus" 4 | # APP_TO_RUN <- "examples/crandash" 5 | # APP_TO_RUN <- "examples/sales" 6 | # APP_TO_RUN <- "examples/minimal/app_sidebar_options.R" 7 | # APP_TO_RUN <- "examples/minimal/app_sidebar_condition_panel.R" 8 | # APP_TO_RUN <- "examples/minimal/app_no_sidebar.R" 9 | # APP_TO_RUN <- "examples/minimal/app_no_header.R" 10 | # APP_TO_RUN <- "examples/minimal/app_header_elements.R" 11 | # APP_TO_RUN <- "examples/minimal/app_custom_classes.R" 12 | # APP_TO_RUN <- "examples/themes/app-darktheme.R" 13 | 14 | # Generate CSS 15 | source("styles/generate_css.R") 16 | 17 | # Generate JS scripts (firstly run `npm i` inside tools dir) 18 | system("gulp --cwd tools/.") 19 | 20 | devtools::load_all(".") 21 | 22 | shiny::runApp(APP_TO_RUN, port = 5167) 23 | -------------------------------------------------------------------------------- /tests/testthat/test-column.R: -------------------------------------------------------------------------------- 1 | context("column") 2 | 3 | test_that("column accepts widths of type double without warnings", { 4 | width <- 6.7 5 | expect_silent(semantic.dashboard::column(width = width)) 6 | }) 7 | 8 | test_that("column don't accept widths smaller than 1", { 9 | width <- 0 10 | expect_error(semantic.dashboard::column(width = width)) 11 | }) 12 | 13 | test_that("column don't accept widths greater than 16", { 14 | width <- 44 15 | expect_error(semantic.dashboard::column(width = width)) 16 | }) 17 | 18 | test_that("column don't accept not numeric widths", { 19 | width <- "a" 20 | expect_error(semantic.dashboard::column(width = width)) 21 | }) 22 | 23 | test_that("column returns a correct object", { 24 | width <- 5 25 | expect_identical(semantic.dashboard::column(width = width), 26 | shiny::tags$div(class = "five wide column")) 27 | }) 28 | -------------------------------------------------------------------------------- /man/tab_item.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tab.R 3 | \name{tab_item} 4 | \alias{tab_item} 5 | \alias{tabItem} 6 | \title{Create a tab} 7 | \usage{ 8 | tab_item(tabName, ..., fluid = TRUE) 9 | 10 | tabItem(tabName, ..., fluid = TRUE) 11 | } 12 | \arguments{ 13 | \item{tabName}{Id of the tab.} 14 | 15 | \item{...}{UI elements to include within the tab.} 16 | 17 | \item{fluid}{Controls whether tab width should be 100\% (TRUE) or limited by Foomantic UI 18 | breakpoints (FALSE).} 19 | } 20 | \value{ 21 | A tab that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 22 | } 23 | \description{ 24 | Create a tab panel with additional UI elements. 25 | } 26 | \section{Functions}{ 27 | \itemize{ 28 | \item \code{tabItem()}: Create a tab (alias for \code{tab_item} for compatibility with 29 | \code{shinydashboard}) 30 | 31 | }} 32 | \examples{ 33 | tab_item(tabName = "tab1", "Tab 1") 34 | } 35 | -------------------------------------------------------------------------------- /man/render_menu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sidebar_menu_output.R 3 | \name{render_menu} 4 | \alias{render_menu} 5 | \alias{renderMenu} 6 | \title{Create a menu output.} 7 | \usage{ 8 | render_menu(expr, env = parent.frame(), quoted = FALSE) 9 | 10 | renderMenu(expr, env = parent.frame(), quoted = FALSE) 11 | } 12 | \arguments{ 13 | \item{expr}{menu.} 14 | 15 | \item{env}{The environment in which to evaluate expr.} 16 | 17 | \item{quoted}{Is expr a quoted expression (with \code{quote()})? This is useful if you want to 18 | save an expression in a variable.} 19 | } 20 | \value{ 21 | A dynamic menu that can be assigned to output. 22 | } 23 | \description{ 24 | Server-side function for dynamic sidebarMenu. 25 | } 26 | \section{Functions}{ 27 | \itemize{ 28 | \item \code{renderMenu()}: Create a menu output (alias for \code{render_menu} for compatibility 29 | with \code{shinydashboard}) 30 | 31 | }} 32 | -------------------------------------------------------------------------------- /styles/layout/_sidebar.scss: -------------------------------------------------------------------------------- 1 | .ui.sidebar ~ .pusher { 2 | transform: none !important; 3 | transition: margin-left .5s ease, margin-right .5s ease; 4 | } 5 | 6 | // Apply margin to content 7 | $sidebar-positions: "left", "right"; 8 | 9 | @each $position in $sidebar-positions { 10 | @each $size, $width in $sizes { 11 | .ui.sidebar.visible:not(.pushable):not(.overlay).#{$position}#{generate-size-selector($size)} + .pusher, 12 | .ui.sidebar.visible.uncover.pushable.#{$position}#{generate-size-selector($size)} + .pusher { 13 | margin-#{$position}: #{$width}px; 14 | } 15 | } 16 | } 17 | 18 | // Fix double borders 19 | $opposite-sides: ("left": "right", "right": "left", "top": "bottom", "bottom": "top"); 20 | 21 | @each $side, $opposide-side in $opposite-sides { 22 | .ui.sidebar.#{$side} { 23 | border-width: 0; 24 | border-#{$opposide-side}-width: 1px; 25 | } 26 | } 27 | 28 | .ui.sidebar .user-panel{ 29 | min-height: 65px; 30 | padding: 13px 16px; 31 | } 32 | -------------------------------------------------------------------------------- /man/message_item.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropdown_menu.R 3 | \name{message_item} 4 | \alias{message_item} 5 | \alias{messageItem} 6 | \title{Create a message item.} 7 | \usage{ 8 | message_item(from, message, ..., icon = "user") 9 | 10 | messageItem(from, message, ..., icon = "user") 11 | } 12 | \arguments{ 13 | \item{from}{Who the message is from.} 14 | 15 | \item{message}{Text of the message.} 16 | 17 | \item{...}{Additional UI elements to include within the dropdown menu.} 18 | 19 | \item{icon}{Additional icon.} 20 | } 21 | \value{ 22 | A message item that can be passed to \code{\link[semantic.dashboard]{dropdownMenu}} 23 | } 24 | \description{ 25 | Create a message item. 26 | } 27 | \section{Functions}{ 28 | \itemize{ 29 | \item \code{messageItem()}: Create a message item (alias for \code{message_item} for compatibility 30 | with \code{shinydashboard}) 31 | 32 | }} 33 | \examples{ 34 | messageItem("Marek", "Another test!", icon = "warning") 35 | } 36 | -------------------------------------------------------------------------------- /man/task_item.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropdown_menu.R 3 | \name{task_item} 4 | \alias{task_item} 5 | \alias{taskItem} 6 | \title{Create a task item.} 7 | \usage{ 8 | task_item(text, value, color = "") 9 | 10 | taskItem(text, value, color = "") 11 | } 12 | \arguments{ 13 | \item{text}{Progress bar label.} 14 | 15 | \item{value}{Progress bar value.} 16 | 17 | \item{color}{Color of the task item. One of \code{c("", "red", "orange", 18 | "yellow", "olive", "green", "teal", "blue", "violet", "purple", "pink", 19 | "brown", "grey", "black")}} 20 | } 21 | \value{ 22 | A task item that can be passed to \code{\link[semantic.dashboard]{dropdownMenu}} 23 | } 24 | \description{ 25 | Create a task item. 26 | } 27 | \section{Functions}{ 28 | \itemize{ 29 | \item \code{taskItem()}: Create a task item (alias for \code{taks_item} for compatibility with 30 | \code{shinydashboard}) 31 | 32 | }} 33 | \examples{ 34 | taskItem("Project progress...", 50.777, color = "red") 35 | } 36 | -------------------------------------------------------------------------------- /man/sidebar_menu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/menu_item.R 3 | \name{sidebar_menu} 4 | \alias{sidebar_menu} 5 | \alias{sidebarMenu} 6 | \title{Create a sidebar menu.} 7 | \usage{ 8 | sidebar_menu(...) 9 | 10 | sidebarMenu(...) 11 | } 12 | \arguments{ 13 | \item{...}{Menu items.} 14 | } 15 | \value{ 16 | A sidebar menu that can be passed \code{\link[semantic.dashboard]{dashboardSidebar}} 17 | } 18 | \description{ 19 | Create a sidebar menu with menu items. 20 | } 21 | \details{ 22 | It's possible to set selected menu item by setting `selected = TRUE` in `menuItem`. 23 | } 24 | \section{Functions}{ 25 | \itemize{ 26 | \item \code{sidebarMenu()}: Create a sidebar menu (alias for \code{sidebar_menu} for compatibility 27 | with \code{shinydashboard}) 28 | 29 | }} 30 | \examples{ 31 | sidebarMenu( 32 | menuItem(tabName = "plot_tab", text = "My plot", icon = icon("home")), 33 | menuItem(tabName = "table_tab", text = "My table", icon = icon("smile"), selected = TRUE) 34 | ) 35 | } 36 | -------------------------------------------------------------------------------- /tools/gulpfile.js: -------------------------------------------------------------------------------- 1 | const eslint = require("gulp-eslint"); 2 | const gulp = require("gulp"); 3 | const plumber = require("gulp-plumber"); 4 | const uglify = require("gulp-terser"); 5 | const concat = require('gulp-concat'); 6 | 7 | // Lint scripts 8 | function scriptsLint() { 9 | return gulp 10 | .src(["../srcjs"]) 11 | .pipe(plumber()) 12 | .pipe(eslint()) 13 | .pipe(eslint.format()) 14 | .pipe(eslint.failAfterError()); 15 | } 16 | 17 | // Transpile and concatenate scripts 18 | function scripts() { 19 | return gulp 20 | .src(["../srcjs/*.js"]) 21 | .pipe(plumber()) 22 | .pipe(concat("semantic.dashboard.js")) 23 | .pipe(gulp.dest("../inst/")) 24 | } 25 | 26 | // Minify scripts 27 | function scripts_uglify() { 28 | return gulp 29 | .src(["../inst/semantic.dashboard.js"]) 30 | .pipe(concat("semantic.dashboard.min.js")) 31 | .pipe(uglify()) 32 | .pipe(gulp.dest("../inst")) 33 | } 34 | 35 | const js = gulp.series(scriptsLint, gulp.series(scripts, scripts_uglify)); 36 | 37 | exports.js = js; 38 | exports.default = js; 39 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: 6 | - develop 7 | workflow_dispatch: 8 | 9 | name: pkgdown 10 | 11 | jobs: 12 | pkgdown: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v2 18 | 19 | - uses: r-lib/actions/setup-pandoc@v2 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::pkgdown, local::. 28 | needs: website 29 | 30 | - name: Deploy to gh-pages branch 31 | run: | 32 | git config --local user.name "$GITHUB_ACTOR" 33 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 34 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 35 | -------------------------------------------------------------------------------- /man/dropdown_menu_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropdown_menu_output.R 3 | \name{dropdown_menu_output} 4 | \alias{dropdown_menu_output} 5 | \alias{dropdownMenuOutput} 6 | \title{Create a dropdown menu output.} 7 | \usage{ 8 | dropdown_menu_output(outputId) 9 | 10 | dropdownMenuOutput(outputId) 11 | } 12 | \arguments{ 13 | \item{outputId}{Id of the output.} 14 | } 15 | \value{ 16 | A dropdown menu that can be passed to \code{\link[semantic.dashboard]{dashboardHeader}} 17 | } 18 | \description{ 19 | UI-side function for dynamic dropdownMenu. 20 | } 21 | \section{Functions}{ 22 | \itemize{ 23 | \item \code{dropdownMenuOutput()}: Create a dropdown menu output (alias for \code{dropdown_menu 24 | output} for compatibility with \code{shinydashboard}) 25 | 26 | }} 27 | \examples{ 28 | \dontrun{ 29 | dropdownMenuOutput("dropdown") 30 | 31 | output$dropdown <- renderDropdownMenu({ 32 | dropdownMenu(messageItem("Michał", "Test message", color = "teal"), 33 | messageItem("Marek", "Another test!", icon = "warning", color = "red")) 34 | }) 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /man/notification_item.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropdown_menu.R 3 | \name{notification_item} 4 | \alias{notification_item} 5 | \alias{notificationItem} 6 | \title{Create a notification item.} 7 | \usage{ 8 | notification_item(text, icon = "warning", color = "") 9 | 10 | notificationItem(text, icon = "warning", color = "") 11 | } 12 | \arguments{ 13 | \item{text}{Text of the notification.} 14 | 15 | \item{icon}{Additional icon.} 16 | 17 | \item{color}{Color of the notification item. One of 18 | \code{c("", "red", "orange", "yellow", "olive", "green", "teal", "blue", 19 | "violet", "purple", "pink", "brown", "grey", "black")}} 20 | } 21 | \value{ 22 | A notification item that can be passed to \code{\link[semantic.dashboard]{dropdownMenu}} 23 | } 24 | \description{ 25 | Create a notification item. 26 | } 27 | \section{Functions}{ 28 | \itemize{ 29 | \item \code{notificationItem()}: Create a notification item (alias for \code{notification_item} for 30 | compatibility with \code{shinydashboard}) 31 | 32 | }} 33 | \examples{ 34 | notificationItem("This is notification!", color = "red") 35 | } 36 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: semantic.dashboard 2 | Type: Package 3 | Title: Dashboard with Fomantic UI Support for Shiny 4 | Version: 0.2.1 5 | Authors@R: c(person("Filip", "Stachura", email = "filip@appsilon.com", role = "aut"), 6 | person("Dominik", "Krzeminski", email = "dominik@appsilon.com", role = "aut"), 7 | person("Krystian", "Igras", role = "aut"), 8 | person("Michał", "Maj", role = "ctb"), 9 | person("Michał", "Drzazga", role = "ctb"), 10 | person("Developers", "Appsilon", email = "support+opensource@appsilon.com", role = "cre"), 11 | person(family = "Appsilon", role = "cph")) 12 | Description: It offers functions for creating dashboard with Fomantic UI. 13 | BugReports: https://github.com/Appsilon/semantic.dashboard/issues 14 | Encoding: UTF-8 15 | License: MIT + file LICENSE 16 | Imports: 17 | utils, 18 | shiny (>= 0.12.1), 19 | shiny.semantic (>= 0.3.3), 20 | htmltools, 21 | glue, 22 | checkmate 23 | Suggests: 24 | covr, 25 | knitr, 26 | lintr, 27 | markdown, 28 | rcmdcheck, 29 | rmarkdown, 30 | shinydashboard, 31 | testthat 32 | RoxygenNote: 7.2.1 33 | VignetteBuilder: 34 | knitr 35 | -------------------------------------------------------------------------------- /pkgdown/extra.css: -------------------------------------------------------------------------------- 1 | :root { 2 | --primary-color: #4AB76C; 3 | } 4 | 5 | .navbar { 6 | background-color: var(--primary-color) !important; 7 | } 8 | 9 | 10 | #navbar > ul.navbar-nav > li.nav-item > a { 11 | color: rgba(255, 255, 255, 0.55); 12 | } 13 | 14 | .navbar-dark .navbar-nav .active > .nav-link { 15 | background-color: var(--primary-color) !important; 16 | color: #fff !important; 17 | } 18 | 19 | .navbar-brand { 20 | color: #fff !important; 21 | } 22 | 23 | #navbar > ul.navbar-nav > li.nav-item a:hover { 24 | background-color: var(--primary-color) !important; 25 | } 26 | 27 | .navbar-dark input[type="search"] { 28 | background-color: #fff !important; 29 | color: #444 !important; 30 | } 31 | 32 | nav .text-muted { 33 | color: #d8d8d8 !important; 34 | } 35 | 36 | a { 37 | color: var(--primary-color); 38 | } 39 | 40 | a:hover { 41 | color: #2c2b2b; 42 | } 43 | 44 | button.btn.btn-primary.btn-copy-ex { 45 | background-color: var(--primary-color); 46 | border-color: var(--primary-color); 47 | } 48 | 49 | .home { 50 | left: 0px; 51 | position: absolute; 52 | padding: 8px 30px; 53 | color: rgba(255,255,255,0.55); 54 | } 55 | 56 | .home:hover { 57 | color: rgba(255,255,255,0.9); 58 | } 59 | -------------------------------------------------------------------------------- /man/value_box_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/value_box.R 3 | \name{value_box_output} 4 | \alias{value_box_output} 5 | \alias{valueBoxOutput} 6 | \alias{infoBoxOutput} 7 | \title{Create a value box output.} 8 | \usage{ 9 | value_box_output(outputId, width = 5) 10 | 11 | valueBoxOutput(outputId, width = 5) 12 | 13 | infoBoxOutput(outputId, width = 5) 14 | } 15 | \arguments{ 16 | \item{outputId}{Id of the output.} 17 | 18 | \item{width}{Width of the valueBox.} 19 | } 20 | \value{ 21 | A value box that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 22 | } 23 | \description{ 24 | UI-side function for dynamic valueBox. 25 | } 26 | \section{Functions}{ 27 | \itemize{ 28 | \item \code{valueBoxOutput()}: Create a valueBox output (alias for \code{value_box_output}) 29 | 30 | \item \code{infoBoxOutput()}: Create a valueBox output (alias for \code{value_box_output}) 31 | 32 | }} 33 | \examples{ 34 | \dontrun{ 35 | valueBoxOutput("value_box") 36 | 37 | output$value_box <- renderValueBox({ 38 | valueBox( 39 | value = 33.45, 40 | subtitle = "Simple valuebox", 41 | icon = icon("bar chart"), 42 | color = "purple", 43 | width = 5) 44 | }) 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /man/dropdown_menu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropdown_menu.R 3 | \name{dropdown_menu} 4 | \alias{dropdown_menu} 5 | \alias{dropdownMenu} 6 | \title{Create a dropdown menu.} 7 | \usage{ 8 | dropdown_menu(..., type = "messages", icon = NULL, show_counter = TRUE) 9 | 10 | dropdownMenu(..., type = "messages", icon = NULL, show_counter = TRUE) 11 | } 12 | \arguments{ 13 | \item{...}{UI elements to include within the dropdown menu.} 14 | 15 | \item{type}{Type of the displayed items.} 16 | 17 | \item{icon}{Icon of the dropdown menu. If not specified created based on \code{type} argument.} 18 | 19 | \item{show_counter}{If true circular label with counter is going to be shown for dropdown.} 20 | } 21 | \value{ 22 | A dropdown menu that can be passed to \code{\link[semantic.dashboard]{dashboardHeader}} 23 | } 24 | \description{ 25 | Create a dropdown menu with additional UI elements. 26 | } 27 | \section{Functions}{ 28 | \itemize{ 29 | \item \code{dropdownMenu()}: Create a dropdown menu (alias for \code{dropdown_menu} for 30 | compatibility with \code{shinydashboard}) 31 | 32 | }} 33 | \examples{ 34 | dropdownMenu(icon = icon("warning sign"), taskItem("Project progress...", 50.777, color = "red")) 35 | dropdownMenu(type = "notifications", notificationItem("This is notification!", color = "red")) 36 | } 37 | -------------------------------------------------------------------------------- /styles/layout/_title.scss: -------------------------------------------------------------------------------- 1 | .ui.menu.dashboard-title { 2 | display: flex; 3 | justify-content: center; 4 | align-items: center; 5 | box-shadow: none; 6 | border-left-width: 0; 7 | border-top-width: 0; 8 | border-bottom-width: 0; 9 | border-top-right-radius: 0; 10 | border-bottom-right-radius: 0; 11 | background: transparent; 12 | } 13 | 14 | @each $size, $width in $sizes { 15 | .dashboard-title#{generate-size-selector($size)} { 16 | width: #{$width}px; 17 | } 18 | 19 | // Hack necessary to align title right border and sidebar right border. 20 | // For some reason they are not in line eve thoug DevTools shows same widths 21 | body.no-margin .dashboard-title#{generate-size-selector($size)} { 22 | width: calc(#{$width}px - 1px); 23 | } 24 | } 25 | 26 | /*-------------- 27 | Colors 28 | -------------- */ 29 | 30 | .ui.dashboard-title { 31 | background-color: rgba(255, 255, 255, 0.9); 32 | color: rgba(0, 0, 0, 0.87); 33 | } 34 | 35 | .ui.inverted.dashboard-title { 36 | color: rgba(255, 255, 255, 0.9); 37 | } 38 | 39 | .ui.inverted.dashboard-title { 40 | background-color: #1B1C1D; 41 | } 42 | 43 | // Might be unnecessary. Investigation needed when themes are fixed. 44 | @each $color, $hash in $colors-map { 45 | .ui.inverted.#{$color}.dashboard-title { 46 | background-color: $hash; 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /man/render_dropdown_menu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dropdown_menu_output.R 3 | \name{render_dropdown_menu} 4 | \alias{render_dropdown_menu} 5 | \alias{renderDropdownMenu} 6 | \title{Create a dropdown menu output.} 7 | \usage{ 8 | render_dropdown_menu(expr, env = parent.frame(), quoted = FALSE) 9 | 10 | renderDropdownMenu(expr, env = parent.frame(), quoted = FALSE) 11 | } 12 | \arguments{ 13 | \item{expr}{dropdownMenu.} 14 | 15 | \item{env}{The environment in which to evaluate expr.} 16 | 17 | \item{quoted}{Is expr a quoted expression (with \code{quote()})? This is useful if you want to 18 | save an expression in a variable.} 19 | } 20 | \value{ 21 | A dynamic dropdown menu that can be assigned to output. 22 | } 23 | \description{ 24 | Server-side function for dynamic dropdownMenu. 25 | } 26 | \section{Functions}{ 27 | \itemize{ 28 | \item \code{renderDropdownMenu()}: Create a dropdown menu output (alias for \code{render_dropdown 29 | menu} for compatibility with \code{shinydashboard}) 30 | 31 | }} 32 | \examples{ 33 | \dontrun{ 34 | dropdownMenuOutput("dropdown") 35 | 36 | output$dropdown <- renderDropdownMenu({ 37 | dropdownMenu(messageItem("Michał", "Test message", color = "teal"), 38 | messageItem("Marek", "Another test!", icon = "warning", color = "red")) 39 | }) 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | context("utils") 2 | 3 | library(shiny) 4 | 5 | test_that("verify_value_allowed shows warning when value not in allowed", { 6 | checked_value <- "wrong_value" 7 | allowed_values <- c("good_value1", "good_value2") 8 | expect_warning(semantic.dashboard:::verify_value_allowed("checked_value", allowed_values)) 9 | }) 10 | 11 | test_that("verify_value_allowed does not show warning when value not in allowed", { 12 | checked_value <- "good_value" 13 | allowed_values <- c("another_good_value", checked_value) 14 | expect_silent(semantic.dashboard:::verify_value_allowed("checked_value", allowed_values)) 15 | }) 16 | 17 | test_that("test get_inverted_class", { 18 | expect_equal(get_inverted_class(TRUE), "inverted") 19 | expect_equal(get_inverted_class(FALSE), "") 20 | }) 21 | 22 | test_that("test interlace_dividers", { 23 | list_divs_with_dividers <- interlace_dividers(tagList(div("a"), div("b"))) 24 | expect_length(list_divs_with_dividers, 3) 25 | }) 26 | 27 | test_that("test random_id_generator", { 28 | id1 <- random_id_generator() 29 | id2 <- random_id_generator() 30 | expect_false(id1 == id2) 31 | expect_true(nchar(random_id_generator(id_length = 3)) == 3) 32 | }) 33 | 34 | test_that("validate_session_object", { 35 | session <- character(1) 36 | expect_error(validate_session_object(session)) 37 | }) 38 | -------------------------------------------------------------------------------- /examples/minimal/app_header_elements.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(semantic.dashboard) 3 | 4 | ui <- dashboardPage(margin = TRUE, 5 | dashboardHeader(title = "Sample app", 6 | titleWidth = "thin", 7 | logo_path = "https://avatars0.githubusercontent.com/u/6096772", 8 | logo_align = "center", 9 | show_menu_button = FALSE, 10 | left = tagList(h4("Header test", style="margin-left: 5px"), shiny::icon("check-circle")), 11 | center = h3("Appsilon"), 12 | right = h5(Sys.time(), style="margin-right: 5px"), 13 | dropdownMenu(type = "notifications", 14 | taskItem("Project progress...", 50.777, color = "red")), 15 | dropdownMenu(icon = icon("red warning sign"), 16 | notificationItem("This is an important notification!", color = "red"))), 17 | 18 | dashboardSidebar(side = "left", size = "thin", color = "teal", 19 | sidebarMenu( 20 | menuItem(tabName = "tab1", "Tab 1"), 21 | menuItem(tabName = "tab2", "Tab 2"))), 22 | 23 | dashboardBody(tabItems( 24 | tabItem(tabName = "tab1", p("Tab 1")), 25 | tabItem(tabName = "tab2", p("Tab 2")))) 26 | ) 27 | 28 | 29 | server <- function(input, output) { 30 | } 31 | 32 | shinyApp(ui, server) 33 | -------------------------------------------------------------------------------- /man/update_tab_items.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/menu_item.R 3 | \name{update_tab_items} 4 | \alias{update_tab_items} 5 | \alias{updateTabItems} 6 | \title{Change the selected tab on the client} 7 | \usage{ 8 | update_tab_items(session = shiny::getDefaultReactiveDomain(), tab) 9 | 10 | updateTabItems(session = shiny::getDefaultReactiveDomain(), tab) 11 | } 12 | \arguments{ 13 | \item{session}{The session object passed to function given to shinyServer} 14 | 15 | \item{tab}{The name of the tab that should be selected} 16 | } 17 | \description{ 18 | Change the selected tab on the client 19 | } 20 | \section{Functions}{ 21 | \itemize{ 22 | \item \code{updateTabItems()}: Change the selected item on the client (alias for 23 | \code{update_tab_items} for compatibility with \code{shinydashboard}) 24 | 25 | }} 26 | \examples{ 27 | if (interactive()) { 28 | ui <- dashboardPage( 29 | dashboardSidebar( 30 | sidebarMenu( 31 | menuItem("Tab 1", tabName = "tab1"), 32 | menuItem("Tab 2", tabName = "tab2") 33 | ) 34 | ), 35 | dashboardBody( 36 | tabItems( 37 | tabItem(tabName = "tab1", h2("Tab 1")), 38 | tabItem(tabName = "tab2", h2("Tab 2")) 39 | ) 40 | ) 41 | ) 42 | 43 | server <- function(input, output, session) { 44 | update_tab_items(tab = "tab2") 45 | } 46 | 47 | shinyApp(ui, server) 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /man/render_value_box.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/value_box.R 3 | \name{render_value_box} 4 | \alias{render_value_box} 5 | \alias{renderValueBox} 6 | \alias{renderInfoBox} 7 | \title{Create a value box output.} 8 | \usage{ 9 | render_value_box(expr, env = parent.frame(), quoted = FALSE) 10 | 11 | renderValueBox(expr, env = parent.frame(), quoted = FALSE) 12 | 13 | renderInfoBox(expr, env = parent.frame(), quoted = FALSE) 14 | } 15 | \arguments{ 16 | \item{expr}{ValueBox.} 17 | 18 | \item{env}{The environment in which to evaluate expr.} 19 | 20 | \item{quoted}{Is expr a quoted expression (with \code{quote()})? 21 | This is useful if you want to save an expression in a variable.} 22 | } 23 | \value{ 24 | A dynamic valueBox that can be assigned to output. 25 | } 26 | \description{ 27 | Server-side function for dynamic valueBox. 28 | } 29 | \section{Functions}{ 30 | \itemize{ 31 | \item \code{renderValueBox()}: Create a value box output (alias for \code{render_value_box}) 32 | 33 | \item \code{renderInfoBox()}: Create a value box output (alias for \code{render_value_box}) 34 | 35 | }} 36 | \examples{ 37 | \dontrun{ 38 | valueBoxOutput("value_box") 39 | 40 | output$value_box <- renderValueBox({ 41 | valueBox( 42 | value = 33.45, 43 | subtitle = "Simple valuebox", 44 | icon = icon("bar chart"), 45 | color = "purple", 46 | width = 5) 47 | }) 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /development/common_args.R: -------------------------------------------------------------------------------- 1 | library(shinydashboard) 2 | library(shiny.semantic) 3 | library(tidyverse) 4 | library(knitr) 5 | library(kableExtra) 6 | 7 | # Arguments comparison between functions from shinydashboard and semantic.dashboard 8 | 9 | common_functions <- intersect(ls("package:shinydashboard"), ls("package:semantic.dashboard")) 10 | common_functions %>% map(~ { 11 | shiny <- names(formals(get(.x, envir = as.environment("package:shinydashboard")))) 12 | semantic <- names(formals(get(.x, envir = as.environment("package:semantic.dashboard")))) 13 | common <- intersect(shiny, semantic) 14 | only_shiny <- setdiff(shiny, semantic) 15 | only_semantic <- setdiff(semantic, shiny) 16 | tibble("function" = .x, 17 | "common arguments" = paste(common, collapse = ", "), 18 | "only in shinydashboard" = paste(only_shiny, collapse = ", "), 19 | "only in semantic.dashboard" = paste(only_semantic, collapse = ", ")) 20 | }) %>% do.call(rbind, .) -> arg_compare 21 | 22 | kable(arg_compare, "html") %>% 23 | kable_styling(full_width = F) %>% 24 | column_spec(1, bold = T, border_right = T) %>% 25 | column_spec(2, width = "30em") %>% 26 | column_spec(3, width = "30em") %>% 27 | column_spec(4, width = "30em") %>% 28 | row_spec(which(arg_compare[,4]!=""), bold = T, color = "white", background = "#D7261E") %>% 29 | row_spec(which(arg_compare[,4]==""), bold = T, color = "white", background = "#D7261E") 30 | -------------------------------------------------------------------------------- /man/value_box.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/value_box.R 3 | \name{value_box} 4 | \alias{value_box} 5 | \alias{valueBox} 6 | \alias{infoBox} 7 | \title{Create a valueBox.} 8 | \usage{ 9 | value_box(subtitle, value, icon = NULL, color = "blue", width = 5, size = "") 10 | 11 | valueBox(subtitle, value, icon = NULL, color = "blue", width = 5, size = "") 12 | 13 | infoBox(subtitle, value, icon = NULL, color = "blue", width = 5, size = "") 14 | } 15 | \arguments{ 16 | \item{subtitle}{Label of the valueBox.} 17 | 18 | \item{value}{Value of the valueBox.} 19 | 20 | \item{icon}{Icon of the valueBox.} 21 | 22 | \item{color}{Color of the valueBox. One of \code{c("", "red", "orange", "yellow", 23 | "olive", "green", "teal", "blue", "violet", "purple", "pink", "brown", "grey", "black")}} 24 | 25 | \item{width}{Width of the valueBox.} 26 | 27 | \item{size}{Size of value. One of \code{c("mini", "tiny", "small", "", "large", "huge")}. 28 | Default is "".} 29 | } 30 | \value{ 31 | A valueBox that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 32 | } 33 | \description{ 34 | Create a valueBox with additional UI elements. 35 | } 36 | \section{Functions}{ 37 | \itemize{ 38 | \item \code{valueBox()}: Create a valueBox (alias for \code{value_box}) 39 | 40 | \item \code{infoBox()}: Create a valueBox (alias for \code{value_box}) 41 | 42 | }} 43 | \examples{ 44 | valueBox("Unread Mail", 44, icon("mail"), color = "blue", width = 5, size = "tiny") 45 | } 46 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(box) 4 | export(column) 5 | export(dashboardBody) 6 | export(dashboardHeader) 7 | export(dashboardPage) 8 | export(dashboardSidebar) 9 | export(dashboard_body) 10 | export(dashboard_header) 11 | export(dashboard_page) 12 | export(dashboard_sidebar) 13 | export(dropdownMenu) 14 | export(dropdownMenuOutput) 15 | export(dropdown_menu) 16 | export(dropdown_menu_output) 17 | export(icon) 18 | export(infoBox) 19 | export(infoBoxOutput) 20 | export(light_semantic_palette) 21 | export(menuItem) 22 | export(menuItemOutput) 23 | export(menuSubItem) 24 | export(menu_item) 25 | export(menu_item_output) 26 | export(messageItem) 27 | export(message_item) 28 | export(notificationItem) 29 | export(notification_item) 30 | export(renderDropdownMenu) 31 | export(renderInfoBox) 32 | export(renderMenu) 33 | export(renderValueBox) 34 | export(render_dropdown_menu) 35 | export(render_menu) 36 | export(render_value_box) 37 | export(semantic_palette) 38 | export(sidebarMenu) 39 | export(sidebarMenuOutput) 40 | export(sidebarUserPanel) 41 | export(sidebar_menu) 42 | export(sidebar_menu_output) 43 | export(sidebar_user_panel) 44 | export(tabBox) 45 | export(tabItem) 46 | export(tabItems) 47 | export(tab_box) 48 | export(tab_item) 49 | export(tab_items) 50 | export(taskItem) 51 | export(task_item) 52 | export(updateTabItems) 53 | export(update_tab_items) 54 | export(valueBox) 55 | export(valueBoxOutput) 56 | export(value_box) 57 | export(value_box_output) 58 | import(checkmate) 59 | import(glue) 60 | import(htmltools) 61 | -------------------------------------------------------------------------------- /examples/bus/metrotransit-data/00-fetch-data.R: -------------------------------------------------------------------------------- 1 | # Information about data source at: 2 | # http://datafinder.org/metadata/transit_schedule_google_feed.html 3 | 4 | # Data reference: 5 | # https://developers.google.com/transit/gtfs/reference?csw=1 6 | 7 | # These are the data files we want to use 8 | datafiles <- c("shapes.txt", "trips.txt") 9 | 10 | # ============================================================================= 11 | # Download and unzip data 12 | # ============================================================================= 13 | download.file("ftp://gisftp.metc.state.mn.us/google_transit.zip", 14 | "google_transit.zip") 15 | 16 | dir.create("raw", showWarnings = FALSE) 17 | 18 | # Extract just the specified data files 19 | unzip("google_transit.zip", files = datafiles, exdir = "raw") 20 | unlink("google_transit.zip") 21 | 22 | # ============================================================================= 23 | # Read in each of the data objects and save to an RDS file 24 | # ============================================================================= 25 | # Clean out old files 26 | unlink("rds", recursive = TRUE) 27 | 28 | dir.create("rds", showWarnings = FALSE) 29 | 30 | for (datafile in datafiles) { 31 | infile <- file.path("raw", datafile) 32 | outfile <- file.path("rds", sub("\\.txt$", ".rds", datafile)) 33 | 34 | cat("Converting ", infile, " to ", outfile, ".\n", sep = "") 35 | 36 | obj <- read.csv(infile, stringsAsFactors = FALSE) 37 | saveRDS(obj, outfile) 38 | } 39 | 40 | # Remove raw data files 41 | unlink("raw", recursive = TRUE) 42 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # Verify that given variable is in the list of allowed values. 2 | verify_value_allowed <- function(variable, values) { 3 | var <- get(variable, envir = parent.frame()) 4 | if (!(var %in% values)) { 5 | warning(paste(paste0("'", variable, "'"), 6 | "argument should be one of:", 7 | paste0("'", values, "'", collapse = ", "))) 8 | } 9 | } 10 | 11 | # Changes logical inverted value to CSS class string. 12 | get_inverted_class <- function(inverted) { 13 | ifelse(inverted, "inverted", "") 14 | } 15 | 16 | # Interlace elements with dividers between each pair of elements. 17 | interlace_dividers <- function(elements) { 18 | dividers <- lapply(seq_along(elements), function(i) shiny::tags$div(class = "divider")) 19 | utils::head(c(rbind(elements, dividers)), -1) # Skips last divider with head. 20 | } 21 | 22 | # Random ID generator 23 | random_id_generator <- function(values = 0:9, id_length = 30) { 24 | paste0(sample(values, id_length, TRUE), collapse = "") 25 | } 26 | 27 | # Check that an object is a ShinySession object, and give an informative error. 28 | # The default label is the caller function's name. 29 | validate_session_object <- function(session, label = as.character(sys.call(sys.parent())[[1]])) { 30 | if (missing(session) || 31 | !inherits(session, c("ShinySession", "MockShinySession", "session_proxy"))) { 32 | stop(call. = FALSE, 33 | sprintf( 34 | "`session` must be a 'ShinySession' object. Did you forget to pass `session` to `%s()`?", 35 | label 36 | ) 37 | ) 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /man/dashboard_body.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_dashboard.R 3 | \name{dashboard_body} 4 | \alias{dashboard_body} 5 | \alias{dashboardBody} 6 | \title{Create a body of a dashboard.} 7 | \usage{ 8 | dashboard_body(..., class = "") 9 | 10 | dashboardBody(..., class = "") 11 | } 12 | \arguments{ 13 | \item{...}{UI elements to include within the body.} 14 | 15 | \item{class}{CSS class to be applied to the container of \code{dashboardBody}. Note it's not the 16 | \code{} tag.} 17 | } 18 | \value{ 19 | A tab that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 20 | } 21 | \description{ 22 | Create a body of a dashboard with tabs and other additional UI elements. 23 | } 24 | \section{Functions}{ 25 | \itemize{ 26 | \item \code{dashboardBody()}: Create a body of a dashboard (alias for \code{dashboard_body} for 27 | compatibility with \code{shinydashboard}) 28 | 29 | }} 30 | \examples{ 31 | if(interactive()){ 32 | 33 | library(shiny) 34 | library(semantic.dashboard) 35 | 36 | ui <- dashboardPage( 37 | dashboardHeader(color = "blue"), 38 | dashboardSidebar(side = "left", size = "thin", color = "teal", 39 | sidebarMenu( 40 | menuItem(tabName = "tab1", "Tab 1"), 41 | menuItem(tabName = "tab2", "Tab 2"))), 42 | dashboardBody(tabItems( 43 | tabItem(tabName = "tab1", p("Tab 1")), 44 | tabItem(tabName = "tab2", p("Tab 2")))) 45 | ) 46 | 47 | server <- function(input, output) { 48 | } 49 | 50 | shinyApp(ui, server) 51 | } 52 | } 53 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | on: push 2 | 3 | name: R-CMD-check 4 | 5 | jobs: 6 | main: 7 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 8 | 9 | runs-on: ${{ matrix.config.os }} 10 | 11 | timeout-minutes: 30 12 | 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | config: 17 | - {os: macOS-latest, r: 'release'} 18 | - {os: windows-latest, r: 'release'} 19 | - {os: ubuntu-22.04, r: 'devel'} 20 | - {os: ubuntu-22.04, r: 'release'} 21 | - {os: ubuntu-22.04, r: 'oldrel'} 22 | 23 | steps: 24 | - name: Checkout repository 25 | uses: actions/checkout@v2 26 | 27 | - name: Install R 28 | uses: r-lib/actions/setup-r@v2 29 | with: 30 | r-version: ${{ matrix.config.r }} 31 | 32 | - name: Install R package dependencies 33 | uses: r-lib/actions/setup-r-dependencies@v2 34 | with: 35 | extra-packages: local::. # Necessary to avoid object usage linter errors. 36 | 37 | - name: R CMD check 38 | if: always() 39 | uses: r-lib/actions/check-r-package@v2 40 | with: 41 | error-on: '"note"' 42 | 43 | - name: Lint 44 | if: always() 45 | shell: Rscript {0} 46 | run: | 47 | lints <- lintr::lint_package() 48 | for (lint in lints) print(lint) 49 | quit(status = length(lints) > 0) 50 | - name: Test coverage 51 | if: matrix.config.os == 'ubuntu-22.04' && matrix.config.r == 'release' 52 | run: | 53 | Rscript -e 'covr::codecov(token = "${{secrets.CODECOV_TOKEN}}")' 54 | -------------------------------------------------------------------------------- /R/tab.R: -------------------------------------------------------------------------------- 1 | #' Create a tab 2 | #' 3 | #' Create a tab panel with additional UI elements. 4 | #' 5 | #' @param tabName Id of the tab. 6 | #' @param fluid Controls whether tab width should be 100\% (TRUE) or limited by Foomantic UI 7 | #' breakpoints (FALSE). 8 | #' @param ... UI elements to include within the tab. 9 | #' @return A tab that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 10 | #' @export 11 | #' @examples 12 | #' tab_item(tabName = "tab1", "Tab 1") 13 | tab_item <- function(tabName, ..., fluid = TRUE) { 14 | data_tab <- paste0("shiny-tab-", tabName) 15 | shiny::div(role = "tabpanel", style = "height: 100%;", 16 | class = paste("ui", "tab tab-pane container", ifelse(fluid, "fluid", "")), 17 | id = data_tab, `data-tab` = data_tab, shiny::tags$div(class = "ui padded grid", ...)) 18 | } 19 | 20 | #' @describeIn tab_item Create a tab (alias for \code{tab_item} for compatibility with 21 | #' \code{shinydashboard}) 22 | #' @export 23 | tabItem <- tab_item 24 | 25 | #' Create a panel with tabs. 26 | #' @description Create a panel with tabs. 27 | #' @param ... Tabs. 28 | #' @return A panel with tabs that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 29 | #' @export 30 | #' @examples 31 | #' tabItems( 32 | #' tabItem(tabName = "tab1", "Tab 1"), 33 | #' tabItem(tabName = "tab2", "Tab 2")) 34 | tab_items <- function(...) { 35 | shiny::tags$div(class = "tab-content", list(...)) 36 | } 37 | 38 | #' @describeIn tab_items Create a panel with tabs (alias for \code{tab_items} for compatibility 39 | #' with \code{shinydashboard}) 40 | #' @export 41 | tabItems <- tab_items 42 | -------------------------------------------------------------------------------- /man/box.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/box.R 3 | \name{box} 4 | \alias{box} 5 | \title{Create a box.} 6 | \usage{ 7 | box( 8 | ..., 9 | title = NULL, 10 | color = "", 11 | ribbon = TRUE, 12 | title_side = "top right", 13 | collapsible = TRUE, 14 | width = 8, 15 | id = NULL, 16 | collapse_icon = "minus", 17 | expand_icon = "plus" 18 | ) 19 | } 20 | \arguments{ 21 | \item{...}{UI elements to include within the box.} 22 | 23 | \item{title}{Label of the box.} 24 | 25 | \item{color}{Color of the box. One of \code{c("", "red", "orange", "yellow", 26 | "olive", "green", "teal", "blue", "violet", "purple", "pink", "brown", "grey", "black")}} 27 | 28 | \item{ribbon}{Should label be presented as ribbon.} 29 | 30 | \item{title_side}{Side of a label. One of \code{c("top", "bottom", "top left", 31 | "top right", "bottom left", "bottom right")} if \code{ribbon = FALSE}, or one of 32 | \code{c("top left", "top right")} if \code{ribbon = TRUE}} 33 | 34 | \item{collapsible}{Should minimize button be added to label.} 35 | 36 | \item{width}{Width of the box.} 37 | 38 | \item{id}{ID of the box.} 39 | 40 | \item{collapse_icon}{Icon class to be used for collapsing (when \code{collapsible = TRUE}).} 41 | 42 | \item{expand_icon}{Icon class to be used for expanding (when \code{collapsible = TRUE}).} 43 | } 44 | \value{ 45 | A box that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 46 | } 47 | \description{ 48 | Create a box with additional UI elements. 49 | } 50 | \examples{ 51 | box(title = "Sample box", color = "blue", width = 11, 52 | "This is a box content" 53 | ) 54 | } 55 | -------------------------------------------------------------------------------- /srcjs/sidebar.js: -------------------------------------------------------------------------------- 1 | /* 2 | SIDEBAR 3 | */ 4 | const initialize_sidebar = (closable, pushable, overlay, dimPage) => { 5 | transitionLeftRight = overlay ? 'overlay' : 'uncover'; 6 | $(document).on('shiny:sessioninitialized', function(event) { 7 | $('.ui.sidebar') 8 | .sidebar({ 9 | context: $('.bottom.segment'), 10 | closable, 11 | dimPage, 12 | defaultTransition: { 13 | computer: { 14 | left : transitionLeftRight, 15 | right : transitionLeftRight, 16 | top : 'overlay', 17 | bottom : 'overlay' 18 | }, 19 | mobile: { 20 | left : transitionLeftRight, 21 | right : transitionLeftRight, 22 | top : 'overlay', 23 | bottom : 'overlay' 24 | } 25 | } 26 | }) 27 | 28 | $('#toggle_menu').click(function() { 29 | $(window).resize(); 30 | }) 31 | 32 | if(pushable) { 33 | $('.ui.sidebar').sidebar('attach events', '#toggle_menu'); 34 | } 35 | 36 | /* Code below is needed to trigger visibility on reactive Shiny outputs. */ 37 | /* Thanks to that users do not have to set suspendWhenHidden to FALSE. */ 38 | let previous_tab; 39 | $(`#uisidebar .item`).tab({ 40 | onVisible: function(target) { 41 | if (previous_tab) { 42 | $(this).trigger('hidden'); 43 | } 44 | $(window).resize(); 45 | $(this).trigger('shown'); 46 | previous_tab = this; 47 | prefix = "shiny-tab-" 48 | Shiny.setInputValue("uisidebar", this.id.substring(prefix.length), {priority: "event"}); 49 | } 50 | }); 51 | }); 52 | } 53 | -------------------------------------------------------------------------------- /inst/semantic.dashboard.js: -------------------------------------------------------------------------------- 1 | /* 2 | SIDEBAR 3 | */ 4 | const initialize_sidebar = (closable, pushable, overlay, dimPage) => { 5 | transitionLeftRight = overlay ? 'overlay' : 'uncover'; 6 | $(document).on('shiny:sessioninitialized', function(event) { 7 | $('.ui.sidebar') 8 | .sidebar({ 9 | context: $('.bottom.segment'), 10 | closable, 11 | dimPage, 12 | defaultTransition: { 13 | computer: { 14 | left : transitionLeftRight, 15 | right : transitionLeftRight, 16 | top : 'overlay', 17 | bottom : 'overlay' 18 | }, 19 | mobile: { 20 | left : transitionLeftRight, 21 | right : transitionLeftRight, 22 | top : 'overlay', 23 | bottom : 'overlay' 24 | } 25 | } 26 | }) 27 | 28 | $('#toggle_menu').click(function() { 29 | $(window).resize(); 30 | }) 31 | 32 | if(pushable) { 33 | $('.ui.sidebar').sidebar('attach events', '#toggle_menu'); 34 | } 35 | 36 | /* Code below is needed to trigger visibility on reactive Shiny outputs. */ 37 | /* Thanks to that users do not have to set suspendWhenHidden to FALSE. */ 38 | let previous_tab; 39 | $(`#uisidebar .item`).tab({ 40 | onVisible: function(target) { 41 | if (previous_tab) { 42 | $(this).trigger('hidden'); 43 | } 44 | $(window).resize(); 45 | $(this).trigger('shown'); 46 | previous_tab = this; 47 | prefix = "shiny-tab-" 48 | Shiny.setInputValue("uisidebar", this.id.substring(prefix.length), {priority: "event"}); 49 | } 50 | }); 51 | }); 52 | } 53 | -------------------------------------------------------------------------------- /man/menu_item.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/menu_item.R 3 | \name{menu_item} 4 | \alias{menu_item} 5 | \alias{menuItem} 6 | \alias{menuSubItem} 7 | \title{Create a menu item.} 8 | \usage{ 9 | menu_item( 10 | text, 11 | ..., 12 | icon = NULL, 13 | tabName = NULL, 14 | href = NULL, 15 | newtab = TRUE, 16 | selected = FALSE 17 | ) 18 | 19 | menuItem( 20 | text, 21 | ..., 22 | icon = NULL, 23 | tabName = NULL, 24 | href = NULL, 25 | newtab = TRUE, 26 | selected = FALSE 27 | ) 28 | 29 | menuSubItem( 30 | text, 31 | ..., 32 | icon = NULL, 33 | tabName = NULL, 34 | href = NULL, 35 | newtab = TRUE, 36 | selected = FALSE 37 | ) 38 | } 39 | \arguments{ 40 | \item{text}{Text to show for the menu item.} 41 | 42 | \item{...}{This may consist of menuSubItems.} 43 | 44 | \item{icon}{Icon of the menu item. (Optional)} 45 | 46 | \item{tabName}{Id of the tab. Not compatible with href.} 47 | 48 | \item{href}{A link address. Not compatible with tabName.} 49 | 50 | \item{newtab}{If href is supplied, should the link open in a new browser tab?} 51 | 52 | \item{selected}{If TRUE, this menuItem will start selected.} 53 | } 54 | \value{ 55 | A menu item that can be passed \code{\link[semantic.dashboard]{sidebarMenu}} 56 | } 57 | \description{ 58 | Create a menu item corresponding to a tab. 59 | } 60 | \section{Functions}{ 61 | \itemize{ 62 | \item \code{menuItem()}: Create a menu item (alias for \code{menu_item} for compatibility with 63 | \code{shinydashboard}) 64 | 65 | \item \code{menuSubItem()}: Create a menu item (alias for \code{menu_item} for compatibility with 66 | \code{shinydashboard}) 67 | 68 | }} 69 | \examples{ 70 | menuItem(tabName = "plot_tab", text = "My plot", icon = icon("home")) 71 | } 72 | -------------------------------------------------------------------------------- /R/tab_box.R: -------------------------------------------------------------------------------- 1 | #' Create a tab box. 2 | #' @description Create a tab box with additional UI elements. 3 | #' @param tabs Tabs to include within the box. 4 | #' @param title Label of the box. 5 | #' @param color Color of the box. One of \code{c("", "red", "orange", "yellow", 6 | #' "olive", "green", "teal", "blue", "violet", "purple", "pink", "brown", "grey", "black")} 7 | #' @param ribbon Should label be presented as ribbon. 8 | #' @param title_side Side of a label. One of \code{c("top", "bottom", "top left", 9 | #' "top right", "bottom left", "bottom right")} if \code{ribbon = FALSE}, or one of 10 | #' \code{c("top left", "top right")} if \code{ribbon = TRUE} 11 | #' @param collapsible Should minimize button be added to label. 12 | #' @param width Width of the box. 13 | #' @param id ID of the box. 14 | #' @param ... other elements of the box. 15 | #' @return A box that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 16 | #' @export 17 | #' @examples 18 | #' tabBox(title = "Sample tab box", color = "blue", width = 5, 19 | #' tabs = list( 20 | #' list(menu = "First Tab", content = "This is first tab"), 21 | #' list(menu = "Second Tab", content = "This is second tab") 22 | #' )) 23 | tab_box <- function(tabs, title = NULL, color = "", ribbon = TRUE, 24 | title_side = "top right", collapsible = TRUE, width = 8, id = NULL, ...) { 25 | box( 26 | shiny.semantic::tabset(tabs), 27 | title = title, 28 | color = color, 29 | ribbon = ribbon, 30 | title_side = title_side, 31 | collapsible = collapsible, 32 | width = width, 33 | id = id, 34 | ... 35 | ) 36 | } 37 | 38 | #' @describeIn tab_box Create a tab box (alias for \code{tab_box} for compatibility with 39 | #' \code{shinydashboard}) 40 | #' @export 41 | tabBox <- tab_box 42 | -------------------------------------------------------------------------------- /R/sidebar_menu_output.R: -------------------------------------------------------------------------------- 1 | #' Create a sidebar menu output. 2 | #' @description UI-side function for dynamic sidebarMenu. 3 | #' @param outputId Id of the output. 4 | #' @return A sidebar menu that can be passed to \code{\link[semantic.dashboard]{dashboardSidebar}} 5 | #' @export 6 | sidebar_menu_output <- function(outputId) { 7 | shiny::uiOutput(outputId) 8 | } 9 | 10 | #' @describeIn sidebar_menu_output Create a sidebar menu output (alias for \code{sidebar_menu 11 | #' output} for compatibility with \code{shinydashboard}) 12 | #' @export 13 | sidebarMenuOutput <- sidebar_menu_output 14 | 15 | #' Create a menu item output. 16 | #' @description UI-side function for dynamic manuItem. 17 | #' @param outputId Id of the output. 18 | #' @return A menu item that can be passed to \code{\link[semantic.dashboard]{sidebarMenu}} 19 | #' @export 20 | menu_item_output <- function(outputId) { 21 | shiny::uiOutput(outputId) 22 | } 23 | 24 | #' @describeIn menu_item_output Create a menu item output (alias for \code{menu_item_output} for 25 | #' compatibility with \code{shinydashboard}) 26 | #' @export 27 | menuItemOutput <- menu_item_output 28 | 29 | #' Create a menu output. 30 | #' @description Server-side function for dynamic sidebarMenu. 31 | #' @param expr menu. 32 | #' @param env The environment in which to evaluate expr. 33 | #' @param quoted Is expr a quoted expression (with \code{quote()})? This is useful if you want to 34 | #' save an expression in a variable. 35 | #' @return A dynamic menu that can be assigned to output. 36 | #' @export 37 | render_menu <- function(expr, env = parent.frame(), quoted = FALSE) { 38 | fun <- shiny::exprToFunction(expr, env, quoted) 39 | shiny::renderUI(fun()) 40 | } 41 | 42 | #' @describeIn render_menu Create a menu output (alias for \code{render_menu} for compatibility 43 | #' with \code{shinydashboard}) 44 | #' @export 45 | renderMenu <- render_menu 46 | -------------------------------------------------------------------------------- /examples/bus/ui.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(leaflet) 3 | library(semantic.dashboard) 4 | 5 | header <- dashboardHeader(color = "blue") 6 | 7 | body <- dashboardBody( 8 | fluidRow( 9 | column(width = 9, 10 | box( 11 | leafletOutput("busmap", height = 500) 12 | ), 13 | box( 14 | uiOutput("numVehiclesTable") 15 | ) 16 | ), 17 | column(width = 3, 18 | box(color = "blue", 19 | uiOutput("routeSelect"), 20 | checkboxGroupInput("directions", "Show", 21 | choices = c( 22 | Northbound = 4, 23 | Southbound = 1, 24 | Eastbound = 2, 25 | Westbound = 3 26 | ), 27 | selected = c(1, 2, 3, 4) 28 | ), 29 | p( 30 | class = "text-muted", 31 | paste("Note: a route number can have several different trips, each", 32 | "with a different path. Only the most commonly-used path will", 33 | "be displayed on the map." 34 | ) 35 | ), 36 | actionButton("zoomButton", "Zoom to fit buses") 37 | ), 38 | box(color = "blue", 39 | selectInput("interval", "Refresh interval", 40 | choices = c( 41 | "30 seconds" = 30, 42 | "1 minute" = 60, 43 | "2 minutes" = 120, 44 | "5 minutes" = 300, 45 | "10 minutes" = 600 46 | ), 47 | selected = "60" 48 | ), 49 | uiOutput("timeSinceLastUpdate"), 50 | actionButton("refresh", "Refresh now"), 51 | p(class = "text-muted", 52 | br(), 53 | "Source data updates every 30 seconds." 54 | ) 55 | ) 56 | ) 57 | ) 58 | ) 59 | 60 | dashboardPage(title = "Twin Cities Buses", 61 | header, 62 | dashboardSidebar(side = "left", size = "thin", visible = FALSE, disable = TRUE), 63 | body 64 | ) 65 | -------------------------------------------------------------------------------- /development/README.md: -------------------------------------------------------------------------------- 1 | # Contributing Guidelines of `semantic.dashboard` 2 | 3 | ## Modifying JS 4 | The library's JS file `semantic.dashboard.min.js` is an output of compilation, concatenation and minification of various JS files contained in the `srcjs` directory. The compilation is made with [gulp](https://gulpjs.com/). 5 | 6 | If you want to add some JS to the library, simply create or modify one of the files in the `srcjs` directory and then go to `tool` directory and run `gulp` command. 7 | 8 | Keep in mind that in order to run this command need to have gulp-cli (`npm i --global gulp-cli`) and the dependencies in `tools` directory (`npm i`) installed. 9 | 10 | After creating new gulp artifact, don't forget to commit both the output, as well as all source JS files. 11 | 12 | 13 | ## Modifying CSS 14 | This project uses [SASS](https://sass-lang.com/) to define styles. SASS files contained in the `styles` folder are compiled to CSS and minified. The output file is `semantic.dashboard.min.css`. Do not edit this file by hand. 15 | 16 | If you want to modify styles, modify (or create) appropriate `.scss` file and then run `styles/generate_css.R`. 17 | 18 | Don't forget to commit both `.scss` as well as `.css` files. 19 | 20 | ## Bumping the version 21 | When you're ready with your changes, bump the version in `DESCRIPTION` file by `0.0.1`. 22 | 23 | ## Updating the changelog 24 | Don't forget to summarize your changes in the `CHANGELOG.md`. 25 | 26 | 27 | ## Useful scripts 28 | The `development/dev.R` script is very useful when working on the library. It will automatically generate the CSS out of SASS, as well as bundle JS. Then it will run example app of your choice (`examples/app.R` by default). 29 | 30 | The script will always run the example app on port `5167` which is useful if you prefer to debug the frontend in your default browser. Go ahead and add a bookmark for `http://localhost:5167/` to quickly access the example app in Chrome. 31 | -------------------------------------------------------------------------------- /examples/crandash/bloomfilter.R: -------------------------------------------------------------------------------- 1 | library(digest) 2 | library(bit) 3 | 4 | rawToInt <- function(bytes) { 5 | Reduce(function(left, right) { 6 | bitwShiftL(left, 8) + right 7 | }, as.integer(bytes), 0L) 8 | } 9 | 10 | # Quick and dirty bloom filter. The hashing "functions" are based on choosing 11 | # random sets of bytes out of a single MD5 hash. Seems to work well for normal 12 | # values, but has not been extensively tested for weird situations like very 13 | # small n or very large p. 14 | BloomFilter <- setRefClass("BloomFilter", 15 | fields = list( 16 | .m = "integer", 17 | .bits = "ANY", 18 | .k = "integer", 19 | .bytesNeeded = "integer", 20 | .bytesToTake = "matrix" 21 | ), 22 | methods = list( 23 | # @param n - Set size 24 | # @param p - Desired false positive probability (e.g. 0.01 for 1%) 25 | initialize = function(n = 10000, p = 0.001) { 26 | m = (as.numeric(n) * log(1 / p)) / (log(2)^2) 27 | 28 | .m <<- as.integer(m) 29 | .bits <<- bit(.m) 30 | .k <<- max(1L, as.integer(round((as.numeric(.m)/n) * log(2)))) 31 | 32 | # This is how many *bytes* of data we need for *each* of the k indices we need to 33 | # generate 34 | .bytesNeeded <<- as.integer(ceiling(log2(.m) / 8)) 35 | .bytesToTake <<- sapply(rep_len(.bytesNeeded, .k), function(byteCount) { 36 | # 16 is number of bytes an md5 hash has 37 | sample.int(16, byteCount, replace = FALSE) 38 | }) 39 | }, 40 | .hash = function(x) { 41 | hash <- digest(x, "md5", serialize = FALSE, raw = TRUE) 42 | sapply(1:.k, function(i) { 43 | val <- rawToInt(hash[.bytesToTake[,i]]) 44 | # Scale down to fit into the desired range 45 | as.integer(val * (as.numeric(.m) / 2^(.bytesNeeded*8))) 46 | }) 47 | }, 48 | has = function(x) { 49 | all(.bits[.hash(x)]) 50 | }, 51 | set = function(x) { 52 | .bits[.hash(x)] <<- TRUE 53 | } 54 | ) 55 | ) 56 | -------------------------------------------------------------------------------- /man/tab_box.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tab_box.R 3 | \name{tab_box} 4 | \alias{tab_box} 5 | \alias{tabBox} 6 | \title{Create a tab box.} 7 | \usage{ 8 | tab_box( 9 | tabs, 10 | title = NULL, 11 | color = "", 12 | ribbon = TRUE, 13 | title_side = "top right", 14 | collapsible = TRUE, 15 | width = 8, 16 | id = NULL, 17 | ... 18 | ) 19 | 20 | tabBox( 21 | tabs, 22 | title = NULL, 23 | color = "", 24 | ribbon = TRUE, 25 | title_side = "top right", 26 | collapsible = TRUE, 27 | width = 8, 28 | id = NULL, 29 | ... 30 | ) 31 | } 32 | \arguments{ 33 | \item{tabs}{Tabs to include within the box.} 34 | 35 | \item{title}{Label of the box.} 36 | 37 | \item{color}{Color of the box. One of \code{c("", "red", "orange", "yellow", 38 | "olive", "green", "teal", "blue", "violet", "purple", "pink", "brown", "grey", "black")}} 39 | 40 | \item{ribbon}{Should label be presented as ribbon.} 41 | 42 | \item{title_side}{Side of a label. One of \code{c("top", "bottom", "top left", 43 | "top right", "bottom left", "bottom right")} if \code{ribbon = FALSE}, or one of 44 | \code{c("top left", "top right")} if \code{ribbon = TRUE}} 45 | 46 | \item{collapsible}{Should minimize button be added to label.} 47 | 48 | \item{width}{Width of the box.} 49 | 50 | \item{id}{ID of the box.} 51 | 52 | \item{...}{other elements of the box.} 53 | } 54 | \value{ 55 | A box that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 56 | } 57 | \description{ 58 | Create a tab box with additional UI elements. 59 | } 60 | \section{Functions}{ 61 | \itemize{ 62 | \item \code{tabBox()}: Create a tab box (alias for \code{tab_box} for compatibility with 63 | \code{shinydashboard}) 64 | 65 | }} 66 | \examples{ 67 | tabBox(title = "Sample tab box", color = "blue", width = 5, 68 | tabs = list( 69 | list(menu = "First Tab", content = "This is first tab"), 70 | list(menu = "Second Tab", content = "This is second tab") 71 | )) 72 | } 73 | -------------------------------------------------------------------------------- /R/dropdown_menu_output.R: -------------------------------------------------------------------------------- 1 | #' Create a dropdown menu output. 2 | #' @description UI-side function for dynamic dropdownMenu. 3 | #' @param outputId Id of the output. 4 | #' @return A dropdown menu that can be passed to \code{\link[semantic.dashboard]{dashboardHeader}} 5 | #' @export 6 | #' @examples 7 | #' \dontrun{ 8 | #' dropdownMenuOutput("dropdown") 9 | #' 10 | #' output$dropdown <- renderDropdownMenu({ 11 | #' dropdownMenu(messageItem("Michał", "Test message", color = "teal"), 12 | #' messageItem("Marek", "Another test!", icon = "warning", color = "red")) 13 | #' }) 14 | #' } 15 | dropdown_menu_output <- function(outputId) { 16 | shiny::uiOutput(outputId, class = "right icon menu") 17 | } 18 | 19 | #' @describeIn dropdown_menu_output Create a dropdown menu output (alias for \code{dropdown_menu 20 | #' output} for compatibility with \code{shinydashboard}) 21 | #' @export 22 | dropdownMenuOutput <- dropdown_menu_output 23 | 24 | #' Create a dropdown menu output. 25 | #' @description Server-side function for dynamic dropdownMenu. 26 | #' @param expr dropdownMenu. 27 | #' @param env The environment in which to evaluate expr. 28 | #' @param quoted Is expr a quoted expression (with \code{quote()})? This is useful if you want to 29 | #' save an expression in a variable. 30 | #' @return A dynamic dropdown menu that can be assigned to output. 31 | #' @export 32 | #' @examples 33 | #' \dontrun{ 34 | #' dropdownMenuOutput("dropdown") 35 | #' 36 | #' output$dropdown <- renderDropdownMenu({ 37 | #' dropdownMenu(messageItem("Michał", "Test message", color = "teal"), 38 | #' messageItem("Marek", "Another test!", icon = "warning", color = "red")) 39 | #' }) 40 | #' } 41 | render_dropdown_menu <- function(expr, env = parent.frame(), quoted = FALSE) { 42 | fun <- shiny::exprToFunction(expr, env, quoted) 43 | shiny::renderUI(fun()) 44 | } 45 | 46 | #' @describeIn render_dropdown_menu Create a dropdown menu output (alias for \code{render_dropdown 47 | #' menu} for compatibility with \code{shinydashboard}) 48 | #' @export 49 | renderDropdownMenu <- render_dropdown_menu 50 | -------------------------------------------------------------------------------- /R/constants.R: -------------------------------------------------------------------------------- 1 | ALLOWED_COLORS <- c( 2 | "", "red", "orange", "yellow", "olive", "green", "teal", 3 | "blue", "violet", "purple", "pink", "brown", "grey", "black" 4 | ) 5 | ALLOWED_SIDEBAR_SIZES <- c("", "thin", "very thin", "wide", "very wide") 6 | ALLOWED_SIDEBAR_SIDES <- c("left", "right", "top", "bottom") 7 | ALLOWED_VALUEBOX_SIZES <- c("mini", "tiny", "small", "", "large", "huge") 8 | ALLOWED_BOX_SIDES_NONRIBBON <- c( 9 | "top", "bottom", "top left", "top right", "bottom left", "bottom right" 10 | ) 11 | ALLOWED_BOX_SIDES_RIBBON <- c("top left", "top right") 12 | COLUMN_WIDTHS <- c( 13 | "", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", 14 | "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen" 15 | ) 16 | MIN_COLUMN_WIDTH <- 1 17 | MAX_COLUMN_WIDTH <- 16 18 | MIN_PROGRESS_VALUE <- 0 19 | MAX_PROGRESS_VALUE <- 100 20 | 21 | DROPDOWN_MENU_ICONS <- list(messages = "mail", notifications = "warning sign", tasks = "tasks") 22 | 23 | dropdown_menu_js <- "$('.ui.dropdown').dropdown();" 24 | 25 | progress_bar_js <- "$('.progress').progress();" 26 | 27 | #' Semantic colors 28 | #' https://github.com/Semantic-Org/Semantic-UI/blob/master/src/themes/default/globals/site.variables 29 | #' @export 30 | semantic_palette <- c( 31 | "#A333C8", "#21BA45", "#2185D0", "#DB2828", "#F2711C", "#FBBD08", "#B5CC18", 32 | "#00B5AD", "#6435C9", "#E03997", "#A5673F", "#767676", "#1B1C1D" 33 | ) 34 | names(semantic_palette) <- c( 35 | "purple", "green", "blue", "red", "orange", "yellow", "olive", "teal", 36 | "violet", "pink", "brown", "grey", "black" 37 | ) 38 | 39 | #' Semantic light colors 40 | #' https://github.com/Semantic-Org/Semantic-UI/blob/master/src/themes/default/globals/site.variables 41 | #' @export 42 | light_semantic_palette <- c( 43 | "#DC73FF", "#2ECC40", "#54C8FF", "#FF695E", "#FF851B", "#FFE21F", 44 | "#D9E778", "#6DFFFF", "#A291FB", "#FF8EDF", "#D67C1C", "#DCDDDE", 45 | "#545454" 46 | ) 47 | 48 | names(light_semantic_palette) <- c( 49 | "lightPurple", "lightGreen", "lightBlue", "lightRed", 50 | "lightOrange", "lightYellow", "lightOlive", "lightTeal", 51 | "lightViolet", "lightPink", "lightBrown", "lightGrey", 52 | "lightBlack" 53 | ) 54 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. 3 | 4 | The format is based on [Keep a Changelog](http://keepachangelog.com/). 5 | 6 | ## [Unreleased] 7 | ### Added 8 | - `sidebarUserPanel` was added increasing support of `shinydashboard` functions 9 | 10 | ### Changed 11 | ### Fixed 12 | ### Removed 13 | 14 | ## [0.2.0] - 15.01.2021 15 | ### Added 16 | - `title`, `titleWidth`, `left`, `center`, `right`, `show_menu_button` and `menu_button_label` parameters for `dashboardHeader` 17 | - `overlay` and `dim_page` parameters for `dashboardSidebar` 18 | - `margin` param for `dashboardPage` 19 | - `fluid` param for `tabItem` 20 | - `class` param for `dashboardPage`, `dashboardBody`, `dashboardSidebar` and `dashboardHeader` 21 | - `dashboardPage`, `dashboardBody`, `dashboardSidebar` and `dashboardHeader` have now built-in CSS classes of syntax `dashboard-` e.g. `dashboard-page`. Thanks to that it's easy to write selectors for DOM nodes related to them 22 | - pkgdown documentation 23 | - tests for dropdown menu, utils and value box 24 | 25 | ### Changed 26 | - Main content will shrink, not move when sidebar is opened and `overlay = FALSE` 27 | ### Fixed 28 | - Issues with layout responsiveness 29 | - Issues with sidebar position and overflow 30 | 31 | ## [0.1.5] - 2020-03-30 32 | ### Added 33 | - option for collapsible icon 34 | - themes support 35 | - conditionPanel 36 | - logo in top panel 37 | 38 | ### Changed 39 | - extended sidebar options 40 | - width values for semantic classes forces 41 | - README 42 | 43 | ### Fixed 44 | - collapsible box 45 | - dashboard body without left margin 46 | 47 | ## [0.1.0] - 2018-01-02 48 | ### Added 49 | - box 50 | - sidebarMenu 51 | - dashboardBody 52 | - dashboardHeader 53 | - dashboardPage 54 | - dashboardSidebar 55 | - menuItem 56 | - renderValueBox 57 | - tabItem 58 | - tabItems 59 | - valueBox 60 | - valueBoxOutput 61 | - dropdownMenu 62 | - dropdownMenuOutput 63 | - infoBox 64 | - infoBoxOutput 65 | - messageItem 66 | - notificationItem 67 | - renderDropdownMenu 68 | - renderInfoBox 69 | - tabBox 70 | - taskItem 71 | 72 | [Unreleased]: https://github.com/Appsilon/semantic.dashboard/compare/0.1.0...HEAD 73 | [0.1.0]: https://github.com/Appsilon/semantic.dashboard/compare/efb5ed9abfd48be547e4ff191925dd5b02f971b2...0.1.0 74 | -------------------------------------------------------------------------------- /man/sidebar_user_panel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/menu_item.R 3 | \name{sidebar_user_panel} 4 | \alias{sidebar_user_panel} 5 | \alias{sidebarUserPanel} 6 | \title{Create a user panel} 7 | \usage{ 8 | sidebar_user_panel(name, subtitle = NULL, image = NULL, image_size = "tiny") 9 | 10 | sidebarUserPanel(name, subtitle = NULL, image = NULL, image_size = "tiny") 11 | } 12 | \arguments{ 13 | \item{name}{Name of the user} 14 | 15 | \item{subtitle}{Information to be displayed below the name (for example 16 | if the user is online)} 17 | 18 | \item{image}{Path to an image. This can be a relative link to an existing 19 | `www/` directory, or an URL to an image} 20 | 21 | \item{image_size}{CSS class to display the image, see Semantic documentation 22 | for all sizes (goes from `mini` to `massive`)} 23 | } 24 | \value{ 25 | A div tag with the user panel 26 | } 27 | \description{ 28 | This creates an user panel using Semantic UI styles. 29 | } 30 | \section{Functions}{ 31 | \itemize{ 32 | \item \code{sidebarUserPanel()}: Create a sidebar user panel (alias for 33 | \code{sidebar_user_panel} for compatibility with \code{shinydashboard}) 34 | 35 | }} 36 | \examples{ 37 | sidebarUserPanel( 38 | "Some Name", 39 | subtitle = shiny::a(href = "#", icon("circle"), "Online"), 40 | # Image file should be in www/ subdir 41 | # or a link to a image 42 | image = "some_image_located_inside_www_dir.jpg", 43 | image_size = "mini" 44 | ) 45 | 46 | ui_user <- sidebarUserPanel( 47 | "Jane Smith", 48 | subtitle = shiny::a(href = "#", icon("circle"), "Online"), 49 | # Image file should be in www/ subdir 50 | # or a link to a image 51 | image = base::system.file( 52 | file.path('examples', "www", "jane_smith.jpg"), 53 | package = "semantic.dashboard" 54 | ), 55 | image_size = "mini" 56 | ) 57 | 58 | if (interactive()) { 59 | ui <- dashboardPage( 60 | dashboardHeader(), 61 | dashboardSidebar( 62 | ui_user, 63 | sidebarMenu( 64 | menuItem("Tab 1", tabName = "tab1"), 65 | menuItem("Tab 2", tabName = "tab2") 66 | ) 67 | ), 68 | body = dashboardBody( 69 | tabItems( 70 | tabItem(tabName = "tab1", h2("Tab 1")), 71 | tabItem(tabName = "tab2", h2("Tab 2")) 72 | ) 73 | ) 74 | ) 75 | 76 | server <- function(input, output, session) {} 77 | shinyApp(ui, server) 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /examples/crandash/ui.R: -------------------------------------------------------------------------------- 1 | dashboardPage(title = "crandash-semantic", 2 | dashboardHeader(color = "blue"), 3 | dashboardSidebar(side = "left", size = "wide", color = "grey", center = TRUE, 4 | div( 5 | sliderInput("rateThreshold", "Warn when rate exceeds", 6 | min = 0, max = 50, value = 3, step = 0.1 7 | ), align = "center", style = "margin: 0.5em;" 8 | ), 9 | menuItem("Dashboard", tabName = "dashboard"), 10 | menuItem("Raw data", tabName = "rawdata") 11 | ), 12 | dashboardBody( 13 | tabItems(selected = 1, 14 | tabItem(tabName = "dashboard", 15 | fluidRow( 16 | valueBoxOutput("rate"), 17 | valueBoxOutput("count"), 18 | valueBoxOutput("users") 19 | ), 20 | fluidRow( 21 | box(width = 10, 22 | title = "Popularity by package (last 5 min)", 23 | color = "blue", ribbon = TRUE, title_side = "top right", 24 | bubblesOutput("packagePlot", width = "100%", height = 600) 25 | ), 26 | box(width = 6, 27 | title = "Top packages (last 5 min)", 28 | color = "blue", ribbon = TRUE, title_side = "top right", 29 | tableOutput("packageTable") 30 | ) 31 | )), 32 | tabItem(tabName = "rawdata", 33 | fluidRow( 34 | numericInput("maxrows", "Rows to show", 25), 35 | verbatimTextOutput("rawtable"), 36 | downloadButton("downloadCsv", "Download as CSV")) 37 | )) 38 | ) 39 | ) 40 | 41 | 42 | -------------------------------------------------------------------------------- /tests/testthat/test-value_box.R: -------------------------------------------------------------------------------- 1 | context("value_box") 2 | 3 | test_that("basic value_box inputs", { 4 | # expects value 5 | expect_error(value_box()) 6 | # simple input 7 | si_str <- as.character( 8 | value_box("Title", "val") 9 | ) 10 | expect_true(any(grepl("ui statistic", 11 | si_str, fixed = TRUE))) 12 | expect_true(any(grepl("
Title
", 13 | si_str, fixed = TRUE))) 14 | # check extra parameters 15 | si_str <- as.character( 16 | value_box("Title", "val", icon = icon("dog")) 17 | ) 18 | expect_true(any(grepl("", 19 | si_str, fixed = TRUE))) 20 | si_str <- as.character( 21 | value_box("Title", "val", color = "blue") 22 | ) 23 | expect_true(any(grepl("ui fluid card blue", 24 | si_str, fixed = TRUE))) 25 | si_str <- as.character( 26 | value_box("Title", "val", width = 6) 27 | ) 28 | expect_true(any(grepl("six wide column", 29 | si_str, fixed = TRUE))) 30 | }) 31 | 32 | 33 | test_that("equivalence of infoBox and valueBox", { 34 | si_str1 <- as.character( 35 | value_box("Title", "val", color = "blue") 36 | ) 37 | si_str2 <- as.character( 38 | infoBox("Title", "val", color = "blue") 39 | ) 40 | si_str3 <- as.character( 41 | valueBox("Title", "val", color = "blue") 42 | ) 43 | expect_equal(si_str1, si_str2) 44 | expect_equal(si_str3, si_str2) 45 | expect_equal(si_str1, si_str3) 46 | }) 47 | 48 | test_that("value_box_output", { 49 | # expects some input 50 | expect_error(value_box_output()) 51 | # simple input 52 | si_str <- as.character( 53 | value_box_output("oid") 54 | ) 55 | expect_true(any(grepl("
", 56 | si_str, fixed = TRUE))) 57 | si_str <- as.character( 58 | value_box_output("oid", width = 6) 59 | ) 60 | expect_true(any(grepl("six wide column", 61 | si_str, fixed = TRUE))) 62 | }) 63 | 64 | test_that("equivalence of valueBoxOutput and infoBoxOutput", { 65 | si_str1 <- as.character( 66 | value_box_output("id1") 67 | ) 68 | si_str2 <- as.character( 69 | valueBoxOutput("id1") 70 | ) 71 | si_str3 <- as.character( 72 | infoBoxOutput("id1") 73 | ) 74 | expect_equal(si_str1, si_str2) 75 | expect_equal(si_str3, si_str2) 76 | expect_equal(si_str1, si_str3) 77 | }) 78 | -------------------------------------------------------------------------------- /tests/testthat/test-dropdown_menu.R: -------------------------------------------------------------------------------- 1 | context("dropdown_menu") 2 | 3 | test_that("test message_item", { 4 | # expects some input 5 | expect_error(message_item()) 6 | # test simple input 7 | si_str <- as.character( 8 | message_item("MMM", "Another test!", icon = "warning") 9 | ) 10 | expect_true(any(grepl("Another test!", 11 | si_str, fixed = TRUE))) 12 | expect_true(any(grepl("MMM", 13 | si_str, fixed = TRUE))) 14 | expect_true(any(grepl("", 15 | si_str, fixed = TRUE))) 16 | }) 17 | 18 | test_that("test equivalence messageItem", { 19 | ui_str1 <- as.character( 20 | message_item("MMM", "Another test!", icon = "warning") 21 | ) 22 | ui_str2 <- as.character( 23 | messageItem("MMM", "Another test!", icon = "warning") 24 | ) 25 | expect_identical(ui_str1, ui_str2) 26 | }) 27 | 28 | test_that("test task_item", { 29 | # expects some input 30 | expect_error(task_item()) 31 | # test simple input 32 | si_str <- as.character( 33 | task_item("Project progress...", 51, color = "red") 34 | ) 35 | expect_true(any(grepl("class=\"ui active progress red\" data-percent=\"51\" data-total=\"100\"", 36 | si_str, fixed = TRUE))) 37 | expect_true(any(grepl("
Project progress...
", 38 | si_str, fixed = TRUE))) 39 | }) 40 | 41 | test_that("test equivalence taskItem", { 42 | ui_str1 <- as.character( 43 | task_item("Project progress...", 51, color = "red") 44 | ) 45 | ui_str2 <- as.character( 46 | taskItem("Project progress...", 51, color = "red") 47 | ) 48 | expect_identical(ui_str1, ui_str2) 49 | }) 50 | 51 | 52 | test_that("test notification_item", { 53 | # expects some input 54 | expect_error(notification_item()) 55 | # test simple input 56 | si_str <- as.character( 57 | notification_item("This is notification!", color = "red") 58 | ) 59 | expect_true(any(grepl("ui label red", 60 | si_str, fixed = TRUE))) 61 | expect_true(any(grepl("This is notification!", 62 | si_str, fixed = TRUE))) 63 | }) 64 | 65 | test_that("test equivalence notificationItem", { 66 | ui_str1 <- as.character( 67 | notification_item("This is notification!", color = "blue") 68 | ) 69 | ui_str2 <- as.character( 70 | notificationItem("This is notification!", color = "blue") 71 | ) 72 | expect_identical(ui_str1, ui_str2) 73 | }) 74 | -------------------------------------------------------------------------------- /man/dashboard_page.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_dashboard.R 3 | \name{dashboard_page} 4 | \alias{dashboard_page} 5 | \alias{dashboardPage} 6 | \title{Create a dashboard.} 7 | \usage{ 8 | dashboard_page( 9 | header, 10 | sidebar, 11 | body, 12 | title = "", 13 | suppress_bootstrap = TRUE, 14 | theme = NULL, 15 | margin = TRUE, 16 | class = "", 17 | sidebar_and_body_container_class = "" 18 | ) 19 | 20 | dashboardPage( 21 | header, 22 | sidebar, 23 | body, 24 | title = "", 25 | suppress_bootstrap = TRUE, 26 | theme = NULL, 27 | margin = TRUE, 28 | class = "", 29 | sidebar_and_body_container_class = "" 30 | ) 31 | } 32 | \arguments{ 33 | \item{header}{Header of a dashboard.} 34 | 35 | \item{sidebar}{Sidebar of a dashboard.} 36 | 37 | \item{body}{Body of a dashboard.} 38 | 39 | \item{title}{Title of a dashboard.} 40 | 41 | \item{suppress_bootstrap}{There are some conflicts in CSS styles between 42 | FomanticUI and Bootstrap. For the time being it's better to suppress Bootstrap. 43 | If \code{TRUE} bootstrap dependency from \code{shiny} will be disabled.} 44 | 45 | \item{theme}{Theme name or path. For possible options see 46 | \code{\link[shiny.semantic]{semanticPage}}.} 47 | 48 | \item{margin}{If \code{TRUE}, margin to be applied to the whole dashboard. 49 | Defaults to \code{TRUE}.} 50 | 51 | \item{class}{CSS class to be applied to the page container (\code{} tag).} 52 | 53 | \item{sidebar_and_body_container_class}{CSS class to be applied to the \code{div} containing 54 | \code{dashboardSidebar} and \code{dashboardBody}.} 55 | } 56 | \value{ 57 | Dashboard. 58 | } 59 | \description{ 60 | Create a page with menu item sidebar and body containing tabs and other additional 61 | elements. 62 | } 63 | \section{Functions}{ 64 | \itemize{ 65 | \item \code{dashboardPage()}: Create a dashboard (alias for \code{dashboard_page} for compatibility 66 | with \code{shinydashboard}) 67 | 68 | }} 69 | \examples{ 70 | if(interactive()){ 71 | 72 | library(shiny) 73 | library(semantic.dashboard) 74 | 75 | ui <- dashboardPage( 76 | dashboardHeader(color = "blue"), 77 | dashboardSidebar(side = "left", size = "thin", color = "teal", 78 | sidebarMenu( 79 | menuItem(tabName = "tab1", "Tab 1"), 80 | menuItem(tabName = "tab2", "Tab 2"))), 81 | dashboardBody(tabItems( 82 | tabItem(tabName = "tab1", p("Tab 1")), 83 | tabItem(tabName = "tab2", p("Tab 2")))) 84 | ) 85 | 86 | server <- function(input, output) { 87 | } 88 | 89 | shinyApp(ui, server) 90 | } 91 | } 92 | -------------------------------------------------------------------------------- /R/box.R: -------------------------------------------------------------------------------- 1 | #' Create a box. 2 | #' @description Create a box with additional UI elements. 3 | #' @param ... UI elements to include within the box. 4 | #' @param title Label of the box. 5 | #' @param color Color of the box. One of \code{c("", "red", "orange", "yellow", 6 | #' "olive", "green", "teal", "blue", "violet", "purple", "pink", "brown", "grey", "black")} 7 | #' @param ribbon Should label be presented as ribbon. 8 | #' @param title_side Side of a label. One of \code{c("top", "bottom", "top left", 9 | #' "top right", "bottom left", "bottom right")} if \code{ribbon = FALSE}, or one of 10 | #' \code{c("top left", "top right")} if \code{ribbon = TRUE} 11 | #' @param collapsible Should minimize button be added to label. 12 | #' @param width Width of the box. 13 | #' @param id ID of the box. 14 | #' @param collapse_icon Icon class to be used for collapsing (when \code{collapsible = TRUE}). 15 | #' @param expand_icon Icon class to be used for expanding (when \code{collapsible = TRUE}). 16 | #' @return A box that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 17 | #' @export 18 | #' @examples 19 | #' box(title = "Sample box", color = "blue", width = 11, 20 | #' "This is a box content" 21 | #' ) 22 | box <- function(..., title = NULL, color = "", ribbon = TRUE, title_side = "top right", 23 | collapsible = TRUE, width = 8, id = NULL, collapse_icon = "minus", 24 | expand_icon = "plus") { 25 | verify_value_allowed("color", c("", ALLOWED_COLORS)) 26 | verify_value_allowed( 27 | "title_side", 28 | if (ribbon) ALLOWED_BOX_SIDES_RIBBON else ALLOWED_BOX_SIDES_NONRIBBON 29 | ) 30 | box_id <- if (!is.character(id)) { 31 | paste0("box_", random_id_generator()) 32 | } else { 33 | id 34 | } 35 | title_id <- sub("box_", "title_", box_id) 36 | label <- if (!is.character(title)) { 37 | NULL 38 | } else { 39 | title_class <- paste("ui", title_side, ifelse(ribbon, "ribbon", "attached"), "label", color) 40 | minimize_button <- if (collapsible) { 41 | shiny.semantic::icon(collapse_icon, style = "cursor: pointer;") 42 | } else { 43 | NULL 44 | } 45 | shiny::div(class = title_class, minimize_button, title) 46 | } 47 | icon_selector <- glue::glue("'#{title_id} > .label > .icon'") 48 | # nolint start: line_length_linter 49 | js_script <- glue::glue("$('#{box_id}').accordion({{ 50 | selector: {{ trigger: {icon_selector} }}, 51 | onOpening: function() {{ $({icon_selector}).removeClass('{expand_icon}').addClass('{collapse_icon}'); }}, 52 | onClosing: function() {{ $({icon_selector}).removeClass('{collapse_icon}').addClass('{expand_icon}'); }} 53 | }});") 54 | # nolint end 55 | column(width = width, 56 | shiny::div(class = paste("ui segment raised", color), 57 | shiny::div(id = box_id, class = "ui accordion", 58 | shiny::div(id = title_id, class = "title", style = "cursor: auto", label), 59 | shiny::div(class = "content active", shiny::div(...)) 60 | ) 61 | ), 62 | if (collapsible) shiny::singleton( 63 | shiny::tags$script(shiny::HTML(paste0("$(document).ready(function() {", js_script, " })"))) 64 | ) 65 | ) 66 | } 67 | -------------------------------------------------------------------------------- /examples/crandash/global.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shinySignals) # devtools::install_github("hadley/shinySignals") 3 | library(dplyr) 4 | library(semantic.dashboard) 5 | library(bubbles) # devtools::install_github("jcheng5/bubbles") 6 | source("bloomfilter.R") 7 | 8 | # An empty prototype of the data frame we want to create 9 | prototype <- data.frame(date = character(), time = character(), 10 | size = numeric(), r_version = character(), r_arch = character(), 11 | r_os = character(), package = character(), version = character(), 12 | country = character(), ip_id = character(), received = numeric()) 13 | 14 | # Connects to streaming log data for cran.rstudio.com and 15 | # returns a reactive expression that serves up the cumulative 16 | # results as a data frame 17 | packageStream <- function(session) { 18 | # Connect to data source 19 | sock <- socketConnection("cransim.rstudio.com", 6789, blocking = FALSE, open = "r") 20 | # Clean up when session is over 21 | session$onSessionEnded(function() { 22 | close(sock) 23 | }) 24 | 25 | # Returns new lines 26 | newLines <- reactive({ 27 | invalidateLater(1000, session) 28 | readLines(sock) 29 | }) 30 | 31 | # Parses newLines() into data frame 32 | reactive({ 33 | if (length(newLines()) == 0) 34 | return() 35 | read.csv(textConnection(newLines()), header=FALSE, stringsAsFactors=FALSE, 36 | col.names = names(prototype) 37 | ) %>% mutate(received = as.numeric(Sys.time())) 38 | }) 39 | } 40 | 41 | # Accumulates pkgStream rows over time; throws out any older than timeWindow 42 | # (assuming the presence of a "received" field) 43 | packageData <- function(pkgStream, timeWindow) { 44 | shinySignals::reducePast(pkgStream, function(memo, value) { 45 | rbind(memo, value) %>% 46 | filter(received > as.numeric(Sys.time()) - timeWindow) 47 | }, prototype) 48 | } 49 | 50 | # Count the total nrows of pkgStream 51 | downloadCount <- function(pkgStream) { 52 | shinySignals::reducePast(pkgStream, function(memo, df) { 53 | if (is.null(df)) 54 | return(memo) 55 | memo + nrow(df) 56 | }, 0) 57 | } 58 | 59 | # Use a bloom filter to probabilistically track the number of unique 60 | # users we have seen; using bloom filter means we will not have a 61 | # perfectly accurate count, but the memory usage will be bounded. 62 | userCount <- function(pkgStream) { 63 | # These parameters estimate that with 5000 unique users added to 64 | # the filter, we'll have a 1% chance of false positive on the next 65 | # user to be queried. 66 | bloomFilter <- BloomFilter$new(5000, 0.01) 67 | total <- 0 68 | reactive({ 69 | df <- pkgStream() 70 | if (!is.null(df) && nrow(df) > 0) { 71 | # ip_id is only unique on a per-day basis. To make them unique 72 | # across days, include the date. And call unique() to make sure 73 | # we don't double-count dupes in the current data frame. 74 | ids <- paste(df$date, df$ip_id) %>% unique() 75 | # Get indices of IDs we haven't seen before 76 | newIds <- !sapply(ids, bloomFilter$has) 77 | # Add the count of new IDs 78 | total <<- total + length(newIds) 79 | # Add the new IDs so we know for next time 80 | sapply(ids[newIds], bloomFilter$set) 81 | } 82 | total 83 | }) 84 | } 85 | -------------------------------------------------------------------------------- /examples/crandash/server.R: -------------------------------------------------------------------------------- 1 | function(input, output, session) { 2 | 3 | # pkgStream is a reactive expression that represents a stream of 4 | # new package download data; up to once a second it may return a 5 | # data frame of new downloads since the last update. 6 | pkgStream <- packageStream(session) 7 | 8 | # Max age of data (5 minutes) 9 | maxAgeSecs <- 60 * 5 10 | 11 | # pkgData is a reactive expression that accumulates previous 12 | # values of pkgStream, discarding any that are older than 13 | # maxAgeSecs. 14 | pkgData <- packageData(pkgStream, maxAgeSecs) 15 | 16 | # dlCount is a reactive expression that keeps track of the total 17 | # number of rows that have ever appeared through pkgStream. 18 | dlCount <- downloadCount(pkgStream) 19 | 20 | # usrCount is a reactive expression that keeps an approximate 21 | # count of all of the unique users that have been seen since the 22 | # app started. 23 | usrCount <- userCount(pkgStream) 24 | 25 | # Record the time that the session started. 26 | startTime <- as.numeric(Sys.time()) 27 | 28 | output$rate <- renderValueBox({ 29 | # The downloadRate is the number of rows in pkgData since 30 | # either startTime or maxAgeSecs ago, whichever is later. 31 | elapsed <- as.numeric(Sys.time()) - startTime 32 | downloadRate <- nrow(pkgData()) / min(maxAgeSecs, elapsed) 33 | 34 | valueBox( 35 | value = formatC(downloadRate, digits = 1, format = "f"), 36 | subtitle = "Downloads per sec (last 5 min)", 37 | icon = icon("smile"), 38 | color = if (downloadRate >= input$rateThreshold) "yellow" else "blue" 39 | ) 40 | }) 41 | 42 | output$count <- renderValueBox({ 43 | valueBox( 44 | value = dlCount(), 45 | subtitle = "Total downloads", 46 | icon = icon("download"), 47 | color = "blue" 48 | ) 49 | }) 50 | 51 | output$users <- renderValueBox({ 52 | valueBox( 53 | value = usrCount(), 54 | subtitle = "Unique users", 55 | icon = icon("users"), 56 | color = "blue" 57 | ) 58 | }) 59 | 60 | output$packagePlot <- renderBubbles({ 61 | if (nrow(pkgData()) == 0) 62 | return() 63 | 64 | order <- unique(pkgData()$package) 65 | df <- pkgData() %>% 66 | group_by(package) %>% 67 | tally() %>% 68 | arrange(desc(n), tolower(package)) %>% 69 | # Just show the top 60, otherwise it gets hard to see 70 | head(60) 71 | 72 | bubbles(df$n, df$package, key = df$package) 73 | }) 74 | 75 | output$packageTable <- renderTable({ 76 | pkgData() %>% 77 | group_by(package) %>% 78 | tally() %>% 79 | arrange(desc(n), tolower(package)) %>% 80 | mutate(percentage = n / nrow(pkgData()) * 100) %>% 81 | select("Package name" = package, "% of downloads" = percentage) %>% 82 | as.data.frame() %>% 83 | head(15) 84 | }, digits = 1) 85 | 86 | output$downloadCsv <- downloadHandler( 87 | filename = "cranlog.csv", 88 | content = function(file) { 89 | write.csv(pkgData(), file) 90 | }, 91 | contentType = "text/csv" 92 | ) 93 | 94 | output$rawtable <- renderPrint({ 95 | orig <- options(width = 1000) 96 | print(tail(pkgData(), input$maxrows)) 97 | options(orig) 98 | }) 99 | } 100 | -------------------------------------------------------------------------------- /pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | title: semantic.dashboard 2 | template: 3 | bootstrap: 5 4 | bootswatch: pulse 5 | bslib: 6 | pkgdown-nav-height: 100px 7 | includes: 8 | in_header: | 9 | 10 | 11 | 17 | 18 | 19 | 25 | 26 | url: https://appsilon.github.io/semantic.dashboard/ 27 | 28 | navbar: 29 | bg: primary 30 | left: 31 | - icon: fa-home 32 | href: index.html 33 | text: "Start" 34 | - icon: fa-university 35 | text: "Tutorials" 36 | href: articles/index.html 37 | - icon: fa-file-code-o 38 | text: "Reference" 39 | href: reference/index.html 40 | - icon: fa-newspaper-o 41 | text: "Changes" 42 | href: CHANGELOG.html 43 | right: 44 | - icon: fa-github fa-lg 45 | href: https://github.com/Appsilon/semantic.dashboard 46 | - icon: fa-twitter fa-lg 47 | href: https://twitter.com/Appsilon 48 | 49 | articles: 50 | - title: All tutorials 51 | desc: ~ 52 | contents: 53 | - '`intro`' 54 | 55 | reference: 56 | - title: Dashboard skeleton 57 | contents: 58 | - '`dashboardBody`' 59 | - '`dashboard_body`' 60 | - '`dashboardHeader`' 61 | - '`dashboard_header`' 62 | - '`dashboardPage`' 63 | - '`dashboard_page`' 64 | - '`dashboardSidebar`' 65 | - '`dashboard_sidebar`' 66 | - '`column`' 67 | - '`box`' 68 | - '`dropdownMenu`' 69 | - '`dropdown_menu`' 70 | - '`dropdownMenuOutput`' 71 | - '`dropdown_menu_output`' 72 | - '`renderDropdownMenu`' 73 | 74 | - title: Other UI elements 75 | desc: All functions that generate UI elements. 76 | contents: 77 | - '`icon`' 78 | - '`infoBox`' 79 | - '`infoBoxOutput`' 80 | - '`menuItem`' 81 | - '`menu_item`' 82 | - '`menuItemOutput`' 83 | - '`menu_item_output`' 84 | - '`menuSubItem`' 85 | - '`messageItem`' 86 | - '`message_item`' 87 | - '`notificationItem`' 88 | - '`notification_item`' 89 | - '`renderInfoBox`' 90 | - '`renderMenu`' 91 | - '`render_menu`' 92 | - '`renderValueBox`' 93 | - '`render_value_box`' 94 | - '`render_dropdown_menu`' 95 | - '`sidebarMenu`' 96 | - '`sidebar_menu`' 97 | - '`sidebarMenuOutput`' 98 | - '`sidebar_menu_output`' 99 | - '`sidebarUserPanel`' 100 | - '`sidebar_user_panel`' 101 | - '`tabBox`' 102 | - '`tab_box`' 103 | - '`tabItem`' 104 | - '`tab_item`' 105 | - '`tabItems`' 106 | - '`tab_items`' 107 | - '`taskItem`' 108 | - '`task_item`' 109 | - '`valueBox`' 110 | - '`value_box`' 111 | - '`valueBoxOutput`' 112 | - '`value_box_output`' 113 | - '`tab_items`' 114 | 115 | - title: Constants 116 | desc: They contain the supported values of certain inputs. 117 | contents: 118 | - '`light_semantic_palette`' 119 | - '`semantic_palette`' 120 | 121 | - title: Other 122 | contents: 123 | - '`update_tab_items`' 124 | -------------------------------------------------------------------------------- /man/dashboard_sidebar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_dashboard.R 3 | \name{dashboard_sidebar} 4 | \alias{dashboard_sidebar} 5 | \alias{dashboardSidebar} 6 | \title{Create a sidebar of a dashboard.} 7 | \usage{ 8 | dashboard_sidebar( 9 | ..., 10 | side = "left", 11 | size = "thin", 12 | color = "", 13 | inverted = FALSE, 14 | closable = FALSE, 15 | pushable = TRUE, 16 | center = FALSE, 17 | visible = TRUE, 18 | disable = FALSE, 19 | overlay = FALSE, 20 | dim_page = FALSE, 21 | class = "" 22 | ) 23 | 24 | dashboardSidebar( 25 | ..., 26 | side = "left", 27 | size = "thin", 28 | color = "", 29 | inverted = FALSE, 30 | closable = FALSE, 31 | pushable = TRUE, 32 | center = FALSE, 33 | visible = TRUE, 34 | disable = FALSE, 35 | overlay = FALSE, 36 | dim_page = FALSE, 37 | class = "" 38 | ) 39 | } 40 | \arguments{ 41 | \item{...}{UI elements to include within the sidebar.} 42 | 43 | \item{side}{Placement of the sidebar. One of \code{c("left", "right", "top", "bottom")}} 44 | 45 | \item{size}{Size of the sidebar. One of \code{c("", "thin", "very thin", "wide", "very wide")}} 46 | 47 | \item{color}{Color of the sidebar / text / icons (depending on the value of `inverted` 48 | parameter. One of \code{c("", "red", "orange", "yellow", "olive", "green", "teal", "blue", 49 | "violet","purple", "pink", "brown", "grey", "black")}} 50 | 51 | \item{inverted}{If FALSE sidebar will be white and text will be colored. \ 52 | If TRUE text will be white and background will be colored. Default is \code{FALSE}.} 53 | 54 | \item{closable}{If \code{TRUE} allow close sidebar by clicking in the body. Default to 55 | \code{FALSE}} 56 | 57 | \item{pushable}{If \code{TRUE} the menu button is active. Default to \code{TRUE}} 58 | 59 | \item{center}{Should label and icon be centerd on menu items. Default to \code{FALSE}} 60 | 61 | \item{visible}{Should sidebar be visible on start. Default to \code{TRUE}} 62 | 63 | \item{disable}{If \code{TRUE}, don't display the sidebar.} 64 | 65 | \item{overlay}{If \code{TRUE}, opened sidebar will cover the tab content. Otherwise it is 66 | displayed next to the content. Relevant only for sidebar positioned on left or right. Default 67 | to \code{FALSE}} 68 | 69 | \item{dim_page}{If \code{TRUE}, page content will be darkened when sidebr is open. Default to 70 | \code{FALSE}} 71 | 72 | \item{class}{CSS class to be applied to the container of \code{dashboardSidebar}.} 73 | } 74 | \value{ 75 | A sidebar that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 76 | } 77 | \description{ 78 | Create a pushable sidebar of a dashboard with menu items and other additional UI 79 | elements. 80 | } 81 | \section{Functions}{ 82 | \itemize{ 83 | \item \code{dashboardSidebar()}: Create a sidebar of a dashboard (alias for \code{dashboard_sidebar} 84 | for compatibility with \code{shinydashboard}) 85 | 86 | }} 87 | \examples{ 88 | if(interactive()){ 89 | 90 | library(shiny) 91 | library(semantic.dashboard) 92 | 93 | ui <- dashboardPage( 94 | dashboardHeader(color = "blue"), 95 | dashboardSidebar(side = "left", size = "thin", color = "teal", 96 | sidebarMenu( 97 | menuItem(tabName = "tab1", "Tab 1"), 98 | menuItem(tabName = "tab2", "Tab 2"))), 99 | dashboardBody(tabItems( 100 | tabItem(tabName = "tab1", p("Tab 1")), 101 | tabItem(tabName = "tab2", p("Tab 2")))) 102 | ) 103 | 104 | server <- function(input, output) { 105 | } 106 | 107 | shinyApp(ui, server) 108 | } 109 | } 110 | -------------------------------------------------------------------------------- /examples/themes/app-darktheme.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shiny.semantic) 3 | library(semantic.dashboard) 4 | library(plotly) 5 | library(DT) 6 | 7 | ui <- dashboardPage( 8 | dashboardHeader(dropdownMenuOutput("dropdown"), 9 | dropdownMenu(type = "notifications", 10 | taskItem("Project progress...", 50.777, color = "red")), 11 | dropdownMenu(icon = icon("red warning sign"), 12 | notificationItem("This is an important notification!", color = "red"))), 13 | dashboardSidebar(side = "left", 14 | sidebarMenu( 15 | menuItem(tabName = "plot_tab", text = "My plot", icon = icon("home")), 16 | menuItem(tabName = "table_tab", text = "My table", icon = icon("smile")))), 17 | dashboardBody( 18 | tabItems( 19 | tabItem(tabName = "plot_tab", 20 | fluidRow( 21 | valueBox("Unread Mail", 44, icon("mail"), color = "blue", width = 5)), 22 | fluidRow( 23 | box(title = "Sample box", color = "blue", width = 11, 24 | selectInput(inputId = "variable1", choices = names(mtcars), 25 | label = "Select first variable", selected = "mpg"), 26 | selectInput(inputId = "variable2", choices = names(mtcars), 27 | label = "Select second variable", selected = "cyl"), 28 | plotlyOutput("mtcars_plot")), 29 | tabBox(title = "Sample box", color = "blue", width = 5, 30 | collapsible = FALSE, 31 | tabs = list( 32 | list(menu = "First Tab", content = "Some text..."), 33 | list(menu = "Second Tab", content = plotlyOutput("mtcars_plot2")) 34 | )))), 35 | tabItem(tabName = "table_tab", 36 | fluidRow( 37 | valueBox("Unread Mail", 144, icon("mail"), color = "blue", width = 6, size = "small"), 38 | valueBox("Spam", 20, icon("mail"), color = "red", width = 5, size = "small"), 39 | valueBox("Readed Mail", 666, icon("mail"), color = "green", width = 5, size = "small") 40 | ), 41 | fluidRow( 42 | box(title = "Classic box", color = "blue", ribbon = FALSE, 43 | title_side = "top left", width = 14, 44 | tags$div( 45 | dataTableOutput("mtcars_table") 46 | , style = paste0("color:", semantic_palette[["blue"]], ";")) 47 | )))) 48 | ), theme = "darkly" 49 | ) 50 | 51 | server <- function(input, output) { 52 | 53 | output$mtcars_plot <- renderPlotly(plot_ly(mtcars, x = ~ mtcars[ , input$variable1], 54 | y = ~ mtcars[ , input$variable2], 55 | type = "scatter", mode = "markers") 56 | ) 57 | output$mtcars_plot2 <- renderPlotly(plot_ly(mtcars, x = ~ mtcars[ , input$variable1], 58 | y = ~ mtcars[ , input$variable2], 59 | type = "scatter", mode = "markers")) 60 | 61 | output$mtcars_table <- renderDataTable(mtcars, options = list(dom = 't')) 62 | 63 | output$dropdown <- renderDropdownMenu({ 64 | dropdownMenu(messageItem("User", "Test message", color = "teal", style = "min-width: 200px"), 65 | messageItem("Users", "Test message", color = "teal", icon = "users"), 66 | messageItem("See this", "Another test", icon = "warning", color = "red")) 67 | }) 68 | } 69 | 70 | shinyApp(ui, server) 71 | -------------------------------------------------------------------------------- /R/value_box.R: -------------------------------------------------------------------------------- 1 | #' Create a valueBox. 2 | #' @description Create a valueBox with additional UI elements. 3 | #' @param subtitle Label of the valueBox. 4 | #' @param value Value of the valueBox. 5 | #' @param icon Icon of the valueBox. 6 | #' @param color Color of the valueBox. One of \code{c("", "red", "orange", "yellow", 7 | #' "olive", "green", "teal", "blue", "violet", "purple", "pink", "brown", "grey", "black")} 8 | #' @param width Width of the valueBox. 9 | #' @param size Size of value. One of \code{c("mini", "tiny", "small", "", "large", "huge")}. 10 | #' Default is "". 11 | #' @return A valueBox that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 12 | #' @export 13 | #' @examples 14 | #' valueBox("Unread Mail", 44, icon("mail"), color = "blue", width = 5, size = "tiny") 15 | value_box <- function(subtitle, value, icon = NULL, color = "blue", width = 5, size = "") { 16 | verify_value_allowed("color", ALLOWED_COLORS) 17 | verify_value_allowed("size", ALLOWED_VALUEBOX_SIZES) 18 | column(width = width, 19 | shiny::div(class = paste("ui fluid card", color), 20 | shiny::div(class = paste("ui statistic", size), 21 | shiny::div(class = "value", icon, value), 22 | shiny::div(class = "label", subtitle)))) 23 | } 24 | 25 | #' @describeIn value_box Create a valueBox (alias for \code{value_box}) 26 | #' @export 27 | valueBox <- value_box 28 | 29 | #' @describeIn value_box Create a valueBox (alias for \code{value_box}) 30 | #' @export 31 | infoBox <- value_box 32 | 33 | 34 | #' Create a value box output. 35 | #' @description UI-side function for dynamic valueBox. 36 | #' @param outputId Id of the output. 37 | #' @param width Width of the valueBox. 38 | #' @return A value box that can be passed to \code{\link[semantic.dashboard]{dashboardBody}} 39 | #' @export 40 | #' @examples 41 | #' \dontrun{ 42 | #' valueBoxOutput("value_box") 43 | #' 44 | #' output$value_box <- renderValueBox({ 45 | #' valueBox( 46 | #' value = 33.45, 47 | #' subtitle = "Simple valuebox", 48 | #' icon = icon("bar chart"), 49 | #' color = "purple", 50 | #' width = 5) 51 | #' }) 52 | #' } 53 | value_box_output <- function(outputId, width = 5) { 54 | column(width = width, shiny::uiOutput(outputId)) 55 | } 56 | 57 | #' @describeIn value_box_output Create a valueBox output (alias for \code{value_box_output}) 58 | #' @export 59 | valueBoxOutput <- value_box_output 60 | 61 | #' @describeIn value_box_output Create a valueBox output (alias for \code{value_box_output}) 62 | #' @export 63 | infoBoxOutput <- value_box_output 64 | 65 | #' Create a value box output. 66 | #' @description Server-side function for dynamic valueBox. 67 | #' @param expr ValueBox. 68 | #' @param env The environment in which to evaluate expr. 69 | #' @param quoted Is expr a quoted expression (with \code{quote()})? 70 | #' This is useful if you want to save an expression in a variable. 71 | #' @return A dynamic valueBox that can be assigned to output. 72 | #' @export 73 | #' @examples 74 | #' \dontrun{ 75 | #' valueBoxOutput("value_box") 76 | #' 77 | #' output$value_box <- renderValueBox({ 78 | #' valueBox( 79 | #' value = 33.45, 80 | #' subtitle = "Simple valuebox", 81 | #' icon = icon("bar chart"), 82 | #' color = "purple", 83 | #' width = 5) 84 | #' }) 85 | #' } 86 | render_value_box <- function(expr, env = parent.frame(), quoted = FALSE) { 87 | fun <- shiny::exprToFunction(expr, env, quoted) 88 | shiny::renderUI(fun()) 89 | } 90 | 91 | #' @describeIn render_value_box Create a value box output (alias for \code{render_value_box}) 92 | #' @export 93 | renderValueBox <- render_value_box 94 | 95 | #' @describeIn render_value_box Create a value box output (alias for \code{render_value_box}) 96 | #' @export 97 | renderInfoBox <- render_value_box 98 | -------------------------------------------------------------------------------- /examples/sales/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | require(semantic.dashboard) 3 | library(ggplot2) 4 | library(dplyr) 5 | recommendation <- read.csv('recommendation.csv', stringsAsFactors = FALSE, header = TRUE) 6 | 7 | # Dashboard header carrying the title of the dashboard 8 | header <- dashboardHeader() 9 | # Sidebar content of the dashboard 10 | sidebar <- dashboardSidebar(size = "wide", 11 | sidebarMenu( 12 | menuItem(text = "Dashboard", tabName = "dashboard", icon = icon("bar chart")), 13 | menuItem(text = "Visit-us", href = "https://www.appsilondatascience.com", icon = icon("at"))) 14 | ) 15 | 16 | frow1 <- fluidRow( 17 | valueBoxOutput("value1"), 18 | valueBoxOutput("value2"), 19 | valueBoxOutput("value3") 20 | ) 21 | frow2 <- fluidRow( 22 | box( 23 | title = "Revenue per Account", 24 | color = "blue", 25 | ribbon = TRUE, 26 | collapsible = TRUE, 27 | width = 8, 28 | plotOutput("revenuebyPrd", height = "300px") 29 | ), 30 | box( 31 | title = "Revenue per Product", 32 | color = "blue", 33 | ribbon = TRUE, 34 | collapsible = TRUE, 35 | width = 8, 36 | plotOutput("revenuebyRegion", height = "300px") 37 | ) 38 | ) 39 | # combine the two fluid rows to make the body 40 | body <- dashboardBody(title = "Basic Dashboard", frow1, frow2) 41 | 42 | ui <- dashboardPage(title = 'This is my Page title', 43 | header, sidebar, body) 44 | 45 | # create the server functions for the dashboard 46 | server <- function(input, output, session) { 47 | #some data manipulation to derive the values of KPI boxes 48 | total.revenue <- sum(recommendation$Revenue) 49 | sales.account <- recommendation %>% group_by(Account) %>% 50 | summarise(value = sum(Revenue)) %>% filter(value == max(value)) 51 | prof.prod <- recommendation %>% group_by(Product) %>% 52 | summarise(value = sum(Revenue)) %>% filter(value == max(value)) 53 | #creating the valueBoxOutput content 54 | output$value1 <- renderValueBox({ 55 | valueBox( 56 | value = formatC(sales.account$value, format="d", big.mark=','), 57 | subtitle = paste('Top Account:', sales.account$Account), 58 | icon = icon("bar chart"), 59 | color = "purple", 60 | width = 5) 61 | }) 62 | output$value2 <- renderValueBox({ 63 | valueBox( 64 | value = formatC(total.revenue, format = "d", big.mark = ','), 65 | subtitle = 'Total Expected Revenue', 66 | icon = icon("line chart"), 67 | color = "green", 68 | width = 5) 69 | }) 70 | output$value3 <- renderValueBox({ 71 | valueBox( 72 | value = formatC(prof.prod$value, format = "d", big.mark = ','), 73 | subtitle = paste('Top Product:', prof.prod$Product), 74 | icon = icon("bar chart"), 75 | color = "blue", 76 | width = 5) 77 | }) 78 | #creating the plotOutput content 79 | output$revenuebyPrd <- renderPlot({ 80 | ggplot(data = recommendation, 81 | aes( x= Product, y = Revenue, fill = factor(Region))) + 82 | scale_fill_manual(values = as.vector(semantic_palette)) + 83 | geom_bar(position = "dodge", stat = "identity") + ylab("Revenue (in Euros)") + 84 | xlab("Product") + theme(legend.position="bottom", 85 | plot.title = element_text(size = 15, face = "bold")) + 86 | ggtitle("Revenue by Product") + labs(fill = "Region") 87 | }) 88 | output$revenuebyRegion <- renderPlot({ 89 | ggplot(data = recommendation, 90 | aes(x = Account, y = Revenue, fill = factor(Region))) + 91 | scale_fill_manual(values = as.vector(semantic_palette)) + 92 | geom_bar(position = "dodge", stat = "identity") + ylab("Revenue (in Euros)") + 93 | xlab("Account") + theme(legend.position="bottom", 94 | plot.title = element_text(size = 15, face = "bold")) + 95 | ggtitle("Revenue by Region") + labs(fill = "Region") 96 | }) 97 | } 98 | 99 | shinyApp(ui, server) 100 | -------------------------------------------------------------------------------- /man/dashboard_header.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_dashboard.R 3 | \name{dashboard_header} 4 | \alias{dashboard_header} 5 | \alias{dashboardHeader} 6 | \title{Create a header of a dashboard.} 7 | \usage{ 8 | dashboard_header( 9 | ..., 10 | left = NULL, 11 | center = NULL, 12 | right = NULL, 13 | title = NULL, 14 | titleWidth = "thin", 15 | logo_align = "center", 16 | logo_path = "", 17 | color = "", 18 | inverted = FALSE, 19 | disable = FALSE, 20 | show_menu_button = TRUE, 21 | menu_button_label = "Menu", 22 | class = "" 23 | ) 24 | 25 | dashboardHeader( 26 | ..., 27 | left = NULL, 28 | center = NULL, 29 | right = NULL, 30 | title = NULL, 31 | titleWidth = "thin", 32 | logo_align = "center", 33 | logo_path = "", 34 | color = "", 35 | inverted = FALSE, 36 | disable = FALSE, 37 | show_menu_button = TRUE, 38 | menu_button_label = "Menu", 39 | class = "" 40 | ) 41 | } 42 | \arguments{ 43 | \item{...}{UI elements to include within the header. They will be displayed on the right side.} 44 | 45 | \item{left}{UI element to put on the left of the header. It will be placed after (to the right) 46 | the title and menu button (if they exist).} 47 | 48 | \item{center}{UI element to put in the center of the header.} 49 | 50 | \item{right}{UI element to put to the right of the header. It will be placed before elements 51 | defined in \code{...} (if there are any).} 52 | 53 | \item{title}{Dashboard title to be displayed in the upper left corner. If NULL, will not display 54 | any title field. Use "" for an empty title.} 55 | 56 | \item{titleWidth}{Title field width, one of \code{c(NULL, "very thin", "thin", "wide", 57 | "very wide")}} 58 | 59 | \item{logo_align}{Where should logo be placed. One of \code{c("left", "center")}} 60 | 61 | \item{logo_path}{Path or URL of the logo to be shown in the header.} 62 | 63 | \item{color}{Color of the sidebar / text / icons (depending on the value of `inverted` parameter. 64 | One of \code{c("", "red", "orange", "yellow", "olive", "green", "teal", "blue", "violet", 65 | "purple", "pink", "brown", "grey", "black")}} 66 | 67 | \item{inverted}{If FALSE sidebar will be white and text will be colored. \ 68 | If TRUE text will be white and background will be colored. Default is \code{FALSE}.} 69 | 70 | \item{disable}{If \code{TRUE}, don't display the header.} 71 | 72 | \item{show_menu_button}{If \code{FALSE}, don't display the menu button. Default is \code{TRUE}.} 73 | 74 | \item{menu_button_label}{Text of the menu button. Default is \code{"Menu"}.} 75 | 76 | \item{class}{CSS class to be applied to the container of \code{dashboardHeader}.} 77 | } 78 | \value{ 79 | A header that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 80 | } 81 | \description{ 82 | Create a header of a dashboard with other additional UI elements. 83 | Hint: use \code{shiny::tagList()} if you want to add multiple elements in 84 | \code{left} / \code{center} or \code{right}. 85 | } 86 | \section{Functions}{ 87 | \itemize{ 88 | \item \code{dashboardHeader()}: Create a header of a dashboard (alias for \code{dashboard_header} 89 | for compatibility with \code{shinydashboard}) 90 | 91 | }} 92 | \examples{ 93 | if(interactive()) { 94 | 95 | library(shiny) 96 | library(semantic.dashboard) 97 | 98 | ui <- dashboardPage( 99 | dashboardHeader(color = "blue", inverted = TRUE), 100 | dashboardSidebar(side = "left", size = "thin", color = "teal", 101 | sidebarMenu( 102 | menuItem(tabName = "tab1", "Tab 1"), 103 | menuItem(tabName = "tab2", "Tab 2"))), 104 | dashboardBody(tabItems( 105 | tabItem(tabName = "tab1", p("Tab 1")), 106 | tabItem(tabName = "tab2", p("Tab 2")))) 107 | ) 108 | 109 | server <- function(input, output) { 110 | } 111 | 112 | shinyApp(ui, server) 113 | } 114 | } 115 | -------------------------------------------------------------------------------- /examples/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shiny.semantic) 3 | library(semantic.dashboard) 4 | library(plotly) 5 | library(DT) 6 | 7 | ui <- dashboardPage( 8 | margin = TRUE, 9 | dashboardHeader( 10 | logo_align = "center", 11 | logo_path = "https://avatars0.githubusercontent.com/u/6096772", 12 | dropdownMenuOutput("dropdown"), 13 | title = "Appsilon", 14 | titleWidth = "thin", 15 | show_menu_button = TRUE, 16 | dropdownMenu( 17 | type = "notifications", 18 | taskItem("Project progress...", 50.777, color = "red") 19 | ), 20 | dropdownMenu( 21 | icon = icon("red warning sign"), 22 | notificationItem("This is an important notification!", color = "red") 23 | ) 24 | ), 25 | dashboardSidebar( 26 | side = "left", 27 | size = "thin", 28 | overlay = FALSE, 29 | pushable = TRUE, 30 | visible = TRUE, 31 | dim_page = FALSE, 32 | closable = FALSE, 33 | sidebarMenu( 34 | sidebarUserPanel( 35 | "Jane Smith", 36 | subtitle = shiny::a(href = "#", icon("circle"), "Online"), 37 | # Original image is published with a free to use license. 38 | # https://www.pexels.com/photo/3492736/ 39 | image = "jane_smith.jpg", 40 | image_size = "mini" 41 | ), 42 | menuItem(tabName = "plot_tab", text = "My plot", icon = icon("home")), 43 | menuItem(tabName = "table_tab", text = "My table", icon = icon("smile")) 44 | ) 45 | ), 46 | 47 | dashboardBody( 48 | tabItems( 49 | tabItem( 50 | tabName = "plot_tab", fluid = TRUE, 51 | fluidRow( 52 | valueBox("Unread Mail", 44, icon("mail"), color = "blue", width = 5)), 53 | fluidRow( 54 | box( 55 | title = "Sample box", color = "blue", width = 11, 56 | selectInput( 57 | inputId = "variable1", 58 | choices = names(mtcars), 59 | label = "Select first variable", 60 | selected = "mpg" 61 | ), 62 | selectInput( 63 | inputId = "variable2", 64 | choices = names(mtcars), 65 | label = "Select second variable", selected = "cyl" 66 | ), 67 | plotlyOutput("mtcars_plot") 68 | ), 69 | tabBox( 70 | title = "Sample box", color = "blue", width = 5, 71 | collapsible = FALSE, 72 | tabs = list( 73 | list(menu = "First Tab", content = "Some text..."), 74 | list(menu = "Second Tab", content = plotlyOutput("mtcars_plot2")) 75 | ) 76 | ) 77 | ) 78 | ), 79 | tabItem( 80 | tabName = "table_tab", fluid = FALSE, 81 | fluidRow( 82 | valueBox("Unread Mail", 144, icon("mail"), color = "blue", width = 6, size = "small"), 83 | valueBox("Spam", 20, icon("mail"), color = "red", width = 5, size = "small"), 84 | valueBox("Readed Mail", 666, icon("mail"), color = "green", width = 5, size = "small") 85 | ), 86 | fluidRow( 87 | box( 88 | title = "Classic box", 89 | color = "red", 90 | ribbon = FALSE, 91 | title_side = "top left", 92 | width = 16, 93 | dataTableOutput("mtcars_table") 94 | ) 95 | ) 96 | ) 97 | ) 98 | ) 99 | ) 100 | 101 | server <- function(input, output) { 102 | 103 | output$mtcars_plot <- renderPlotly( 104 | plot_ly( 105 | mtcars, x = ~ mtcars[ , input$variable1], 106 | y = ~ mtcars[ ,input$variable2], 107 | type = "scatter", 108 | mode = "markers" 109 | ) 110 | ) 111 | output$mtcars_plot2 <- renderPlotly( 112 | plot_ly( 113 | mtcars, x = ~ mtcars[ , input$variable1], 114 | y = ~ mtcars[ , input$variable2], 115 | type = "scatter", 116 | mode = "markers" 117 | ) 118 | ) 119 | output$mtcars_table <- renderDataTable(mtcars) 120 | 121 | output$dropdown <- renderDropdownMenu({ 122 | dropdownMenu( 123 | messageItem("User", "Test message", color = "teal", style = "min-width: 200px"), 124 | messageItem("Users", "Test message", color = "teal", icon = "users"), 125 | messageItem("See this", "Another test", icon = "warning", color = "red") 126 | ) 127 | }) 128 | } 129 | 130 | shinyApp(ui, server) 131 | -------------------------------------------------------------------------------- /inst/semantic.dashboard.min.css: -------------------------------------------------------------------------------- 1 | body{min-height:unset !important;display:flex;flex-direction:column}body:not(.no-margin){padding:10px}body.no-margin>.ui.top.menu{border-top:0}body.no-margin>.ui.segment.pushable{border:0}body>.ui.segment.pushable.attached{display:flex;overflow:hidden;margin-bottom:0}body>.ui.segment.pushable>.pusher{overflow:auto;width:100%}.dashboard-body.ui.grid{margin:0}.dashboard-body.ui.grid .tab-content{padding-left:0;padding-right:0;width:100%}.ui.menu.dashboard-title{display:flex;justify-content:center;align-items:center;box-shadow:none;border-left-width:0;border-top-width:0;border-bottom-width:0;border-top-right-radius:0;border-bottom-right-radius:0;background:transparent}.dashboard-title.thin{width:150px}body.no-margin .dashboard-title.thin{width:calc(150px - 1px)}.dashboard-title{width:260px}body.no-margin .dashboard-title{width:calc(260px - 1px)}.dashboard-title.wide{width:350px}body.no-margin .dashboard-title.wide{width:calc(350px - 1px)}.dashboard-title[class*='very thin']{width:60px}body.no-margin .dashboard-title[class*='very thin']{width:calc(60px - 1px)}.dashboard-title[class*='very wide']{width:475px}body.no-margin .dashboard-title[class*='very wide']{width:calc(475px - 1px)}.ui.dashboard-title{background-color:rgba(255,255,255,0.9);color:rgba(0,0,0,0.87)}.ui.inverted.dashboard-title{color:rgba(255,255,255,0.9)}.ui.inverted.dashboard-title{background-color:#1B1C1D}.ui.inverted.red.dashboard-title{background-color:#DB2828}.ui.inverted.orange.dashboard-title{background-color:#F2711C}.ui.inverted.yellow.dashboard-title{background-color:#FBBD08}.ui.inverted.olive.dashboard-title{background-color:#B5CC18}.ui.inverted.green.dashboard-title{background-color:#21BA45}.ui.inverted.teal.dashboard-title{background-color:#00B5AD}.ui.inverted.blue.dashboard-title{background-color:#2185D0}.ui.inverted.violet.dashboard-title{background-color:#6435C9}.ui.inverted.purple.dashboard-title{background-color:#A333C8}.ui.inverted.pink.dashboard-title{background-color:#E03997}.ui.inverted.brown.dashboard-title{background-color:#A5673F}.ui.inverted.grey.dashboard-title{background-color:#767676}.ui.inverted.black.dashboard-title{background-color:#1B1C1D}.ui.top.menu.dashboard-header{justify-content:space-between}.ui.top.menu.dashboard-header h1,.ui.top.menu.dashboard-header h2,.ui.top.menu.dashboard-header h3,.ui.top.menu.dashboard-header h4,.ui.top.menu.dashboard-header h5,.ui.top.menu.dashboard-header h6{margin:0}.ui.top.menu.dashboard-header:after{content:none}.ui.top.menu.dashboard-header .logo{height:30px;margin:5px}.ui.top.menu.dashboard-header .header-part{display:flex;align-items:center}body.no-margin .ui.top.menu.dashboard-header{border-radius:0}.ui.sidebar~.pusher{transform:none !important;transition:margin-left .5s ease, margin-right .5s ease}.ui.sidebar.visible:not(.pushable):not(.overlay).left.thin+.pusher,.ui.sidebar.visible.uncover.pushable.left.thin+.pusher{margin-left:150px}.ui.sidebar.visible:not(.pushable):not(.overlay).left+.pusher,.ui.sidebar.visible.uncover.pushable.left+.pusher{margin-left:260px}.ui.sidebar.visible:not(.pushable):not(.overlay).left.wide+.pusher,.ui.sidebar.visible.uncover.pushable.left.wide+.pusher{margin-left:350px}.ui.sidebar.visible:not(.pushable):not(.overlay).left[class*='very thin']+.pusher,.ui.sidebar.visible.uncover.pushable.left[class*='very thin']+.pusher{margin-left:60px}.ui.sidebar.visible:not(.pushable):not(.overlay).left[class*='very wide']+.pusher,.ui.sidebar.visible.uncover.pushable.left[class*='very wide']+.pusher{margin-left:475px}.ui.sidebar.visible:not(.pushable):not(.overlay).right.thin+.pusher,.ui.sidebar.visible.uncover.pushable.right.thin+.pusher{margin-right:150px}.ui.sidebar.visible:not(.pushable):not(.overlay).right+.pusher,.ui.sidebar.visible.uncover.pushable.right+.pusher{margin-right:260px}.ui.sidebar.visible:not(.pushable):not(.overlay).right.wide+.pusher,.ui.sidebar.visible.uncover.pushable.right.wide+.pusher{margin-right:350px}.ui.sidebar.visible:not(.pushable):not(.overlay).right[class*='very thin']+.pusher,.ui.sidebar.visible.uncover.pushable.right[class*='very thin']+.pusher{margin-right:60px}.ui.sidebar.visible:not(.pushable):not(.overlay).right[class*='very wide']+.pusher,.ui.sidebar.visible.uncover.pushable.right[class*='very wide']+.pusher{margin-right:475px}.ui.sidebar.left{border-width:0;border-right-width:1px}.ui.sidebar.right{border-width:0;border-left-width:1px}.ui.sidebar.top{border-width:0;border-bottom-width:1px}.ui.sidebar.bottom{border-width:0;border-top-width:1px}.ui.sidebar .user-panel{min-height:65px;padding:13px 16px} 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # semantic.dashboard semantic.dashboard logo 2 | 3 | > _Quick, beautiful and customizable dashboard template for Shiny based on shiny.semantic and Fomantic UI._ 4 | 5 | 6 | [![R-CMD-check](https://github.com/Appsilon/semantic.dashboard/workflows/R-CMD-check/badge.svg)](https://github.com/Appsilon/semantic.dashboard/actions/workflows/main.yml) 7 | [![codecov](https://codecov.io/gh/Appsilon/semantic.dashboard/branch/master/graph/badge.svg)](https://codecov.io/gh/Appsilon/semantic.dashboard) 8 | [![cranlogs](https://cranlogs.r-pkg.org/badges/semantic.dashboard)](https://CRAN.R-project.org/package=semantic.dashboard) 9 | [![total](https://cranlogs.r-pkg.org/badges/grand-total/semantic.dashboard)](https://CRAN.R-project.org/package=semantic.dashboard) 10 | 11 | 12 | Are you fed up with ordinary `shinydashboard` look? 13 | 14 | Give your app a new fresh look with [Fomantic UI](https://fomantic-ui.com/) support. 15 | 16 | ``` r 17 | library(shiny) 18 | library(shinydashboard) # <-- Change this line to: library(semantic.dashboard) 19 | 20 | ui <- dashboardPage( 21 | dashboardHeader(title = "Basic dashboard"), 22 | dashboardSidebar(sidebarMenu( 23 | menuItem(tabName = "home", text = "Home", icon = icon("home")), 24 | menuItem(tabName = "another", text = "Another Tab", icon = icon("heart")) 25 | )), 26 | dashboardBody( 27 | fluidRow( 28 | box(plotOutput("plot1", height = 250)), 29 | box( 30 | title = "Controls", 31 | sliderInput("slider", "Number of observations:", 1, 100, 50) 32 | ) 33 | ) 34 | ) 35 | ) 36 | 37 | server <- function(input, output) { 38 | set.seed(122) 39 | histdata <- rnorm(500) 40 | output$plot1 <- renderPlot({ 41 | data <- histdata[seq_len(input$slider)] 42 | hist(data) 43 | }) 44 | } 45 | 46 | shinyApp(ui, server) 47 | ``` 48 | 49 | ![Semantic dashboards comparison](man/figures/compare.png) 50 | 51 | `semantic.dashboard` offers basic functions for creating dashboard with Fomantic UI. 52 | 53 | ## How to install? 54 | 55 | Install `shiny.semantic` library first. [Here](https://github.com/Appsilon/shiny.semantic) you can find how. 56 | 57 | You can install a stable version `semantic.dashboard` from CRAN repository: 58 | 59 | install.packages("semantic.dashboard") 60 | 61 | The development version can be installed from GitHub using `remotes`. 62 | 63 | remotes::install_github("Appsilon/semantic.dashboard") 64 | 65 | To install [previous version]() you can run: 66 | 67 | remotes::install_github("Appsilon/semantic.dashboard", ref = "0.1.0") 68 | 69 | ## Example 70 | 71 | You can find examples in the `examples/` folder of the [GitHub repository](https://github.com/Appsilon/semantic.dashboard). 72 | 73 | You can check [documentation](https://appsilon.github.io/semantic.dashboard/) for tutorials. 74 | 75 | ## How to contribute? 76 | 77 | If you want to contribute to this project please submit a regular PR, once you're done with new feature or bug fix. Please check `development/README.md` first! It contains useful 78 | information that will help you run your dev environment for `semantic.dashboard`. 79 | 80 | ## Troubleshooting 81 | 82 | We used the latest versions of dependencies for this library, so please update your R environment before installation. 83 | 84 | However, if you encounter any problems, try the following: 85 | 86 | 1. Up-to-date R language environment 87 | 2. Installing specific dependent libraries versions 88 | - shiny.semantic 89 | 90 | ## Future enhacements 91 | 92 | - Release of a stable 1.0.0 version 93 | - Closer integration with shinydashboard 94 | 95 | ## Appsilon 96 | 97 | 98 | 99 | Appsilon is a **Posit (formerly RStudio) Full Service Certified Partner**.
100 | Learn more at [appsilon.com](https://appsilon.com). 101 | 102 | Get in touch [opensource@appsilon.com](mailto:opensource@appsilon.com) 103 | 104 | Explore the [Rhinoverse](https://rhinoverse.dev) - a family of R packages built around [Rhino](https://appsilon.github.io/rhino/)! 105 | 106 | We are hiring! 107 | -------------------------------------------------------------------------------- /vignettes/intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Build your first semantic.dashboard" 3 | author: "Appsilon" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Build your first semantic.dashboard} 8 | %\VignetteEngine{knitr::knitr} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include = FALSE, screenshot.force = FALSE} 13 | knitr::opts_chunk$set( 14 | echo = TRUE, 15 | collapse = TRUE, 16 | comment = "#>" 17 | ) 18 | library(shiny) 19 | library(shiny.semantic) 20 | library(semantic.dashboard) 21 | ``` 22 | 23 | # What is a dashboard? 24 | 25 | R Shiny is an excellent tool for interactive data visualizations. However, fitting a large number of graphs onto just one Shiny page may prove to be a challenge. In our experience, virtually all projects with new KPIs being introduced along the way result in inadequate and not readable final reports. 26 | 27 | Dashboards provide a solution. They allow the developer to intuitively structure their reports by breaking them down into sections, panels and tabs. This makes it much easier for the final user to navigate through the data. 28 | 29 | # Why Semantic Dashboard? 30 | 31 | Semantic Dashboard offers an alternative look of your dashboard based on the [Fomantic UI](https://fomantic-ui.com/). Historically, we built this package around *Semantic UI* 32 | library, but it got deprecated and now (since December 2019) we base on the well-supported 33 | and maintained community fork called [Fomantic UI](https://fomantic-ui.com/). 34 | 35 | It relies and uses components from the mother package [shiny.semantic](https://github.com/Appsilon/shiny.semantic/). 36 | 37 | # Semantic Dashboard 38 | 39 | Basic dashboard structure is presented below. 40 | 41 | ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} 42 | library(shiny) 43 | library(semantic.dashboard) 44 | 45 | ui <- dashboardPage( 46 | dashboardHeader(), 47 | dashboardSidebar(), 48 | dashboardBody() 49 | ) 50 | 51 | server <- shinyServer(function(input, output, session) { 52 | 53 | }) 54 | 55 | shinyApp(ui, server) 56 | ``` 57 | 58 | Each `dashboardPage` consists of three elements: *header*, *sidebar*, and *body*. 59 | 60 | ## Editing header 61 | 62 | Here is one example of how to make header more interesting: 63 | 64 | ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} 65 | dashboardHeader(color = "blue", title = "Dashboard Demo", inverted = TRUE) 66 | ``` 67 | 68 | Now let's add also a notification on the right: 69 | 70 | ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} 71 | dashboardHeader(color = "blue", title = "Dashboard Demo", inverted = TRUE, 72 | dropdownMenu(type = "notifications", 73 | taskItem("Project progress...", 50.777, color = "red"))) 74 | ``` 75 | 76 | ## Editing Sidebar and Body 77 | 78 | In the sidebar we can define the references to the subpages that will be displayed in the content. 79 | For example: 80 | 81 | ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} 82 | dashboardSidebar( 83 | size = "thin", color = "teal", 84 | sidebarMenu( 85 | menuItem(tabName = "main", "Main"), 86 | menuItem(tabName = "extra", "Extra") 87 | ) 88 | ) 89 | ``` 90 | 91 | 92 | **PRACTICE** *Try to add icons to the `menuItem`.* 93 | The content of the app can be defined ike this. Note that we refer to exactly 94 | the same `tabName` as in the sidebar. 95 | 96 | ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} 97 | dashboardBody( 98 | tabItems( 99 | selected = 1, 100 | tabItem( 101 | tabName = "main", 102 | box(h1("main"), title = "A b c", width = 16, color = "orange") 103 | ), 104 | tabItem( 105 | tabName = "extra", 106 | h1("extra") 107 | ) 108 | ) 109 | ) 110 | ``` 111 | 112 | Note that we used `box` here with color set to *orange*. The list of all Fomantic 113 | color you may find here: `semantic_palette`. 114 | 115 | # Full code 116 | 117 | The effect and complete code for this example is presented below. 118 | 119 | dashboard 120 | 121 | ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} 122 | library(shiny) 123 | library(semantic.dashboard) 124 | 125 | ui <- dashboardPage( 126 | dashboardHeader(color = "blue", title = "Dashboard Demo", inverted = TRUE, 127 | dropdownMenu(type = "notifications", 128 | taskItem("Project progress...", 50.777, color = "red"))), 129 | dashboardSidebar( 130 | size = "thin", color = "teal", 131 | sidebarMenu( 132 | menuItem(tabName = "main", "Main"), 133 | menuItem(tabName = "extra", "Extra") 134 | ) 135 | ), 136 | dashboardBody( 137 | tabItems( 138 | selected = 1, 139 | tabItem( 140 | tabName = "main", 141 | box(h1("main"), title = "A b c", width = 16, color = "orange") 142 | ), 143 | tabItem( 144 | tabName = "extra", 145 | h1("extra") 146 | ) 147 | ) 148 | ) 149 | ) 150 | 151 | server <- function(input, output, session) {} 152 | 153 | shinyApp(ui, server) 154 | ``` 155 | -------------------------------------------------------------------------------- /R/dropdown_menu.R: -------------------------------------------------------------------------------- 1 | #' Create a dropdown menu. 2 | #' @description Create a dropdown menu with additional UI elements. 3 | #' @param ... UI elements to include within the dropdown menu. 4 | #' @param type Type of the displayed items. 5 | #' @param icon Icon of the dropdown menu. If not specified created based on \code{type} argument. 6 | #' @param show_counter If true circular label with counter is going to be shown for dropdown. 7 | #' @return A dropdown menu that can be passed to \code{\link[semantic.dashboard]{dashboardHeader}} 8 | #' @export 9 | #' @examples 10 | #' dropdownMenu(icon = icon("warning sign"), taskItem("Project progress...", 50.777, color = "red")) 11 | #' dropdownMenu(type = "notifications", notificationItem("This is notification!", color = "red")) 12 | dropdown_menu <- function(..., type = "messages", icon = NULL, show_counter = TRUE) { 13 | icon <- if (!is.null(icon)) { 14 | icon 15 | } else { 16 | icon(DROPDOWN_MENU_ICONS[[type]]) 17 | } 18 | notifications <- list(...) 19 | counter <- if (show_counter) { 20 | shiny::tags$div(class = "ui circular mini label", length(notifications), style = "") 21 | } else { 22 | NULL 23 | } 24 | 25 | shiny::tags$button(class = "ui icon top right inline item dropdown button", 26 | style = "margin-right: 0", 27 | icon, 28 | counter, 29 | shiny::tags$div(class = "menu", interlace_dividers(notifications)), 30 | shiny::tags$script(dropdown_menu_js), 31 | shiny::tags$script(progress_bar_js)) 32 | } 33 | 34 | #' @describeIn dropdown_menu Create a dropdown menu (alias for \code{dropdown_menu} for 35 | #' compatibility with \code{shinydashboard}) 36 | #' @export 37 | dropdownMenu <- dropdown_menu 38 | 39 | #' Create a message item. 40 | #' @description Create a message item. 41 | #' @param from Who the message is from. 42 | #' @param message Text of the message. 43 | #' @param ... Additional UI elements to include within the dropdown menu. 44 | #' @param icon Additional icon. 45 | #' @return A message item that can be passed to \code{\link[semantic.dashboard]{dropdownMenu}} 46 | #' @export 47 | #' @examples 48 | #' messageItem("Marek", "Another test!", icon = "warning") 49 | message_item <- function(from, message, ..., icon = "user") { 50 | shiny::tags$a(class = "item", 51 | shiny::tags$span(class = "description", message), 52 | shiny::tags$span(class = "text", 53 | shiny::tags$i(class = paste(icon, "icon")), 54 | from), 55 | ...) 56 | } 57 | 58 | #' @describeIn message_item Create a message item (alias for \code{message_item} for compatibility 59 | #' with \code{shinydashboard}) 60 | #' @export 61 | messageItem <- message_item 62 | 63 | #' Create a task item. 64 | #' @description Create a task item. 65 | #' @param text Progress bar label. 66 | #' @param value Progress bar value. 67 | #' @param color Color of the task item. One of \code{c("", "red", "orange", 68 | #' "yellow", "olive", "green", "teal", "blue", "violet", "purple", "pink", 69 | #' "brown", "grey", "black")} 70 | #' @return A task item that can be passed to \code{\link[semantic.dashboard]{dropdownMenu}} 71 | #' @export 72 | #' @examples 73 | #' taskItem("Project progress...", 50.777, color = "red") 74 | task_item <- function(text, value, color = "") { 75 | if (!is.numeric(value) || (value < MIN_PROGRESS_VALUE) || (value > MAX_PROGRESS_VALUE)) { 76 | warning(paste("'value' must be between", MIN_PROGRESS_VALUE, "and", MAX_PROGRESS_VALUE)) 77 | } 78 | verify_value_allowed("color", c("", ALLOWED_COLORS)) 79 | shiny::tags$div( 80 | class = "item", 81 | style = "min-width: 200px;", 82 | shiny::tags$div( 83 | class = paste("ui active progress", color), 84 | `data-percent` = value, 85 | `data-total` = 100, 86 | shiny::tags$div(class = "bar", shiny::tags$div(class = "progress")), 87 | shiny::tags$div(class = "label", text) 88 | ) 89 | ) 90 | } 91 | 92 | #' @describeIn task_item Create a task item (alias for \code{taks_item} for compatibility with 93 | #' \code{shinydashboard}) 94 | #' @export 95 | taskItem <- task_item 96 | 97 | #' Create a notification item. 98 | #' @description Create a notification item. 99 | #' @param text Text of the notification. 100 | #' @param icon Additional icon. 101 | #' @param color Color of the notification item. One of 102 | #' \code{c("", "red", "orange", "yellow", "olive", "green", "teal", "blue", 103 | #' "violet", "purple", "pink", "brown", "grey", "black")} 104 | #' @return A notification item that can be passed to \code{\link[semantic.dashboard]{dropdownMenu}} 105 | #' @export 106 | #' @examples 107 | #' notificationItem("This is notification!", color = "red") 108 | notification_item <- function(text, icon = "warning", color = "") { 109 | verify_value_allowed("color", c("", ALLOWED_COLORS)) 110 | shiny::tags$div(class = "item", 111 | shiny::tags$div(class = paste("ui label", color), 112 | shiny::tags$i(class = paste("small", icon, "icon")), text)) 113 | } 114 | 115 | #' @describeIn notification_item Create a notification item (alias for \code{notification_item} for 116 | #' compatibility with \code{shinydashboard}) 117 | #' @export 118 | notificationItem <- notification_item 119 | -------------------------------------------------------------------------------- /inst/semantic.dashboard.css: -------------------------------------------------------------------------------- 1 | body { 2 | min-height: unset !important; 3 | display: flex; 4 | flex-direction: column; 5 | } 6 | 7 | body:not(.no-margin) { 8 | padding: 10px; 9 | } 10 | 11 | body.no-margin > .ui.top.menu { 12 | border-top: 0; 13 | } 14 | 15 | body.no-margin > .ui.segment.pushable { 16 | border: 0; 17 | } 18 | 19 | body > .ui.segment.pushable.attached { 20 | display: flex; 21 | overflow: hidden; 22 | margin-bottom: 0; 23 | } 24 | 25 | body > .ui.segment.pushable > .pusher { 26 | overflow: auto; 27 | width: 100%; 28 | } 29 | 30 | .dashboard-body.ui.grid { 31 | margin: 0; 32 | } 33 | 34 | .dashboard-body.ui.grid .tab-content { 35 | padding-left: 0; 36 | padding-right: 0; 37 | width: 100%; 38 | } 39 | 40 | .ui.menu.dashboard-title { 41 | display: flex; 42 | justify-content: center; 43 | align-items: center; 44 | box-shadow: none; 45 | border-left-width: 0; 46 | border-top-width: 0; 47 | border-bottom-width: 0; 48 | border-top-right-radius: 0; 49 | border-bottom-right-radius: 0; 50 | background: transparent; 51 | } 52 | 53 | .dashboard-title.thin { 54 | width: 150px; 55 | } 56 | 57 | body.no-margin .dashboard-title.thin { 58 | width: calc(150px - 1px); 59 | } 60 | 61 | .dashboard-title { 62 | width: 260px; 63 | } 64 | 65 | body.no-margin .dashboard-title { 66 | width: calc(260px - 1px); 67 | } 68 | 69 | .dashboard-title.wide { 70 | width: 350px; 71 | } 72 | 73 | body.no-margin .dashboard-title.wide { 74 | width: calc(350px - 1px); 75 | } 76 | 77 | .dashboard-title[class*='very thin'] { 78 | width: 60px; 79 | } 80 | 81 | body.no-margin .dashboard-title[class*='very thin'] { 82 | width: calc(60px - 1px); 83 | } 84 | 85 | .dashboard-title[class*='very wide'] { 86 | width: 475px; 87 | } 88 | 89 | body.no-margin .dashboard-title[class*='very wide'] { 90 | width: calc(475px - 1px); 91 | } 92 | 93 | /*-------------- 94 | Colors 95 | -------------- */ 96 | .ui.dashboard-title { 97 | background-color: rgba(255, 255, 255, 0.9); 98 | color: rgba(0, 0, 0, 0.87); 99 | } 100 | 101 | .ui.inverted.dashboard-title { 102 | color: rgba(255, 255, 255, 0.9); 103 | } 104 | 105 | .ui.inverted.dashboard-title { 106 | background-color: #1B1C1D; 107 | } 108 | 109 | .ui.inverted.red.dashboard-title { 110 | background-color: #DB2828; 111 | } 112 | 113 | .ui.inverted.orange.dashboard-title { 114 | background-color: #F2711C; 115 | } 116 | 117 | .ui.inverted.yellow.dashboard-title { 118 | background-color: #FBBD08; 119 | } 120 | 121 | .ui.inverted.olive.dashboard-title { 122 | background-color: #B5CC18; 123 | } 124 | 125 | .ui.inverted.green.dashboard-title { 126 | background-color: #21BA45; 127 | } 128 | 129 | .ui.inverted.teal.dashboard-title { 130 | background-color: #00B5AD; 131 | } 132 | 133 | .ui.inverted.blue.dashboard-title { 134 | background-color: #2185D0; 135 | } 136 | 137 | .ui.inverted.violet.dashboard-title { 138 | background-color: #6435C9; 139 | } 140 | 141 | .ui.inverted.purple.dashboard-title { 142 | background-color: #A333C8; 143 | } 144 | 145 | .ui.inverted.pink.dashboard-title { 146 | background-color: #E03997; 147 | } 148 | 149 | .ui.inverted.brown.dashboard-title { 150 | background-color: #A5673F; 151 | } 152 | 153 | .ui.inverted.grey.dashboard-title { 154 | background-color: #767676; 155 | } 156 | 157 | .ui.inverted.black.dashboard-title { 158 | background-color: #1B1C1D; 159 | } 160 | 161 | .ui.top.menu.dashboard-header { 162 | justify-content: space-between; 163 | } 164 | 165 | .ui.top.menu.dashboard-header h1, .ui.top.menu.dashboard-header h2, .ui.top.menu.dashboard-header h3, .ui.top.menu.dashboard-header h4, .ui.top.menu.dashboard-header h5, .ui.top.menu.dashboard-header h6 { 166 | margin: 0; 167 | } 168 | 169 | .ui.top.menu.dashboard-header:after { 170 | content: none; 171 | } 172 | 173 | .ui.top.menu.dashboard-header .logo { 174 | height: 30px; 175 | margin: 5px; 176 | } 177 | 178 | .ui.top.menu.dashboard-header .header-part { 179 | display: flex; 180 | align-items: center; 181 | } 182 | 183 | body.no-margin .ui.top.menu.dashboard-header { 184 | border-radius: 0; 185 | } 186 | 187 | .ui.sidebar ~ .pusher { 188 | transform: none !important; 189 | transition: margin-left .5s ease, margin-right .5s ease; 190 | } 191 | 192 | .ui.sidebar.visible:not(.pushable):not(.overlay).left.thin + .pusher, 193 | .ui.sidebar.visible.uncover.pushable.left.thin + .pusher { 194 | margin-left: 150px; 195 | } 196 | 197 | .ui.sidebar.visible:not(.pushable):not(.overlay).left + .pusher, 198 | .ui.sidebar.visible.uncover.pushable.left + .pusher { 199 | margin-left: 260px; 200 | } 201 | 202 | .ui.sidebar.visible:not(.pushable):not(.overlay).left.wide + .pusher, 203 | .ui.sidebar.visible.uncover.pushable.left.wide + .pusher { 204 | margin-left: 350px; 205 | } 206 | 207 | .ui.sidebar.visible:not(.pushable):not(.overlay).left[class*='very thin'] + .pusher, 208 | .ui.sidebar.visible.uncover.pushable.left[class*='very thin'] + .pusher { 209 | margin-left: 60px; 210 | } 211 | 212 | .ui.sidebar.visible:not(.pushable):not(.overlay).left[class*='very wide'] + .pusher, 213 | .ui.sidebar.visible.uncover.pushable.left[class*='very wide'] + .pusher { 214 | margin-left: 475px; 215 | } 216 | 217 | .ui.sidebar.visible:not(.pushable):not(.overlay).right.thin + .pusher, 218 | .ui.sidebar.visible.uncover.pushable.right.thin + .pusher { 219 | margin-right: 150px; 220 | } 221 | 222 | .ui.sidebar.visible:not(.pushable):not(.overlay).right + .pusher, 223 | .ui.sidebar.visible.uncover.pushable.right + .pusher { 224 | margin-right: 260px; 225 | } 226 | 227 | .ui.sidebar.visible:not(.pushable):not(.overlay).right.wide + .pusher, 228 | .ui.sidebar.visible.uncover.pushable.right.wide + .pusher { 229 | margin-right: 350px; 230 | } 231 | 232 | .ui.sidebar.visible:not(.pushable):not(.overlay).right[class*='very thin'] + .pusher, 233 | .ui.sidebar.visible.uncover.pushable.right[class*='very thin'] + .pusher { 234 | margin-right: 60px; 235 | } 236 | 237 | .ui.sidebar.visible:not(.pushable):not(.overlay).right[class*='very wide'] + .pusher, 238 | .ui.sidebar.visible.uncover.pushable.right[class*='very wide'] + .pusher { 239 | margin-right: 475px; 240 | } 241 | 242 | .ui.sidebar.left { 243 | border-width: 0; 244 | border-right-width: 1px; 245 | } 246 | 247 | .ui.sidebar.right { 248 | border-width: 0; 249 | border-left-width: 1px; 250 | } 251 | 252 | .ui.sidebar.top { 253 | border-width: 0; 254 | border-bottom-width: 1px; 255 | } 256 | 257 | .ui.sidebar.bottom { 258 | border-width: 0; 259 | border-top-width: 1px; 260 | } 261 | 262 | .ui.sidebar .user-panel { 263 | min-height: 65px; 264 | padding: 13px 16px; 265 | } 266 | -------------------------------------------------------------------------------- /examples/bus/server.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(curl) # make the jsonlite suggested dependency explicit 3 | 4 | # 1=South, 2=East, 3=West, 4=North 5 | dirColors <-c("1" = "#595490", "2" = "#527525", "3" = "#A93F35", "4" = "#BA48AA") 6 | 7 | # Download data from the Twin Cities Metro Transit API 8 | # http://svc.metrotransit.org/NexTrip/help 9 | 10 | ## NOTE: Due to connection problem with above link, data from 'getMetroData' was simulated! 11 | getMetroData <- function(path) { 12 | ## url <- paste0("http://svc.metrotransit.org/NexTrip/", path, "?format=json") 13 | ## jsonlite::fromJSON(url) 14 | data.frame( 15 | Route = sample(2:7, 100, replace = TRUE), 16 | Direction = sample(1:4, 100, replace = TRUE), 17 | VehicleLongitude = rnorm(100, -93.258133, 0.1), 18 | VehicleLatitude = rnorm(100, 44.986656, 0.1) 19 | ) 20 | } 21 | 22 | # Load static trip and shape data 23 | trips <- readRDS("metrotransit-data/rds/trips.rds") 24 | shapes <- readRDS("metrotransit-data/rds/shapes.rds") 25 | 26 | 27 | # Get the shape for a particular route. This isn't perfect. Each route has a 28 | # large number of different trips, and each trip can have a different shape. 29 | # This function simply returns the most commonly-used shape across all trips for 30 | # a particular route. 31 | get_route_shape <- function(route) { 32 | routeid <- paste0(route, "-75") 33 | 34 | # For this route, get all the shape_ids listed in trips, and a count of how 35 | # many times each shape is used. We'll just pick the most commonly-used shape. 36 | shape_counts <- trips %>% 37 | filter(route_id == routeid) %>% 38 | group_by(shape_id) %>% 39 | summarise(n = n()) %>% 40 | arrange(-n) 41 | 42 | shapeid <- shape_counts$shape_id[1] 43 | 44 | # Get the coordinates for the shape_id 45 | shapes %>% filter(shape_id == shapeid) 46 | } 47 | 48 | 49 | function(input, output, session) { 50 | 51 | # Route select input box 52 | output$routeSelect <- renderUI({ 53 | live_vehicles <- getMetroData("VehicleLocations/0") 54 | 55 | routeNums <- sort(unique(as.numeric(live_vehicles$Route))) 56 | # Add names, so that we can add all=0 57 | names(routeNums) <- routeNums 58 | routeNums <- c(All = 0, routeNums) 59 | selectInput("routeNum", "Route", choices = routeNums, selected = routeNums[2]) 60 | }) 61 | 62 | # Locations of all active vehicles 63 | vehicleLocations <- reactive({ 64 | input$refresh # Refresh if button clicked 65 | 66 | # Get interval (minimum 30) 67 | interval <- max(as.numeric(input$interval), 30) 68 | # Invalidate this reactive after the interval has passed, so that data is 69 | # fetched again. 70 | invalidateLater(interval * 1000, session) 71 | 72 | getMetroData("VehicleLocations/0") 73 | }) 74 | 75 | # Locations of vehicles for a particular route 76 | routeVehicleLocations <- reactive({ 77 | if (is.null(input$routeNum)) 78 | return() 79 | 80 | locations <- vehicleLocations() 81 | 82 | if (as.numeric(input$routeNum) == 0) 83 | return(locations) 84 | 85 | locations[locations$Route == input$routeNum, ] 86 | }) 87 | 88 | # Get time that vehicles locations were updated 89 | lastUpdateTime <- reactive({ 90 | vehicleLocations() # Trigger this reactive when vehicles locations are updated 91 | Sys.time() 92 | }) 93 | 94 | # Number of seconds since last update 95 | output$timeSinceLastUpdate <- renderUI({ 96 | # Trigger this every 5 seconds 97 | invalidateLater(5000, session) 98 | p( 99 | class = "text-muted", 100 | "Data refreshed ", 101 | round(difftime(Sys.time(), lastUpdateTime(), units = "secs")), 102 | " seconds ago." 103 | ) 104 | }) 105 | 106 | output$numVehiclesTable <- renderUI({ 107 | locations <- routeVehicleLocations() 108 | if (length(locations) == 0 || nrow(locations) == 0) 109 | return(NULL) 110 | 111 | # Create a Bootstrap-styled table 112 | tags$table(class = "table", 113 | tags$thead(tags$tr( 114 | tags$th("Color"), 115 | tags$th("Direction"), 116 | tags$th("Number of vehicles") 117 | )), 118 | tags$tbody( 119 | tags$tr( 120 | tags$td(span(style = sprintf( 121 | "width:1.1em; height:1.1em; background-color:%s; display:inline-block;", 122 | dirColors[4] 123 | ))), 124 | tags$td("Northbound"), 125 | tags$td(nrow(locations[locations$Direction == "4",])) 126 | ), 127 | tags$tr( 128 | tags$td(span(style = sprintf( 129 | "width:1.1em; height:1.1em; background-color:%s; display:inline-block;", 130 | dirColors[1] 131 | ))), 132 | tags$td("Southbound"), 133 | tags$td(nrow(locations[locations$Direction == "1",])) 134 | ), 135 | tags$tr( 136 | tags$td(span(style = sprintf( 137 | "width:1.1em; height:1.1em; background-color:%s; display:inline-block;", 138 | dirColors[2] 139 | ))), 140 | tags$td("Eastbound"), 141 | tags$td(nrow(locations[locations$Direction == "2",])) 142 | ), 143 | tags$tr( 144 | tags$td(span(style = sprintf( 145 | "width:1.1em; height:1.1em; background-color:%s; display:inline-block;", 146 | dirColors[3] 147 | ))), 148 | tags$td("Westbound"), 149 | tags$td(nrow(locations[locations$Direction == "3",])) 150 | ), 151 | tags$tr(class = "active", 152 | tags$td(), 153 | tags$td("Total"), 154 | tags$td(nrow(locations)) 155 | ) 156 | ) 157 | ) 158 | }) 159 | 160 | # Store last zoom button value so we can detect when it's clicked 161 | lastZoomButtonValue <- NULL 162 | 163 | output$busmap <- renderLeaflet({ 164 | locations <- routeVehicleLocations() 165 | if (length(locations) == 0) 166 | return(NULL) 167 | 168 | # Show only selected directions 169 | locations <- filter(locations, Direction %in% as.numeric(input$directions)) 170 | 171 | # Four possible directions for bus routes 172 | dirPal <- colorFactor(dirColors, names(dirColors)) 173 | 174 | map <- leaflet(locations) %>% 175 | addTiles('http://{s}.tile.thunderforest.com/transport/{z}/{x}/{y}.png') %>% 176 | addCircleMarkers( 177 | ~VehicleLongitude, 178 | ~VehicleLatitude, 179 | color = ~dirPal(Direction), 180 | opacity = 0.8, 181 | radius = 8 182 | ) 183 | 184 | if (as.numeric(input$routeNum) != 0) { 185 | route_shape <- get_route_shape(input$routeNum) 186 | 187 | map <- addPolylines(map, 188 | route_shape$shape_pt_lon, 189 | route_shape$shape_pt_lat, 190 | fill = FALSE 191 | ) 192 | } 193 | 194 | rezoom <- "first" 195 | # If zoom button was clicked this time, and store the value, and rezoom 196 | if (!identical(lastZoomButtonValue, input$zoomButton)) { 197 | lastZoomButtonValue <<- input$zoomButton 198 | rezoom <- "always" 199 | } 200 | 201 | map <- map %>% mapOptions(zoomToLimits = rezoom) 202 | 203 | map 204 | }) 205 | } 206 | -------------------------------------------------------------------------------- /R/menu_item.R: -------------------------------------------------------------------------------- 1 | #' Create Semantic UI icon tag (alias for \code{icon} for compatibility with \code{shinydashboard}) 2 | #' 3 | #' This creates an icon tag using Semantic UI styles. 4 | #' 5 | #' @param type A name of an icon. Look at http://semantic-ui.com/elements/icon.html for all 6 | #' possibilities. 7 | #' @param ... Other arguments to be added as attributes of the tag (e.g. style, class etc.) 8 | #' 9 | #' @export 10 | #' @examples 11 | #' icon("dog") 12 | icon <- function(type, ...) { 13 | shiny.semantic::icon(type, ...) 14 | } 15 | 16 | #' Valid tab name should not containt dot character '.'. 17 | #' @param name Tab name to validate. 18 | #' @keywords internal 19 | validate_tab_name <- function(name) { 20 | if (grepl(".", name, fixed = TRUE)) { 21 | stop("tabName must not have a '.' in it.") 22 | } 23 | } 24 | 25 | #' Create a menu item. 26 | #' @description Create a menu item corresponding to a tab. 27 | #' @param text Text to show for the menu item. 28 | #' @param ... This may consist of menuSubItems. 29 | #' @param icon Icon of the menu item. (Optional) 30 | #' @param tabName Id of the tab. Not compatible with href. 31 | #' @param href A link address. Not compatible with tabName. 32 | #' @param newtab If href is supplied, should the link open in a new browser tab? 33 | #' @param selected If TRUE, this menuItem will start selected. 34 | #' @return A menu item that can be passed \code{\link[semantic.dashboard]{sidebarMenu}} 35 | #' @export 36 | #' @examples 37 | #' menuItem(tabName = "plot_tab", text = "My plot", icon = icon("home")) 38 | menu_item <- function(text, 39 | ..., 40 | icon = NULL, 41 | tabName = NULL, 42 | href = NULL, 43 | newtab = TRUE, 44 | selected = FALSE) { 45 | sub_items <- list(...) 46 | if (!is.null(href) + (!is.null(tabName) + (length(sub_items) > 0) != 1)) { 47 | stop("Must have either href, tabName, or sub-items (contained in ...).") 48 | } 49 | data_tab <- NULL 50 | target <- NULL 51 | isTabItem <- FALSE 52 | 53 | if (!is.null(tabName)) { 54 | validate_tab_name(tabName) 55 | isTabItem <- TRUE 56 | data_tab <- paste0("shiny-tab-", tabName) 57 | href <- paste0("#", data_tab) 58 | } else if (is.null(href)) { 59 | href <- "#" 60 | } else if (newtab) { 61 | target <- "_blank" 62 | } 63 | 64 | if (length(sub_items) == 0) { 65 | shiny::tags$a( 66 | class = "item", href = href, icon, text, 67 | `data-tab` = data_tab, 68 | `data-toggle` = if (isTabItem) "tab", 69 | `data-value` = if (!is.null(tabName)) tabName, 70 | target = target, 71 | if (selected) shiny::singleton(shiny::tags$script(shiny::HTML(glue::glue(" 72 | $(function() {{ 73 | ['.dashboard-sidebar a', '.tab-content > div'].forEach(function(tag) {{ 74 | $(`${{tag}}[data-tab]`).removeClass('active'); 75 | $(`${{tag}}[data-tab=\"{data_tab}\"]`).addClass('active'); 76 | }}) 77 | }}) 78 | ")))) 79 | ) 80 | } else { 81 | shiny::tags$div(class = "item", 82 | shiny::tags$div(class = "header", text), 83 | shiny::tags$div(class = "menu", sub_items) 84 | ) 85 | } 86 | } 87 | 88 | #' @describeIn menu_item Create a menu item (alias for \code{menu_item} for compatibility with 89 | #' \code{shinydashboard}) 90 | #' @export 91 | menuItem <- menu_item 92 | 93 | #' @describeIn menu_item Create a menu item (alias for \code{menu_item} for compatibility with 94 | #' \code{shinydashboard}) 95 | #' @export 96 | menuSubItem <- menu_item 97 | 98 | #' Create a sidebar menu. 99 | #' @description Create a sidebar menu with menu items. 100 | #' @param ... Menu items. 101 | #' @return A sidebar menu that can be passed \code{\link[semantic.dashboard]{dashboardSidebar}} 102 | #' @export 103 | #' @details 104 | #' It's possible to set selected menu item by setting `selected = TRUE` in `menuItem`. 105 | #' @examples 106 | #' sidebarMenu( 107 | #' menuItem(tabName = "plot_tab", text = "My plot", icon = icon("home")), 108 | #' menuItem(tabName = "table_tab", text = "My table", icon = icon("smile"), selected = TRUE) 109 | #' ) 110 | sidebar_menu <- function(...) { 111 | shiny::div(id = "uisidebar", list(...)) 112 | } 113 | 114 | #' @describeIn sidebar_menu Create a sidebar menu (alias for \code{sidebar_menu} for compatibility 115 | #' with \code{shinydashboard}) 116 | #' @export 117 | sidebarMenu <- sidebar_menu 118 | 119 | #' Change the selected tab on the client 120 | #' @param session The session object passed to function given to shinyServer 121 | #' @param tab The name of the tab that should be selected 122 | #' @examples 123 | #' if (interactive()) { 124 | #' ui <- dashboardPage( 125 | #' dashboardSidebar( 126 | #' sidebarMenu( 127 | #' menuItem("Tab 1", tabName = "tab1"), 128 | #' menuItem("Tab 2", tabName = "tab2") 129 | #' ) 130 | #' ), 131 | #' dashboardBody( 132 | #' tabItems( 133 | #' tabItem(tabName = "tab1", h2("Tab 1")), 134 | #' tabItem(tabName = "tab2", h2("Tab 2")) 135 | #' ) 136 | #' ) 137 | #' ) 138 | #' 139 | #' server <- function(input, output, session) { 140 | #' update_tab_items(tab = "tab2") 141 | #' } 142 | #' 143 | #' shinyApp(ui, server) 144 | #' } 145 | #' @export 146 | update_tab_items <- function(session = shiny::getDefaultReactiveDomain(), tab) { 147 | validate_session_object(session) # nolint: object_usage_linter 148 | session$sendCustomMessage("update_tab", tab) 149 | } 150 | 151 | #' @describeIn update_tab_items Change the selected item on the client (alias for 152 | #' \code{update_tab_items} for compatibility with \code{shinydashboard}) 153 | #' @export 154 | updateTabItems <- update_tab_items 155 | 156 | #' Create a user panel 157 | #' 158 | #' @description This creates an user panel using Semantic UI styles. 159 | #' 160 | #' @param name Name of the user 161 | #' @param subtitle Information to be displayed below the name (for example 162 | #' if the user is online) 163 | #' @param image Path to an image. This can be a relative link to an existing 164 | #' `www/` directory, or an URL to an image 165 | #' @param image_size CSS class to display the image, see Semantic documentation 166 | #' for all sizes (goes from `mini` to `massive`) 167 | #' 168 | #' @return A div tag with the user panel 169 | #' @export 170 | #' 171 | #' @examples 172 | #' sidebarUserPanel( 173 | #' "Some Name", 174 | #' subtitle = shiny::a(href = "#", icon("circle"), "Online"), 175 | #' # Image file should be in www/ subdir 176 | #' # or a link to a image 177 | #' image = "some_image_located_inside_www_dir.jpg", 178 | #' image_size = "mini" 179 | #' ) 180 | #' 181 | #' ui_user <- sidebarUserPanel( 182 | #' "Jane Smith", 183 | #' subtitle = shiny::a(href = "#", icon("circle"), "Online"), 184 | #' # Image file should be in www/ subdir 185 | #' # or a link to a image 186 | #' image = base::system.file( 187 | #' file.path('examples', "www", "jane_smith.jpg"), 188 | #' package = "semantic.dashboard" 189 | #' ), 190 | #' image_size = "mini" 191 | #' ) 192 | #' 193 | #' if (interactive()) { 194 | #' ui <- dashboardPage( 195 | #' dashboardHeader(), 196 | #' dashboardSidebar( 197 | #' ui_user, 198 | #' sidebarMenu( 199 | #' menuItem("Tab 1", tabName = "tab1"), 200 | #' menuItem("Tab 2", tabName = "tab2") 201 | #' ) 202 | #' ), 203 | #' body = dashboardBody( 204 | #' tabItems( 205 | #' tabItem(tabName = "tab1", h2("Tab 1")), 206 | #' tabItem(tabName = "tab2", h2("Tab 2")) 207 | #' ) 208 | #' ) 209 | #' ) 210 | #' 211 | #' server <- function(input, output, session) {} 212 | #' shinyApp(ui, server) 213 | #' } 214 | sidebar_user_panel <- function(name, 215 | subtitle = NULL, 216 | image = NULL, 217 | image_size = "tiny") { 218 | shiny::div( 219 | class = "user-panel", 220 | if (!is.null(image)) { 221 | shiny::img( 222 | src = image, 223 | class = glue::glue("ui {image_size} circular left floated image", 224 | alt = "User Image") 225 | ) 226 | }, 227 | p(name), subtitle 228 | ) 229 | } 230 | 231 | #' @describeIn sidebar_user_panel Create a sidebar user panel (alias for 232 | #' \code{sidebar_user_panel} for compatibility with \code{shinydashboard}) 233 | #' @export 234 | sidebarUserPanel <- sidebar_user_panel 235 | -------------------------------------------------------------------------------- /R/semantic_dashboard.R: -------------------------------------------------------------------------------- 1 | #' semantic.dashboard 2 | #' 3 | #' @name semantic.dashboard 4 | #' @import htmltools 5 | #' @import glue 6 | #' @import checkmate 7 | #' @keywords internal 8 | NULL 9 | 10 | #' Create a header of a dashboard. 11 | #' @description Create a header of a dashboard with other additional UI elements. 12 | #' Hint: use \code{shiny::tagList()} if you want to add multiple elements in 13 | #' \code{left} / \code{center} or \code{right}. 14 | #' @param ... UI elements to include within the header. They will be displayed on the right side. 15 | #' @param left UI element to put on the left of the header. It will be placed after (to the right) 16 | #' the title and menu button (if they exist). 17 | #' @param center UI element to put in the center of the header. 18 | #' @param right UI element to put to the right of the header. It will be placed before elements 19 | #' defined in \code{...} (if there are any). 20 | #' @param title Dashboard title to be displayed in the upper left corner. If NULL, will not display 21 | #' any title field. Use "" for an empty title. 22 | #' @param titleWidth Title field width, one of \code{c(NULL, "very thin", "thin", "wide", 23 | #' "very wide")} 24 | #' @param logo_align Where should logo be placed. One of \code{c("left", "center")} 25 | #' @param logo_path Path or URL of the logo to be shown in the header. 26 | #' @param color Color of the sidebar / text / icons (depending on the value of `inverted` parameter. 27 | #' One of \code{c("", "red", "orange", "yellow", "olive", "green", "teal", "blue", "violet", 28 | #' "purple", "pink", "brown", "grey", "black")} 29 | #' @param inverted If FALSE sidebar will be white and text will be colored. \ 30 | #' If TRUE text will be white and background will be colored. Default is \code{FALSE}. 31 | #' @param disable If \code{TRUE}, don't display the header. 32 | #' @param show_menu_button If \code{FALSE}, don't display the menu button. Default is \code{TRUE}. 33 | #' @param menu_button_label Text of the menu button. Default is \code{"Menu"}. 34 | #' @param class CSS class to be applied to the container of \code{dashboardHeader}. 35 | #' @return A header that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 36 | #' @export 37 | #' @examples 38 | #' if(interactive()) { 39 | #' 40 | #' library(shiny) 41 | #' library(semantic.dashboard) 42 | #' 43 | #' ui <- dashboardPage( 44 | #' dashboardHeader(color = "blue", inverted = TRUE), 45 | #' dashboardSidebar(side = "left", size = "thin", color = "teal", 46 | #' sidebarMenu( 47 | #' menuItem(tabName = "tab1", "Tab 1"), 48 | #' menuItem(tabName = "tab2", "Tab 2"))), 49 | #' dashboardBody(tabItems( 50 | #' tabItem(tabName = "tab1", p("Tab 1")), 51 | #' tabItem(tabName = "tab2", p("Tab 2")))) 52 | #' ) 53 | #' 54 | #' server <- function(input, output) { 55 | #' } 56 | #' 57 | #' shinyApp(ui, server) 58 | #' } 59 | dashboard_header <- function(..., left = NULL, center = NULL, right = NULL, 60 | title = NULL, titleWidth = "thin", 61 | logo_align = "center", logo_path = "", 62 | color = "", inverted = FALSE, disable = FALSE, 63 | show_menu_button = TRUE, menu_button_label = "Menu", 64 | class = "") { 65 | if (disable) { 66 | NULL 67 | } else { 68 | verify_value_allowed("color", ALLOWED_COLORS) 69 | verify_value_allowed("titleWidth", ALLOWED_SIDEBAR_SIZES) 70 | 71 | inverted_value <- get_inverted_class(inverted) 72 | 73 | title_span <- if (!is.null(title)) { 74 | title_class <- paste( 75 | c("ui menu dashboard-title", titleWidth, inverted_value, color), 76 | collapse = " " 77 | ) 78 | shiny::span(title, class = title_class) 79 | } else { 80 | NULL 81 | } 82 | 83 | logo <- if (logo_path != "") { 84 | shiny::tags$img( 85 | class = "logo", 86 | src = logo_path 87 | ) 88 | } else { 89 | NULL 90 | } 91 | 92 | menu_button <- if (isTRUE(show_menu_button)) { 93 | shiny::tags$a( 94 | id = "toggle_menu", class = "item", 95 | shiny::tags$i(class = "sidebar icon"), 96 | menu_button_label 97 | ) 98 | } else { 99 | NULL 100 | } 101 | 102 | logo_left <- if (logo_align == "left") logo 103 | logo_center <- if (logo_align == "center") logo 104 | logo_right <- if (logo_align == "right") logo 105 | 106 | left_content <- div( 107 | class = "header-part header-part__left", 108 | title_span, 109 | menu_button, 110 | logo_left, 111 | left 112 | ) 113 | center_content <- div(class = "header-part header-part__center", logo_center, center) 114 | right_content <- div(class = "header-part header-part__right", logo_right, right, ...) 115 | 116 | shiny::div( 117 | class = paste("ui top attached dashboard-header", inverted_value, color, "menu", class), 118 | left_content, 119 | center_content, 120 | right_content 121 | ) 122 | } 123 | } 124 | 125 | #' @describeIn dashboard_header Create a header of a dashboard (alias for \code{dashboard_header} 126 | #' for compatibility with \code{shinydashboard}) 127 | #' @export 128 | dashboardHeader <- dashboard_header 129 | 130 | 131 | #' Create a sidebar of a dashboard. 132 | #' @description Create a pushable sidebar of a dashboard with menu items and other additional UI 133 | #' elements. 134 | #' @param ... UI elements to include within the sidebar. 135 | #' @param side Placement of the sidebar. One of \code{c("left", "right", "top", "bottom")} 136 | #' @param size Size of the sidebar. One of \code{c("", "thin", "very thin", "wide", "very wide")} 137 | #' @param color Color of the sidebar / text / icons (depending on the value of `inverted` 138 | #' parameter. One of \code{c("", "red", "orange", "yellow", "olive", "green", "teal", "blue", 139 | #' "violet","purple", "pink", "brown", "grey", "black")} 140 | #' @param inverted If FALSE sidebar will be white and text will be colored. \ 141 | #' If TRUE text will be white and background will be colored. Default is \code{FALSE}. 142 | #' @param center Should label and icon be centerd on menu items. Default to \code{FALSE} 143 | #' @param visible Should sidebar be visible on start. Default to \code{TRUE} 144 | #' @param disable If \code{TRUE}, don't display the sidebar. 145 | #' @param closable If \code{TRUE} allow close sidebar by clicking in the body. Default to 146 | #' \code{FALSE} 147 | #' @param pushable If \code{TRUE} the menu button is active. Default to \code{TRUE} 148 | #' @param overlay If \code{TRUE}, opened sidebar will cover the tab content. Otherwise it is 149 | #' displayed next to the content. Relevant only for sidebar positioned on left or right. Default 150 | #' to \code{FALSE} 151 | #' @param dim_page If \code{TRUE}, page content will be darkened when sidebr is open. Default to 152 | #' \code{FALSE} 153 | #' @param class CSS class to be applied to the container of \code{dashboardSidebar}. 154 | #' @return A sidebar that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 155 | #' @export 156 | #' @examples 157 | #' if(interactive()){ 158 | #' 159 | #' library(shiny) 160 | #' library(semantic.dashboard) 161 | #' 162 | #' ui <- dashboardPage( 163 | #' dashboardHeader(color = "blue"), 164 | #' dashboardSidebar(side = "left", size = "thin", color = "teal", 165 | #' sidebarMenu( 166 | #' menuItem(tabName = "tab1", "Tab 1"), 167 | #' menuItem(tabName = "tab2", "Tab 2"))), 168 | #' dashboardBody(tabItems( 169 | #' tabItem(tabName = "tab1", p("Tab 1")), 170 | #' tabItem(tabName = "tab2", p("Tab 2")))) 171 | #' ) 172 | #' 173 | #' server <- function(input, output) { 174 | #' } 175 | #' 176 | #' shinyApp(ui, server) 177 | #' } 178 | dashboard_sidebar <- function(..., side = "left", size = "thin", color = "", inverted = FALSE, 179 | closable = FALSE, pushable = TRUE, center = FALSE, visible = TRUE, 180 | disable = FALSE, overlay = FALSE, dim_page = FALSE, class = "") { 181 | if (disable || length(list(...)) < 1) { 182 | NULL 183 | } else { 184 | arguments <- list(...) 185 | verify_value_allowed("side", ALLOWED_SIDEBAR_SIDES) 186 | verify_value_allowed("size", ALLOWED_SIDEBAR_SIZES) 187 | verify_value_allowed("color", ALLOWED_COLORS) 188 | 189 | display_type <- ifelse(center, "labeled icon", "") 190 | uncover_class <- ifelse(isTRUE(visible) & isFALSE(overlay), "uncover", "") 191 | if (side %in% c("top", "bottom")) uncover_class <- "" 192 | overlay_class <- ifelse(isTRUE(visible) & isTRUE(overlay), "overlay", "") 193 | inverted_value <- get_inverted_class(inverted) 194 | 195 | closable <- ifelse(closable, quote(true), quote(false)) 196 | pushable <- ifelse(pushable, quote(true), quote(false)) 197 | overlay <- ifelse(overlay, quote(true), quote(false)) 198 | dim_page <- ifelse(dim_page, quote(true), quote(false)) 199 | 200 | do.call( 201 | shiny::div, 202 | list( 203 | closable = glue::glue("{closable}"), 204 | id = arguments$id, 205 | class = paste( 206 | "dashboard-sidebar ui", 207 | size, 208 | side, 209 | color, 210 | ifelse(side %in% c("top", "bottom"), "", "vertical"), 211 | display_type, 212 | ifelse(visible, "visible", ""), 213 | inverted_value, 214 | "menu sidebar", 215 | uncover_class, 216 | overlay_class, 217 | class 218 | ), 219 | arguments, 220 | shiny::tags$script(glue::glue( 221 | "initialize_sidebar({closable}, {pushable}, {overlay}, {dim_page})" 222 | )), 223 | shiny::tags$script(src = "src/updateTabItems.js") 224 | ) 225 | ) 226 | } 227 | } 228 | 229 | #' @describeIn dashboard_sidebar Create a sidebar of a dashboard (alias for \code{dashboard_sidebar} 230 | #' for compatibility with \code{shinydashboard}) 231 | #' @export 232 | dashboardSidebar <- dashboard_sidebar 233 | 234 | 235 | #' Create a body of a dashboard. 236 | #' @description Create a body of a dashboard with tabs and other additional UI elements. 237 | #' @param ... UI elements to include within the body. 238 | #' @param class CSS class to be applied to the container of \code{dashboardBody}. Note it's not the 239 | #' \code{} tag. 240 | #' @return A tab that can be passed to \code{\link[semantic.dashboard]{dashboardPage}} 241 | #' @export 242 | #' @examples 243 | #' if(interactive()){ 244 | #' 245 | #' library(shiny) 246 | #' library(semantic.dashboard) 247 | #' 248 | #' ui <- dashboardPage( 249 | #' dashboardHeader(color = "blue"), 250 | #' dashboardSidebar(side = "left", size = "thin", color = "teal", 251 | #' sidebarMenu( 252 | #' menuItem(tabName = "tab1", "Tab 1"), 253 | #' menuItem(tabName = "tab2", "Tab 2"))), 254 | #' dashboardBody(tabItems( 255 | #' tabItem(tabName = "tab1", p("Tab 1")), 256 | #' tabItem(tabName = "tab2", p("Tab 2")))) 257 | #' ) 258 | #' 259 | #' server <- function(input, output) { 260 | #' } 261 | #' 262 | #' shinyApp(ui, server) 263 | #' } 264 | dashboard_body <- function(..., class = "") { 265 | shiny::div(class = paste("ui grid pusher dashboard-body", class), ...) 266 | } 267 | 268 | #' @describeIn dashboard_body Create a body of a dashboard (alias for \code{dashboard_body} for 269 | #' compatibility with \code{shinydashboard}) 270 | #' @export 271 | dashboardBody <- dashboard_body 272 | 273 | #' Create a dashboard. 274 | #' @description Create a page with menu item sidebar and body containing tabs and other additional 275 | #' elements. 276 | #' @param header Header of a dashboard. 277 | #' @param sidebar Sidebar of a dashboard. 278 | #' @param body Body of a dashboard. 279 | #' @param title Title of a dashboard. 280 | #' @param margin If \code{TRUE}, margin to be applied to the whole dashboard. 281 | #' Defaults to \code{TRUE}. 282 | #' @param theme Theme name or path. For possible options see 283 | #' \code{\link[shiny.semantic]{semanticPage}}. 284 | #' @param class CSS class to be applied to the page container (\code{} tag). 285 | #' @param sidebar_and_body_container_class CSS class to be applied to the \code{div} containing 286 | #' \code{dashboardSidebar} and \code{dashboardBody}. 287 | #' @param suppress_bootstrap There are some conflicts in CSS styles between 288 | #' FomanticUI and Bootstrap. For the time being it's better to suppress Bootstrap. 289 | #' If \code{TRUE} bootstrap dependency from \code{shiny} will be disabled. 290 | #' @return Dashboard. 291 | #' @export 292 | #' @examples 293 | #' if(interactive()){ 294 | #' 295 | #' library(shiny) 296 | #' library(semantic.dashboard) 297 | #' 298 | #' ui <- dashboardPage( 299 | #' dashboardHeader(color = "blue"), 300 | #' dashboardSidebar(side = "left", size = "thin", color = "teal", 301 | #' sidebarMenu( 302 | #' menuItem(tabName = "tab1", "Tab 1"), 303 | #' menuItem(tabName = "tab2", "Tab 2"))), 304 | #' dashboardBody(tabItems( 305 | #' tabItem(tabName = "tab1", p("Tab 1")), 306 | #' tabItem(tabName = "tab2", p("Tab 2")))) 307 | #' ) 308 | #' 309 | #' server <- function(input, output) { 310 | #' } 311 | #' 312 | #' shinyApp(ui, server) 313 | #' } 314 | dashboard_page <- function(header, sidebar, body, title = "", 315 | suppress_bootstrap = TRUE, theme = NULL, 316 | margin = TRUE, class = "", sidebar_and_body_container_class = "") { # nolint: object_length_linter 317 | # TODO: Remove this line when it is added to semanticPage() 318 | if (is.null(sidebar)) header$children[[1]] <- NULL 319 | sidebar_and_body <- div( 320 | class = paste("ui bottom attached segment pushable", sidebar_and_body_container_class), 321 | sidebar, 322 | body 323 | ) 324 | 325 | margin_class <- ifelse(isFALSE(margin), "no-margin", "") 326 | class <- paste("dashboard-page", margin_class, class) 327 | shiny.semantic::semanticPage( 328 | header, 329 | sidebar_and_body, 330 | get_dashboard_dependencies(), 331 | margin = "0", 332 | title = title, 333 | theme = theme, 334 | suppress_bootstrap = suppress_bootstrap, 335 | class = class 336 | ) 337 | } 338 | 339 | #' @describeIn dashboard_page Create a dashboard (alias for \code{dashboard_page} for compatibility 340 | #' with \code{shinydashboard}) 341 | #' @export 342 | dashboardPage <- dashboard_page 343 | --------------------------------------------------------------------------------