From ab3d8d29956206f2cbf6507271117dd8cb76848c Mon Sep 17 00:00:00 2001 From: hfri Date: Sat, 14 Jun 2025 14:29:58 +0200 Subject: [PATCH 1/5] Layout adapted to "new house style"- simple version; download button and functionality for .csv data included --- server.R | 79 ++++++++++++++++++++++++++++++++------------------- ui.R | 32 +++++++++++++++++++-- www/style.css | 75 +++++++++++++++++++++++++++++++++++------------- 3 files changed, 134 insertions(+), 52 deletions(-) diff --git a/server.R b/server.R index 2d0a126..20d5cdc 100644 --- a/server.R +++ b/server.R @@ -967,20 +967,24 @@ server <- function(input, output, session) { ## --- MAIN OUTPUT ------ - # Shared function to generate combined plot + # Create a reactiveValues container to hold the data frames + plot_data <- reactiveValues( + bar_data = NULL, + heatmap_data = NULL + ) + + # Reactive function that returns only the final Plotly object combined_plot_fn <- reactive({ session$userData$bar_data() %...>% { - bar_data_df <- .; bar_data_df <- bar_data_df$df + bar_data_df <- .$df # extract the data frame session$userData$heatmap_data() %...>% { heatmap_data_df <- . # Calculate max count for dynamic axis range max_count <- max(bar_data_df$Counts, na.rm = TRUE) + xaxis_range <- c(0, max_count + max_count * 0.1) # 10% padding - # Use 10% buffer or just add 20 units if scale is small - xaxis_range <- c(0, max_count + max_count * 1.1) # or max_count * 1.1 for percentage padding - - # Bar chart + # Create the bar chart bar_chart <- plot_ly( data = bar_data_df, x = ~Counts, @@ -996,19 +1000,13 @@ server <- function(input, output, session) { ) %>% layout( title = 'Total Counts per Species and Time Period', - xaxis = list( - title = 'Counts', - range = xaxis_range - ), - yaxis = list( - title = 'Species', - categoryorder = "total ascending" - ), + xaxis = list(title = 'Counts', range = xaxis_range), + yaxis = list(title = 'Species', categoryorder = "total ascending"), margin = list(r = 5), cliponaxis = FALSE ) - # Heatmap + # Determine heatmap settings based on the input if (input$agg_method == "percentage") { z_data <- heatmap_data_df$Percentage text_data <- round(heatmap_data_df$Percentage) @@ -1022,16 +1020,17 @@ server <- function(input, output, session) { colorbar_title <- "Counts" plot_title <- "Counts per Species" zmin <- min(bar_data_df$Counts, na.rm = TRUE) - zmax <- ceiling(max_count/ 10) * 10 + zmax <- ceiling(max_count / 10) * 10 } + # Create the heatmap heatmap <- plot_ly( data = heatmap_data_df, x = ~Period, y = ~conceptLabel, z = z_data, zmin = zmin, - zmax= zmax, + zmax = zmax, text = text_data, texttemplate = "%{text}", hoverinfo = 'text', @@ -1044,33 +1043,31 @@ server <- function(input, output, session) { layout( title = plot_title, xaxis = list(title = 'Time Period'), - yaxis = list(title = '', showticklabels = FALSE) + yaxis = list(title = '', showticklabels = FALSE) ) - # Combine + # Update the reactiveValues with the data frames for downloading later + plot_data$bar_data <- bar_data_df + plot_data$heatmap_data <- heatmap_data_df + + # Return only the combined plot (not a list) subplot(bar_chart, heatmap, nrows = 1, margin = 0.05) } } }) - # Render the plot + # Render the plot by resolving the promise to the final Plotly object output$combined_plot <- renderPlotly({ combined_plot_fn() }) - # Use a reactiveVal to cache the final plot - plot_cache <- reactiveVal(NULL) - # Save the completed plot to cache whenever it's re-rendered + # (Optional) Cache the final plot if you want to use it in a download handler for the HTML + plot_cache <- reactiveVal(NULL) observeEvent(combined_plot_fn(), { combined_plot_fn() %...>% plot_cache() }) - # Render the plot from the reactive (unchanged) - output$combined_plot <- renderPlotly({ - combined_plot_fn() - }) - - # Download handler + # Download handler for the Plotly HTML plot output$download_plotly <- downloadHandler( filename = function() { paste("combined_plot", ".html", sep = "") @@ -1080,10 +1077,32 @@ server <- function(input, output, session) { if (is.null(p)) { stop("Plot is not yet ready for download.") } - saveWidget(as_widget(p), file) } ) + + # Download handler for the CSV data containing the bar and heatmap data frames + output$download_csv <- downloadHandler( + filename = function() { + paste("combined_data", ".zip", sep = "") + }, + content = function(file) { + tmpdir <- tempdir() + bar_file <- file.path(tmpdir, "bar_data.csv") + heatmap_file <- file.path(tmpdir, "heatmap_data.csv") + + # Check that plot_data has been updated + if (is.null(plot_data$bar_data) || is.null(plot_data$heatmap_data)) { + stop("Data is not available yet.") + } + + write.csv(plot_data$bar_data, bar_file, row.names = FALSE) + write.csv(plot_data$heatmap_data, heatmap_file, row.names = FALSE) + + # Zip the CSV files together (requires the 'zip' package) + zip::zipr(zipfile = file, files = c(bar_file, heatmap_file), root = tmpdir) + } + ) ### TAB RAW CONCEPTS observeEvent(input$GetData, { diff --git a/ui.R b/ui.R index d829d2d..c3b79d1 100644 --- a/ui.R +++ b/ui.R @@ -14,6 +14,7 @@ library(plotly) # multi language +#source("ui_header.R") tryCatch({ # try to get online version @@ -49,17 +50,37 @@ ui <- fluidPage( # Load custom stylesheet includeCSS("www/style.css"), + shiny::tagList( + div( + class = "header", + + # combine the two logos, next to each other + div( + # logo SC + tags$a( + href = "https://sensingclues.org", + target = "_blank", + class = "logo", img(src = "logo_white.png")), + ), + + # titel + div( + class = "title", + "ACTIVITY PATTERN", + style = "font-size: 18px;" + ), + br(),br(),br(),br(),br(),br(),br() + ) + ), sidebarLayout( sidebarPanel( width = 3, HTML( paste0( "
", - "", "
" ) ), - # --- About Box --- div(class = "about-box", h4("About"), @@ -97,6 +118,10 @@ ui <- fluidPage( ) ), br(), + div( + style = "position: fixed; top: 45%; left: 60%; transform: translate(-50%, -50%);", + add_busy_spinner(spin = "fading-circle", width = "100px", height = "100px") + ), div(class = "filter-section data-sources-box", h4("Data Sources"), @@ -251,7 +276,8 @@ ui <- fluidPage( 12, div( style = "margin-top: 20px;", - downloadButton("download_plotly", "Download plot (.html)") + downloadButton("download_plotly", "Download plot (.html)"), + downloadButton("download_csv", "Download Data (.csv)") ) ) ) diff --git a/www/style.css b/www/style.css index 5b9d588..d0900ef 100644 --- a/www/style.css +++ b/www/style.css @@ -1,21 +1,21 @@ $blue: #1E88E5; -$indigo: #3949AB; -$purple: #5E35B1; -$pink: #D81B60; -$red: #E53935; -$orange: #FB8C00; -$yellow: #FDD835; -$green: #43A047; -$teal: #00897B; -$cyan: #00ACC1; - -$primary: #004D40; -$secondary: #FFAB00; -$success: #00897B; -$info: #607D8B; -$warning: #FB8C00; -$danger: #E53935; -$light: $gray-100; + $indigo: #3949AB; + $purple: #5E35B1; + $pink: #D81B60; + $red: #E53935; + $orange: #FB8C00; + $yellow: #FDD835; + $green: #43A047; + $teal: #00897B; + $cyan: #00ACC1; + + $primary: #004D40; + $secondary: #FFAB00; + $success: #00897B; + $info: #607D8B; + $warning: #FB8C00; + $danger: #E53935; + $light: $gray-100; $dark: $gray-800; body { @@ -23,7 +23,44 @@ body { } + +/* ============================ + Header (20% viewport height with 10% horizontal padding) +============================ */ +.header { + display: flex; + align-items: center; /* Center elements vertically */ + justify-content: space-between; /* Distribute items across the header */ + background-color: #004d40; + height: 11vh; + padding: 2rem 7vw; /* Adjust horizontal padding */ + border-bottom: 2px solid #00332b; + position: relative; + z-index: 0; +} + +.header .logo img { + height: 40px; + margin-top: 0.5rem; +} + +.header .title { + font-size: 1.5rem; + font-weight: bold; + letter-spacing: 1px; + color: white; + text-align: center; /* Center the title text */ +} + + .well { - background-color: #004D40; - color: #ECEFF1; + background-color: #ECEFF1; + # color: #ECEFF1; } + +
+ + +
\ No newline at end of file From efa57cb1ac4319e5aafb1e86557faca37f09b037 Mon Sep 17 00:00:00 2001 From: hfri Date: Wed, 18 Jun 2025 19:54:54 +0200 Subject: [PATCH 2/5] adapted the colour scale to max count referring to periods --- server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server.R b/server.R index 20d5cdc..0cfe296 100644 --- a/server.R +++ b/server.R @@ -981,7 +981,7 @@ server <- function(input, output, session) { heatmap_data_df <- . # Calculate max count for dynamic axis range - max_count <- max(bar_data_df$Counts, na.rm = TRUE) + max_count <- max(heatmap_data_df$Counts, na.rm = TRUE) xaxis_range <- c(0, max_count + max_count * 0.1) # 10% padding # Create the bar chart From f25077f7aed6399ae55a7b3f9920205909897bab Mon Sep 17 00:00:00 2001 From: hfri Date: Fri, 20 Jun 2025 20:11:09 +0200 Subject: [PATCH 3/5] Collapsible about box toegevoegd --- ui.R | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 67 insertions(+), 6 deletions(-) diff --git a/ui.R b/ui.R index c3b79d1..a39c6b0 100644 --- a/ui.R +++ b/ui.R @@ -81,13 +81,74 @@ ui <- fluidPage( "
" ) ), - # --- About Box --- - div(class = "about-box", - h4("About"), - p("Add a small descriptive text about the app here.") + # --- Collapsible About Box --- + tags$head( + tags$link(rel = "stylesheet", href = "https://fonts.googleapis.com/icon?family=Material+Icons"), + tags$style(HTML(" + .collapsible-section summary::-webkit-details-marker { + display: none; + } + .readmore { + font-weight: normal; + font-size: inherit; + color: #004d40; + text-decoration: underline; + } + .collapsible-header { + display: flex; + align-items: center; + justify-content: space-between; + cursor: pointer; + font-size: 16px; + font-weight: bold; + margin-bottom: 5px; + } + .collapsible-header .expand-icon { + transition: transform 0.3s ease; + font-size: 24px; + color: #555; + } + details[open] .expand-icon { + transform: rotate(180deg); + } + ")) ), - br(), - # --- End About Box --- + + tags$details( + id = "aboutCollapse", + class = "collapsible-section", + tags$summary( + class = "collapsible-header", + HTML('Aboutexpand_more') + ), + p("Add a small descriptive text about the app here."), + tags$a( + "Learn more", + href = "https://example.com", # Change to your real link + class = "readmore", + target = "_blank" + ) + ), + + tags$script(HTML(" + document.addEventListener('DOMContentLoaded', function() { + var el = document.getElementById('aboutCollapse'); + if (el) { + var summary = el.querySelector('summary'); + summary.addEventListener('click', function(e) { + setTimeout(function() { + var icon = summary.querySelector('.expand-icon'); + if (el.hasAttribute('open')) { + icon.style.transform = 'rotate(180deg)'; + } else { + icon.style.transform = 'rotate(0deg)'; + } + }, 100); + }); + } + }); +")), + # --- End Collapsible About Box --- # Custom button styles tags$head( From bdc820843f6476e6de8653786c0e0c6061130df1 Mon Sep 17 00:00:00 2001 From: hfri Date: Sun, 22 Jun 2025 14:23:49 +0200 Subject: [PATCH 4/5] Added text to about section. Added link to sensingclues website (not to an about section yet) --- ui.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ui.R b/ui.R index a39c6b0..5b2a874 100644 --- a/ui.R +++ b/ui.R @@ -121,10 +121,10 @@ ui <- fluidPage( class = "collapsible-header", HTML('Aboutexpand_more') ), - p("Add a small descriptive text about the app here."), + p("This app lets you explore animal observation data of your desired time period. You can discover typical activity patterns by hour, month, or season using the interactive heatmap, discover total counts per species, and download underlying data.."), tags$a( "Learn more", - href = "https://example.com", # Change to your real link + href = "https://www.sensingclues.org/", # Change to your real link class = "readmore", target = "_blank" ) From fb696599da62477ff2f6bb0ccf1f3356206d3e2d Mon Sep 17 00:00:00 2001 From: hfri Date: Sun, 22 Jun 2025 15:23:49 +0200 Subject: [PATCH 5/5] Adapted about text after suggestion, added appropriate link and space between username and about text --- ui.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ui.R b/ui.R index 5b2a874..2717578 100644 --- a/ui.R +++ b/ui.R @@ -121,10 +121,10 @@ ui <- fluidPage( class = "collapsible-header", HTML('Aboutexpand_more') ), - p("This app lets you explore animal observation data of your desired time period. You can discover typical activity patterns by hour, month, or season using the interactive heatmap, discover total counts per species, and download underlying data.."), + p("This app lets you explore animal observation data for any period. Use the heatmap to reveal activity trends by hour, month, or season, view total counts per species, and download the underlying dataset."), tags$a( "Learn more", - href = "https://www.sensingclues.org/", # Change to your real link + href = "https://www.sensingclues.org/about-activity-pattern", # Change to your real link class = "readmore", target = "_blank" ) @@ -165,7 +165,7 @@ ui <- fluidPage( "#downloadData{background-color:#FB8C00; color:white; font-size:100%}" ), ), - + br(), # Remove old heading h3(i18n$t("labels.obsReport")) uiOutput("userstatus"), br(),