diff --git a/activity_heatmap.R b/activity_heatmap.R deleted file mode 100644 index 2c36dd5..0000000 --- a/activity_heatmap.R +++ /dev/null @@ -1,247 +0,0 @@ -## Activity patterns -## Author: Hanna Fricke -## Date: 11-03-2025 -## Description: The goal is to create a heatmap that allows users to identify activity patterns of e.g. animal species over time (time of day, month, season) -## To-Dos -## [x] User time period - dynamic -## [x] User label for counts - dynamic -## [x] season based on user input - dynamic -## [x] name dataframes better -- obs_df is good for now but not really general (might be sounds)--> now data -## [] include some form of filter so that you really only get animals -## [x] time binning we need to improve and actually make 1 h bins. --> decide if you just want to make seperate new columns for that or -## [x] x-axis range heatmap needs to be different depending on selected period -## [] Include date range input for data -## [x] x-axis should display either 24h range or 12 months -## [x] make sure that user season cannot be paired with month or hour parameters -## [] See how you can adapt the season parameter that it can be an input that you provide as a user (e.g. a range slider) -## [x] make sure heatmap colour is also filled if factor levels are not in df -## [x] Include button that allows switching views from season to year to month -## [x] Include selection for time period of data -## [x] make sure that only one year is diplayed per view --> tested only on 2024 -## [] Include the option for different aggregates--> total observations of average observation time of the day depending on season and month -## [] Include button to switch between sensor and cameratrap data -## [] x- axis for hourly view is in steps of 2 atm --> make 1 -## [] include normalised view 0-1 -## [] use Shiny to read in data -## [] Include Ontology ID as ID not concept label -## [] Include box that allows to insert method of observation -## [] Visualise numbers in the bar graph and heatmap -## [] Include server side of methods -## [] Include relative counts -## [] add reverse ordering - -## Set up libraries -library(pacman) -p_load(ggplot2, plotly, dplyr, tidyr, quantmod, sensingcluesr) # makes loading and installing easier Lubridate needed? - -library(tidyr) -## import data from SC platform - chose Demo group africa -cookie <- login_cluey("XXX", "XXXX") # insert login - -groups <- get_groups(cookie, - from = "1900-01-01", # set so that dates include everything - to = "2999-12-31", - url = "https://focus.sensingclues.org/") # to get the names of the groups (REMOVE later) - -df <- get_observations( - cookie, - from = as.Date("2023-01-01"), # data was available from 2024 , adapt later to long e.g. from 1900-01-01 - to = Sys.Date(), - group = 'focus-project-1234' # demo group Africa -) - - -## Inspect demo data --> REMOVE later -df_copy<- df %>% mutate_if(is.character, as.factor) # check what values are in the dataframe -# Get the levels of each factor column -factor_levels <- lapply(df_copy[, sapply(df_copy, is.factor)], levels) -obs_df <- subset(df,description == "Observation animal") -dim(obs_df) == dim(subset(df, observationType == "animal")) # cross check if you really got all the animal data, seems like it -obs_df$when <- as.POSIXct(obs_df$when, format = "%Y-%m-%dT%H:%M:%S") # proper format for later - -## Note to myself: I need to filter out the properties from the observation from the animal names - -write.csv(obs_df, file ="C:/Users/hanna/Documents/africa_demo.csv") -## --------------------------------------------------------------------------------------------------------------------------------------- -## Make first Shiny version -# UI -ui <- fluidPage( - sidebarLayout( - sidebarPanel( - selectInput("selected_year", "Select Year:", choices = c("All", unique(format(obs_df$when, "%Y")))), # choices from all years in data - radioButtons("time_input", "Select time period:", # period one wants to look at - choices = c("Hourly" = "hourly", "Monthly" = "monthly", "Seasonal" = "season")), - numericInput("topX", "Number of rows to display:", value = 10, min = 1, step = 1), # User input for top X - radioButtons("method", "Select method of observation:", # period one wants to look at - choices = c("Cameratrap" = "cameratrap", "Animal sighting" = "animal sighting", "Sensor" = "sensor","Other" = "other")), - conditionalPanel( # only display if input is season - condition = "input.time_input == 'season'", - numericInput("num_seasons", "Number of Seasons:", value = 1, min = 1), # select how many seasons you expect - uiOutput("season_inputs"), # placeholder that reacts to server side - ) - ), - mainPanel( - plotlyOutput("combined_plot") - ) - ) -) - -server <- function(input, output, session) { - - # Generate input fields per season dynamically based on number of seasons user desires - output$season_inputs <- renderUI({ - req(input$num_seasons) # required input before going further - lapply(1:input$num_seasons, function(i) { - textInput(inputId = paste0("season_", i), label = paste("Season", i, "(e.g., '12,1,2' for Dec-Jan-Feb):"), value = "") - }) # loop through number of seasons and add suffix (e.g. 2 seasons = season_1, season_2) - }) - message(print(class(output))) - # Reactive expression to parse user-defined seasons - user_defined_seasons <- reactive({ - req(input$num_seasons) - seasons <- list() - for (i in 1:input$num_seasons) { - season_input <- input[[paste0("season_", i)]] - if (!is.null(season_input) && season_input != "") { - months <- unlist(strsplit(season_input, ",")) - seasons[[paste0("Season_", i)]] <- sprintf("%02d", as.numeric(trimws(months))) - } - } - seasons - }) - - - # Filter data based on year - filtered_data <- reactive({ - if (input$selected_year == "All") { - obs_df - } else { - obs_df %>% filter(format(when, "%Y") == input$selected_year) - } - }) - - # Prepare data for plotting --> in reactive format - plot_data <- reactive({ - data <- filtered_data() - time_input <- input$time_input - seasons <- user_defined_seasons() - - data <- data %>% - mutate(Period = case_when( - time_input == "hourly" ~ format(when, "%H"), - time_input == "monthly" ~ format(when, "%m"), - time_input == "season" ~ purrr::map_chr(format(when, "%m"), function(month) { - season <- names(seasons)[sapply(seasons, function(s) month %in% s)] - if (length(season) > 0) season else NA - }), - TRUE ~ NA_character_ - )) - - if (time_input == "hourly") { - data$Period <- factor(data$Period, levels = sprintf("%02d", 0:23), labels = paste0(sprintf("%02d", 0:23), "h")) - } else if (time_input == "monthly") { - data$Period <- factor(data$Period, levels = sprintf("%02d", 1:12), labels = month.abb) - } else if (time_input == "season") { - data$Period <- factor(data$Period, levels = names(seasons)) - } - - data - }) - - # Render combined plot - output$combined_plot <- renderPlotly({ - data <- plot_data() - - # Group data by Period and Label - bar_data <- data %>% - group_by(conceptLabel) %>% - summarise(Counts = n(), .groups = 'drop') - - - # Apply top X filter - topX <- input$topX - if (topX > 0) { - bar_data <- bar_data %>% - top_n(topX, Counts) %>% - arrange(desc(Counts)) - } - - # Order species according to frequency of detection for the bar chart - ordered_species <- bar_data %>% - arrange(Counts) %>% - pull(conceptLabel) - - # Heatmap Data Preparation - heatmap_data <- data %>% - group_by(conceptLabel, Period) %>% - summarise(Counts = n(), .groups = 'drop') - - # Create a full set of all combinations of conceptLabel and Period - full_periods <- expand.grid( - conceptLabel = unique(heatmap_data$conceptLabel), - Period = levels(data$Period) - ) - - # Left join the full combination set with the observed data to ensure all combinations - heatmap_data_complete <- full_periods %>% - left_join(heatmap_data, by = c("conceptLabel", "Period")) %>% - mutate(Counts = ifelse(is.na(Counts), 0, Counts)) - - # Apply top X filter to heatmap data - if (topX > 0) { - heatmap_data_complete <- heatmap_data_complete %>% - filter(conceptLabel %in% bar_data$conceptLabel) - } - ## ORDERED SPECIES NEEDS TO BE INCLUDED HERE! FILTERED - - heatmap_data_complete$conceptLabel <- factor(heatmap_data_complete$conceptLabel, levels = unique(c( - ordered_species, heatmap_data_complete$conceptLabel - ))) - - bar_chart <- plot_ly( - bar_data, - x = ~ Counts, - y = ~ conceptLabel, - type = 'bar', - orientation = 'h', - text = ~ Counts, # Add text for counts on bars - textposition = 'outside', # Position the text outside the bars - marker = list( - color = 'rgba(50, 171, 96, 0.6)', - line = list(color = 'rgba(50, 171, 96, 1.0)', width = 1) - ) -) %>% - layout( - title = 'Total Counts per Species and Time Period', - xaxis = list(title = 'Counts'), - yaxis = list(title = 'Species', categoryorder = "total ascending") - ) - - # Now use heatmap_data_complete for your heatmap plot - heatmap <- plot_ly( - data = heatmap_data_complete, - x = ~ Period, - y = ~ conceptLabel, - z = ~ Counts, - text = ~ Counts, - texttemplate = "%{text}", # Display the text values within the cells - hoverinfo = 'text', # Show text when hovering over a cell - colorbar = list(title = 'Counts'), # Optional: label for color scale - type = 'heatmap', - colorscale = 'Greens', - showscale = TRUE, - reversescale = TRUE - ) %>% - layout( - title = 'Counts per Species', - xaxis = list(title = 'Time Period'), - yaxis = list(title = 'Species') - ) - - subplot(bar_chart, heatmap, nrows = 1, margin = 0.05) %>% - layout(title = 'Activity Pattern') - }) -} - -# Run the application -shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/functions.R b/functions.R index e346807..0ea9920 100644 --- a/functions.R +++ b/functions.R @@ -61,10 +61,11 @@ build_tree_from_concepts <- function(concepts, counts) { for (i in 1:length(concepts)) { dfn <- rbind(dfn, c(concepts[[i]]$id, concepts[[i]]$parent, concepts[[i]]$label)) } + names(dfn) <- c("from", "to", "label") # filter concepts to only the base ontology dfn <- dfn %>% filter(grepl("SCCSSOntology", from)) - + tree <- FromDataFrameNetwork(dfn, check = "check") trav <- Traverse(tree) trav_name <- Get(trav, "name") @@ -80,7 +81,7 @@ build_tree_from_concepts <- function(concepts, counts) { df_counts <- bind_rows(dfs) # order df according to traverse sequence f <- df_counts[match(trav_name, df_counts$X_value), "frequency"] - + # set new attribute tree$Set(freq = f) @@ -95,77 +96,10 @@ build_tree_from_concepts <- function(concepts, counts) { stateLeafs <- list(opened = TRUE, selected = TRUE) nLeafs <- tree$leafCount tree$Set(state = rep(list(stateLeafs), nLeafs), filterFun = isLeaf) - # seems impossible to have tree opened and selected from tree.data object - #stateNotLeafs <- list(opened = TRUE) - #tree$Set(state = rep(list(stateNotLeafs),length(tree)-nLeafs), filterFun = isNotLeaf) - # "state": { - # "opened": true, - # "disabled": false, - # "selected": false, - # "loaded": false - # } - #tree$Do(function(node) node$state = list(opened = TRUE, disabled = FALSE, selected = TRUE, loaded = FALSE)) - - #tree = lapply(tree, function(x) structure(x, stopened = T)) - return(tree) } -# ----------------------------------------------------------------------------- -# OBSERVATIONS -# ----------------------------------------------------------------------------- - -## EVENTUALLY CONVERT PLOT INTO A FUNCTION - - -# ----------------------------------------------------------------------------- -# INTERSECTION -# ----------------------------------------------------------------------------- - -# # check which observations are in which layers -# intersect_observations_to_layers <- function(layer, obs) { -# # per feature -# for (i in 1:nrow(layer)){ -# # json -# # name is in properties -# #j <- unlist(f[[i]]) -# f01 <- layer[i,] -# -# label <- f01$NAME -# -# # make sure coordinate systems are the same -# # we actually overwrite the features crs so this could be wrong... -# f01 <- st_set_crs(f01, st_crs(obs)) -# # drop z dimension -# f01 <- st_zm(f01) -# # seems most MULTIPOLYGONS are POLYGONS at the lower level -# f01 <- st_make_valid(f01) -# -# # f01$geometry <- f01$geometry %>% -# # s2::s2_rebuild() %>% -# # sf::st_as_sfc() -# -# # check which points intersect with polygon -# tryCatch({ -# # do not use s2 -# sf::sf_use_s2(FALSE) -# lst <- st_intersects(obs, f01, sparse = FALSE) -# message(paste("LAYER ", label, " is OK")) -# sf::sf_use_s2(TRUE) -# # fill in the name for these points -# if (sum(lst) > 0) { -# obs[lst,]$area <- label -# } -# }, -# #error -# error = function(cond) message(paste("LAYER ", label, " has issues")) -# ) #tryCatch -# } -# return(obs) -# } - - # ----------------------------------------------------------------------------- # VISUALIZATIONS # ----------------------------------------------------------------------------- diff --git a/server.R b/server.R index b1c5961..2d0a126 100644 --- a/server.R +++ b/server.R @@ -401,7 +401,11 @@ server <- function(input, output, session) { output$season_inputs <- renderUI({ req(input$num_seasons) # required input before going further lapply(1:input$num_seasons, function(i) { - textInput(inputId = paste0("season_", i), label = paste("Season", i), value = "") + # Wrap each textInput in a div with styling for horizontal layout and reduced width + div(style = "display: inline-block; width: 75px; margin-right: 10px;", # Adjust width and margin as needed + textInput(inputId = paste0("season_", i), label = paste("Season", i), value = "") + ) + }) # loop through number of seasons and add suffix (e.g. 2 seasons = season_1, season_2) }) @@ -455,8 +459,41 @@ server <- function(input, output, session) { top_nodes <- sapply(session$userData$tree$children, function(x) x$name) cw_node <- "https://sensingclues.poolparty.biz/SCCSSOntology/6477" tr_node <- "https://sensingclues.poolparty.biz/SCCSSOntology/42" + rm11_node<- "https://sensingclues.poolparty.biz/SCCSSOntology/62" + rm12_node<- "https://sensingclues.poolparty.biz/SCCSSOntology/1911" + if (cw_node %in% top_nodes) {invisible(session$userData$tree$RemoveChild(cw_node))} if (tr_node %in% top_nodes) {invisible(session$userData$tree$RemoveChild(tr_node))} + if (rm11_node %in% top_nodes) {invisible(session$userData$tree$RemoveChild(rm11_node))} + if (rm12_node %in% top_nodes) {invisible(session$userData$tree$RemoveChild(rm12_node))} + + + # Access the top-level nodes + top_children <- session$userData$tree$children + + # Loop over top-level nodes to access their second-level children + for (parent in top_children) { + # Access second-level children of the current parent node + second_level_children <- parent$children + + # Check if the parent has any second-level children + if (!is.null(second_level_children)) { + # Extract the names of second-level children + obs_nodes <- sapply(second_level_children, function(x) x$name) + + # Define nodes to remove + rm13_node <- "https://sensingclues.poolparty.biz/SCCSSOntology/89" + rm14_node <- "https://sensingclues.poolparty.biz/SCCSSOntology/106" + rm15_node <- "https://sensingclues.poolparty.biz/SCCSSOntology/461" + + # Remove second-level children from the current parent node + if (rm13_node %in% obs_nodes) { invisible(parent$RemoveChild(rm13_node)) } + if (rm14_node %in% obs_nodes) { invisible(parent$RemoveChild(rm14_node)) } + if (rm15_node %in% obs_nodes) { invisible(parent$RemoveChild(rm15_node)) } + } + } + + if (length(session$userData$tree$children) == 0) {session$userData$tree <- list()} jsonTree <- shinyTree::treeToJSON(session$userData$tree, pretty = TRUE, createNewId = FALSE) enable_all(c("DateRange", "GroupListDiv", "GetData")) @@ -761,14 +798,17 @@ server <- function(input, output, session) { ## -- HEATMAP AND BAR GRAPH TAB -- code from hanna1 - # Filter dataset based on year of observation -- filtered_data now unnecessary + # Prepare data + + # Filter dataset based on year of observation --> remove later + session$userData$filtered_data <- reactive({ session$userData$processed_obsdata() %...>% { df <- . # Debugging messages message("Debug: Year filtered dataframe has ", nrow(df), " rows") - + return(df) # Return the filtered dataframe } }) @@ -857,6 +897,7 @@ server <- function(input, output, session) { # heatmap data transformation + # include proper if else session$userData$heatmap_data <- reactive({ session$userData$plot_data() %...>% { df <- . @@ -866,35 +907,37 @@ server <- function(input, output, session) { group_by(conceptLabel, Period) %>% summarise(Counts = n(), .groups = 'drop') - message( - "Debug - heatmap_data(): Grouped and summarized data. Rows after grouping: ", - nrow(df) - ) - # Ensure Period is an ordered factor AGAIN to avoid issues df$Period <- factor(df$Period, levels = levels(df$Period)) + # Create full grid of conceptLabel x Period full_periods <- expand.grid( conceptLabel = unique(df$conceptLabel), Period = levels(df$Period), - # Explicitly use levels stringsAsFactors = FALSE ) - message( - "Debug - heatmap_data(): Created full period grid with ", - nrow(full_periods), - " rows." - ) + message("Debug - heatmap_data(): Created full period grid with ", nrow(full_periods), " rows.") + # Fill missing combinations with 0 counts df_result <- full_periods %>% left_join(df, by = c("conceptLabel", "Period")) %>% - mutate(Counts = ifelse(is.na(Counts), 0, Counts)) # Ensure missing counts are filled with 0 + mutate(Counts = ifelse(is.na(Counts), 0, Counts)) - message( - "Debug - heatmap_data(): Applied full periods and resolved missing values. Rows after merging: ", - nrow(df_result) - ) + message("Debug - heatmap_data(): Applied full periods and resolved missing values. Rows after merging: ", + nrow(df_result)) + + # Now calculate percentages if needed + if (input$agg_method == "percentage") { + df_totals <- df_result %>% + group_by(conceptLabel) %>% + summarise(Total_Count = sum(Counts), .groups = 'drop') + + df_result <- df_result %>% + left_join(df_totals, by = "conceptLabel") %>% + mutate(Percentage = ifelse(Total_Count > 0, (Counts / Total_Count) * 100, 0)) + message("Percentage calculated") + } # Use bar data for ordering the heatmap data session$userData$bar_data() %...>% { @@ -908,38 +951,43 @@ server <- function(input, output, session) { filter(conceptLabel %in% bar_df$conceptLabel) } - # Ensure conceptLabel is ordered correctly --> needed to do that again otherwise it didnt take the factors correctly + # Ensure conceptLabel is ordered correctly df_result$conceptLabel <- factor(df_result$conceptLabel, levels = ordered_species) df_result$Period <- factor(df_result$Period, levels = levels(df$Period)) + message("Debug - heatmap_data(): Applied Top X filter. Rows remaining: ", nrow(df_result)) - return(df_result) + return(df_result) } } }) + ## --- MAIN OUTPUT ------ - output$combined_plot <- renderPlotly({ - # Resolve bar_data and heatmap_data otherwise plotly doesnt work + # Shared function to generate combined plot + combined_plot_fn <- reactive({ session$userData$bar_data() %...>% { - bar_data_df <- . - bar_data_df <- bar_data_df$df # - + bar_data_df <- .; bar_data_df <- bar_data_df$df session$userData$heatmap_data() %...>% { heatmap_data_df <- . + # Calculate max count for dynamic axis range + max_count <- max(bar_data_df$Counts, na.rm = TRUE) - # Create bar chart + # 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 bar_chart <- plot_ly( data = bar_data_df, - x = ~ Counts, - y = ~ conceptLabel, + x = ~Counts, + y = ~conceptLabel, type = 'bar', orientation = 'h', - text = ~ Counts, + text = ~Counts, textposition = 'outside', marker = list( color = 'rgba(50, 171, 96, 0.6)', @@ -948,40 +996,95 @@ server <- function(input, output, session) { ) %>% layout( title = 'Total Counts per Species and Time Period', - xaxis = list(title = 'Counts'), - 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 ) - # Create heatmap + # Heatmap + if (input$agg_method == "percentage") { + z_data <- heatmap_data_df$Percentage + text_data <- round(heatmap_data_df$Percentage) + colorbar_title <- "Percentage" + plot_title <- "Relative fractions (%) per species" + zmin <- 0 + zmax <- 100 + } else { + z_data <- heatmap_data_df$Counts + text_data <- heatmap_data_df$Counts + colorbar_title <- "Counts" + plot_title <- "Counts per Species" + zmin <- min(bar_data_df$Counts, na.rm = TRUE) + zmax <- ceiling(max_count/ 10) * 10 + } + heatmap <- plot_ly( data = heatmap_data_df, - x = ~ Period, - y = ~ conceptLabel, - z = ~ Counts, - text = ~ Counts, + x = ~Period, + y = ~conceptLabel, + z = z_data, + zmin = zmin, + zmax= zmax, + text = text_data, texttemplate = "%{text}", hoverinfo = 'text', - colorbar = list(title = 'Counts'), + colorbar = list(title = colorbar_title), type = 'heatmap', colorscale = 'Greens', showscale = TRUE, reversescale = TRUE ) %>% layout( - title = 'Counts per Species', + title = plot_title, xaxis = list(title = 'Time Period'), - yaxis = list(title = 'Species') + yaxis = list(title = '', showticklabels = FALSE) ) - # Combine the plots - subplot(bar_chart, heatmap, nrows = 1, margin = 0.05) %>% - layout(title = 'Activity Pattern') + # Combine + subplot(bar_chart, heatmap, nrows = 1, margin = 0.05) } } }) + # Render the plot + 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 + 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 + output$download_plotly <- downloadHandler( + filename = function() { + paste("combined_plot", ".html", sep = "") + }, + content = function(file) { + p <- plot_cache() + if (is.null(p)) { + stop("Plot is not yet ready for download.") + } + + saveWidget(as_widget(p), file) + } + ) + ### TAB RAW CONCEPTS observeEvent(input$GetData, { # make container for displaying hover text for column headings diff --git a/ui.R b/ui.R index 9a5996f..d829d2d 100644 --- a/ui.R +++ b/ui.R @@ -29,6 +29,7 @@ if (!exists("i18n")) { } i18n$set_translation_language("en") +# js code to get the browser language - Corrected escaping js_lang <- "var language = window.navigator.userLanguage || window.navigator.language; Shiny.onInputChange('browser_language', language); console.log(language);" @@ -38,7 +39,8 @@ ui <- fluidPage( shiny.i18n::usei18n(i18n), extendShinyjs(text = js_lang, functions = c()), - # Get timezone from browser + # Get timezone from browser - Corrected escaping + tags$script( "$(document).on('shiny:sessioninitialized', function(event) { var n = Intl.DateTimeFormat().resolvedOptions().timeZone; @@ -58,6 +60,14 @@ ui <- fluidPage( ) ), + # --- About Box --- + div(class = "about-box", + h4("About"), + p("Add a small descriptive text about the app here.") + ), + br(), + # --- End About Box --- + # Custom button styles tags$head( tags$style( @@ -74,31 +84,49 @@ ui <- fluidPage( ), ), - h3(i18n$t("labels.obsReport")), + # Remove old heading h3(i18n$t("labels.obsReport")) uiOutput("userstatus"), br(), - br(), - disabled(dateRangeInput("DateRange", i18n$t("labels.selectPeriod"))), - br(), - disabled(div( - class = "choosechannel", - id = "GroupListDiv", - pickerInput( - inputId = "GroupList", - label = i18n$t("labels.selectGroup"), - choices = list(), - multiple = TRUE, - options = pickerOptions( - actionsBox = TRUE, - noneSelectedText = '', - selectAllText = i18n$t("labels.selectAll"), - deselectAllText = i18n$t("labels.deselectAll") + + # --- Filter Sections --- + div(class = "filter-section time-period-box", + h4("Time Period"), + # Added a container div for easier styling of the date range input width + div(class = "date-range-input-container", + disabled(dateRangeInput("DateRange", i18n$t("labels.selectPeriod"))) ) - ) - )), + ), + br(), + + div(class = "filter-section data-sources-box", + h4("Data Sources"), + disabled(div( + class = "choosechannel", + id = "GroupListDiv", + pickerInput( + inputId = "GroupList", + label = i18n$t("labels.selectGroup"), # This label might be redundant with the H4 heading, consider removing if needed + choices = list(), + multiple = TRUE, + options = pickerOptions( + actionsBox = TRUE, + noneSelectedText = '', + selectAllText = i18n$t("labels.selectAll"), + deselectAllText = i18n$t("labels.deselectAll") + ) + ) + )) + ), br(), - shinyTree("conceptTree", checkbox = TRUE, theme = "proton"), + + div(class = "filter-section concepts-box", + h4("Concepts"), + p("Select concepts (one or more)"), + shinyTree("conceptTree", checkbox = TRUE, theme = "proton") + ), br(), + # --- End Filter Sections --- + disabled(actionButton( "GetData", i18n$t("commands.getdata"), icon = NULL )), @@ -108,76 +136,132 @@ ui <- fluidPage( mainPanel( width = 9, tags$head(tags$style( - HTML(" - .sep { + # Corrected escaping for the CSS content within HTML() + HTML(".sep { width: 20px; height: 1px; float: left; - } - ") + }") )), tabsetPanel( type = "tabs", - tabPanel(i18n$t("Activity Pattern"), fluidPage(fluidRow(column( - 12, - div( - style = "display: flex; align-items: center; gap: 20px;", - selectInput( - inputId = "time_input", - label = i18n$t("Time interval"), - choices = list( - "Hourly" = "hourly", - "Monthly" = "monthly", - "Seasonal" = "season" - ), - selected = "hourly" # Default selection - ), - selectInput( - inputId = "method", - label = i18n$t("Observation method"), - choices = list( - "Cameratrap" = "cameratrap", - "Animal sighting" = "animal sighting", - "Sensor" = "sensor", - "Other" = "other" # DONT HARDCODE IN FUTURE BUT BASE IT ON DATA!!!!!!!!! - ), - selected = "Cameratrap" # Default selection - ), - numericInput( - "topX", - "Top rows:", - value = 10, - min = 1, - step = 1 - ), - div( - style = "display: flex; align-items: center; gap: 10px;", - conditionalPanel( - condition = "input.time_input == 'season'", - div( - numericInput( - "num_seasons", - "# Seasons:", - value = 1, - min = 1 - ), - bsTooltip( - "num_seasons", - "Select the number of seasons for analysis. Input the calendar month number to specify season. (1 = January, 2 = February, etc.)", - placement = "right", - options = list(container = "body") - ) - ), - uiOutput("season_inputs") # Now inside the conditionalPanel - ) - ) - ) - ) + tabPanel(i18n$t("Activity Pattern"), + fluidPage( + + # === Time Interval Row === + fluidRow( + column( + 12, + div( + style = "display: flex; align-items: center; gap: 20px; margin-top: 10px;", + + # Time Interval Box + div( + style = "width: 100px;", + selectInput( + inputId = "time_input", + label = i18n$t("Time interval"), + choices = list( + "Hourly" = "hourly", + "Monthly" = "monthly", + "Seasonal" = "season" + ), + selected = "hourly", + width = "100%" + ) + ), + + # Conditional Season Controls + conditionalPanel( + condition = "input.time_input == 'season'", + div( + style = "display: flex; align-items: center; gap: 20px;", + div( + style = "width: 100px;", + numericInput( + "num_seasons", + "# Seasons:", + value = 1, + min = 1, + width = "100%" + ), + bsTooltip( + "num_seasons", + "Select the number of seasons for analysis. Input the calendar month number to specify season. (1 = January, 2 = February, etc.)", + placement = "right", + options = list(container = "body") + ) + ), + div( + style = "display: flex; flex-wrap: wrap; gap: 10px;", + uiOutput("season_inputs") + ) + ) + ) + ) + ) + ), + + # === TopX and Aggregation Method Row === + fluidRow( + column( + 12, + div( + style = "display: flex; align-items: center; gap: 20px; margin-top: 15px;", + + # Top X Filter Box (match width to Time Interval box) + div( + style = "width: 100px;", + numericInput( + inputId = "topX", + label = "Top rows:", + value = 10, + min = 1, + step = 1, + width = "100%" + ) + ), + + # Aligned Radio Buttons (inline, vertically centered) + div( + style = "display: flex; align-items: flex-end; height: 58px;", # Adjust height to match input height + radioButtons( + inputId = "agg_method", + label = NULL, + choices = list("Counts" = "counts", "Percentage" = "percentage"), + selected = "counts", + inline = TRUE + ) + ) + ) + ) + ), + + # === Plot Row === + fluidRow( + column( + 12, + plotlyOutput("combined_plot") + ) + ), + + # === Download Button Row === + fluidRow( + column( + 12, + div( + style = "margin-top: 20px;", + downloadButton("download_plotly", "Download plot (.html)") + ) + ) + ) + ) ), - fluidRow( - column(12, plotlyOutput("combined_plot"))))), tabPanel(i18n$t("labels.rawConceptsTab"), fluidRow(column( - 12, DT::dataTableOutput("tableRawConcepts") - )), + tabPanel( + i18n$t("labels.rawConceptsTab"), + fluidRow(column( + 12, DT::dataTableOutput("tableRawConcepts") + )), div( style = "position: fixed; top: 45%; left: 60%; transform: translate(-50%, -50%);", add_busy_spinner( @@ -211,4 +295,4 @@ ui <- fluidPage( ) ) ) -) +) \ No newline at end of file