Skip to content

Adapt UI to housestyle with foldable about and adjust color scale of the heatmap #3

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
JanKeesSchakel merged 5 commits into from
Jun 23, 2025
Merged

Adapt UI to housestyle with foldable about and adjust color scale of the heatmap #3

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
ab3d8d2
Layout adapted to "new house style"- simple version; download button …
hfri Jun 14, 2025
efa57cb
adapted the colour scale to max count referring to periods
hfri Jun 18, 2025
f25077f
Collapsible about box toegevoegd
hfri Jun 20, 2025
bdc8208
Added text to about section. Added link to sensingclues website (not …
hfri Jun 22, 2025
fb69659
Adapted about text after suggestion, added appropriate link and space…
hfri Jun 22, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
81 changes: 50 additions & 31 deletions server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)

# 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
max_count <- max(heatmap_data_df$Counts, na.rm = TRUE)
xaxis_range <- c(0, max_count + max_count * 0.1) # 10% padding

# Bar chart
# Create the bar chart
bar_chart <- plot_ly(
data = bar_data_df,
x = ~Counts,
Expand All @@ -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)
Expand All @@ -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',
Expand All @@ -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 = "")
Expand All @@ -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, {
Expand Down
105 changes: 96 additions & 9 deletions ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ library(plotly)

# multi language

#source("ui_header.R")

tryCatch({
# try to get online version
Expand Down Expand Up @@ -49,24 +50,105 @@ 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(
"<br>",
"<a href='https://www.sensingclues.org/portal/'><img style = 'display: block; margin-left: auto; margin-right: auto;' src='logo_white.png' width = '150'></a>",
"<br>"
)
),
# --- 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);
}
"))
),

# --- About Box ---
div(class = "about-box",
h4("About"),
p("Add a small descriptive text about the app here.")
tags$details(
id = "aboutCollapse",
class = "collapsible-section",
tags$summary(
class = "collapsible-header",
HTML('<span>About</span><i class="material-icons expand-icon">expand_more</i>')
),
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/about-activity-pattern", # Change to your real link
class = "readmore",
target = "_blank"
)
),
br(),
# --- End About Box ---

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(
Expand All @@ -83,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(),
Expand All @@ -97,6 +179,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"),
Expand Down Expand Up @@ -251,7 +337,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)")
)
)
)
Expand Down
75 changes: 56 additions & 19 deletions www/style.css
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,29 +1,66 @@
$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 {
font-family: Verdana;

}


/* ============================
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;
}

<div class="sidebar">
<div class="sidebar-logo">
<img src="path/to/sidebar-logo.png" alt="Sidebar Logo">
</div>
<!-- Sidebar content -->
</div>