From ed4093a980a04f169024d046a0712432c32a4f69 Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Thu, 12 Dec 2024 13:28:50 +0000 Subject: [PATCH 1/8] reactable example initial commit --- R/ui_panels/example_tab_1.R | 6 ++- global.R | 1 + server.R | 83 +++++++++++++++++++++++++------------ 3 files changed, 62 insertions(+), 28 deletions(-) diff --git a/R/ui_panels/example_tab_1.R b/R/ui_panels/example_tab_1.R index 691c80c..a537a4e 100644 --- a/R/ui_panels/example_tab_1.R +++ b/R/ui_panels/example_tab_1.R @@ -120,7 +120,11 @@ example_tab_1_panel <- function() { ) ), # Benchmarking table -------------------------------------- - dataTableOutput("tabBenchmark") + h2('An example Datatable'), + dataTableOutput("tabBenchmark"), + br(), + h2('An example Reactable'), + reactableOutput("tabBenchmark2") ) ) ) diff --git a/global.R b/global.R index 8536b45..ad28c60 100644 --- a/global.R +++ b/global.R @@ -24,6 +24,7 @@ shhh(library(shinyGovstyle)) # Creating charts and tables shhh(library(ggplot2)) shhh(library(DT)) +shhh(library(reactable)) # Data and string manipulation shhh(library(dplyr)) diff --git a/server.R b/server.R index de3d8c8..9db91a3 100644 --- a/server.R +++ b/server.R @@ -35,17 +35,17 @@ server <- function(input, output, session) { "plotly_click-A", "plotly_hover-A", "plotly_afterplot-A", ".clientValue-default-plotlyCrosstalkOpts" )) - + observe({ # Trigger this observer every time an input changes reactiveValuesToList(input) session$doBookmark() }) - + onBookmarked(function(url) { updateQueryString(url) }) - + observe({ if (input$navlistPanel == "Example tab 1") { change_window_title( @@ -66,7 +66,7 @@ server <- function(input, output, session) { ) } }) - + # Cookies logic ------------------------------------------------------------- observeEvent(input$cookies, { if (!is.null(input$cookies)) { @@ -92,7 +92,7 @@ server <- function(input, output, session) { shinyjs::hide(id = "cookieMain") } }) - + # Need these set of observeEvent to create a path through the cookie banner observeEvent(input$cookieAccept, { msg <- list( @@ -104,7 +104,7 @@ server <- function(input, output, session) { shinyjs::show(id = "cookieAcceptDiv") shinyjs::hide(id = "cookieMain") }) - + observeEvent(input$cookieReject, { msg <- list( name = "dfe_analytics", @@ -115,15 +115,15 @@ server <- function(input, output, session) { shinyjs::show(id = "cookieRejectDiv") shinyjs::hide(id = "cookieMain") }) - + observeEvent(input$hideAccept, { shinyjs::toggle(id = "cookieDiv") }) - + observeEvent(input$hideReject, { shinyjs::toggle(id = "cookieDiv") }) - + observeEvent(input$remove, { shinyjs::toggle(id = "cookieMain") msg <- list(name = "dfe_analytics", value = "denied") @@ -131,11 +131,11 @@ server <- function(input, output, session) { session$sendCustomMessage("analytics-consent", msg) print(input$cookies) }) - + cookies_data <- reactive({ input$cookies }) - + output$cookie_status <- renderText({ cookie_text_stem <- "To better understand the reach of our dashboard tools, this site uses cookies to identify numbers of unique users as part of Google @@ -153,15 +153,15 @@ server <- function(input, output, session) { "Cookies consent has not been confirmed." } }) - + observeEvent(input$cookieLink, { # Need to link here to where further info is located. You can # updateTabsetPanel to have a cookie page for instance updateTabsetPanel(session, "navlistPanel", - selected = "Support and feedback" + selected = "Support and feedback" ) }) - + # Dataset with timeseries data ---------------------------------------------- reactive_rev_bal <- reactive({ df_revbal %>% filter( @@ -169,7 +169,7 @@ server <- function(input, output, session) { school_phase == input$selectPhase ) }) - + # Dataset with benchmark data ----------------------------------------------- reactive_benchmark <- reactive({ df_revbal %>% @@ -179,7 +179,7 @@ server <- function(input, output, session) { year == max(year) ) }) - + # Charts -------------------------------------------------------------------- # Line chart for revenue balance over time output$lineRevBal <- renderGirafe({ @@ -193,7 +193,7 @@ server <- function(input, output, session) { height_svg = 5.0 ) }) - + # Benchmarking bar chart output$colBenchmark <- renderGirafe({ girafe( @@ -206,7 +206,7 @@ server <- function(input, output, session) { height_svg = 5.0 ) }) - + # Benchmarking table output$tabBenchmark <- renderDataTable({ datatable( @@ -223,7 +223,36 @@ server <- function(input, output, session) { ) ) }) + + output$tabBenchmark2 <- renderReactable({ + reactable( + reactive_benchmark() %>% + select( + Area = area_name, + `Average Revenue Balance (£)` = average_revenue_balance, + `Total Revenue Balance (£m)` = total_revenue_balance_million + ), + # defaultPageSizr and minRows needed for Pagination: example here + # defaultPageSize = 4, + # minRows = 4, + # searchable = TRUE, # uncomment line if you want a search box + # filterable = TRUE, # uncomment line if you want filters at the top + # filters on individual columns also possible + defaultSorted = list("Total Revenue Balance (£m)" = "desc"), + defaultColDef = colDef( + style = JS("function(rowInfo, column, state) { + // Highlight sorted columns + for (let i = 0; i < state.sorted.length; i++) { + if (state.sorted[i].id === column.id) { + return { background: 'rgba(0, 0, 0, 0.03)' } + } + } + }") + ) + ) + }) + # Value boxes --------------------------------------------------------------- # Create a reactive value for average revenue balance latest_average_balance <- reactive({ @@ -235,7 +264,7 @@ server <- function(input, output, session) { ) %>% pull(average_revenue_balance) }) - + # Create a reactive value for previous year average previous_average_balance <- reactive({ previous_year <- reactive_rev_bal() %>% @@ -246,13 +275,13 @@ server <- function(input, output, session) { ) %>% pull(average_revenue_balance) }) - + # Export values for use in UI tests ----------------------------------------- exportTestValues( avg_rev_bal_value = latest_average_balance(), prev_avg_rev_bal_value = previous_average_balance() ) - + # Create a value box for average revenue balance output$box_balance_latest <- renderValueBox({ value_box( @@ -261,7 +290,7 @@ server <- function(input, output, session) { color = "blue" ) }) - + # Create a value box for the change on previous year output$box_balance_change <- renderValueBox({ value_box( @@ -274,12 +303,12 @@ server <- function(input, output, session) { color = "blue" ) }) - + # Link in the user guide panel back to the main panel ----------------------- observeEvent(input$link_to_app_content_tab, { updateTabsetPanel(session, "navlistPanel", selected = "Example tab 1") }) - + # Download the underlying data button -------------------------------------- output$download_data <- downloadHandler( filename = "shiny_template_underlying_data.csv", @@ -287,14 +316,14 @@ server <- function(input, output, session) { write.csv(df_revbal, file) } ) - + # Dynamic label showing custom selections ----------------------------------- output$dropdown_label <- renderText({ paste0("Current selections: ", input$selectPhase, ", ", input$selectArea) }) - + # Stop app ------------------------------------------------------------------ session$onSessionEnded(function() { stopApp() }) -} +} \ No newline at end of file From 0bde91e763c1db3698fa783465cbf7913ece0c42 Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Thu, 12 Dec 2024 14:49:47 +0000 Subject: [PATCH 2/8] adding reactR and reactable --- renv.lock | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/renv.lock b/renv.lock index 6bd93f4..add7d47 100644 --- a/renv.lock +++ b/renv.lock @@ -1204,6 +1204,31 @@ ], "Hash": "5e3c5dc0b071b21fa128676560dbe94d" }, + "reactR": { + "Package": "reactR", + "Version": "0.6.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "b8e3d93f508045812f47136c7c44c251" + }, + "reactable": { + "Package": "reactable", + "Version": "0.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "digest", + "htmltools", + "htmlwidgets", + "jsonlite", + "reactR" + ], + "Hash": "6069eb2a6597963eae0605c1875ff14c" + }, "rematch2": { "Package": "rematch2", "Version": "2.1.2", From cb6223617e6053b43a72af87262ad10ad026751d Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Thu, 19 Dec 2024 11:41:00 +0000 Subject: [PATCH 3/8] removing datatable, running styler and lintr --- R/ui_panels/example_tab_1.R | 5 +-- server.R | 75 ++++++++++++++----------------------- www/dfe_shiny_gov_style.css | 48 ++++++++++++++++++++++++ 3 files changed, 78 insertions(+), 50 deletions(-) diff --git a/R/ui_panels/example_tab_1.R b/R/ui_panels/example_tab_1.R index a537a4e..1544fb0 100644 --- a/R/ui_panels/example_tab_1.R +++ b/R/ui_panels/example_tab_1.R @@ -120,10 +120,7 @@ example_tab_1_panel <- function() { ) ), # Benchmarking table -------------------------------------- - h2('An example Datatable'), - dataTableOutput("tabBenchmark"), - br(), - h2('An example Reactable'), + h2("An example Reactable"), reactableOutput("tabBenchmark2") ) ) diff --git a/server.R b/server.R index 9db91a3..3bffc80 100644 --- a/server.R +++ b/server.R @@ -35,17 +35,17 @@ server <- function(input, output, session) { "plotly_click-A", "plotly_hover-A", "plotly_afterplot-A", ".clientValue-default-plotlyCrosstalkOpts" )) - + observe({ # Trigger this observer every time an input changes reactiveValuesToList(input) session$doBookmark() }) - + onBookmarked(function(url) { updateQueryString(url) }) - + observe({ if (input$navlistPanel == "Example tab 1") { change_window_title( @@ -66,7 +66,7 @@ server <- function(input, output, session) { ) } }) - + # Cookies logic ------------------------------------------------------------- observeEvent(input$cookies, { if (!is.null(input$cookies)) { @@ -92,7 +92,7 @@ server <- function(input, output, session) { shinyjs::hide(id = "cookieMain") } }) - + # Need these set of observeEvent to create a path through the cookie banner observeEvent(input$cookieAccept, { msg <- list( @@ -104,7 +104,7 @@ server <- function(input, output, session) { shinyjs::show(id = "cookieAcceptDiv") shinyjs::hide(id = "cookieMain") }) - + observeEvent(input$cookieReject, { msg <- list( name = "dfe_analytics", @@ -115,15 +115,15 @@ server <- function(input, output, session) { shinyjs::show(id = "cookieRejectDiv") shinyjs::hide(id = "cookieMain") }) - + observeEvent(input$hideAccept, { shinyjs::toggle(id = "cookieDiv") }) - + observeEvent(input$hideReject, { shinyjs::toggle(id = "cookieDiv") }) - + observeEvent(input$remove, { shinyjs::toggle(id = "cookieMain") msg <- list(name = "dfe_analytics", value = "denied") @@ -131,11 +131,11 @@ server <- function(input, output, session) { session$sendCustomMessage("analytics-consent", msg) print(input$cookies) }) - + cookies_data <- reactive({ input$cookies }) - + output$cookie_status <- renderText({ cookie_text_stem <- "To better understand the reach of our dashboard tools, this site uses cookies to identify numbers of unique users as part of Google @@ -153,15 +153,15 @@ server <- function(input, output, session) { "Cookies consent has not been confirmed." } }) - + observeEvent(input$cookieLink, { # Need to link here to where further info is located. You can # updateTabsetPanel to have a cookie page for instance updateTabsetPanel(session, "navlistPanel", - selected = "Support and feedback" + selected = "Support and feedback" ) }) - + # Dataset with timeseries data ---------------------------------------------- reactive_rev_bal <- reactive({ df_revbal %>% filter( @@ -169,7 +169,7 @@ server <- function(input, output, session) { school_phase == input$selectPhase ) }) - + # Dataset with benchmark data ----------------------------------------------- reactive_benchmark <- reactive({ df_revbal %>% @@ -179,7 +179,7 @@ server <- function(input, output, session) { year == max(year) ) }) - + # Charts -------------------------------------------------------------------- # Line chart for revenue balance over time output$lineRevBal <- renderGirafe({ @@ -193,7 +193,7 @@ server <- function(input, output, session) { height_svg = 5.0 ) }) - + # Benchmarking bar chart output$colBenchmark <- renderGirafe({ girafe( @@ -206,24 +206,7 @@ server <- function(input, output, session) { height_svg = 5.0 ) }) - - # Benchmarking table - output$tabBenchmark <- renderDataTable({ - datatable( - reactive_benchmark() %>% - select( - Area = area_name, - `Average Revenue Balance (£)` = average_revenue_balance, - `Total Revenue Balance (£m)` = total_revenue_balance_million - ), - options = list( - scrollX = TRUE, - paging = FALSE, - searching = FALSE - ) - ) - }) - + output$tabBenchmark2 <- renderReactable({ reactable( reactive_benchmark() %>% @@ -232,7 +215,7 @@ server <- function(input, output, session) { `Average Revenue Balance (£)` = average_revenue_balance, `Total Revenue Balance (£m)` = total_revenue_balance_million ), - # defaultPageSizr and minRows needed for Pagination: example here + # defaultPageSize and minRows needed for Pagination: example here # defaultPageSize = 4, # minRows = 4, # searchable = TRUE, # uncomment line if you want a search box @@ -252,7 +235,7 @@ server <- function(input, output, session) { ) }) - + # Value boxes --------------------------------------------------------------- # Create a reactive value for average revenue balance latest_average_balance <- reactive({ @@ -264,7 +247,7 @@ server <- function(input, output, session) { ) %>% pull(average_revenue_balance) }) - + # Create a reactive value for previous year average previous_average_balance <- reactive({ previous_year <- reactive_rev_bal() %>% @@ -275,13 +258,13 @@ server <- function(input, output, session) { ) %>% pull(average_revenue_balance) }) - + # Export values for use in UI tests ----------------------------------------- exportTestValues( avg_rev_bal_value = latest_average_balance(), prev_avg_rev_bal_value = previous_average_balance() ) - + # Create a value box for average revenue balance output$box_balance_latest <- renderValueBox({ value_box( @@ -290,7 +273,7 @@ server <- function(input, output, session) { color = "blue" ) }) - + # Create a value box for the change on previous year output$box_balance_change <- renderValueBox({ value_box( @@ -303,12 +286,12 @@ server <- function(input, output, session) { color = "blue" ) }) - + # Link in the user guide panel back to the main panel ----------------------- observeEvent(input$link_to_app_content_tab, { updateTabsetPanel(session, "navlistPanel", selected = "Example tab 1") }) - + # Download the underlying data button -------------------------------------- output$download_data <- downloadHandler( filename = "shiny_template_underlying_data.csv", @@ -316,14 +299,14 @@ server <- function(input, output, session) { write.csv(df_revbal, file) } ) - + # Dynamic label showing custom selections ----------------------------------- output$dropdown_label <- renderText({ paste0("Current selections: ", input$selectPhase, ", ", input$selectArea) }) - + # Stop app ------------------------------------------------------------------ session$onSessionEnded(function() { stopApp() }) -} \ No newline at end of file +} diff --git a/www/dfe_shiny_gov_style.css b/www/dfe_shiny_gov_style.css index ae9cbb1..2fb0ca7 100644 --- a/www/dfe_shiny_gov_style.css +++ b/www/dfe_shiny_gov_style.css @@ -409,4 +409,52 @@ html { .small-box.bg-dark-blue { background-color: #12436D !important; color: #ffffff !important; +} + +/* Set default reactable styles */ +.reactable { + font-size: 1rem !important; + table-layout: fixed; + width: 100% !important; + word-break: keep-all; /* Prevents breaking words mid-word */ + white-space: normal; /* Allows line breaks between words */ +} + +@media screen and (min-width: 1440px) { + .bslib-sidebar-layout .sidebar-title { + font-size: 1.188rem !important; /* Slightly larger font size for large monitors */ + } +} + +@media screen and (min-width: 1240px) { + .bslib-sidebar-layout .sidebar-title { + font-size: 1.1rem !important; /* Slightly larger font size for large laptops */ + } +} + +/* Media query for laptop screens (1024px or smaller) */ +@media screen and (max-width: 1024px) { + .reactable, + .bslib-sidebar-layout > .sidebar > .sidebar-content label, + .selectize-control.multi .selectize-input.has-items { + font-size: 0.9rem !important; /* Slightly smaller font size for laptops */ + } +} + +/* Media query for tablet-sized screens (768px or smaller) */ +@media screen and (max-width: 768px) { + .reactable, + .bslib-sidebar-layout > .sidebar > .sidebar-content label, + .selectize-control.multi .selectize-input.has-items { + font-size: 0.8rem !important; /* Smaller font size for tablets */ + } +} + +/* Media query for small screens (480px or smaller) */ +@media screen and (max-width: 480px) { + .reactable, + .bslib-sidebar-layout > .sidebar > .sidebar-content label, + .selectize-control.multi .selectize-input.has-items { + font-size: 0.7rem !important; /* Even smaller font size for mobile */ + } } \ No newline at end of file From 0622941c1be29bd2942c5233ce0bb652eebe7b82 Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Mon, 6 Jan 2025 12:39:44 +0000 Subject: [PATCH 4/8] Update www/dfe_shiny_gov_style.css adding Rich's additions to css Co-authored-by: Rich Bielby --- www/dfe_shiny_gov_style.css | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/www/dfe_shiny_gov_style.css b/www/dfe_shiny_gov_style.css index 2fb0ca7..2bf7075 100644 --- a/www/dfe_shiny_gov_style.css +++ b/www/dfe_shiny_gov_style.css @@ -419,7 +419,30 @@ html { word-break: keep-all; /* Prevents breaking words mid-word */ white-space: normal; /* Allows line breaks between words */ } +.bar-sort-header:hover, +.bar-sort-header:focus { + background: #fd0; +} + +/* Add a top bar on ascending sort */ +.bar-sort-header[aria-sort="ascending"] { + box-shadow: inset 0 0.188rem 0 0 #1d70b8; +} + +/* Add a bottom bar on descending sort */ +.bar-sort-header[aria-sort="descending"] { + box-shadow: inset 0 -0.188rem 0 0 #1d70b8; +} + +/* Add an animation when toggling between ascending and descending sort */ +.bar-sort-header { + transition: box-shadow 0.3s cubic-bezier(0.175, 0.885, 0.32, 1.275); +} +/* Table row highlighting -------------------------------------------------- */ +.rt-tr-highlight:hover { + background-color: #fd0; +} @media screen and (min-width: 1440px) { .bslib-sidebar-layout .sidebar-title { font-size: 1.188rem !important; /* Slightly larger font size for large monitors */ From 81295a8c59c6f43c0746c3ae8f2da34f5cf626ca Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Mon, 6 Jan 2025 12:42:55 +0000 Subject: [PATCH 5/8] include searchable and filterable --- server.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/server.R b/server.R index 3bffc80..9ff47b0 100644 --- a/server.R +++ b/server.R @@ -215,12 +215,10 @@ server <- function(input, output, session) { `Average Revenue Balance (£)` = average_revenue_balance, `Total Revenue Balance (£m)` = total_revenue_balance_million ), - # defaultPageSize and minRows needed for Pagination: example here - # defaultPageSize = 4, - # minRows = 4, - # searchable = TRUE, # uncomment line if you want a search box - # filterable = TRUE, # uncomment line if you want filters at the top - # filters on individual columns also possible + defaultPageSize = 4, + minRows = 4, + searchable = TRUE, # uncomment line if you want a search box + filterable = TRUE, # uncomment line if you want filters at the top defaultSorted = list("Total Revenue Balance (£m)" = "desc"), defaultColDef = colDef( style = JS("function(rowInfo, column, state) { From 7f5493a0182b6f69b0bd08c2512fa74c98106454 Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Mon, 6 Jan 2025 13:22:58 +0000 Subject: [PATCH 6/8] add header class --- server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server.R b/server.R index e837e40..4c8dbe3 100644 --- a/server.R +++ b/server.R @@ -137,7 +137,7 @@ server <- function(input, output, session) { searchable = TRUE, # uncomment line if you want a search box filterable = TRUE, # uncomment line if you want filters at the top defaultSorted = list("Total Revenue Balance (£m)" = "desc"), - defaultColDef = colDef( + defaultColDef = colDef(headerClass = "bar-sort-header", style = JS("function(rowInfo, column, state) { // Highlight sorted columns for (let i = 0; i < state.sorted.length; i++) { From ef36a2a074bc26f29288cbbf495faf988d49583d Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Mon, 6 Jan 2025 13:24:57 +0000 Subject: [PATCH 7/8] styler split the row --- server.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/server.R b/server.R index 4c8dbe3..60fa5e3 100644 --- a/server.R +++ b/server.R @@ -137,7 +137,8 @@ server <- function(input, output, session) { searchable = TRUE, # uncomment line if you want a search box filterable = TRUE, # uncomment line if you want filters at the top defaultSorted = list("Total Revenue Balance (£m)" = "desc"), - defaultColDef = colDef(headerClass = "bar-sort-header", + defaultColDef = colDef( + headerClass = "bar-sort-header", style = JS("function(rowInfo, column, state) { // Highlight sorted columns for (let i = 0; i < state.sorted.length; i++) { From 616d5445c18de9e832d8fefbfafa306a8fc0129b Mon Sep 17 00:00:00 2001 From: alex-rogers-hub Date: Mon, 6 Jan 2025 14:06:33 +0000 Subject: [PATCH 8/8] updated renv.lock file --- renv.lock | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/renv.lock b/renv.lock index add7d47..8fd0a84 100644 --- a/renv.lock +++ b/renv.lock @@ -4,7 +4,7 @@ "Repositories": [ { "Name": "CRAN", - "URL": "https://packagemanager.posit.co/cran/latest" + "URL": "http://cran.rstudio.com" } ] }, @@ -1154,9 +1154,9 @@ }, "promises": { "Package": "promises", - "Version": "1.3.0", + "Version": "1.3.2", "Source": "Repository", - "Repository": "RSPM", + "Repository": "CRAN", "Requirements": [ "R6", "Rcpp", @@ -1166,7 +1166,7 @@ "rlang", "stats" ], - "Hash": "434cd5388a3979e74be5c219bcd6e77d" + "Hash": "c84fd4f75ea1f5434735e08b7f50fbca" }, "ps": { "Package": "ps", @@ -1336,7 +1336,7 @@ }, "shiny": { "Package": "shiny", - "Version": "1.9.1", + "Version": "1.10.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -1365,7 +1365,7 @@ "withr", "xtable" ], - "Hash": "6a293995a66e12c48d13aa1f957d09c7" + "Hash": "4b4477baa9a939c5577e5ddb4bf01f28" }, "shinyGovstyle": { "Package": "shinyGovstyle",