├── .Rbuildignore ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── R ├── download-csv.R ├── input-date-range.R ├── input-select-period.R ├── input-toggle-pct.R ├── metric-panel-footer.R ├── metric-panel.R ├── plots.R ├── preview.R ├── titles.R ├── utils-panel-metric.R ├── utils-pipe.R ├── utils-plots.R └── utils.R ├── README.md ├── man ├── date_range_presets_vec.Rd ├── download_csv.Rd ├── get_dimension_tabs.Rd ├── get_plot_type.Rd ├── get_value.Rd ├── input_date_range.Rd ├── input_select_period.Rd ├── input_toggle_pct.Rd ├── metric_panel.Rd ├── metric_panel_footer.Rd ├── pipe.Rd ├── plot_metric_condensed.Rd ├── preview_metric.Rd └── title_with_modal.Rd └── shinymetrics.Rproj /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^shinymetrics\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^\.travis\.yml$ 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | 6 | # Mac 7 | .DS_Store 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | sudo: false 5 | cache: packages 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinymetrics 2 | Title: Shiny Modules to Visualize Tidy Metrics 3 | Version: 0.0.1 4 | Authors@R: c(person("Ramnath", "Vaidyanathan", email = "ramnath.vaidya@gmail.com", role = c("cre", "aut")), 5 | person("David", "Robinson", email = "admiral.david@gmail.com", role = "aut")) 6 | Maintainer: Ramnath Vaidyanathan 7 | Description: A collection of shiny modules to visualize tidy metrics. 8 | Depends: R (>= 3.4.0) 9 | License: MIT + file LICENSE 10 | Encoding: UTF-8 11 | LazyData: true 12 | RoxygenNote: 6.1.1 13 | Imports: 14 | shiny, 15 | shinyWidgets, 16 | dplyr, 17 | stringr, 18 | methods, 19 | purrr, 20 | shinydashboard, 21 | magrittr, 22 | rlang, 23 | tidymetrics, 24 | plotly, 25 | scales, 26 | forcats, 27 | humanize, 28 | bsplus, 29 | commonmark, 30 | htmltools, 31 | shinycssloaders 32 | Suggests: 33 | shinybones 34 | Remotes: 35 | ramnathv/shinybones, 36 | ramnathv/tidymetrics 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2019 2 | COPYRIGHT HOLDER: Ramnath Vaidyanathan 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2019 Ramnath Vaidyanathan 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(download_csv) 5 | export(download_csv_ui) 6 | export(input_select_period) 7 | export(metric_panel) 8 | export(metric_panel_footer) 9 | export(metric_panel_ui) 10 | export(plot_metric_condensed) 11 | export(preview_metric) 12 | export(title_with_modal) 13 | export(title_with_popover) 14 | export(title_with_tooltip) 15 | import(htmltools) 16 | importFrom(bsplus,bs_attach_modal) 17 | importFrom(bsplus,bs_embed_popover) 18 | importFrom(bsplus,bs_embed_tooltip) 19 | importFrom(bsplus,bs_modal) 20 | importFrom(bsplus,use_bs_popover) 21 | importFrom(bsplus,use_bs_tooltip) 22 | importFrom(commonmark,markdown_html) 23 | importFrom(dplyr,case_when) 24 | importFrom(humanize,natural_time) 25 | importFrom(magrittr,"%>%") 26 | importFrom(methods,formalArgs) 27 | importFrom(plotly,add_bars) 28 | importFrom(plotly,add_lines) 29 | importFrom(plotly,config) 30 | importFrom(plotly,layout) 31 | importFrom(plotly,plot_ly) 32 | importFrom(purrr,map) 33 | importFrom(rlang,":=") 34 | importFrom(rlang,.data) 35 | importFrom(rlang,quo) 36 | importFrom(rlang,quo_name) 37 | importFrom(scales,hue_pal) 38 | importFrom(shiny,NS) 39 | importFrom(shiny,fluidRow) 40 | importFrom(shinycssloaders,withSpinner) 41 | importFrom(shinydashboard,box) 42 | importFrom(stringr,str_c) 43 | importFrom(tidymetrics,discard_constant_dimensions) 44 | importFrom(tidymetrics,discard_dimensions) 45 | importFrom(tidymetrics,keep_dimensions) 46 | -------------------------------------------------------------------------------- /R/download-csv.R: -------------------------------------------------------------------------------- 1 | #' Download Data as CSV 2 | #' 3 | #' A shiny module that adds a download button to download data as a CSV. 4 | #' 5 | #' @param input standard \code{shiny} boilerplate 6 | #' @param output standard \code{shiny} boilerplate 7 | #' @param session standard \code{shiny} boilerplate 8 | #' @param dataset a data frame, or a function/reactive that returns a data frame 9 | #' @param filename a string, or a function/reactive that returns a string 10 | #' @param ... additional parameters to pass to \code{\link[utils]{write.csv}} 11 | #' @export 12 | #' @examples 13 | #' \dontrun{ 14 | #' shinybones::preview_module(download_csv, 15 | #' dataset = mtcars, 16 | #' filename = function(){ 17 | #' paste0('mtcars-', format(Sys.time(), "%Y-%m-%d-%H-%M-%S"), '.csv') 18 | #' } 19 | #' ) 20 | #' } 21 | download_csv <- function(input, output, session, dataset, filename, ...){ 22 | output$data <- shiny::downloadHandler( 23 | filename = filename, 24 | content = function(file){ 25 | utils::write.csv(get_value(dataset), file, row.names = FALSE, ...) 26 | } 27 | ) 28 | } 29 | 30 | #' @param id a string indicating the id to use the module with. 31 | #' @rdname download_csv 32 | #' @export 33 | download_csv_ui <- function(id, ...){ 34 | ns <- shiny::NS(id) 35 | shiny::downloadButton(ns('data'), label = ' CSV') 36 | } 37 | -------------------------------------------------------------------------------- /R/input-date-range.R: -------------------------------------------------------------------------------- 1 | #' Create date range input with preset ranges 2 | #' 3 | #' This is a shiny module to create a date range input with presets for the 4 | #' Last 1 week, 2 weeks, 6 months etc. 5 | #' 6 | #' @param input standard \code{shiny} boilerplate 7 | #' @param output standard \code{shiny} boilerplate 8 | #' @param session standard \code{shiny} boilerplate 9 | #' @param id a string indicating the id to call the module with 10 | #' @param date_range a range of dates 11 | #' @param selected_date_range_preset selected date range preset 12 | #' @param ... additional parameters passed to the module 13 | #' @examples 14 | #' library(shiny) 15 | #' \dontrun{ 16 | #' shinybones::preview_module(input_date_range, use_box = TRUE) 17 | #' test_date_range <- function(input, output, session, ...){ 18 | #' ns <- session$ns 19 | #' date_range_input <- callModule(input_date_range, 'date_range') 20 | #' output$date_range_text <- renderText({ 21 | #' paste(date_range_input(), collapse = " - ") 22 | #' }) 23 | #' } 24 | #' test_date_range_ui <- function(id, ...){ 25 | #' ns <- shiny::NS(id) 26 | #' shinydashboard::box( 27 | #' width = 12, 28 | #' title = 'Date Range Input', 29 | #' input_date_range_ui(ns('date_range')), 30 | #' column(12, textOutput(ns('date_range_text'))) 31 | #' ) 32 | #' } 33 | #' shinybones::preview_module(test_date_range) 34 | #' } 35 | #' @return A reactive vector of the selected date range 36 | input_date_range <- function(input, output, session, 37 | date_range = c(Sys.Date() - 365, Sys.Date()), 38 | selected_date_range_preset = 'Last Year', 39 | ...){ 40 | ns <- session$ns 41 | output$ui_date_range_custom <- shiny::renderUI({ 42 | date_range <- get_value(date_range) 43 | shiny::req(input$date_range_preset) 44 | if (input$date_range_preset == 'custom_period'){ 45 | shiny::dateRangeInput( 46 | ns('date_range'), 47 | label = 'from', 48 | start = date_range[1], 49 | end = date_range[2], 50 | min = date_range[1], 51 | max = date_range[2] 52 | ) 53 | } 54 | }) 55 | output$ui_date_range_preset <- shiny::renderUI({ 56 | date_range_presets <- date_range_presets_vec( 57 | max(get_value(date_range)) 58 | ) 59 | choices_date_range_preset = c( 60 | date_range_presets, 61 | "Custom Period" = "custom_period" 62 | ) 63 | selected_date_range_preset <- set_selected( 64 | input$date_range_preset, 65 | choices_date_range_preset, 66 | date_range_presets[get_value(selected_date_range_preset)] 67 | ) 68 | shinyWidgets::pickerInput( 69 | ns("date_range_preset"), 70 | label = "over", 71 | choices = choices_date_range_preset, 72 | selected = selected_date_range_preset 73 | ) 74 | }) 75 | 76 | date_range_selected <- shiny::reactive({ 77 | shiny::req(input$date_range_preset) 78 | if (input$date_range_preset == 'custom_period'){ 79 | input$date_range 80 | } else { 81 | c(input$date_range_preset, as.character(max(date_range))) 82 | } 83 | }) 84 | return(date_range_selected) 85 | } 86 | 87 | #' @rdname input_date_range 88 | input_date_range_ui <- function(id, ...){ 89 | ns <- shiny::NS(id) 90 | shiny::tagList( 91 | shiny::column(4, shiny::uiOutput(ns('ui_date_range_preset'))), 92 | shiny::column(8, shiny::uiOutput(ns('ui_date_range_custom'))), 93 | input_date_range_ui_css() 94 | ) 95 | } 96 | 97 | input_date_range_ui_css <- function(){ 98 | shiny::tags$style(shiny::HTML(' 99 | .input-daterange > .input-sm { 100 | height:34px; 101 | background-color:#f4f4f4; 102 | } 103 | .input-daterange > .input-sm.form-control{ 104 | height:34px; 105 | background-color:#f4f4f4; 106 | } 107 | ')) 108 | } 109 | 110 | #' Date Range Presets 111 | #' 112 | #' This function returns a vector of preset date ranges like Last N Weeks. 113 | #' 114 | #' @param max_date The max date for date range to return 115 | #' @importFrom dplyr case_when 116 | #' @importFrom stringr str_c 117 | date_range_presets_vec <- function(max_date = NULL){ 118 | weeks_back <- c(1, 2, 4, 8, 12, 26, 365 / 7, 10*365 / 7) 119 | dates <- as.character(Sys.Date() - as.integer(weeks_back*7)) 120 | weeks_back <- as.integer(weeks_back) 121 | names(dates) <- dplyr::case_when( 122 | weeks_back == 1 ~ "Last Week", 123 | weeks_back <= 12 ~ stringr::str_c("Last ", weeks_back, " Weeks"), 124 | weeks_back == 26 ~ "Last 6 Months", 125 | weeks_back == 52 ~ "Last Year", 126 | weeks_back > 52 ~ "All Time" 127 | ) 128 | if (!is.null(max_date)) { 129 | dates <- dates[dates <= max_date] 130 | } 131 | dates 132 | } 133 | 134 | -------------------------------------------------------------------------------- /R/input-select-period.R: -------------------------------------------------------------------------------- 1 | #' Create a picker input to select aggregation period 2 | #' 3 | #' @param inputId the input slot that will be used to access the value. 4 | #' @param selected_period a string indicating selected period 5 | #' @param periods a named vector of periods. 6 | #' @param label a string to display as label. 7 | #' @param select_func a select input function. Either 8 | #' \code{\link[shiny]{selectInput}} or \code{\link[shinyWidgets]{pickerInput}} 9 | #' @param ... additional parameters passed on to \code{select_func} 10 | #' @export 11 | #' @examples 12 | #' \dontrun{ 13 | #' input_select_period('period') %>% 14 | #' shinybones::preview_component() 15 | #' input_select_period('period', selected_period = 'week') %>% 16 | #' shinybones::preview_component() 17 | #' } 18 | input_select_period <- function(inputId, 19 | selected_period = NULL, 20 | periods = 'All', 21 | label = 'aggregated_by', 22 | select_func = shiny::selectInput, 23 | ...){ 24 | choices <- period_presets_vec(get_value(periods)) 25 | select_func( 26 | inputId, 27 | label = label, 28 | choices = choices, 29 | selected = choices[selected_period], 30 | ... 31 | ) 32 | } 33 | 34 | period_presets_vec <- function(periods = "All"){ 35 | periods_all <- c( 36 | "Day" = "day", "Week" = "week", 37 | "Month" = "month", "Quarter" = "quarter", 38 | "Year" = "year", 39 | "Rolling 7 Day" = 'rolling_7d', "Rolling 28 Day" = "rolling_28d", 40 | "Rolling 56 Day" = "rolling_56d" 41 | ) 42 | if (length(periods) == 1 && periods == 'All'){ 43 | periods_all 44 | } else { 45 | periods_all[periods_all %in% periods] 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /R/input-toggle-pct.R: -------------------------------------------------------------------------------- 1 | #' Radio buttons to toggle between number and percentage. 2 | #' 3 | #' @param inputId the input slot that will be used to access the value. 4 | #' @param label label to display alongside the buttons 5 | #' @param size size of the radio buttons ('sm', 'xs', or 'lg') 6 | #' @param ... additional parameters to pass to 7 | #' \code{\link[shinyWidgets]{radioGroupButtons}} 8 | #' @examples 9 | #' \dontrun{ 10 | #' input_toggle_pct('show_pct') %>% 11 | #' shinybones::preview_component() 12 | #' } 13 | input_toggle_pct <- function(inputId, label = 'as', size = 'sm', ...){ 14 | shinyWidgets::radioGroupButtons( 15 | inputId = inputId, 16 | label = "as", 17 | choices = c( 18 | `` = "number", 19 | `` = "percent" 20 | ), 21 | checkIcon = list( 22 | yes = shiny::icon("ok", lib = 'glyphicon') 23 | ), 24 | size = "sm", 25 | ... 26 | ) 27 | } 28 | -------------------------------------------------------------------------------- /R/metric-panel-footer.R: -------------------------------------------------------------------------------- 1 | #' Metric Panel Footer 2 | #' 3 | #' This is a component module to ... 4 | #' 5 | #' 6 | #' @param id a string indicating the id to call the module with 7 | #' @param input standard \code{shiny} boilerplate 8 | #' @param output standard \code{shiny} boilerplate 9 | #' @param session standard \code{shiny} boilerplate 10 | #' @param metric a \code{tbl_metric} object 11 | #' @inheritParams input_date_range 12 | #' @inheritParams input_select_period 13 | #' @param ... Additional parameters to pass to module 14 | #' @examples 15 | #' \dontrun{ 16 | #' shinybones::preview_module(metric_panel_footer, 17 | #' selected_date_range_preset = 'Last Week', 18 | #' selected_period = 'month' 19 | #' ) 20 | #' } 21 | #' @export 22 | #' @importFrom shiny NS fluidRow 23 | #' @importFrom shinydashboard box 24 | #' @importFrom rlang .data 25 | #' @examples 26 | #' \dontrun{ 27 | #' library(dplyr) 28 | #' metrics <- datacampr::dc_s3_read('metrics_condensed.rds')$metrics_condensed 29 | #' preview_metric(metrics$content_courses_avg_rating_wtd) 30 | #' } 31 | metric_panel_footer <- function(input, output, session, 32 | metric, 33 | date_range = range(metric$date), 34 | selected_date_range_preset = 'Last Year', 35 | ...){ 36 | ns <- session$ns 37 | rv_date_range <- shiny::callModule(input_date_range, "date_range", 38 | date_range = date_range, 39 | date_range_preset = selected_date_range_preset 40 | ) 41 | 42 | metric_filtered <- shiny::reactive({ 43 | date_range <- rv_date_range() 44 | get_value(metric) %>% 45 | dplyr::filter(.data$period == input$period) %>% 46 | dplyr::filter(date >= date_range[1]) %>% 47 | dplyr::filter(date <= date_range[2]) %>% 48 | dplyr::arrange(date) 49 | }) 50 | 51 | metric_download <- shiny::reactive({ 52 | metric_filtered() %>% 53 | dplyr::select(-.data$period) %>% 54 | dplyr::as_tibble() 55 | }) 56 | 57 | shiny::callModule(download_csv, 'download_data', 58 | dataset = metric_download, 59 | filename = function(){ 60 | paste0( 61 | gsub("_", "-", attr(metric, 'metadata')$metric_full), 62 | '-', 63 | gsub("_", "-", input$period), 64 | '-', 65 | format(Sys.time(), "%Y-%m-%d-%H-%M-%S"), 66 | '.csv' 67 | ) 68 | } 69 | ) 70 | return(metric_filtered) 71 | } 72 | 73 | #' @rdname metric_panel_footer 74 | metric_panel_footer_ui <- function(id, selected_period = NULL, periods, ...){ 75 | ns <- shiny::NS(id) 76 | download_csv_ui_right <- function(...){ 77 | shiny::tags$div( 78 | class = 'pull-right', 79 | style='margin-top:25px;', 80 | download_csv_ui(...) 81 | ) 82 | } 83 | shiny::fluidRow( 84 | shinydashboard::box( 85 | width = 12, 86 | title = NULL, 87 | # Percentage Toggle ---- 88 | shiny::column(2, input_toggle_pct(ns('show_pct'))), 89 | # Period Picker ---- 90 | shiny::column(3, input_select_period( 91 | ns('period'), 92 | selected_period = selected_period, 93 | periods = periods 94 | )), 95 | # Date Range Selector ---- 96 | shiny::column(5, shiny::fluidRow( 97 | input_date_range_ui(ns('date_range')) 98 | )), 99 | # Download Button ---- 100 | shiny::column(2, download_csv_ui_right(ns('download_data'))) 101 | ) 102 | ) 103 | } 104 | 105 | -------------------------------------------------------------------------------- /R/metric-panel.R: -------------------------------------------------------------------------------- 1 | #' Display a metric in a panel 2 | #' 3 | #' 4 | #' @export 5 | #' @param id a string indicating the id to call the module with 6 | #' @param input standard \code{shiny} boilerplate 7 | #' @param output standard \code{shiny} boilerplate 8 | #' @param session standard \code{shiny} boilerplate 9 | #' @param metric A metric to display. It should be a list with data and title 10 | #' @param plot_type Either "line" or "bar": if neither is given, it guesses 11 | #' "line" for \code{pct}, \code{avg}, \code{min}, \code{median}, and \code{max} 12 | #' metrics, and "bar" otherwise. Ignored if \code{plot_fun} is provided. 13 | #' @param plot_fun A plotting function that takes two arguments - data and 14 | #' dimension 15 | #' @param plot_post_process a function to post-process the default plot 16 | #' @param orientation a string indicating orientation (vertical or horizontal) 17 | #' @param selected_date_range_preset Default date range preset to use. Use 18 | #' \code{date_range_presets_vec()} to look up possible presets 19 | #' @param selected_period Default period to display the data 20 | #' @param height height of the panel 21 | #' @param hidden_dimensions A vector of dimension names that should not be 22 | #' displayed as tabs. 23 | #' @param div_bottom_left html to display on bottom left of the panel 24 | #' @param ... Additional parameters passed to the server 25 | #' @examples 26 | #' library(dplyr) 27 | #' \dontrun{ 28 | #' metrics_condensed <- datacampr::dc_s3_read( 29 | #' "metrics_condensed.rds" 30 | #' )$metrics_condensed 31 | #' preview_metric( 32 | #' metric = metrics_condensed$finance_forecasts_usd_arr_total, 33 | #' plot_type = 'line' 34 | #' ) 35 | #' preview_metric(metrics_condensed$finance_cash_usd_cash_in) 36 | #' } 37 | #' @importFrom shinycssloaders withSpinner 38 | #' @importFrom tidymetrics discard_constant_dimensions 39 | #' @export 40 | metric_panel <- function(input, output, session, 41 | metric, 42 | plot_type = NULL, 43 | plot_fun = NULL, 44 | plot_post_process = NULL, 45 | orientation = 'vertical', 46 | selected_date_range_preset = "All Time", 47 | selected_period = "Week", 48 | height = 400, 49 | div_bottom_left = NULL, 50 | hidden_dimensions = NULL, 51 | ...){ 52 | 53 | ns = session$ns 54 | metric <- purrr::possibly( 55 | tidymetrics::discard_constant_dimensions, metric 56 | )(metric) 57 | 58 | rv_metric_filtered <- shiny::callModule(metric_panel_footer, 'metric_filtered', 59 | metric = metric, 60 | date_range = c(Sys.Date() - 365, Sys.Date()), 61 | selected_date_range_preset = selected_date_range_preset, 62 | selected_period = selected_period 63 | ) 64 | 65 | if (is.null(div_bottom_left)){ 66 | div_bottom_left <- show_as_tags(attr(metric, 'metadata')$dimensions_filters) 67 | } 68 | dimension_tabs <- metric %>% 69 | get_dimension_tabs(hidden_dimensions) 70 | 71 | dimension_tabs %>% 72 | lapply(function(x){ 73 | output[[paste0('plot_', x$name)]] <- plotly::renderPlotly({ 74 | plot_metric_condensed( 75 | metric = rv_metric_filtered(), 76 | plot_type = plot_type, 77 | dimension = x$name 78 | ) 79 | }) 80 | }) 81 | 82 | output$ui_tabs <- shiny::renderUI({ 83 | tab_box <- metric_panel_ui_tabs( 84 | ns, metric, height = height, orientation = orientation, 85 | div_bottom_left = div_bottom_left 86 | ) 87 | tagList( 88 | div(class = 'col-sm-12', style = 'margin-bottom:15px', tab_box), 89 | div(class = 'col-sm-12', metric_panel_footer_ui( 90 | ns('metric_filtered'), 91 | selected_period = selected_period, 92 | periods = metric %>% 93 | dplyr::distinct(.data$period) %>% 94 | dplyr::pull(.data$period) 95 | )) 96 | ) 97 | }) 98 | } 99 | 100 | #' @export 101 | #' @rdname metric_panel 102 | metric_panel_ui <- function(id, ...){ 103 | ns <- shiny::NS(id) 104 | shiny::uiOutput(ns('ui_tabs')) 105 | } 106 | 107 | metric_panel_ui_tabs <- function(ns, metric, height = 400, 108 | orientation = 'vertical', 109 | div_bottom_left = div_bottom_left, 110 | ...){ 111 | tabs <- get_dimension_tabs(metric) 112 | metadata <- attr(metric, 'metadata') 113 | title <- metric_panel_ui_title(metadata, ns) 114 | tab_selected <- utils::tail(tabs, 1)[[1]]$name 115 | tab_panels <- tabs %>% 116 | get_value() %>% 117 | purrr::map(~ { 118 | id = paste0('plot_', .x$name) 119 | shiny::tabPanel( 120 | id = id, 121 | value = .x$name, 122 | title = tags$span(.x$value$title) %>% 123 | bsplus::bs_embed_tooltip(.x$value$description), 124 | tagList( 125 | plotly::plotlyOutput(ns(id), height = height) %>% 126 | shinycssloaders::withSpinner(), 127 | div( 128 | div_bottom_left, 129 | div(class = 'pull-right', text_updated_at(metadata$updated_at)) 130 | ) 131 | ) 132 | ) 133 | }) %>% 134 | append( 135 | list( 136 | title = title, side = "right", selected = tab_selected, 137 | width = NULL, 138 | id = ns('dimension'), height = height + 50 139 | ) 140 | ) 141 | do.call(shinydashboard::tabBox, tab_panels) 142 | } 143 | 144 | metric_panel_ui_title <- function(metadata, ns = shiny::NS(NULL)){ 145 | title = title_with_modal( 146 | metadata$title, 147 | help_title = tags$span( 148 | metadata$title, 149 | shiny::tags$a( 150 | shiny::icon('code'), href = metadata$rmd_link, target = "_blank" 151 | ) 152 | ), 153 | help_text = metadata$description, 154 | # footer = dcdash:::enhanced_footer(ns, metadata), 155 | is_h3 = FALSE 156 | ) 157 | } 158 | -------------------------------------------------------------------------------- /R/plots.R: -------------------------------------------------------------------------------- 1 | #' Plot a condensed metric 2 | #' 3 | #' @param metric a \code{tbl_metric} object 4 | #' @param plot_type a string indicating type of plot (line/bar) 5 | #' @param dimension a string indicating the dimension to visualize 6 | #' @param quietly a boolean indicating if messages should be suppressed 7 | #' @param ... additional parameters passed 8 | #' @examples 9 | #' \dontrun{ 10 | #' library(dplyr) 11 | #' metrics_condensed <- datacampr::dc_s3_read( 12 | #' 'metrics_condensed.rds' 13 | #' )$metrics_condensed 14 | 15 | #' metric %>% 16 | #' filter(period == 'week') %>% 17 | #' filter(date >= Sys.Date() - 365) %>% 18 | #' plot_metric_condensed() 19 | #' 20 | #' metrics_condensed$product_time_median_time_spent %>% 21 | #' filter(period == 'week') %>% 22 | #' filter(date >= Sys.Date() - 365) %>% 23 | #' plot_metric_condensed_line(dimension = 'subscription_type') 24 | #' 25 | #' metrics_condensed$content_courses_avg_rating_wtd %>% 26 | #' filter(period == 'rolling_28d') %>% 27 | #' filter(date >= Sys.Date() - 365) %>% 28 | #' plot_metric_condensed() 29 | #' 30 | #' metrics_condensed$content_courses_avg_rating_wtd %>% 31 | #' filter(period == 'rolling_28d') %>% 32 | #' filter(date >= Sys.Date() - 365) %>% 33 | #' plot_metric_condensed('ds_track') 34 | #' 35 | #' flights_nyc_avg_arr_delay %>% 36 | #' filter(period == 'week') %>% 37 | #' plot_metric_condensed(plot_type = 'bar') 38 | #' 39 | #' flights_nyc_avg_arr_delay %>% 40 | #' filter(period == 'week') %>% 41 | #' plot_metric_condensed(plot_type = 'bar', dimension = 'origin') 42 | #' 43 | #' flights_nyc_avg_arr_delay %>% 44 | #' filter(period == 'week') %>% 45 | #' plot_metric_condensed(plot_type = 'line') 46 | #' 47 | #' flights_nyc_avg_arr_delay %>% 48 | #' filter(period == 'week') %>% 49 | #' plot_metric_condensed(plot_type = 'line', dimension = 'origin') 50 | #' } 51 | #' @export 52 | #' @importFrom plotly plot_ly layout config add_lines add_bars 53 | plot_metric_condensed <- function(metric, 54 | dimension = 'all', 55 | plot_type = NULL, 56 | quietly = TRUE, 57 | ...){ 58 | if (is.null(plot_type)){ 59 | metric_id <- attr(metric, 'metadata')$metric 60 | plot_type <- get_plot_type(metric_id) 61 | } 62 | if (plot_type == 'line'){ 63 | plot_metric_condensed_line(metric, dimension, quietly, ...) 64 | } else { 65 | plot_metric_condensed_bar(metric, dimension, quietly, ...) 66 | } 67 | } 68 | 69 | plot_metric_condensed_line <- function(metric, 70 | dimension = "all", 71 | quietly = TRUE, 72 | ...){ 73 | dim_sym <- rlang::sym(dimension) 74 | metric_processed <- metric %>% 75 | preprocess_data(dimension, keep_attribute_all = TRUE, quietly = quietly) 76 | 77 | plt <- if (dimension == 'all'){ 78 | metric_processed %>% 79 | plotly::plot_ly(x = ~ date, y = ~ value, color = I('black')) 80 | } else { 81 | metric_processed %>% 82 | dplyr::mutate(size = dplyr::if_else(!!dim_sym == 'all', 3, 1)) %>% 83 | plotly::plot_ly( 84 | x = ~ date, y = ~ value, 85 | color = stats::as.formula(paste("~", dimension)), 86 | colors = get_colors(metric_processed, dimension), 87 | size = ~ size, sizes = c(1, 4) 88 | ) 89 | } 90 | 91 | plt %>% 92 | plotly::add_lines() %>% 93 | plotly::layout( 94 | plot_bgcolor = "#EBF4F7", 95 | hovermode = "compare", 96 | margin = list(r = 60), 97 | xaxis = get_xaxis_opts(metric), 98 | yaxis = get_yaxis_opts(metric) 99 | ) %>% 100 | plotly::config(displayModeBar = FALSE) 101 | } 102 | 103 | plot_metric_condensed_bar <- function(metric, 104 | dimension = 'all', 105 | quietly = TRUE, 106 | barmode = 'stack', 107 | show_pct = FALSE, 108 | ...){ 109 | metric_processed <- metric %>% 110 | preprocess_data( 111 | dimension, 112 | show_pct = show_pct, 113 | keep_attribute_all = FALSE, 114 | quietly = quietly 115 | ) 116 | plt <- if (dimension == "all"){ 117 | metric_processed %>% 118 | plotly::plot_ly(x = ~ date, y = ~ value, colors = '#3ac') 119 | } else { 120 | metric_processed %>% 121 | plotly::plot_ly( 122 | x = ~ date, y = ~ value, 123 | color = stats::as.formula(paste("~", dimension)), 124 | colors = get_colors(metric_processed, dimension) 125 | ) 126 | } 127 | plt %>% 128 | plotly::add_bars() %>% 129 | plotly::config(displayModeBar = FALSE) %>% 130 | plotly::layout( 131 | plot_bgcolor = "#EBF4F7", 132 | hovermode = "compare", 133 | barmode = barmode, 134 | legend = list(orientation = "v"), 135 | margin = list(r = 60), 136 | xaxis = get_xaxis_opts(metric), 137 | yaxis = get_yaxis_opts(metric, show_pct = show_pct) 138 | ) 139 | } 140 | -------------------------------------------------------------------------------- /R/preview.R: -------------------------------------------------------------------------------- 1 | #' Preview a metric in a shinydashboard 2 | #' 3 | #' @importFrom rlang quo quo_name 4 | #' @export 5 | #' @examples 6 | #' library(dplyr) 7 | #' \dontrun{ 8 | #' metric_satisfaction <- datacampr::tbl_metric_product_survey_avg_satisfaction() 9 | #' preview_metric(metric_satisfaction) 10 | #' metric_rating <- datacampr::tbl_metric_content_courses_avg_rating_wtd() 11 | #' preview_metric(metric_rating, selected_period = 'Rolling 28 Day') 12 | #' preview_metric( 13 | #' metric_rating %>% 14 | #' filter(launch_status == "live") %>% 15 | #' filter(technology == "R"), 16 | #' selected_period = 'Rolling 28 Day' 17 | #' ) 18 | #' } 19 | #' @param metric a \code{tbl_metric} object 20 | #' @param ... additional parameters passed to \code{metric_panel} 21 | #' @export 22 | preview_metric <- function(metric, ...){ 23 | shinybones::preview_module(metric_panel, metric = metric, ...) 24 | } 25 | -------------------------------------------------------------------------------- /R/titles.R: -------------------------------------------------------------------------------- 1 | #' Title with help text in an informative modal, popover or tooltip 2 | #' 3 | #' @export 4 | #' @param title title 5 | #' @param help_text help_text 6 | #' @param help_title help_title 7 | #' @param is_h3 a boolean indicating if title should be wrapped in \code{h3} 8 | #' @param ... additional argument passed on to \code{\link[bsplus]{bs_modal}} 9 | #' @importFrom bsplus bs_attach_modal bs_modal 10 | #' @importFrom commonmark markdown_html 11 | #' @import htmltools 12 | title_with_modal <- function(title, help_text, help_title = title, 13 | is_h3 = TRUE, ...){ 14 | id <- .generate_id() 15 | modal_id <- paste0(id, '-help') 16 | help_modal <- span(class = "dc-help", style='cursor:pointer;', 17 | shiny::icon('question-circle-o') 18 | ) %>% 19 | bsplus::bs_attach_modal(modal_id) 20 | tagList( 21 | if (is_h3) { 22 | shiny::tags$h3(title, class = 'box-title', help_modal) 23 | } else { 24 | shiny::tagList(title, help_modal) 25 | }, 26 | bsplus::bs_modal( 27 | id = modal_id, 28 | title = help_title, 29 | body = htmltools::HTML( 30 | commonmark::markdown_html(help_text) 31 | ), 32 | ... 33 | ) 34 | ) 35 | } 36 | 37 | #' @export 38 | #' @rdname title_with_modal 39 | #' @importFrom bsplus bs_embed_tooltip use_bs_tooltip 40 | title_with_tooltip <- function(title, help_text, ...){ 41 | tagList( 42 | h3(title, class = 'box-title', 43 | span(class = 'dc-help', 44 | shiny::icon('question-circle-o') %>% 45 | bsplus::bs_embed_tooltip(title = help_text, ...) 46 | ) 47 | ), 48 | shiny::singleton(bsplus::use_bs_tooltip()) 49 | ) 50 | } 51 | 52 | 53 | #' @rdname title_with_modal 54 | #' @export 55 | #' @importFrom bsplus bs_embed_popover use_bs_popover 56 | title_with_popover <- function(title, help_text, help_title = title, ...){ 57 | shiny::tagList( 58 | shiny::h3(title, class = 'box-title', 59 | shiny::span(class = 'dc-help', style='cursor:pointer', 60 | shiny::icon('question-circle-o') %>% 61 | bsplus::bs_embed_popover(title = help_title, content = help_text, ...) 62 | ) 63 | ), 64 | shiny::singleton(bsplus::use_bs_popover()) 65 | ) 66 | } 67 | 68 | .generate_id <- function(){ 69 | paste(c("id", sample(c(letters, 1:10), 20, replace = TRUE)), collapse = "") 70 | } 71 | -------------------------------------------------------------------------------- /R/utils-panel-metric.R: -------------------------------------------------------------------------------- 1 | #' Get dimension tabs 2 | #' 3 | #' @param metric a \code{tbl_metric} object 4 | #' @param hidden_dimensions a vector of dimensions that should be hidden 5 | #' @examples 6 | #' library(dplyr) 7 | #' \dontrun{ 8 | #' metrics_condensed <- datacampr::dc_s3_read( 9 | #' 'metrics_condensed.rds' 10 | #' )$metrics_condensed 11 | #' metrics_condensed$finance_churn_pct_b2c_churn %>% 12 | #' get_dimension_tabs() 13 | #' } 14 | #' @importFrom humanize natural_time 15 | get_dimension_tabs <- function(metric, hidden_dimensions = NULL){ 16 | metric_expanded <- metric %>% 17 | get_value() %>% 18 | expand_metric() 19 | dimensions <- metric_expanded$dimensions 20 | dimension_cols <- metric_expanded$data %>% 21 | var_names_dimensions() 22 | nb_dimensions <- metric_expanded$data %>% 23 | tidymetrics::discard_dimensions(quietly = TRUE) %>% 24 | NROW() 25 | has_dimensions = isTRUE(nb_dimensions > 0) 26 | 27 | d <- dimensions %>% 28 | rev() %>% 29 | purrr::map(~ { 30 | # BUG: Figure out what I was trying to do here 31 | # .x$title <- dplyr::coalesce(.x$title, .x$metric) 32 | .x$description <- dplyr::coalesce(.x$description, .x$title) 33 | .x 34 | }) %>% 35 | iterate_list() %>% 36 | purrr::keep(~ .$name %in% dimension_cols) 37 | 38 | if (has_dimensions){ 39 | append_dimension_all(d) 40 | } else { 41 | d 42 | } 43 | } 44 | 45 | # Iterate over a list 46 | # NOTE: This is copied over from whisker::iteratelist 47 | iterate_list <- function(x, name = 'name', value = 'value'){ 48 | x <- as.list(x) 49 | nms <- names(x) 50 | lapply(seq_along(x), function(i) { 51 | l <- list() 52 | l[name] <- nms[i] 53 | l[value] <- x[i] 54 | l 55 | }) 56 | } 57 | 58 | # Append the dimension 'all' 59 | append_dimension_all <- function(x){ 60 | if (length(x) > 1) { 61 | append(x, list( 62 | list( 63 | name = 'all', 64 | value = list(title = 'All', description = 'All') 65 | ) 66 | )) 67 | } else { 68 | x 69 | } 70 | } 71 | 72 | show_as_tags <- function(x){ 73 | if (is.null(x)) return(shiny::span(shiny::HTML(" "))) 74 | x_colors <- custom_palette(length(x)) 75 | names(x_colors) <- x 76 | x %>% 77 | purrr::map(~ { 78 | shiny::tags$span(.x, 79 | class = 'label', 80 | style = sprintf('background-color:%s', x_colors[.x]) 81 | ) 82 | }) %>% 83 | shiny::tagList() 84 | } 85 | 86 | 87 | text_updated_at <- function(updated_at){ 88 | if (is.null(updated_at)){ 89 | updated_at <- 'Last updated: Unknown' 90 | return(shiny::tags$small(class = 'text-danger', updated_at)) 91 | } 92 | time_elapsed = as.numeric( 93 | difftime(Sys.time(), updated_at, units = 'hours') 94 | ) 95 | updated_at <- humanize::natural_time(updated_at) 96 | updated_at <- paste('Last updated:', updated_at) 97 | if (time_elapsed >= 48){ 98 | shiny::tags$small(class = 'text-danger', updated_at) 99 | } else if (time_elapsed >= 24){ 100 | shiny::tags$small(class = 'text-warning', updated_at) 101 | } else { 102 | shiny::tags$small(updated_at) 103 | } 104 | } 105 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /R/utils-plots.R: -------------------------------------------------------------------------------- 1 | #' Get default plot_type 2 | #' 3 | #' @param metric_id metric id 4 | #' @param plot_type plot type 5 | #' @importFrom tidymetrics keep_dimensions discard_dimensions 6 | #' @importFrom scales hue_pal 7 | #' @importFrom rlang := 8 | #' @examples 9 | #' \dontrun{ 10 | #' get_plot_type('pct_avg_rating') 11 | #' get_plot_type('nb_started') 12 | #' get_plot_type('nb_started', 'line') 13 | #' } 14 | get_plot_type <- function(metric_id, plot_type = NULL){ 15 | if (!is.null(plot_type)){ 16 | return(plot_type) 17 | } 18 | line_types <- "^(pct|avg|min|median|max)_" 19 | if (stringr::str_detect(metric_id, line_types)) { 20 | "line" 21 | } else { 22 | "bar" 23 | } 24 | } 25 | 26 | custom_palette <- function(n){ 27 | pal <- c("#8468c4", "#33AACC", "#263E63") 28 | if (n <= 3) { 29 | grDevices::colorRampPalette(rev(pal), space = "rgb")( n ) 30 | } else { 31 | c( 32 | c("#263E63", "#8468c4"), 33 | scales::hue_pal(h = c(0, 360), l = 65, c = 120)(n - 2) 34 | ) 35 | } 36 | } 37 | 38 | # Get colors for a dimension in a metric object 39 | # 40 | # @param metric A \code{tbl_metric} object. 41 | # @param dimension A string indicating the dimension. 42 | get_colors <- function(metric_processed, dimension){ 43 | levels <- levels(metric_processed[[dimension]]) 44 | colors <- custom_palette(length(levels)) 45 | if ('All' %in% levels){ 46 | colors[levels == 'All'] <- 'black' 47 | } 48 | return(colors) 49 | } 50 | 51 | # Relevel metric dimensions 52 | # 53 | # NOTE: This function can be applied during metric creation if the 54 | # levels are based on a static period and date range. 55 | relevel_dimension <- function(metric, dimension){ 56 | dimension_sym <- rlang::sym(dimension) 57 | metadata <- attr(metric, 'metadata') 58 | levels <- metadata$dimensions %>% 59 | purrr::map('levels') %>% 60 | magrittr::extract2(dimension) 61 | if (is.null(levels)){ 62 | metric %>% 63 | dplyr::mutate(!!dimension := forcats::fct_reorder( 64 | !!dimension_sym, .data$value, mean, .desc = TRUE 65 | )) 66 | } else if (!is.null(names(levels))){ 67 | metric %>% 68 | dplyr::mutate(!!dimension := 69 | factor(!!dimension_sym, levels = names(levels)) 70 | ) 71 | } else { 72 | metric 73 | } 74 | } 75 | 76 | preprocess_data <- function(metric, 77 | dimension = 'all', 78 | keep_attribute_all = TRUE, 79 | show_pct = FALSE, 80 | quietly = FALSE){ 81 | dimension_sym <- rlang::sym(dimension) 82 | d <- if (dimension == "all"){ 83 | metric %>% 84 | tidymetrics::discard_dimensions(quietly = quietly) 85 | } else { 86 | metric %>% 87 | tidymetrics::keep_dimensions(!!dimension, 88 | keep_attribute_all = keep_attribute_all, 89 | quietly = quietly 90 | ) %>% 91 | relevel_dimension(dimension) 92 | } 93 | if (show_pct){ 94 | d <- d %>% 95 | dplyr::as_data_frame() %>% 96 | dplyr::group_by(.data$date, .data$period) %>% 97 | dplyr::mutate(value = .data$value / sum(.data$value, na.rm = TRUE)) 98 | } 99 | return(d) 100 | } 101 | 102 | 103 | # Get options to format x-axis 104 | get_xaxis_opts <- function(metric){ 105 | period <- metric$period[1] 106 | nb_dates <- metric %>% 107 | dplyr::distinct(date) %>% 108 | dplyr::pull(date) %>% 109 | length() 110 | l <- if (period %in% c("month", "quarter")){ 111 | if (nb_dates <= 6){ 112 | if (period == 'month'){ 113 | list(tickformat = '%b %Y', dtick = "M1") 114 | } else { 115 | list(tickformat = '%b %Y', dtick = "M3") 116 | } 117 | } else { 118 | list(tickformat = '%b %Y') 119 | } 120 | } else { 121 | list() 122 | } 123 | l$title = "" 124 | return(l) 125 | } 126 | 127 | # Get options to format y-axis 128 | get_yaxis_opts <- function(metric, show_pct = FALSE){ 129 | metric_name <- attr(metric, 'metadata')$metric 130 | o <- list() 131 | o <- if (show_pct){ 132 | list( 133 | tickformat = ',.0%', 134 | range = c(0, 1) 135 | ) 136 | } else if (grepl("^pct\\_", metric_name)){ 137 | list( 138 | tickformat = ',.0%', 139 | rangemode = "tozero" 140 | ) 141 | } else { 142 | list( 143 | tickprefix = if (grepl("^usd\\_", metric_name)) "$" else "", 144 | range = c(0, Inf) 145 | ) 146 | } 147 | o$title = "" 148 | # o$nticks = 5 149 | return(o) 150 | } 151 | 152 | expand_metric <- function(metric){ 153 | metadata <- attr(metric, 'metadata') 154 | if (!is.null(metadata)){ 155 | class(metric) <- class(metric)[class(metric) != "tbl_metric"] 156 | c(list(data = metric), metadata) 157 | } else { 158 | metric 159 | } 160 | } 161 | 162 | expand_metrics <- function(metrics){ 163 | if (!('data' %in% metrics[[1]])){ 164 | metrics %>% 165 | purrr::map(expand_metric) 166 | } else 167 | metrics 168 | } 169 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' S3 method to get the value of an object 2 | #' 3 | #' @param x an object whose value is to be retrieved 4 | #' @param ... additional parameters passed on to the method. 5 | #' @importFrom methods formalArgs 6 | #' @importFrom purrr map 7 | get_value <- function(x, ...){ 8 | UseMethod('get_value', x) 9 | } 10 | 11 | get_value.default <- function(x, ...){ 12 | return(x) 13 | } 14 | 15 | get_value.reactive <- function(x, ...){ 16 | x() 17 | } 18 | 19 | set_selected <- function(x, choices, default){ 20 | if (!is.null(x) && (x %in% choices)){ 21 | x 22 | } else { 23 | default 24 | } 25 | } 26 | 27 | 28 | # Utility to do map + do.call 29 | map_call <- function(.x, .f, ...){ 30 | purrr::map(.x, ~ do.call(.f, .x)) 31 | } 32 | 33 | map_call_2 <- function(.x, .f, ...){ 34 | purrr::map(.x, ~ do_call_2(.f, .x)) 35 | } 36 | 37 | # Extend do 38 | do_call_2 <- function (what, args, ...){ 39 | args_what <- methods::formalArgs(what) 40 | args <- args[names(args) %in% c("", args_what)] 41 | do.call(what, args, ...) 42 | } 43 | 44 | # Copied over from tidymetrics 45 | var_names_dimensions <- function(tbl){ 46 | set1 <- tbl %>% 47 | dplyr::ungroup() %>% 48 | dplyr::select_if(~ is.character(.x) || is.factor(.x)) %>% 49 | colnames() %>% 50 | setdiff(c('date', 'value', 'period', 'metric')) 51 | 52 | set2 <- stringr::str_subset(colnames(tbl), "_id$") 53 | 54 | dplyr::union(set1, set2) 55 | } 56 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # shinymetrics 2 | 3 | 4 | [![Travis build status](https://travis-ci.org/ramnathv/shinymetrics.svg?branch=master)](https://travis-ci.org/ramnathv/shinymetrics) 5 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 6 | 7 | 8 | Shiny modules for visualizing tidy metrics. 9 | -------------------------------------------------------------------------------- /man/date_range_presets_vec.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input-date-range.R 3 | \name{date_range_presets_vec} 4 | \alias{date_range_presets_vec} 5 | \title{Date Range Presets} 6 | \usage{ 7 | date_range_presets_vec(max_date = NULL) 8 | } 9 | \arguments{ 10 | \item{max_date}{The max date for date range to return} 11 | } 12 | \description{ 13 | This function returns a vector of preset date ranges like Last N Weeks. 14 | } 15 | -------------------------------------------------------------------------------- /man/download_csv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/download-csv.R 3 | \name{download_csv} 4 | \alias{download_csv} 5 | \alias{download_csv_ui} 6 | \title{Download Data as CSV} 7 | \usage{ 8 | download_csv(input, output, session, dataset, filename, ...) 9 | 10 | download_csv_ui(id, ...) 11 | } 12 | \arguments{ 13 | \item{input}{standard \code{shiny} boilerplate} 14 | 15 | \item{output}{standard \code{shiny} boilerplate} 16 | 17 | \item{session}{standard \code{shiny} boilerplate} 18 | 19 | \item{dataset}{a data frame, or a function/reactive that returns a data frame} 20 | 21 | \item{filename}{a string, or a function/reactive that returns a string} 22 | 23 | \item{...}{additional parameters to pass to \code{\link[utils]{write.csv}}} 24 | 25 | \item{id}{a string indicating the id to use the module with.} 26 | } 27 | \description{ 28 | A shiny module that adds a download button to download data as a CSV. 29 | } 30 | \examples{ 31 | \dontrun{ 32 | shinybones::preview_module(download_csv, 33 | dataset = mtcars, 34 | filename = function(){ 35 | paste0('mtcars-', format(Sys.time(), "\%Y-\%m-\%d-\%H-\%M-\%S"), '.csv') 36 | } 37 | ) 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /man/get_dimension_tabs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-panel-metric.R 3 | \name{get_dimension_tabs} 4 | \alias{get_dimension_tabs} 5 | \title{Get dimension tabs} 6 | \usage{ 7 | get_dimension_tabs(metric, hidden_dimensions = NULL) 8 | } 9 | \arguments{ 10 | \item{metric}{a \code{tbl_metric} object} 11 | 12 | \item{hidden_dimensions}{a vector of dimensions that should be hidden} 13 | } 14 | \description{ 15 | Get dimension tabs 16 | } 17 | \examples{ 18 | library(dplyr) 19 | \dontrun{ 20 | metrics_condensed <- datacampr::dc_s3_read( 21 | 'metrics_condensed.rds' 22 | )$metrics_condensed 23 | metrics_condensed$finance_churn_pct_b2c_churn \%>\% 24 | get_dimension_tabs() 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /man/get_plot_type.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-plots.R 3 | \name{get_plot_type} 4 | \alias{get_plot_type} 5 | \title{Get default plot_type} 6 | \usage{ 7 | get_plot_type(metric_id, plot_type = NULL) 8 | } 9 | \arguments{ 10 | \item{metric_id}{metric id} 11 | 12 | \item{plot_type}{plot type} 13 | } 14 | \description{ 15 | Get default plot_type 16 | } 17 | \examples{ 18 | \dontrun{ 19 | get_plot_type('pct_avg_rating') 20 | get_plot_type('nb_started') 21 | get_plot_type('nb_started', 'line') 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /man/get_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{get_value} 4 | \alias{get_value} 5 | \title{S3 method to get the value of an object} 6 | \usage{ 7 | get_value(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object whose value is to be retrieved} 11 | 12 | \item{...}{additional parameters passed on to the method.} 13 | } 14 | \description{ 15 | S3 method to get the value of an object 16 | } 17 | -------------------------------------------------------------------------------- /man/input_date_range.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input-date-range.R 3 | \name{input_date_range} 4 | \alias{input_date_range} 5 | \alias{input_date_range_ui} 6 | \title{Create date range input with preset ranges} 7 | \usage{ 8 | input_date_range(input, output, session, date_range = c(Sys.Date() - 365, 9 | Sys.Date()), selected_date_range_preset = "Last Year", ...) 10 | 11 | input_date_range_ui(id, ...) 12 | } 13 | \arguments{ 14 | \item{input}{standard \code{shiny} boilerplate} 15 | 16 | \item{output}{standard \code{shiny} boilerplate} 17 | 18 | \item{session}{standard \code{shiny} boilerplate} 19 | 20 | \item{date_range}{a range of dates} 21 | 22 | \item{selected_date_range_preset}{selected date range preset} 23 | 24 | \item{...}{additional parameters passed to the module} 25 | 26 | \item{id}{a string indicating the id to call the module with} 27 | } 28 | \value{ 29 | A reactive vector of the selected date range 30 | } 31 | \description{ 32 | This is a shiny module to create a date range input with presets for the 33 | Last 1 week, 2 weeks, 6 months etc. 34 | } 35 | \examples{ 36 | library(shiny) 37 | \dontrun{ 38 | shinybones::preview_module(input_date_range, use_box = TRUE) 39 | test_date_range <- function(input, output, session, ...){ 40 | ns <- session$ns 41 | date_range_input <- callModule(input_date_range, 'date_range') 42 | output$date_range_text <- renderText({ 43 | paste(date_range_input(), collapse = " - ") 44 | }) 45 | } 46 | test_date_range_ui <- function(id, ...){ 47 | ns <- shiny::NS(id) 48 | shinydashboard::box( 49 | width = 12, 50 | title = 'Date Range Input', 51 | input_date_range_ui(ns('date_range')), 52 | column(12, textOutput(ns('date_range_text'))) 53 | ) 54 | } 55 | shinybones::preview_module(test_date_range) 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /man/input_select_period.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input-select-period.R 3 | \name{input_select_period} 4 | \alias{input_select_period} 5 | \title{Create a picker input to select aggregation period} 6 | \usage{ 7 | input_select_period(inputId, selected_period = NULL, periods = "All", 8 | label = "aggregated_by", select_func = shiny::selectInput, ...) 9 | } 10 | \arguments{ 11 | \item{inputId}{the input slot that will be used to access the value.} 12 | 13 | \item{selected_period}{a string indicating selected period} 14 | 15 | \item{periods}{a named vector of periods.} 16 | 17 | \item{label}{a string to display as label.} 18 | 19 | \item{select_func}{a select input function. Either 20 | \code{\link[shiny]{selectInput}} or \code{\link[shinyWidgets]{pickerInput}}} 21 | 22 | \item{...}{additional parameters passed on to \code{select_func}} 23 | } 24 | \description{ 25 | Create a picker input to select aggregation period 26 | } 27 | \examples{ 28 | \dontrun{ 29 | input_select_period('period') \%>\% 30 | shinybones::preview_component() 31 | input_select_period('period', selected_period = 'week') \%>\% 32 | shinybones::preview_component() 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /man/input_toggle_pct.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input-toggle-pct.R 3 | \name{input_toggle_pct} 4 | \alias{input_toggle_pct} 5 | \title{Radio buttons to toggle between number and percentage.} 6 | \usage{ 7 | input_toggle_pct(inputId, label = "as", size = "sm", ...) 8 | } 9 | \arguments{ 10 | \item{inputId}{the input slot that will be used to access the value.} 11 | 12 | \item{label}{label to display alongside the buttons} 13 | 14 | \item{size}{size of the radio buttons ('sm', 'xs', or 'lg')} 15 | 16 | \item{...}{additional parameters to pass to 17 | \code{\link[shinyWidgets]{radioGroupButtons}}} 18 | } 19 | \description{ 20 | Radio buttons to toggle between number and percentage. 21 | } 22 | \examples{ 23 | \dontrun{ 24 | input_toggle_pct('show_pct') \%>\% 25 | shinybones::preview_component() 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /man/metric_panel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/metric-panel.R 3 | \name{metric_panel} 4 | \alias{metric_panel} 5 | \alias{metric_panel_ui} 6 | \title{Display a metric in a panel} 7 | \usage{ 8 | metric_panel(input, output, session, metric, plot_type = NULL, 9 | plot_fun = NULL, plot_post_process = NULL, 10 | orientation = "vertical", selected_date_range_preset = "All Time", 11 | selected_period = "Week", height = 400, div_bottom_left = NULL, 12 | hidden_dimensions = NULL, ...) 13 | 14 | metric_panel_ui(id, ...) 15 | } 16 | \arguments{ 17 | \item{input}{standard \code{shiny} boilerplate} 18 | 19 | \item{output}{standard \code{shiny} boilerplate} 20 | 21 | \item{session}{standard \code{shiny} boilerplate} 22 | 23 | \item{metric}{A metric to display. It should be a list with data and title} 24 | 25 | \item{plot_type}{Either "line" or "bar": if neither is given, it guesses 26 | "line" for \code{pct}, \code{avg}, \code{min}, \code{median}, and \code{max} 27 | metrics, and "bar" otherwise. Ignored if \code{plot_fun} is provided.} 28 | 29 | \item{plot_fun}{A plotting function that takes two arguments - data and 30 | dimension} 31 | 32 | \item{plot_post_process}{a function to post-process the default plot} 33 | 34 | \item{orientation}{a string indicating orientation (vertical or horizontal)} 35 | 36 | \item{selected_date_range_preset}{Default date range preset to use. Use 37 | \code{date_range_presets_vec()} to look up possible presets} 38 | 39 | \item{selected_period}{Default period to display the data} 40 | 41 | \item{height}{height of the panel} 42 | 43 | \item{div_bottom_left}{html to display on bottom left of the panel} 44 | 45 | \item{hidden_dimensions}{A vector of dimension names that should not be 46 | displayed as tabs.} 47 | 48 | \item{...}{Additional parameters passed to the server} 49 | 50 | \item{id}{a string indicating the id to call the module with} 51 | } 52 | \description{ 53 | Display a metric in a panel 54 | } 55 | \examples{ 56 | library(dplyr) 57 | \dontrun{ 58 | metrics_condensed <- datacampr::dc_s3_read( 59 | "metrics_condensed.rds" 60 | )$metrics_condensed 61 | preview_metric( 62 | metric = metrics_condensed$finance_forecasts_usd_arr_total, 63 | plot_type = 'line' 64 | ) 65 | preview_metric(metrics_condensed$finance_cash_usd_cash_in) 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /man/metric_panel_footer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/metric-panel-footer.R 3 | \name{metric_panel_footer} 4 | \alias{metric_panel_footer} 5 | \alias{metric_panel_footer_ui} 6 | \title{Metric Panel Footer} 7 | \usage{ 8 | metric_panel_footer(input, output, session, metric, 9 | date_range = range(metric$date), 10 | selected_date_range_preset = "Last Year", ...) 11 | 12 | metric_panel_footer_ui(id, selected_period = NULL, periods, ...) 13 | } 14 | \arguments{ 15 | \item{input}{standard \code{shiny} boilerplate} 16 | 17 | \item{output}{standard \code{shiny} boilerplate} 18 | 19 | \item{session}{standard \code{shiny} boilerplate} 20 | 21 | \item{metric}{a \code{tbl_metric} object} 22 | 23 | \item{date_range}{a range of dates} 24 | 25 | \item{selected_date_range_preset}{selected date range preset} 26 | 27 | \item{...}{Additional parameters to pass to module} 28 | 29 | \item{id}{a string indicating the id to call the module with} 30 | 31 | \item{selected_period}{a string indicating selected period} 32 | 33 | \item{periods}{a named vector of periods.} 34 | } 35 | \description{ 36 | This is a component module to ... 37 | } 38 | \examples{ 39 | \dontrun{ 40 | shinybones::preview_module(metric_panel_footer, 41 | selected_date_range_preset = 'Last Week', 42 | selected_period = 'month' 43 | ) 44 | } 45 | \dontrun{ 46 | library(dplyr) 47 | metrics <- datacampr::dc_s3_read('metrics_condensed.rds')$metrics_condensed 48 | preview_metric(metrics$content_courses_avg_rating_wtd) 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/plot_metric_condensed.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plots.R 3 | \name{plot_metric_condensed} 4 | \alias{plot_metric_condensed} 5 | \title{Plot a condensed metric} 6 | \usage{ 7 | plot_metric_condensed(metric, dimension = "all", plot_type = NULL, 8 | quietly = TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{metric}{a \code{tbl_metric} object} 12 | 13 | \item{dimension}{a string indicating the dimension to visualize} 14 | 15 | \item{plot_type}{a string indicating type of plot (line/bar)} 16 | 17 | \item{quietly}{a boolean indicating if messages should be suppressed} 18 | 19 | \item{...}{additional parameters passed} 20 | } 21 | \description{ 22 | Plot a condensed metric 23 | } 24 | \examples{ 25 | \dontrun{ 26 | library(dplyr) 27 | metrics_condensed <- datacampr::dc_s3_read( 28 | 'metrics_condensed.rds' 29 | )$metrics_condensed 30 | metric \%>\% 31 | filter(period == 'week') \%>\% 32 | filter(date >= Sys.Date() - 365) \%>\% 33 | plot_metric_condensed() 34 | 35 | metrics_condensed$product_time_median_time_spent \%>\% 36 | filter(period == 'week') \%>\% 37 | filter(date >= Sys.Date() - 365) \%>\% 38 | plot_metric_condensed_line(dimension = 'subscription_type') 39 | 40 | metrics_condensed$content_courses_avg_rating_wtd \%>\% 41 | filter(period == 'rolling_28d') \%>\% 42 | filter(date >= Sys.Date() - 365) \%>\% 43 | plot_metric_condensed() 44 | 45 | metrics_condensed$content_courses_avg_rating_wtd \%>\% 46 | filter(period == 'rolling_28d') \%>\% 47 | filter(date >= Sys.Date() - 365) \%>\% 48 | plot_metric_condensed('ds_track') 49 | 50 | flights_nyc_avg_arr_delay \%>\% 51 | filter(period == 'week') \%>\% 52 | plot_metric_condensed(plot_type = 'bar') 53 | 54 | flights_nyc_avg_arr_delay \%>\% 55 | filter(period == 'week') \%>\% 56 | plot_metric_condensed(plot_type = 'bar', dimension = 'origin') 57 | 58 | flights_nyc_avg_arr_delay \%>\% 59 | filter(period == 'week') \%>\% 60 | plot_metric_condensed(plot_type = 'line') 61 | 62 | flights_nyc_avg_arr_delay \%>\% 63 | filter(period == 'week') \%>\% 64 | plot_metric_condensed(plot_type = 'line', dimension = 'origin') 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /man/preview_metric.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/preview.R 3 | \name{preview_metric} 4 | \alias{preview_metric} 5 | \title{Preview a metric in a shinydashboard} 6 | \usage{ 7 | preview_metric(metric, ...) 8 | } 9 | \arguments{ 10 | \item{metric}{a \code{tbl_metric} object} 11 | 12 | \item{...}{additional parameters passed to \code{metric_panel}} 13 | } 14 | \description{ 15 | Preview a metric in a shinydashboard 16 | } 17 | \examples{ 18 | library(dplyr) 19 | \dontrun{ 20 | metric_satisfaction <- datacampr::tbl_metric_product_survey_avg_satisfaction() 21 | preview_metric(metric_satisfaction) 22 | metric_rating <- datacampr::tbl_metric_content_courses_avg_rating_wtd() 23 | preview_metric(metric_rating, selected_period = 'Rolling 28 Day') 24 | preview_metric( 25 | metric \%>\% 26 | filter(launch_status == "live") \%>\% 27 | filter(technology == "R"), 28 | selected_period = 'Rolling 28 Day' 29 | ) 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /man/title_with_modal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/titles.R 3 | \name{title_with_modal} 4 | \alias{title_with_modal} 5 | \alias{title_with_tooltip} 6 | \alias{title_with_popover} 7 | \title{Title with help text in an informative modal, popover or tooltip} 8 | \usage{ 9 | title_with_modal(title, help_text, help_title = title, is_h3 = TRUE, 10 | ...) 11 | 12 | title_with_tooltip(title, help_text, ...) 13 | 14 | title_with_popover(title, help_text, help_title = title, ...) 15 | } 16 | \arguments{ 17 | \item{title}{title} 18 | 19 | \item{help_text}{help_text} 20 | 21 | \item{help_title}{help_title} 22 | 23 | \item{is_h3}{a boolean indicating if title should be wrapped in \code{h3}} 24 | 25 | \item{...}{additional argument passed on to \code{\link[bsplus]{bs_modal}}} 26 | } 27 | \description{ 28 | Title with help text in an informative modal, popover or tooltip 29 | } 30 | -------------------------------------------------------------------------------- /shinymetrics.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 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 | --------------------------------------------------------------------------------