# -------------------------------------------------------------------------------
# Title:        Interactive Medical Data App
# Authors:      Sarah Braun, Christian Draeger, Lea Michaelis,
#               Sherry Freiesleben, Dagmar Waltemath,
#               Matthias Löbe, Judith Wodke
# Date:         2025-01-08
# Contact:      sarah.braun@med.uni-greifswald.de
# Description:  Shiny dashboard for uploading, combining, visualizing,
#               and summarizing CSV/JSON/FHIR datasets.
# -------------------------------------------------------------------------------

# use this if the ragg renderer doesn't work, it defaults to the standard renderer than
options(shiny.useragg = FALSE)

# 1. Install and load required packages
ensure_pkg <- function(pkgs) {
  missing <- setdiff(pkgs, installed.packages()[, "Package"])
  if (length(missing)) install.packages(missing, dependencies = TRUE)
  invisible(lapply(pkgs, library, character.only = TRUE))
}

required_pkgs <- c(
  "shiny", "shinythemes", "shinyjqui",
  "jsonlite", "readr",
  "fhircrackr", "httr",
  "dplyr", "tidyr",
  "ggplot2", "leaflet",
  "DT"
)

ensure_pkg(required_pkgs)

# 2. Helper: sanitize dynamic input IDs
make_safe_id <- function(x) {
  id <- gsub("[^[:alnum:]_]", "_", x)
  id <- gsub("_+", "_", id)
  gsub("^_|_$", "", id)
}

# Get all unique categories across all datasets for consistent x-axis
getAllCategories <- function(data_list) {
  all_cats <- unique(unlist(lapply(data_list, function(x) x$data$Category)))
  # Sort categories: put "unknown" last, others alphabetically
  known_cats <- sort(all_cats[all_cats != "unknown"])
  if ("unknown" %in% all_cats) {
    c(known_cats, "unknown")
  } else {
    known_cats
  }
}

# 3. UI definition
ui <- fluidPage(
  theme = shinytheme("spacelab"),

  # Custom CSS & JS
  tags$head(
    tags$style(HTML("
    .plot_box {
      min-width: 300px;
      padding: 15px;
      border: 1px solid #B0B0B0;
      border-radius: 8px;
      box-shadow: 0 4px 8px rgba(0,0,0,0.1);
      background-color: transparent;
      position: absolute;
    }

    #plot_area {
      position: relative;
      height: 800px;
      border: 1px solid #DDD;
      overflow: auto;
      padding: 10px;
    }
  ")),
    tags$script(HTML("
      // Function to arrange plots side by side with dynamic width
      function arrangeSideBySide() {
        var plots = $('.plot_box');
        var containerWidth = $('#plot_area').width() - 20;
        var plotHeight = 350;

        plots.each(function(index) {
          var $plot = $(this);

          // Get number of categories from the plot's filter dropdown
          var plotIndex = $plot.find('select[id^=\"filter_\"]').attr('id');
          if (plotIndex) {
            var filterSelect = $('#' + plotIndex);
            var categoryCount = filterSelect.find('option').length;

            // Calculate width: base 250px + 40px per category, max 800px
            var plotWidth = Math.min(800, Math.max(250, 250 + (categoryCount * 40)));
            $plot.css('width', plotWidth + 'px');
          } else {
            // Fallback to default width
            var plotWidth = 300;
            $plot.css('width', plotWidth + 'px');
          }

          // Calculate position
          var currentRowWidth = 0;
          var currentRow = 0;
          var plotsInCurrentRow = [];

          // Group plots by rows
          plots.slice(0, index + 1).each(function(i) {
            var thisWidth = parseInt($(this).css('width')) + 20; // Add margin
            if (currentRowWidth + thisWidth > containerWidth && plotsInCurrentRow.length > 0) {
              currentRow++;
              currentRowWidth = thisWidth;
              plotsInCurrentRow = [i];
            } else {
              currentRowWidth += thisWidth;
              plotsInCurrentRow.push(i);
            }
          });

          // Position this plot
          var leftOffset = 0;
          for (var i = 0; i < plotsInCurrentRow.length; i++) {
            if (plotsInCurrentRow[i] === index) break;
            leftOffset += parseInt(plots.eq(plotsInCurrentRow[i]).css('width')) + 20;
          }

          $plot.css({
            top: (currentRow * plotHeight) + 'px',
            left: leftOffset + 'px'
          });
        });
      }

    // Initialize side-by-side layout when plots are added
    $(document).on('DOMNodeInserted', '#plot_area', function() {
      setTimeout(arrangeSideBySide, 100);
    });

    // Re-arrange on window resize
    $(window).resize(function() {
      setTimeout(arrangeSideBySide, 100);
    });

    // Stack all plots
    $(document).on('click','#stackPlots',function(){
      $('.plot_box').css({top:'0px',left:'0px'});
    });

    // Arrange plots side by side
    $(document).on('click','#arrangeSideBySide',function(){
      arrangeSideBySide();
    });

    // Stack selected plots
    $(document).on('click','#stackSelectedPlots',function(){
      var sel = $('#selectedPlotsToStack').val()||[];
      sel.slice(0,2).forEach(function(name){
        $('.plot_box[data-plot-name=\"'+name+'\"]')
          .css({top:'0px',left:'0px'});
      });
    });

    // Initialize side-by-side layout on page load
    $(document).ready(function() {
      setTimeout(arrangeSideBySide, 500);
    });
  "))
  ),

  navbarPage("Medical Data Dashboard",

             # -- Data Upload Tab --
             tabPanel("Data Upload",
                      sidebarLayout(
                        sidebarPanel(
                          h4("Upload Files"),
                          fileInput("newFiles", "Add Files",
                                    accept = c(".csv", ".json"), multiple = TRUE),
                          hr(),
                          uiOutput("fileListUI"),
                          actionButton("removeSelected", "Remove Selected",
                                       class = "btn btn-danger",
                                       style = "margin-top: 10px; width: 100%;")
                        ),
                        mainPanel(
                          h4("Uploaded Datasets"),
                          span("Upload your files and assign each a type. Files will be used in the corresponding tabs."),
                          hr(),
                          tableOutput("dataList")
                        )
                      )
             ),
             # -- Census Data Tab --
             tabPanel("Census Data",
                      sidebarLayout(
                        sidebarPanel(
                          h4("Data Selection"),
                          uiOutput("censusFileSelector"),
                          uiOutput("fhirFileSelector"),
                          h4("Visualization Options"),
                          selectInput("census_chart_type", "Chart Type:",
                                      choices = c("Grouped Bar Chart" = "grouped",
                                                  "Stacked Bar Chart" = "stacked"),
                                      selected = "grouped"),
                          checkboxInput("census_show_values", "Show Values on Bars", FALSE),
                          checkboxInput("census_log_scale", "Log Scale (Y-axis)", FALSE),
                          hr(),
                          downloadButton("downloadCensusData", "Download Census Data (JSON)"),
                          br(), br(),
                          downloadButton("downloadCensusPlot", "Download Plot (PNG)"),
                        ),
                        mainPanel(
                          h4("Census Population by Age Group and Gender"),
                          plotOutput("censusPlot", height = "600px"),
                          hr(),
                          h4("Census Data Summary"),
                          tableOutput("censusSummaryTable"),
                          hr(),
                          h4("Raw Census Data"),
                          DT::dataTableOutput("censusDataTable"),
                          hr(),
                          h4("FHIR Patient Data Summary"),
                          tableOutput("fhirSummaryTable"),
                          hr(),
                          h4("Raw FHIR Patient Data"),
                          DT::dataTableOutput("fhirDataTable")
                        )
                      )
             ),
             # -- FHIR in bins Tab --
             tabPanel("FHIR in bins",
                sidebarLayout(
                  sidebarPanel(
                    h4("Select FHIR Files"),
                    uiOutput("fhirFileSelectorBinning"),
                    hr(),
                    h4("Category Selection"),
                    uiOutput("fhirResourceTypeUIBinning"),
                    hr(),
                    uiOutput("fhirMappingUIBinning"),
                    conditionalPanel(
                      condition = "input.fhir_category_col_binning != null && input.fhir_category_col_binning != ''",
                      h4("Create the bins"),
                      radioButtons(
                        "value_types", "What is the type of the values",
                        c("Numeric" = "num", "Boolean" = "bool", "Text" = "text"), "text"),
                      conditionalPanel(
                        condition = "input.value_types != null && input.value_types != 'bool'",
                        sliderInput("fhir_n_bins", "Number of bins:",
                                    min = 1, max = 50, value = 5, step = 1)
                      ),
                      hr(),
                      radioButtons("bins_display_mode", "Display as:",
                                   choices = c("Percentages" = "percent",
                                               "Absolute Counts" = "absolute"),
                                   selected = "percent")
                    ),
                    uiOutput("fhirValuesUIBinning")
                  ),
                  mainPanel(
                    h4("Visualisation of the fhir data in bins"),
                    plotOutput("plotBins", height = "400px"),
                    br(),
                    actionButton("downloadBinsReport", "Download Report",
                                 class = "btn btn-primary",
                                 icon = icon("download"))
                  )
                ),
             ),
             # -- Visualization Tab --
             tabPanel("Visualization",
                      sidebarLayout(
                        sidebarPanel(
                          h4("Data Sources"),
                          uiOutput("vizSourceSelector"),
                          hr(),
                          h4("Binning"),
                          radioButtons("viz_bin_type", "Use bins from:",
                                       choices = c("Census (Age × Gender)" = "census",
                                                   "FHIR in Bins"          = "fhir_bins"),
                                       selected = "census"),
                          hr(),
                          h4("Display"),
                          radioButtons("viz_display_mode", "Display as:",
                                       choices = c("Percentages"     = "percent",
                                                  "Absolute Counts" = "absolute"),
                                       selected = "percent"),
                          radioButtons("x_axis_display_mode", "X-Axis mode:",
                                       choices = c("As selected bin source"     = "uniform",
                                                   "Minimal" = "individual"),
                                       selected = "uniform"),
                          radioButtons("viz_layout_mode", "Layout:",
                                       choices = c("Individual plots" = "individual",
                                                   "Overlay"          = "overlay"),
                                       selected = "individual"),
                          conditionalPanel(
                            condition = "input.viz_layout_mode == 'overlay'",
                            sliderInput("viz_overlay_alpha", "Transparency:",
                                        min = 0.1, max = 1, value = 0.5, step = 0.05)
                          )
                        ),
                        mainPanel(
                          uiOutput("vizPlotsUI")
                        )
                      )
             ),

             # -- Combined Data Tab --
             tabPanel("Combined Data",
                      fluidRow(
                        column(8,
                               h4("Combined Data Plot"),
                               plotOutput("combinedPlot"),
                               hr(),
                               h4("Intersection Plot"),
                               plotOutput("intersectionPlot")
                        ),
                        column(4,
                               div(style = "padding:15px; border:1px solid #DDD; border-radius:8px; background-color:#FFF;",
                                   h4("Combine Data"),
                                   checkboxGroupInput("combineFiles",
                                                      "Select Files to Combine:", choices = NULL),
                                   uiOutput("valueSelectors"),
                                   actionButton("combineData", "Combine Data"),
                                   downloadButton("downloadCombined", "Download Combined Data (JSON)"),
                                   br(), br(),
                                   h4("Intersection Settings"),
                                   p("Only categories present in ALL selected files will be kept."),
                                   selectInput("intersectionValues",
                                               "Common Categories:", choices = NULL, multiple = TRUE),
                                   actionButton("combineIntersection", "Combine Intersection Data"),
                                   downloadButton("downloadIntersection", "Download Intersection Data (JSON)")
                               )
                        )
                      )
             ),

             # -- Statistics Tab --
             tabPanel("Statistics",
                      fluidRow(
                        column(12,
                               h4("Dataset Statistics"),
                               tableOutput("statTable"),
                               hr(),
                               h4("Category Summary"),
                               tags$ul(
                                 tags$li(strong("Green:"), " present in ALL files"),
                                 tags$li(strong("Yellow:"), " present in ≥2 files"),
                                 tags$li(strong("Red:"), " present in only 1 file")
                               ),
                               uiOutput("categorySummary")
                        )
                      )
             )

  ) # navbarPage
) # fluidPage  # 4. Server logic
server <- function(input, output, session) {

  # 4.0 Manage file list
  uploadedFiles <- reactiveVal(list())
  lastCensusPlot <- reactiveVal(NULL)

  # 4.1 Load JSON data
  loadJsonData <- function(path) {
    tryCatch({
      jd <- fromJSON(path)

      # Check if the expected structure exists
      if (!is.null(jd$Histogram$Category$`@value`) &&
          !is.null(jd$Histogram$Count$`@value`)) {

        data.frame(
          Category = jd$Histogram$Category$`@value`,
          Count    = as.numeric(jd$Histogram$Count$`@value`),
          stringsAsFactors = FALSE
        )
      } else {
        # JSON doesn't have expected structure
        warning(paste("JSON file", path, "doesn't have expected Histogram structure"))
        data.frame(Category = character(), Count = numeric(), stringsAsFactors = FALSE)
      }
    }, error = function(e) {
      # If JSON parsing fails or structure is wrong
      warning(paste("Error loading JSON file:", e$message))
      data.frame(Category = character(), Count = numeric(), stringsAsFactors = FALSE)
    })
  }

  # 4.2 Load CSV data with optional column mapping
  loadCsvData <- function(path, idx) {
    df <- read.csv(path, stringsAsFactors = FALSE)

    # If the CSV already has Category and Count columns, use them directly
    if (all(c("Category", "Count") %in% colnames(df))) {
      df$Count <- as.numeric(df$Count)
      return(df[!is.na(df$Count), ])
    }

    # Otherwise, we need column mapping
    category_col <- input[[paste0("map_cat_", idx)]]

    # If no category column is selected yet, return empty data frame
    if (is.null(category_col) || category_col == "") {
      return(data.frame(Category = character(), Count = numeric(), stringsAsFactors = FALSE))
    }

    # Check if the selected column exists in the current data frame
    if (!category_col %in% colnames(df)) {
      return(data.frame(Category = character(), Count = numeric(), stringsAsFactors = FALSE))
    }

    # Count occurrences of each category
    tryCatch({
      result <- df %>%
        count(Category = .data[[category_col]], name = "Count") %>%
        as.data.frame(stringsAsFactors = FALSE)

      result$Count <- as.numeric(result$Count)
      result[!is.na(result$Count), ]
    }, error = function(e) {
      # If there's any error, return empty data frame
      data.frame(Category = character(), Count = numeric(), stringsAsFactors = FALSE)
    })
  }

  # 4.3 load FHIR files

  loadFhirFile <- function(path, filename) {
    tryCatch({
      fhir_data <- fromJSON(path, simplifyVector = FALSE)

      # Helper function to safely flatten any FHIR resource
      flatten_fhir_resource <- function(resource, prefix = "") {
        result <- list()

        if (is.list(resource)) {
          for (name in names(resource)) {
            value <- resource[[name]]
            current_key <- if (prefix == "") name else paste(prefix, name, sep = ".")

            if (is.null(value)) {
              result[[current_key]] <- NA_character_
            } else if (is.list(value) && !is.null(names(value))) {
              # Named list - recurse
              nested_result <- flatten_fhir_resource(value, current_key)
              result <- c(result, nested_result)
            } else if (is.list(value)) {
              # Unnamed list (array) - convert to delimited string
              if (length(value) > 0) {
                array_strings <- sapply(value, function(item) {
                  if (is.list(item)) {
                    if (!is.null(item$value)) {
                      return(as.character(item$value))
                    } else if (!is.null(item$display)) {
                      return(as.character(item$display))
                    } else if (!is.null(item$code)) {
                      return(as.character(item$code))
                    } else if (!is.null(item$system)) {
                      return(paste0(item$system, ":", item$code %||% ""))
                    } else {
                      non_null_values <- item[!sapply(item, is.null)]
                      if (length(non_null_values) > 0) {
                        key_value_pairs <- paste(names(non_null_values),
                                                 sapply(non_null_values, as.character),
                                                 sep = ":", collapse = ",")
                        return(paste0("{", key_value_pairs, "}"))
                      } else {
                        return("")
                      }
                    }
                  } else {
                    return(as.character(item))
                  }
                })
                result[[current_key]] <- paste(array_strings[array_strings != ""], collapse = "; ")
              } else {
                result[[current_key]] <- NA_character_
              }
            } else if (length(value) > 1) {
              result[[current_key]] <- paste(as.character(value), collapse = "; ")
            } else {
              result[[current_key]] <- as.character(value)
            }
          }
        } else {
          key <- if (prefix == "") "value" else prefix
          result[[key]] <- as.character(resource)
        }

        return(result)
      }

      # Handle both single resources and bundles
      if (is.list(fhir_data) && !is.null(fhir_data$resourceType)) {
        if (fhir_data$resourceType == "Bundle" && !is.null(fhir_data$entry)) {
          # Extract resources and group by type
          resources_by_type <- list()

          for (i in seq_along(fhir_data$entry)) {
            entry <- fhir_data$entry[[i]]
            if (is.list(entry) && !is.null(entry$resource) &&
                is.list(entry$resource) && !is.null(entry$resource$resourceType)) {

              resource <- entry$resource
              resource_type <- tolower(as.character(resource$resourceType))

              # Initialize list for this resource type if needed
              if (is.null(resources_by_type[[resource_type]])) {
                resources_by_type[[resource_type]] <- list()
              }

              # Add resource to appropriate type group
              resources_by_type[[resource_type]][[length(resources_by_type[[resource_type]]) + 1]] <- resource
            }
          }

          # Create separate data frame for each resource type
          result_list <- list()

          for (resource_type in names(resources_by_type)) {
            resources <- resources_by_type[[resource_type]]
            df_list <- list()

            for (i in seq_along(resources)) {
              resource <- resources[[i]]

              # Flatten the resource
              flattened <- flatten_fhir_resource(resource)

              # Add resource type prefix to all column names
              if (length(flattened) > 0) {
                prefixed_flattened <- list()
                for (col_name in names(flattened)) {
                  prefixed_name <- paste(resource_type, col_name, sep = ".")
                  prefixed_flattened[[prefixed_name]] <- flattened[[col_name]]
                }
                flattened <- prefixed_flattened
              }

              # Create data frame for this resource
              if (length(flattened) > 0) {
                flattened <- lapply(flattened, function(x) {
                  if (is.null(x) || length(x) == 0) {
                    return(NA_character_)
                  } else {
                    return(as.character(x))
                  }
                })

                df_list[[i]] <- data.frame(flattened, stringsAsFactors = FALSE, check.names = FALSE)
              }
            }

            # Combine all resources of this type
            if (length(df_list) > 0) {
              df_list <- Filter(function(x) !is.null(x) && nrow(x) > 0, df_list)

              if (length(df_list) > 0) {
                # Standardize columns
                all_cols <- unique(unlist(lapply(df_list, names)))
                df_list <- lapply(df_list, function(df) {
                  missing_cols <- setdiff(all_cols, names(df))
                  for (col in missing_cols) {
                    df[[col]] <- NA_character_
                  }
                  return(df[, all_cols, drop = FALSE])
                })

                result_df <- do.call(rbind, df_list)
                rownames(result_df) <- NULL

                # Store with resource type key
                result_list[[paste0(filename, "_", resource_type)]] <- result_df
              }
            }
          }

          return(result_list)
        }
      }

      # Return empty list if no valid data found
      return(list())

    }, error = function(e) {
      warning(paste("Error loading FHIR file", filename, ":", e$message))
      return(list())
    })
  }

  # Helper function for null coalescing
  `%||%` <- function(x, y) {
    if (is.null(x) || length(x) == 0) y else x
  }

  # 4.3.1 Dynamic UI: mapping CSV columns
  output$mappingUI <- renderUI({
    req(input$dataFiles)
    fps <- input$dataFiles$datapath
    fns <- input$dataFiles$name
    uiList <- lapply(seq_along(fps), function(i) {
      if (tools::file_ext(fns[i]) == "csv") {
        df0 <- read.csv(fps[i], stringsAsFactors = FALSE)

        # Sort column names - group by resource type prefix, then alphabetically
        col_names <- colnames(df0)

        # Separate columns with resource type prefixes from those without
        prefixed_cols <- col_names[grepl("\\.", col_names)]
        non_prefixed_cols <- col_names[!grepl("\\.", col_names)]

        if (length(prefixed_cols) > 0) {
          # Group prefixed columns by resource type
          resource_groups <- split(prefixed_cols, sapply(prefixed_cols, function(x) {
            strsplit(x, "\\.")[[1]][1]
          }))

          # Sort resource types alphabetically, then sort columns within each group
          sorted_prefixed <- unlist(lapply(sort(names(resource_groups)), function(res_type) {
            cols <- resource_groups[[res_type]]
            # Put basic fields first (resourceType, id, meta.*), then sort the rest
            basic_pattern <- paste0("^", res_type, "\\.(resourceType|id|meta\\.)")
            basic_cols <- cols[grepl(basic_pattern, cols)]
            other_cols <- cols[!grepl(basic_pattern, cols)]
            c(sort(basic_cols), sort(other_cols))
          }))

          # Combine: non-prefixed first (sorted), then prefixed (grouped and sorted)
          sorted_cols <- c(sort(non_prefixed_cols), sorted_prefixed)
        } else {
          # No prefixed columns, just sort normally
          sorted_cols <- sort(col_names)
        }

        #if (!all(c("Category","Count") %in% colnames(df0))) {
        tagList(
          h4(paste("Map columns for", fns[i])),
          selectInput(paste0("map_cat_", i),
                      "Category column:", choices = sorted_cols),
          #selectInput(paste0("map_cnt_", i),
          #            "Count column:",    choices = sorted_cols)
        )
        #}
      }
    })
    do.call(tagList, uiList)
  })

  # 4.3.2
  output$censusFileSelector <- renderUI({
    files <- uploadedFiles()
    census_files <- Filter(function(f) f$type == "census", files)
    if (length(census_files) == 0) {
      p("No census files uploaded yet. Please upload in the Data Upload tab.",
        style = "color:#999; font-size:12px;")
    } else {
      selectInput("selected_census_file", "Census File:",
                  choices = setNames(
                    sapply(census_files, `[[`, "path"),
                    sapply(census_files, `[[`, "name")
                  ))
    }
  })

  output$fhirFileSelector <- renderUI({
    files <- uploadedFiles()
    fhir_files <- Filter(function(f) f$type == "fhir", files)
    if (length(fhir_files) == 0) {
      p("No FHIR files uploaded yet. Please upload in the Data Upload tab.",
        style = "color:#999; font-size:12px;")
    } else {
      selectInput("selected_fhir_file", "FHIR File:",
                  choices = setNames(
                    sapply(fhir_files, `[[`, "path"),
                    sapply(fhir_files, `[[`, "name")
                  ))
    }
  })

  loadCensusData <- function(path) {
    tryCatch({
      census_json <- fromJSON(path, simplifyVector = FALSE)

      if (is.null(census_json$group) || length(census_json$group) == 0) {
        warning("No group data found in census file")
        return(NULL)
      }

      first_group <- if (is.list(census_json$group[[1]])) {
        census_json$group[[1]]
      } else {
        census_json$group
      }

      if (is.null(first_group$stratifier) || length(first_group$stratifier) == 0) {
        warning("No stratifier found in census file")
        return(NULL)
      }

      stratifiers <- first_group$stratifier

      # ── Detect format ────────────────────────────────────────────────────────────
      # Composite: stratifier entries have $stratum[[1]]$component
      # Separate:  stratifier entries have $code with LOINC codes for age/gender
      first_stratum <- stratifiers[[1]]$stratum[[1]]
      is_composite  <- !is.null(first_stratum$component)

      if (is_composite) {
        # ── Composite format (existing logic) ──────────────────────────────────────
        stratum_list <- stratifiers[[1]]$stratum

        census_data <- lapply(stratum_list, function(stratum) {
          components <- stratum$component
          if (is.null(components) || length(components) < 2) return(NULL)

          age    <- components[[1]]$value$text %||% NA
          gender <- components[[2]]$value$text %||% NA

          count <- 0
          if (!is.null(stratum$measureScore$value)) {
            count <- as.numeric(stratum$measureScore$value)
          } else if (!is.null(stratum$population)) {
            count <- as.numeric(stratum$population[[1]]$count %||% 0)
          }

          data.frame(Age = age, Gender = gender, Count = count,
                     stringsAsFactors = FALSE)
        })

        census_df <- do.call(rbind, Filter(Negate(is.null), census_data))

      } else {
        # ── Separate format: two stratifiers, one for gender, one for age ──────────
        # Identify which stratifier is gender and which is age by LOINC code
        get_loinc <- function(strat) {
          tryCatch({
            strat$code[[1]]$coding[[1]]$code
          }, error = function(e) NA_character_)
        }

        gender_strat <- NULL
        age_strat    <- NULL

        for (s in stratifiers) {
          loinc <- get_loinc(s)
          if (!is.na(loinc) && loinc == "99502-7") gender_strat <- s  # Recorded sex or gender
          if (!is.na(loinc) && loinc == "46251-5") age_strat    <- s  # Age group
        }

        # Fallback: if LOINC codes not found, use position (first=gender, second=age)
        if (is.null(gender_strat)) gender_strat <- stratifiers[[1]]
        if (is.null(age_strat))    age_strat    <- stratifiers[[2]]

        # Extract genders
        genders <- lapply(gender_strat$stratum, function(s) {
          list(
            value = s$value$text %||% NA,
            count = as.numeric(s$population[[1]]$count %||% 0)
          )
        })

        # Extract age groups
        ages <- lapply(age_strat$stratum, function(s) {
          list(
            value = s$value$text %||% NA,
            count = as.numeric(s$population[[1]]$count %||% 0)
          )
        })

        total <- sum(sapply(genders, `[[`, "count"), na.rm = TRUE)

        # Cross-tabulate: distribute counts proportionally across age × gender
        # Since separate format has no cross-tabulation, estimate each cell as:
        # count(age_i) * count(gender_j) / total
        rows <- lapply(ages, function(a) {
          lapply(genders, function(g) {
            estimated_count <- if (total > 0) {
              round(a$count * g$count / total)
            } else 0
            data.frame(
              Age    = a$value,
              Gender = g$value,
              Count  = estimated_count,
              stringsAsFactors = FALSE
            )
          })
        })

        census_df <- do.call(rbind, unlist(rows, recursive = FALSE))
      }

      if (is.null(census_df) || nrow(census_df) == 0) {
        warning("No valid census data extracted")
        return(NULL)
      }

      census_df <- census_df[!is.na(census_df$Age) & !is.na(census_df$Gender), ]
      census_df$Count <- as.numeric(census_df$Count)
      return(census_df)

    }, error = function(e) {
      warning(paste("Error loading census JSON:", e$message))
      return(NULL)
    })
  }

  # 4.4a Fetch comprehensive FHIR data using _include and _revinclude

  # Replace the fhirRawData function with this corrected version:

  fhirRawData <- reactive({
    #if (input$data_source == "fhir") {
      if (input$fhir_input_type == "api") {
        # Existing API logic - wrap in eventReactive
        req(input$load_fhir)
        req(input$fhir_url, input$max_bundles)

        showNotification("Starting FHIR data load...", type = "default", id = "fhir_load")

        all_resources <- list()

        resource_types_to_fetch <- c("Patient", "Observation", "Condition", "MedicationRequest",
                                     "Procedure", "Encounter", "AllergyIntolerance", "Immunization")

        for (resource_type in resource_types_to_fetch) {
          tryCatch({
            req_resource <- fhir_url(url = input$fhir_url, resource = resource_type)

            bundles <- fhir_search(
              request = req_resource,
              verbose = 0,
              max_bundles = input$max_bundles
            )

            if (length(bundles) > 0) {
              desc <- fhir_table_description(
                resource = resource_type,
                sep = " || ",
                brackets = character(0),
                rm_empty_cols = FALSE,
                format = "compact"
              )

              df <- fhir_crack(bundles = bundles, design = desc, verbose = 0)

              if (!is.null(df) && nrow(df) > 0) {
                all_resources[[resource_type]] <- df
              }
            }
          }, error = function(e) {
            print(paste("Error fetching", resource_type, ":", e$message))
          })
        }

        removeNotification("fhir_load")

        if (length(all_resources) > 0) {
          showNotification(paste("Loaded", length(all_resources), "resource types"), type = "default")
        } else {
          showNotification("No data could be loaded", type = "error")
        }

        return(all_resources)

      } else if (input$fhir_input_type == "file") {
        # File upload logic
        req(input$fhirFiles)

        all_files_data <- list()
        fps <- input$fhirFiles$datapath
        fns <- input$fhirFiles$name

        for (i in seq_along(fps)) {
          file_data_list <- loadFhirFile(fps[i], fns[i])  # Now returns list of resource types
          if (!is.null(file_data_list) && length(file_data_list) > 0) {
            # Merge all resource types from this file into main list
            all_files_data <- c(all_files_data, file_data_list)
          }
        }

        return(all_files_data)
      }
    #}
    return(NULL)
  })

  # 4.4b UI for selecting resource type to visualize
  output$fhirResourceTypeUI <- renderUI({
    #if (input$data_source == "fhir") {
      fhir_data <- fhirRawData()

      if (!is.null(fhir_data)) {
        available_resources <- names(fhir_data)

        if (length(available_resources) > 0) {
          if (input$fhir_input_type == "api") {
            selectInput("fhir_resource_to_viz", "Resource Type to Visualize:",
                        choices = available_resources,
                        selected = available_resources[1])
          } else {
            # For file uploads, add resource type selector
            resource_types <- unique(sapply(available_resources, function(x) {
              parts <- strsplit(x, "_")[[1]]
              if (length(parts) > 1) parts[length(parts)] else x
            }))

            tagList(
              selectInput("fhir_resource_to_viz", "Resource Type to Visualize:",
                          choices = resource_types,
                          selected = resource_types[1]),
#              tags$div(
#                h5("Available Datasets:"),
#                tags$ul(lapply(available_resources, function(x) tags$li(x)))
              #)
            )
          }
        }
      }
    #}
  })

  # 4.4c Update the mapping UI to show columns from selected resource
  output$fhirMappingUI <- renderUI({
    if (input$data_source == "fhir") {
      fhir_data <- fhirRawData()
      if (!is.null(fhir_data)) {
        if (input$fhir_input_type == "api") {
          req(input$fhir_resource_to_viz)
          df <- fhir_data[[input$fhir_resource_to_viz]]
          if (!is.null(df) && nrow(df) > 0) {
            selectInput("fhir_category_col", "Category column:",
                        choices = colnames(df),
                        selected = colnames(df)[1])
          }
        } else {
          # For file uploads, filter columns by selected resource type
          req(input$fhir_resource_to_viz)

          # Get all datasets that match the selected resource type
          selected_resource_type <- input$fhir_resource_to_viz
          matching_datasets <- names(fhir_data)[grepl(paste0("_", selected_resource_type, "$"), names(fhir_data))]

          if (length(matching_datasets) > 0) {
            # Get columns from all matching datasets
            all_columns <- unique(unlist(lapply(matching_datasets, function(dataset_name) {
              colnames(fhir_data[[dataset_name]])
            })))

            # Filter to only columns that match the selected resource type
            resource_prefix <- paste0(tolower(selected_resource_type), ".")
            resource_columns <- all_columns[grepl(paste0("^", resource_prefix), all_columns)]

            if (length(resource_columns) > 0) {
              # Remove the resource type prefix from display names
              display_names <- gsub(paste0("^", resource_prefix), "", resource_columns)

              # Sort: basic fields first, then alphabetically
              basic_fields <- c("resourceType", "id")
              meta_fields <- display_names[grepl("^meta\\.", display_names)]
              other_fields <- display_names[!display_names %in% basic_fields & !grepl("^meta\\.", display_names)]

              sorted_display_names <- c(
                intersect(basic_fields, display_names),
                sort(meta_fields),
                sort(other_fields)
              )

              # Create named vector: display names as labels, full column names as values
              choices <- setNames(resource_columns[match(sorted_display_names, display_names)], sorted_display_names)

              selectInput("fhir_category_col", "Category column:",
                          choices = choices,
                          selected = choices[1])
            }
          }
        }
      }
    }
  })

  # 4.5.1 List all uploaded files/requested data
  allDataUploads <- reactive({
    req(input$dataFiles, input$fhirFiles, input$fhirApiRequest, input$censusFiles)

    json_files <- input$dataFiles
    fhir_bundles <- input$fhirFiles
    census_files <- input$censusFiles
    fhir_api <- input$fhirApiRequest

  })

  # 4.5.2 Aggregate uploaded/FHIR datasets

  allData <- reactive({
    req(input$data_source)
    files <- uploadedFiles()
    csv_json_files <- Filter(function(f) f$type == "csv_json", files)

    if (input$data_source == "file") {
      if (length(csv_json_files) == 0) return(list())

      results <- lapply(seq_along(csv_json_files), function(i) {
        f   <- csv_json_files[[i]]
        ext <- tools::file_ext(f$name)

        df <- tryCatch({
          switch(ext,
                 "json" = loadJsonData(f$path),
                 "csv"  = loadCsvData(f$path, i),
                 NULL
          )
        }, error = function(e) {
          warning(paste("Error processing file", f$name, ":", e$message))
          NULL
        })

        if (!is.null(df) && nrow(df) > 0) {
          list(name = f$name, data = df)
        } else {
          NULL
        }
      })

      results[!sapply(results, is.null)]

    } else if (input$data_source == "fhir") {
      fhir_data <- fhirRawData()
      if (!is.null(fhir_data) && length(fhir_data) > 0) {
        results <- list()

        if (input$fhir_input_type == "file") {
          req(input$fhir_category_col)
          req(input$fhir_resource_to_viz)

          selected_resource_type <- input$fhir_resource_to_viz
          matching_datasets <- names(fhir_data)[grepl(paste0("_", selected_resource_type, "$"), names(fhir_data))]

          for (dataset_key in matching_datasets) {
            df <- fhir_data[[dataset_key]]
            category_col <- input$fhir_category_col

            if (category_col %in% colnames(df)) {
              df[[category_col]] <- ifelse(is.na(df[[category_col]]) | df[[category_col]] == "",
                                           "unknown", as.character(df[[category_col]]))

              result_df <- df %>%
                count(Category = .data[[category_col]], name = "Count") %>%
                as.data.frame(stringsAsFactors = FALSE)

              if (nrow(result_df) > 0) {
                results[[length(results) + 1]] <- list(name = dataset_key, data = result_df)
              }
            }
          }
        } else {
          if (!is.null(input$fhir_resource_to_viz) && !is.null(input$fhir_category_col)) {
            resource_key <- input$fhir_resource_to_viz
            if (resource_key %in% names(fhir_data)) {
              df <- fhir_data[[resource_key]]
              category_col <- input$fhir_category_col

              if (category_col %in% colnames(df)) {
                df[[category_col]] <- ifelse(is.na(df[[category_col]]), "unknown", df[[category_col]])

                result_df <- df %>%
                  count(Category = .data[[category_col]], name = "Count") %>%
                  as.data.frame(stringsAsFactors = FALSE)

                if (nrow(result_df) > 0) {
                  resource_name <- paste0("FHIR-", input$fhir_resource_to_viz, ":", input$fhir_url)
                  results[[length(results) + 1]] <- list(name = resource_name, data = result_df)
                }
              }
            }
          }
        }
        return(results)
      }
    }

    return(list())
  })

  # 4.6 Global maximum for shared y-axis
  globalMax <- reactive({
    req(allData())
    max(unlist(lapply(allData(), function(x) x$data$Count)),
        na.rm = TRUE)
  })

  # 4.7 Render dataset list & basic stats
  output$dataList <- renderTable({
    do.call(rbind, lapply(allData(), function(x)
      data.frame(Dataset = x$name,
                 Rows    = nrow(x$data),
                 stringsAsFactors = FALSE)))
  })
  output$statTable <- renderTable({
    do.call(rbind, lapply(allData(), function(x)
      data.frame(Dataset = x$name,
                 Count   = nrow(x$data),
                 Mean    = mean(x$data$Count, na.rm = TRUE),
                 stringsAsFactors = FALSE)))
  })

  # 4.8 Update UI choices for combine/stack tabs
  observe({
    req(allData())
    names <- sapply(allData(), `[[`, "name")
    updateCheckboxGroupInput(session, "combineFiles",
                             choices = names, selected = names)
    updateSelectInput(session, "selectedPlotsToStack",
                      choices = names)
  })

  # 4.9 Dynamic selectors for each chosen file
  observe({
    req(allData())
    dl <- allData()

    # Make sure we have data before proceeding
    if (length(dl) == 0) return(NULL)

    # Use local() to create a closure for each iteration
    for (i in seq_along(dl)) {
      local({
        idx <- i
        f <- dl[[idx]]

        # Make sure the data frame exists and has data
        if (is.null(f$data) || nrow(f$data) == 0) return(NULL)

        ui_name   <- paste0("plotUI_", idx)
        plot_name <- paste0("plot_", idx)

        output[[ui_name]] <- renderUI({
          enabled <- input[[paste0("cb_", idx)]]
          if (isTRUE(enabled)) {
            plotOutput(plot_name, height = "300px")
          }
        })

        output[[plot_name]] <- renderPlot({
          enabled <- input[[paste0("cb_", idx)]]
          chart     <- input[[paste0("pt_", idx)]]
          filterCat <- input[[paste0("filter_", idx)]]
          alpha     <- input[[paste0("op_", idx)]]
          data0     <- f$data  # Now this is captured in the local scope

          # Get all categories across all datasets for consistent x-axis
          all_categories <- getAllCategories(dl)

          # Ensure data0 has all categories (add missing ones with Count = 0)
          missing_cats <- setdiff(all_categories, data0$Category)
          if (length(missing_cats) > 0) {
            missing_data <- data.frame(
              Category = missing_cats,
              Count = 0,
              stringsAsFactors = FALSE
            )
            data0 <- rbind(data0, missing_data)
          }

          # Apply filter if selected
          df0 <- if (!is.null(filterCat) && length(filterCat) > 0) {
            data0[data0$Category %in% filterCat, ]
          } else {
            data0
          }

          # Ensure categories are in consistent order
          df0$Category <- factor(df0$Category, levels = all_categories)

          p_base <- ggplot(df0, aes(x = Category, y = Count, fill = Category)) +
            theme_minimal(base_size = 14) +
            scale_y_continuous(limits = c(0, globalMax())) +
            scale_x_discrete(drop = FALSE)  # Show all categories even if Count = 0

          p <- switch(chart,
                      "Histogram" = p_base + geom_bar(stat = "identity", alpha = alpha),
                      "Pie Chart" = ggplot(df0, aes(x = "", y = Count, fill = Category)) +
                        geom_bar(stat = "identity", alpha = alpha, width = 1) +
                        coord_polar("y", start = 0),
                      "Line Chart" = ggplot(df0, aes(x = Category, y = Count, group = 1)) +
                        geom_line(size = 1.2, alpha = alpha) +
                        geom_point(size = 3, alpha = alpha) +
                        scale_x_discrete(drop = FALSE)
          )

          p + labs(title = f$name, x = "Category", y = "Count") +
            theme(panel.background = element_rect(fill = "transparent", colour = NA),
                  plot.background  = element_rect(fill = "transparent", colour = NA),
                  panel.grid       = element_blank(),
                  axis.text.x = element_text(angle = 45, hjust = 1),  # Rotate labels if needed
                  legend.position = "none"
            )
        }, bg = "transparent")
      })
    }
  })

  # 4.10 Combine data across files (robust)
  combinedData <- reactiveVal(NULL)
  observeEvent(input$combineData, {
    req(input$combineFiles)
    dl <- allData()

    cmb <- do.call(rbind, lapply(input$combineFiles, function(fn) {
      idx     <- which(sapply(dl, `[[`, "name") == fn)
      df0     <- dl[[idx]]$data
      safe_fn <- make_safe_id(fn)
      sel     <- input[[paste0("values_", safe_fn)]]
      if (is.null(sel)) return(NULL)
      df1 <- df0[df0$Category %in% sel, , drop = FALSE]
      df1$Source <- fn
      df1$Count  <- as.numeric(df1$Count)
      df1        <- df1[!is.na(df1$Count), ]
      if (nrow(df1) == 0) return(NULL)
      df1
    }))

    if (is.null(cmb) || nrow(cmb) == 0) {
      showNotification("No valid data selected for combination.", type = "error")
      return(NULL)
    }

    combinedData(cmb)
  })

  output$combinedPlot <- renderPlot({
    req(combinedData())
    ggplot(combinedData(), aes(x = Category, y = Count, fill = Source)) +
      geom_bar(stat = "identity", position = "stack") +
      scale_y_continuous(limits = c(0, globalMax())) +
      theme_minimal(base_size = 14) +
      labs(title = "Combined Data", x = "Category", y = "Count")
  })

  output$downloadCombined <- downloadHandler(
    filename = function() paste0("combined_data_", Sys.Date(), ".json"),
    content  = function(file) jsonlite::write_json(combinedData(), file)
  )

  # 4.11 Intersection across all selected files
  intersectionData <- reactiveVal(NULL)
  observe({
    req(input$combineFiles)
    dl     <- allData()[sapply(allData(), `[[`, "name") %in% input$combineFiles]
    common <- Reduce(intersect, lapply(dl, function(x) x$data$Category))
    updateSelectInput(session, "intersectionValues",
                      choices = common, selected = common)
  })

  observeEvent(input$combineIntersection, {
    req(input$combineFiles)
    cats <- input$intersectionValues
    if (is.null(cats) || length(cats) == 0) {
      showNotification("No categories selected for intersection.", type = "error")
      return(NULL)
    }

    dl <- allData()
    inter <- do.call(rbind, lapply(input$combineFiles, function(fn) {
      idx  <- which(sapply(dl, `[[`, "name") == fn)
      df0  <- dl[[idx]]$data
      df1  <- df0[df0$Category %in% cats, , drop = FALSE]
      df1$Source <- fn
      df1$Count  <- as.numeric(df1$Count)
      df1        <- df1[!is.na(df1$Count), ]
      if (nrow(df1) == 0) return(NULL)
      df1
    }))

    if (is.null(inter) || nrow(inter) == 0) {
      showNotification("No intersection data found.", type = "error")
      return(NULL)
    }

    intersectionData(inter)
  })

  output$intersectionPlot <- renderPlot({
    req(intersectionData())
    ggplot(intersectionData(), aes(x = Category, y = Count, fill = Source)) +
      geom_bar(stat = "identity", position = "stack") +
      scale_y_continuous(limits = c(0, globalMax())) +
      theme_minimal(base_size = 14) +
      labs(title = "Intersection Data", x = "Category", y = "Count")
  })

  output$downloadIntersection <- downloadHandler(
    filename = function() paste0("intersection_data_", Sys.Date(), ".json"),
    content  = function(file) jsonlite::write_json(intersectionData(), file)
  )

  # 4.12 Map of German integration centers
  #output$map <- renderLeaflet({
  #  centers <- data.frame(
  #    name = c("Greifswald","Dresden","Leipzig","Aachen","Hannover","Hamburg","Berlin"),
  #    lat  = c(54.093,51.050,51.339,50.775,52.374,53.550,52.520),
  #    lng  = c(13.387,13.738,12.374,6.083,9.738,9.993,13.405),
  #    stringsAsFactors = FALSE
  #  )
  #  germany <- geodata::gadm("Germany", level = 0, path = tempdir())
  #  leaflet() %>%
  #    addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  #    addPolygons(data = germany, color = "#333333", weight = 1, fill = FALSE) %>%
  #    setView(lng = 10.5, lat = 51.0, zoom = 6) %>%
  #    addCircleMarkers(data = centers, lat = ~lat, lng = ~lng,
  #                     label = ~name, radius = 6, fill = TRUE, fillOpacity = 0.9)
  #})


  #### Census data reactive
  censusData <- reactive({
    req(input$selected_census_file)
    census_df <- loadCensusData(input$selected_census_file)
    if (is.null(census_df)) {
      showNotification("Failed to load census data.", type = "error")
      return(NULL)
    }
    census_df$Source <- "Census"
    showNotification(paste("Loaded", nrow(census_df), "census records"), type = "message")
    return(census_df)
  })

  fhirPatientData <- reactive({
    req(censusData())

    census_df            <- censusData()
    census_age_labels    <- unique(census_df$Age)
    census_gender_labels <- unique(census_df$Gender)

    tryCatch({
      req(input$selected_fhir_file)
      raw <- jsonlite::fromJSON(input$selected_fhir_file, simplifyVector = FALSE)

      entries <- NULL
      if (!is.null(raw$resourceType) && raw$resourceType == "Bundle") {
        entries <- raw$entry
      } else if (is.list(raw)) {
        entries <- raw
      }

      if (is.null(entries) || length(entries) == 0) {
        showNotification("No entries found in FHIR bundle.", type = "warning")
        return(NULL)
      }

      patients <- Filter(function(e) {
        res <- if (!is.null(e$resource)) e$resource else e
        !is.null(res$resourceType) && res$resourceType == "Patient"
      }, entries)

      if (length(patients) == 0) {
        showNotification("No Patient resources found in FHIR bundle.", type = "warning")
        return(NULL)
      }

      records <- lapply(patients, function(e) {
        p      <- if (!is.null(e$resource)) e$resource else e
        bd     <- p$birthDate %||% NA_character_
        gender <- p$gender    %||% NA_character_
        list(birthDate = as.character(bd), gender = as.character(gender))
      })

      df <- data.frame(
        birthDate = sapply(records, `[[`, "birthDate"),
        gender    = sapply(records, `[[`, "gender"),
        stringsAsFactors = FALSE
      )

      today <- Sys.Date()

      df$age_numeric <- sapply(df$birthDate, function(bd) {
        if (is.null(bd) || is.na(bd) || !nzchar(trimws(bd))) return(NA_real_)

        bd <- trimws(bd)
        bd <- sub("T.*$", "", bd)

        bd_padded <- if (nchar(bd) == 4)      paste0(bd, "-01-01")
        else if (nchar(bd) == 7) paste0(bd, "-01")
        else                     bd

        dob <- tryCatch(as.Date(bd_padded), error = function(e) NA)

        if (is.null(dob) || length(dob) == 0 || is.na(dob)) return(NA_real_)
        if (dob >= today || dob < as.Date("1900-01-01"))     return(NA_real_)

        year_diff       <- as.numeric(format(today, "%Y")) - as.numeric(format(dob, "%Y"))
        birthday_passed <- format(today, "%m-%d") >= format(dob, "%m-%d")
        as.numeric(year_diff - ifelse(birthday_passed, 0L, 1L))
      })

      df$Age    <- bin_age_to_census_groups(df$age_numeric, census_age_labels)
      df$Gender <- map_fhir_gender(df$gender, census_gender_labels)
      df        <- df[!is.na(df$Age) & !is.na(df$Gender), ]

      if (nrow(df) == 0) {
        showNotification(
          "FHIR patients could not be matched to census Age/Gender groups.",
          type = "warning"
        )
        return(NULL)
      }

      result <- df %>%
        dplyr::count(Age, Gender, name = "Count") %>%
        as.data.frame(stringsAsFactors = FALSE)

      result$Source <- "FHIR"

      showNotification(
        paste0("FHIR: ", nrow(df), " patients matched across ",
               nrow(result), " Age×Gender groups"),
        type = "message"
      )

      return(result)

    }, error = function(e) {
      showNotification(paste("Error parsing FHIR bundle:", e$message), type = "error")
      return(NULL)
    })
  })

  # Census plot
  output$censusPlot <- renderPlot({
    req(censusData())

    census_df  <- censusData()
    fhir_df    <- fhirPatientData()     # NULL if no FHIR file uploaded yet — that's fine

    chart_type  <- input$census_chart_type
    show_values <- input$census_show_values

    # ── Combine census + FHIR (if available) ────────────────────────────────────
    if (!is.null(fhir_df)) {
      # Keep only Age groups and Genders present in census so axes stay consistent
      fhir_df <- fhir_df[fhir_df$Age    %in% unique(census_df$Age) &
                           fhir_df$Gender %in% unique(census_df$Gender), ]

      plot_df <- rbind(
        census_df[, c("Age", "Gender", "Count", "Source")],
        fhir_df  [, c("Age", "Gender", "Count", "Source")]
      )

      # Interaction label used for fill: e.g. "female · Census", "male · FHIR"
      plot_df$fill_group <- paste(plot_df$Gender, "\u00b7", plot_df$Source)

      # Colour palette: one hue per gender (from Set2), light shade = Census, dark = FHIR
      genders      <- sort(unique(census_df$Gender))
      base_colours <- RColorBrewer::brewer.pal(max(3, length(genders)), "Set2")[seq_along(genders)]

      # Census uses Set2 (soft greens/blues/oranges), FHIR uses Dark2 (bold versions)
      census_colours <- RColorBrewer::brewer.pal(max(3, length(genders)), "Set2")[seq_along(genders)]
      fhir_colours   <- RColorBrewer::brewer.pal(max(3, length(genders)), "Dark2")[seq_along(genders)]

      fill_vals <- c()
      for (k in seq_along(genders)) {
        census_lbl <- paste(genders[k], "\u00b7 Census")
        fhir_lbl   <- paste(genders[k], "\u00b7 FHIR")
        fill_vals[census_lbl] <- census_colours[k]
        fill_vals[fhir_lbl]   <- fhir_colours[k]
      }

      overlay_active <- TRUE
    } else {
      # No FHIR data — plot census only exactly as before
      plot_df <- census_df[, c("Age", "Gender", "Count", "Source")]
      plot_df$fill_group <- plot_df$Gender

      fill_vals      <- NULL    # fall back to scale_fill_brewer below
      overlay_active <- FALSE
    }

    plot_df <- plot_df %>%
      group_by(Source) %>%
      mutate(Percent = round(Count / sum(Count, na.rm = TRUE) * 100, 2)) %>%
      ungroup()

    age_order <- unique(plot_df$Age[order(as.numeric(sub("[-+].*", "", plot_df$Age)))])
    plot_df$Age <- factor(plot_df$Age, levels = age_order)
    # ── Base ggplot ──────────────────────────────────────────────────────────────
    p <- ggplot(plot_df, aes(x = Age, y = Percent, fill = fill_group)) +
      theme_minimal(base_size = 14) +
      labs(
        title = if (overlay_active) "Population by Age Group and Gender  (Census vs FHIR)"
        else                "Population by Age Group and Gender",
        x     = "Age Group",
        y = "Population (%)",
        fill  = if (overlay_active) "Gender \u00b7 Source" else "Gender"
      ) +
      theme(
        axis.text.x  = element_text(angle = 45, hjust = 1),
        legend.position = "bottom",
        plot.title   = element_text(hjust = 0.5, face = "bold", size = 16)
      )

    # Apply manual colours when FHIR overlay is active
    if (overlay_active) {
      p <- p + scale_fill_manual(values = fill_vals)
    } else {
      p <- p + scale_fill_brewer(palette = "Set2")
    }

    # ── Geoms based on chart type ────────────────────────────────────────────────
    dodge_width <- if (overlay_active) 0.85 else 0.9   # slightly tighter when doubled

    if (chart_type == "grouped" || chart_type == "dodged") {
      p <- p + geom_bar(stat = "identity",
                        position = position_dodge(width = dodge_width),
                        alpha = 1,
                        colour = "white", linewidth = 0.2)
      if (show_values) {
        p <- p + geom_text(aes(label = Count),
                           position = position_dodge(width = dodge_width),
                           vjust = -0.4, size = 2.8)
      }

    } else if (chart_type == "stacked") {
      p <- ggplot(plot_df, aes(x = Age, y = Percent, fill = fill_group)) +
        theme_minimal(base_size = 14) +
        labs(
          title = if (overlay_active) "Population by Age Group and Gender  (Census vs FHIR)"
          else "Population by Age Group and Gender",
          x     = "Age Group",
          y     = "Population (%)",
          fill  = if (overlay_active) "Gender · Source" else "Gender"
        ) +
        theme(
          axis.text.x  = element_text(angle = 45, hjust = 1),
          legend.position = "bottom",
          plot.title   = element_text(hjust = 0.5, face = "bold", size = 16)
        ) +
        geom_bar(stat = "identity", position = "stack", alpha = 1,
                 colour = "white", linewidth = 0.2) +
        {if (overlay_active) facet_wrap(~Source, ncol = 2) else NULL} +
        {if (overlay_active) scale_fill_manual(values = fill_vals)
          else scale_fill_brewer(palette = "Set2")}

      if (show_values) {
        p <- p + geom_text(aes(label = paste0(Percent, "%")),
                           position = position_stack(vjust = 0.5), size = 2.8)
      }
    }

    if (isTRUE(input$census_log_scale)) {
      p <- p + scale_y_continuous(
        trans = "log10",
        labels = scales::comma
      )
    }
    lastCensusPlot(p)
    return(p)
  })

  # Input files table

  output$inputFilesTable <- DT::renderDataTable({
    req()
  })


  # Census summary table
  output$censusSummaryTable <- renderTable({
    req(censusData())

    df <- censusData()

    # Create summary statistics
    summary_df <- df %>%
      group_by(Gender) %>%
      summarise(
        Total_Population = sum(Count, na.rm = TRUE),
        Age_Groups = n_distinct(Age),
        Average_per_Group = round(mean(Count, na.rm = TRUE), 0)
      ) %>%
      as.data.frame()

    return(summary_df)
  })

  # Census data table
  output$censusDataTable <- DT::renderDataTable({
    req(censusData())

    df <- censusData()

    # Sort age groups numerically
    age_order <- unique(df$Age[order(as.numeric(sub("[-+].*", "", df$Age)))])
    df$Age <- factor(df$Age, levels = age_order)
    df <- df[order(df$Age), ]
    df$Age <- as.character(df$Age)  # convert back so DT renders it cleanly

    DT::datatable(
      df,
      options = list(
        pageLength = 25,
        scrollX = TRUE,
        order = list()  # ← remove default ordering so our pre-sort is respected
      ),
      rownames = FALSE
    )
  })

  output$fhirSummaryTable <- renderTable({
    req(fhirPatientData())

    df <- fhirPatientData()

    df %>%
      group_by(Gender) %>%
      summarise(
        Total_Patients = sum(Count, na.rm = TRUE),
        Age_Groups = n_distinct(Age),
        Average_per_Group = round(mean(Count, na.rm = TRUE), 0)
      ) %>%
      as.data.frame()
  })

  output$fhirDataTable <- DT::renderDataTable({
    req(fhirPatientData())

    df <- fhirPatientData()

    # Sort age groups numerically
    age_order <- unique(df$Age[order(as.numeric(sub("[-+].*", "", df$Age)))])
    df$Age <- factor(df$Age, levels = age_order)
    df <- df[order(df$Age), ]
    df$Age <- as.character(df$Age)

    DT::datatable(
      df,
      options = list(
        pageLength = 25,
        scrollX = TRUE,
        order = list()
      ),
      rownames = FALSE
    )
  })

  # Download census data
  output$downloadCensusData <- downloadHandler(
    filename = function() {
      paste0("census_data_", Sys.Date(), ".json")
    },
    content = function(file) {
      req(censusData())
      jsonlite::write_json(censusData(), file, pretty = TRUE)
    }
  )

  # Download census plot
  output$downloadCensusPlot <- downloadHandler(
    filename = function() {
      paste0("census_plot_", Sys.Date(), ".png")
    },
    content = function(file) {
      req(lastCensusPlot())
      ggsave(file, plot = lastCensusPlot(), width = 12, height = 8, dpi = 300)
    }
  )

  # ── HELPER: bin a numeric age into whatever age-group labels exist in census ──
  # Reads the census age labels (e.g. "0-17", "18-34", "35-49", "50-64", "65+")
  # and maps a numeric age to the correct label.
  # Returns NA if no label can be matched.
  bin_age_to_census_groups <- function(age_numeric, census_age_labels) {
    # Parse each label into a (low, high) pair
    # Supported formats:  "0-17"  "18-34"  "65+"  "under 18"  "80 and over"
    parse_label <- function(lbl) {
      lbl <- trimws(lbl)
      # Pattern: "65+" or "65 and over" or "65 and older" → [65, Inf)
      if (grepl("^(\\d+)\\s*\\+$", lbl) ||
          grepl("^(\\d+)\\s+and\\s+(over|older|above)", lbl, ignore.case = TRUE) ||
          grepl("^(\\d+)\\s+or\\s+(over|older|above)", lbl, ignore.case = TRUE)) {
        lo <- as.numeric(sub("^(\\d+).*", "\\1", lbl))
        return(c(lo, Inf))
      }
      # Pattern: "under 18" or "less than 18" → [0, 17]
      if (grepl("^under\\s+(\\d+)$", lbl, ignore.case = TRUE) ||
          grepl("^less\\s+than\\s+(\\d+)$", lbl, ignore.case = TRUE)) {
        hi <- as.numeric(sub("\\D*(\\d+)$", "\\1", lbl)) - 1
        print("bin: ", c(0, hi))
        return(c(0, hi))
      }
      # Pattern: "18-34" or "18 to 34" or "18–34"
      m <- regmatches(lbl, regexpr("^(\\d+)\\s*[-–to]+\\s*(\\d+)$", lbl))
      if (length(m) == 1) {
        nums <- as.numeric(regmatches(m, gregexpr("\\d+", m))[[1]])
        return(c(nums[1], nums[2]))
      }
      # Single number label – exact match
      if (grepl("^\\d+$", lbl)) {
        n <- as.numeric(lbl)
        return(c(n, n))
      }
      return(c(NA, NA))
    }

    # Build lookup table once
    bounds <- lapply(census_age_labels, parse_label)

    # Assign each age
    sapply(age_numeric, function(a) {
      if (is.na(a)) return(NA_character_)
      for (k in seq_along(census_age_labels)) {
        lo <- bounds[[k]][1]; hi <- bounds[[k]][2]
        if (!is.na(lo) && a >= lo && a <= hi) return(census_age_labels[k])
      }
      NA_character_          # age falls outside all defined groups
    })
  }

  # ── HELPER: normalise FHIR gender to census Gender labels ────────────────────
  # census_gender_labels: the unique Gender values found in censusData()
  # fhir_gender: character vector of raw FHIR gender values
  map_fhir_gender <- function(fhir_gender, census_gender_labels) {
    fhir_lower   <- tolower(trimws(as.character(fhir_gender)))
    census_lower <- tolower(trimws(census_gender_labels))

    unique_fhir <- unique(fhir_lower)
    # Remove NA values from the unique set — handle them at the end
    unique_fhir <- unique_fhir[!is.na(unique_fhir)]

    mapping <- setNames(rep(NA_character_, length(unique_fhir)), unique_fhir)

    for (fg in unique_fhir) {
      exact <- census_lower == fg
      exact[is.na(exact)] <- FALSE          # ← guard: NA → FALSE
      if (any(exact)) { mapping[fg] <- census_gender_labels[which(exact)[1]]; next }

      sub_match <- startsWith(census_lower, fg) | startsWith(fg, census_lower)
      sub_match[is.na(sub_match)] <- FALSE  # ← same guard
      if (any(sub_match)) { mapping[fg] <- census_gender_labels[which(sub_match)[1]]; next }

      if (!is.na(fg) && fg %in% c("male", "m"))             { m <- census_lower %in% c("male","männlich","m","man");    if (any(m)) mapping[fg] <- census_gender_labels[which(m)[1]] }
      if (!is.na(fg) && fg %in% c("female", "f", "w"))      { m <- census_lower %in% c("female","weiblich","f","w","woman"); if (any(m)) mapping[fg] <- census_gender_labels[which(m)[1]] }
      if (!is.na(fg) && fg %in% c("other", "diverse", "d")) { m <- census_lower %in% c("other","diverse","d","divers"); if (any(m)) mapping[fg] <- census_gender_labels[which(m)[1]] }
      if (!is.na(fg) && fg %in% c("unknown", ""))           { m <- census_lower %in% c("unknown","unbekannt","u");      if (any(m)) mapping[fg] <- census_gender_labels[which(m)[1]] }
    }

    # Apply mapping — NA fhir_gender values map to NA_character_ naturally
    mapped <- mapping[fhir_lower]
    ifelse(is.na(mapped), NA_character_, mapped)
  }

  # 4.13 Draggable mini‐plots
  output$plotsUI <- renderUI({
    req(allData())
    dl <- allData()
    tagList(lapply(seq_along(dl), function(i) {
      f      <- dl[[i]]
      safe_i <- i
      jqui_draggable(
        div(class = "plot_box", `data-plot-name` = f$name,
            div(style = "display:flex; justify-content:space-between;",
                h4(f$name), checkboxInput(paste0("cb_", safe_i), NULL, TRUE)
            ),
            selectizeInput(paste0("filter_", safe_i), "Filter Categories:",
                           choices = unique(f$data$Category), multiple = TRUE),
            selectInput(paste0("pt_", safe_i), "Chart Type:",
                        c("Histogram", "Pie Chart", "Line Chart")),
            uiOutput(paste0("plotUI_", safe_i)),
            sliderInput(paste0("op_", safe_i), "Transparency:",
                        min = 0.1, max = 1, value = 1, step = 0.1),
            downloadButton(paste0("download_", safe_i), "Export JSON",
                           class = "btn btn-sm btn-outline-secondary",
                           style = "width: 100%; margin-top: 10px;")
        )
      )
    }))
  })

  # 4.14 Category summary table
  output$categorySummary <- renderUI({
    req(allData())
    dl    <- allData()
    names <- sapply(dl, `[[`, "name")
    catMap <- list()
    for (f in dl) for (c in unique(f$data$Category)) {
      catMap[[c]] <- union(catMap[[c]], f$name)
    }

    # Build HTML table
    html <- '<table style="width:100%; border-collapse:collapse;" border="1">'
    html <- paste0(html, '<tr style="background:#f2f2f2;"><th>Category</th>',
                   paste0('<th>', names, '</th>', collapse = ''), '<th>Count</th></tr>')

    for (c in names(catMap)) {
      pres  <- length(catMap[[c]])
      color <- if      (pres == length(names)) "#d4edda"
      else if (pres >= 2)               "#fff3cd"
      else                              "#f8d7da"
      row  <- paste0(
        '<tr><td>', c, '</td>',
        paste0(ifelse(names %in% catMap[[c]],
                      paste0('<td style="background:', color, ';"></td>'),
                      '<td></td>'),
               collapse = ''),
        '<td style="text-align:center;">', pres, '</td></tr>'
      )
      html <- paste0(html, row)
    }

    HTML(paste0(html, '</table>'))
  })

  # 4.15 Individual plot download handlers
  observe({
    req(allData())
    dl <- allData()

    for (i in seq_along(dl)) {
      local({
        idx <- i
        f <- dl[[idx]]

        output[[paste0("download_", idx)]] <- downloadHandler(
          filename = function() {
            # Create safe filename from dataset name
            safe_name <- make_safe_id(f$name)
            category_col <- input$fhir_category_col
            safe_category <- make_safe_id(category_col)
            paste0(safe_name, "_", safe_category, "_", Sys.Date(), ".json")
          },
          content = function(file) {
            # Get the current filtered data (same logic as plot)
            filterCat <- input[[paste0("filter_", idx)]]

            export_data <- if (!is.null(filterCat) && length(filterCat) > 0) {
              f$data[f$data$Category %in% filterCat, ]
            } else {
              f$data
            }

            # Add metadata to the export
            export_object <- list(
              metadata = list(
                dataset_name = f$name,
                category_column = input$fhir_category_col,
                export_date = Sys.time(),
                total_rows = nrow(export_data),
                filtered = !is.null(filterCat) && length(filterCat) > 0,
                filter_categories = if (!is.null(filterCat)) filterCat else NULL
              ),
              data = export_data
            )

            jsonlite::write_json(export_object, file, pretty = TRUE, auto_unbox = TRUE)
          }
        )
      })
    }
  })

  # 4.16 handle file additions
  observeEvent(input$newFiles, {
    req(input$newFiles)
    current <- uploadedFiles()

    new_entries <- lapply(seq_len(nrow(input$newFiles)), function(i) {
      list(
        name = input$newFiles$name[i],
        path = input$newFiles$datapath[i],
        type = "csv_json"  # default type
      )
    })

    # Avoid duplicates by name
    existing_names <- sapply(current, `[[`, "name")
    new_entries <- Filter(function(e) !e$name %in% existing_names, new_entries)

    uploadedFiles(c(current, new_entries))
  })

  # 4.17 handlie file removal
  observeEvent(input$removeSelected, {
    current <- uploadedFiles()

    # Collect which checkboxes are checked
    to_remove <- which(sapply(seq_along(current), function(i) {
      isTRUE(input[[paste0("file_select_", i)]])
    }))

    if (length(to_remove) > 0) {
      uploadedFiles(current[-to_remove])
    }
  })

  # 4.19 Render file list UI
  output$fileListUI <- renderUI({
    files <- uploadedFiles()
    if (length(files) == 0) {
      return(p("No files uploaded yet.", style = "color: #999;"))
    }

    tagList(
      h4("Uploaded Files"),
      lapply(seq_along(files), function(i) {
        f <- files[[i]]
        div(style = "display:flex; align-items:center; gap:10px; margin-bottom:8px;
                   padding:8px; border:1px solid #DDD; border-radius:4px;",
            checkboxInput(paste0("file_select_", i), label = NULL, value = FALSE),
            div(style = "flex:1; font-size:13px; word-break:break-all;", f$name),
            selectInput(paste0("file_type_", i), label = NULL,
                        choices = c("CSV/JSON" = "csv_json",
                                    "Census"   = "census",
                                    "FHIR"     = "fhir"),
                        selected = f$type,
                        width = "130px")
        )
      })
    )
  })

  # 4.20 Sync type changes
  observe({
    files <- uploadedFiles()
    if (length(files) == 0) return()

    updated <- lapply(seq_along(files), function(i) {
      type_val <- input[[paste0("file_type_", i)]]
      if (!is.null(type_val)) files[[i]]$type <- type_val
      files[[i]]
    })

    uploadedFiles(updated)
  })

  # 4.18 FHIR data binning and aggregation
  output$fhirFileSelectorBinning <- renderUI({
    files <- uploadedFiles()
    fhir_files <- Filter(function(f) f$type == "fhir", files)
    if (length(fhir_files) == 0) {
      p("No FHIR files uploaded yet. Please upload in the Data Upload tab.",
        style = "color:#999; font-size:12px;")
    } else {
      checkboxGroupInput("selected_fhir_files_binning", "Select FHIR Files:",
                         choices = setNames(
                           sapply(fhir_files, `[[`, "path"),
                           sapply(fhir_files, `[[`, "name")
                         ))
    }
  })

  fhirDataBinning <- reactive({
    req(input$selected_fhir_files_binning)

    selected_paths <- input$selected_fhir_files_binning
    files <- uploadedFiles()
    fhir_files <- Filter(function(f) f$type == "fhir" && f$path %in% selected_paths, files)

    if (length(fhir_files) == 0) return(list())

    all_files_data <- list()
    for (f in fhir_files) {
      file_data_list <- loadFhirFile(f$path, f$name)
      if (!is.null(file_data_list) && length(file_data_list) > 0) {
        all_files_data <- c(all_files_data, file_data_list)
      }
    }

    return(all_files_data)
  })

  output$fhirMappingUIBinning <- renderUI({
    fhir_data <- fhirDataBinning()
    req(input$fhir_resource_to_viz_binning)

    selected_resource_type <- input$fhir_resource_to_viz_binning
    matching_datasets <- names(fhir_data)[grepl(paste0("_", selected_resource_type, "$"), names(fhir_data))]

    if (length(matching_datasets) > 0) {
      all_columns <- unique(unlist(lapply(matching_datasets, function(dataset_name) {
        colnames(fhir_data[[dataset_name]])
      })))

      resource_prefix <- paste0(tolower(selected_resource_type), ".")
      resource_columns <- all_columns[grepl(paste0("^", resource_prefix), all_columns)]

      if (length(resource_columns) > 0) {
        selectInput("fhir_category_col_binning", "Category column:",
                    choices = resource_columns,
                    selected = resource_columns[1])
      }

    }
  })

  output$fhirValuesUIBinning <- renderUI({
    fhir_data <- fhirDataBinning()
    req(input$fhir_category_col_binning, input$fhir_resource_to_viz_binning)

    selected_resource_type <- input$fhir_resource_to_viz_binning
    selected_attribute <- input$fhir_category_col_binning

    n_bins <- input$fhir_n_bins %||% 5 #get bins from input or default to 5 if input isn't loaded yet
    value_type <- input$value_types %||% FALSE

    # Get unique values from the selected column
    matching_datasets <- names(fhir_data)[grepl(paste0("_", selected_resource_type, "$"), names(fhir_data))]

    uniqueValues <- sort(unique(unlist(lapply(matching_datasets, function(dataset_name) {
      df <- fhir_data[[dataset_name]]
      if (selected_attribute %in% colnames(df)) {
        df[[selected_attribute]]
      }
      else cat("FAILED \n")
    }))))

    if (value_type == "bool"){
      n_bins = 2
    }

    bin_inputs <- lapply(1:n_bins, function(i){
      if(value_type == "num"){
        numericInput(
          paste0("bin_", i), paste("Bin", i, "max:"), i)
      } else {
        selectInput(
          inputId = paste0("bin_", i),
          label = paste("Bin", i, "values:"),
          choices = uniqueValues,
          multiple = FALSE
        )
      }
    })

    tagList(
      h4("Create the bins"),
      bin_inputs
    )
  })

  output$plotBins <- renderPlot({
    fhir_data <- fhirDataBinning()
    req(input$fhir_category_col_binning, input$fhir_resource_to_viz_binning,
        input$fhir_n_bins, input$value_types, input$selected_fhir_files_binning)

    selected_resource_type <- input$fhir_resource_to_viz_binning
    selected_attribute     <- input$fhir_category_col_binning
    n_bins                 <- input$fhir_n_bins
    value_type             <- input$value_types
    display_mode           <- input$bins_display_mode

    files     <- uploadedFiles()
    fhir_files <- Filter(function(f) f$type == "fhir" &&
                           f$path %in% input$selected_fhir_files_binning, files)
    file_name_map <- setNames(
      sapply(fhir_files, `[[`, "name"),
      sapply(fhir_files, `[[`, "path")
    )

    # Get all data from matching datasets, tagged by source file
    matching_datasets <- names(fhir_data)[grepl(paste0("_", selected_resource_type, "$"),
                                                names(fhir_data))]

    all_data <- do.call(rbind, lapply(matching_datasets, function(dataset_name) {
      df <- fhir_data[[dataset_name]]
      if (selected_attribute %in% colnames(df)) {
        # Extract source file path from dataset name
        # dataset_name format is "filename_resourcetype"
        source_name <- dataset_name
        for (path in names(file_name_map)) {
          fname <- tools::file_path_sans_ext(file_name_map[path])
          if (grepl(fname, dataset_name, fixed = TRUE)) {
            source_name <- file_name_map[path]
            break
          }
        }
        data.frame(
          value  = df[[selected_attribute]],
          source = source_name,
          stringsAsFactors = FALSE
        )
      }
    }))

    if (is.null(all_data) || nrow(all_data) == 0) return(NULL)

    # Assign each value to a bin
    all_data$bin <- NA_character_
    for (i in 1:n_bins) {
      if (value_type == "text") {
        bin_values <- input[[paste0("bin_", i)]]
        if (!is.null(bin_values) && length(bin_values) > 0) {
          all_data$bin[all_data$value %in% bin_values] <- paste("Bin", i)
        }
      } else if (value_type == "num") {
        bin_max <- input[[paste0("bin_", i)]]
        bin_min <- input[[paste0("bin_", i - 1)]] %||% -Inf
        all_data$bin[all_data$value <= bin_max & all_data$value > bin_min] <- paste("Bin", i)
      } else if (value_type == "bool") {
        if (i == 1) all_data$bin[all_data$value == FALSE] <- paste("Bin", i)
        if (i == 2) all_data$bin[all_data$value == TRUE]  <- paste("Bin", i)
      }
    }

    all_data <- all_data[!is.na(all_data$bin), ]
    if (nrow(all_data) == 0) return(NULL)

    # Count per bin per source
    # Count per bin per source
    bin_counts <- all_data %>%
      count(source, bin, name = "Count") %>%
      as.data.frame()

    # Calculate percentages within each source
    bin_counts <- bin_counts %>%
      group_by(source) %>%
      mutate(Percent = round(Count / sum(Count) * 100, 2)) %>%
      ungroup()

    # Truncate labels to 15 characters
    truncate_label <- function(x, max_chars = 15) {
      ifelse(nchar(x) > max_chars, paste0(substr(x, 1, max_chars), "..."), x)
    }

    # Build bin labels from selected values
    bin_labels <- setNames(sapply(1:n_bins, function(i) {
      if (value_type == "text") {
        vals <- input[[paste0("bin_", i)]]
        if (!is.null(vals) && length(vals) > 0) truncate_label(vals) else paste("Bin", i)
      } else if (value_type == "num") {
        bin_max <- input[[paste0("bin_", i)]]
        bin_min <- input[[paste0("bin_", i - 1)]] %||% -Inf
        if (is.infinite(bin_min)) paste0("≤ ", bin_max) else paste0(bin_min, " – ", bin_max)
      } else if (value_type == "bool") {
        if (i == 1) "False" else "True"
      }
    }), paste0("Bin ", 1:n_bins))

    # Apply labels
    bin_counts$bin_label <- bin_labels[bin_counts$bin]
    bin_counts$bin_label <- factor(bin_counts$bin_label, levels = bin_labels)

    y_var   <- if (display_mode == "percent") "Percent" else "Count"
    y_label <- if (display_mode == "percent") "Percentage (%)" else "Count"

    ggplot(bin_counts, aes(x = bin_label, y = .data[[y_var]], fill = bin_label)) +
      geom_bar(stat = "identity", position = position_dodge(width = 0.9)) +
      theme_minimal(base_size = 14) +
      labs(
        title = paste("Distribution of", selected_attribute, "across bins"),
        x     = "Bin",
        y     = y_label,
        fill  = "Bin"
      ) +
      scale_fill_brewer(palette = "Set2") +
      facet_wrap(~source, ncol = length(unique(bin_counts$source))) +
      theme(
        legend.position = "bottom",
        axis.text.x = element_text(angle = 45, hjust = 1)
      )
  })

  output$fhirResourceTypeUIBinning <- renderUI({
    fhir_data <- fhirDataBinning()
    if (is.null(fhir_data) || length(fhir_data) == 0) return(NULL)

    available_resources <- names(fhir_data)
    if (length(available_resources) > 0) {
      resource_types <- unique(sapply(available_resources, function(x) {
        parts <- strsplit(x, "_")[[1]]
        if (length(parts) > 1) parts[length(parts)] else x
      }))

      selectInput("fhir_resource_to_viz_binning", "Resource Type:",
                  choices = resource_types,
                  selected = resource_types[1])
    }
  })

  output$vizSourceSelector <- renderUI({
    files <- uploadedFiles()
    if (length(files) == 0) {
      return(p("No files uploaded yet.", style = "color:#999; font-size:12px;"))
    }

    checkboxGroupInput("viz_selected_sources", "Select Sources:",
                       choices  = setNames(
                         sapply(files, `[[`, "path"),
                         sapply(files, `[[`, "name")
                       ),
                       selected = sapply(files, `[[`, "path"))
  })

  vizData <- reactive({
    req(input$viz_selected_sources)

    files        <- uploadedFiles()
    selected     <- Filter(function(f) f$path %in% input$viz_selected_sources, files)
    bin_type     <- input$viz_bin_type
    display_mode <- input$viz_display_mode

    results <- lapply(selected, function(f) {

      if (bin_type == "census") {
        # Use census Age x Gender bins
        # Load census reference directly — independent of Census tab selector
        all_files  <- uploadedFiles()
        census_files <- Filter(function(f) f$type == "census", all_files)

        census_ref <- if (!is.null(input$selected_census_file)) {
          loadCensusData(input$selected_census_file)
        } else if (length(census_files) > 0) {
          loadCensusData(census_files[[1]]$path)
        } else {
          NULL
        }

        if (is.null(census_ref)) return(NULL)

        census_age_labels    <- unique(census_ref$Age)
        census_gender_labels <- unique(census_ref$Gender)
        census_age_labels    <- unique(census_ref$Age)
        census_gender_labels <- unique(census_ref$Gender)

        tryCatch({
          if (f$type == "census") {
            df <- loadCensusData(f$path)
            if (is.null(df)) return(NULL)
            df$Source <- f$name

            # Calculate percent within this source
            df <- df %>%
              mutate(x_label = paste(Age, Gender, sep = " · ")) %>%
              group_by(x_label) %>%
              summarise(Count = sum(Count), .groups = "drop")

          } else if (f$type == "fhir") {
            raw     <- jsonlite::fromJSON(f$path, simplifyVector = FALSE)
            entries <- if (!is.null(raw$resourceType) && raw$resourceType == "Bundle") raw$entry else raw
            if (is.null(entries) || length(entries) == 0) return(NULL)

            patients <- Filter(function(e) {
              res <- if (!is.null(e$resource)) e$resource else e
              !is.null(res$resourceType) && res$resourceType == "Patient"
            }, entries)
            if (length(patients) == 0) return(NULL)

            records <- lapply(patients, function(e) {
              p <- if (!is.null(e$resource)) e$resource else e
              list(birthDate = as.character(p$birthDate %||% NA_character_),
                   gender    = as.character(p$gender    %||% NA_character_))
            })

            df <- data.frame(
              birthDate = sapply(records, `[[`, "birthDate"),
              gender    = sapply(records, `[[`, "gender"),
              stringsAsFactors = FALSE
            )

            today <- Sys.Date()
            df$age_numeric <- sapply(df$birthDate, function(bd) {
              if (is.null(bd) || is.na(bd) || !nzchar(trimws(bd))) return(NA_real_)
              bd <- sub("T.*$", "", trimws(bd))
              bd_padded <- if (nchar(bd) == 4) paste0(bd, "-01-01")
              else if (nchar(bd) == 7) paste0(bd, "-01")
              else bd
              dob <- tryCatch(as.Date(bd_padded), error = function(e) NA)
              if (is.na(dob) || dob >= today || dob < as.Date("1900-01-01")) return(NA_real_)
              year_diff       <- as.numeric(format(today, "%Y")) - as.numeric(format(dob, "%Y"))
              birthday_passed <- format(today, "%m-%d") >= format(dob, "%m-%d")
              as.numeric(year_diff - ifelse(birthday_passed, 0L, 1L))
            })

            df$Age    <- bin_age_to_census_groups(df$age_numeric, census_age_labels)
            df$Gender <- map_fhir_gender(df$gender, census_gender_labels)
            df        <- df[!is.na(df$Age) & !is.na(df$Gender), ]
            if (nrow(df) == 0) return(NULL)

            df <- df %>%
              dplyr::count(Age, Gender, name = "Count") %>%
              mutate(x_label = paste(Age, Gender, sep = " · "))

          } else {
            return(NULL)
          }

          # Sort x_label by age numerically
          age_order <- unique(df$x_label[order(as.numeric(sub("[-+].*", "",
                                                              sub(" · .*", "", df$x_label))))])
          df$x_label <- factor(df$x_label, levels = age_order)

          if (display_mode == "percent") {
            df <- df %>% mutate(y_val = round(Count / sum(Count) * 100, 2))
          } else {
            df <- df %>% mutate(y_val = Count)
          }

          # Full label set for uniform x-axis
          all_x_labels <-  if (bin_type == "census") {
            age_order <- unique(census_ref$Age[order(as.numeric(sub("[-+].*", "", census_ref$Age)))])
            genders   <- sort(unique(census_ref$Gender))
            as.vector(t(outer(age_order, genders, paste, sep = " · ")))
          } else {
            # All bin labels from FHIR bins
            req(input$fhir_n_bins, input$value_types)
            n_bins     <- input$fhir_n_bins
            value_type <- input$value_types
            truncate_label <- function(x, max_chars = 15) {
              ifelse(nchar(x) > max_chars, paste0(substr(x, 1, max_chars), "..."), x)
            }
            sapply(1:n_bins, function(i) {
              if (value_type == "text") {
                vals <- input[[paste0("bin_", i)]]
                if (!is.null(vals) && length(vals) > 0) truncate_label(vals) else paste("Bin", i)
              } else if (value_type == "num") {
                bin_max <- input[[paste0("bin_", i)]]
                bin_min <- input[[paste0("bin_", i - 1)]] %||% -Inf
                if (is.infinite(bin_min)) paste0("≤ ", bin_max) else paste0(bin_min, " – ", bin_max)
              } else {
                if (i == 1) "False" else "True"
              }
            })
          }

          # Expand to full label set for uniform mode
          if (input$x_axis_display_mode == "uniform") {
            full_df <- data.frame(x_label = factor(all_x_labels, levels = all_x_labels),
                                  stringsAsFactors = FALSE)
            df <- full_df %>%
              left_join(df %>% mutate(x_label = as.character(x_label)),
                        by = "x_label") %>%
              mutate(
                Count = ifelse(is.na(Count), 0, Count),
                y_val = ifelse(is.na(y_val), 0, y_val)
              )
            df$x_label <- factor(df$x_label, levels = all_x_labels)
          }

          list(name = f$name, data = df)

        }, error = function(e) {
          warning(paste("vizData error for", f$name, ":", e$message))
          NULL
        })

      } else if (bin_type == "fhir_bins") {
        # Use FHIR in bins configuration
        req(input$fhir_resource_to_viz_binning,
            input$fhir_category_col_binning,
            input$fhir_n_bins,
            input$value_types)

        if (f$type != "fhir") return(NULL)

        tryCatch({
          file_data_list <- loadFhirFile(f$path, f$name)
          if (is.null(file_data_list) || length(file_data_list) == 0) return(NULL)

          selected_resource_type <- input$fhir_resource_to_viz_binning
          selected_attribute     <- input$fhir_category_col_binning
          n_bins                 <- input$fhir_n_bins
          value_type             <- input$value_types

          matching_datasets <- names(file_data_list)[grepl(
            paste0("_", selected_resource_type, "$"), names(file_data_list))]
          if (length(matching_datasets) == 0) return(NULL)

          all_vals <- do.call(rbind, lapply(matching_datasets, function(dn) {
            d <- file_data_list[[dn]]
            if (selected_attribute %in% colnames(d)) {
              data.frame(value = d[[selected_attribute]], stringsAsFactors = FALSE)
            }
          }))
          if (is.null(all_vals) || nrow(all_vals) == 0) return(NULL)

          # Build bin labels
          truncate_label <- function(x, max_chars = 15) {
            ifelse(nchar(x) > max_chars, paste0(substr(x, 1, max_chars), "..."), x)
          }

          bin_labels <- setNames(sapply(1:n_bins, function(i) {
            if (value_type == "text") {
              vals <- input[[paste0("bin_", i)]]
              if (!is.null(vals) && length(vals) > 0) truncate_label(vals) else paste("Bin", i)
            } else if (value_type == "num") {
              bin_max <- input[[paste0("bin_", i)]]
              bin_min <- input[[paste0("bin_", i - 1)]] %||% -Inf
              if (is.infinite(bin_min)) paste0("≤ ", bin_max) else paste0(bin_min, " – ", bin_max)
            } else {
              if (i == 1) "False" else "True"
            }
          }), paste0("Bin ", 1:n_bins))

          # Assign bins
          all_vals$bin <- NA_character_
          for (i in 1:n_bins) {
            if (value_type == "text") {
              bv <- input[[paste0("bin_", i)]]
              if (!is.null(bv)) all_vals$bin[all_vals$value %in% bv] <- paste("Bin", i)
            } else if (value_type == "num") {
              bmax <- input[[paste0("bin_", i)]]
              bmin <- input[[paste0("bin_", i - 1)]] %||% -Inf
              all_vals$bin[all_vals$value <= bmax & all_vals$value > bmin] <- paste("Bin", i)
            } else {
              if (i == 1) all_vals$bin[all_vals$value == FALSE] <- paste("Bin", i)
              if (i == 2) all_vals$bin[all_vals$value == TRUE]  <- paste("Bin", i)
            }
          }

          all_vals <- all_vals[!is.na(all_vals$bin), ]
          if (nrow(all_vals) == 0) return(NULL)

          df <- all_vals %>%
            count(bin, name = "Count") %>%
            mutate(x_label = bin_labels[bin],
                   x_label = factor(x_label, levels = bin_labels))

          if (display_mode == "percent") {
            df <- df %>% mutate(y_val = round(Count / sum(Count) * 100, 2))
          } else {
            df <- df %>% mutate(y_val = Count)
          }

          # Full label set for uniform x-axis
          all_x_labels <-  if (bin_type == "census") {
            age_order <- unique(census_ref$Age[order(as.numeric(sub("[-+].*", "", census_ref$Age)))])
            genders   <- sort(unique(census_ref$Gender))
            as.vector(t(outer(age_order, genders, paste, sep = " · ")))
          } else {
            # All bin labels from FHIR bins
            req(input$fhir_n_bins, input$value_types)
            n_bins     <- input$fhir_n_bins
            value_type <- input$value_types
            truncate_label <- function(x, max_chars = 15) {
              ifelse(nchar(x) > max_chars, paste0(substr(x, 1, max_chars), "..."), x)
            }
            sapply(1:n_bins, function(i) {
              if (value_type == "text") {
                vals <- input[[paste0("bin_", i)]]
                if (!is.null(vals) && length(vals) > 0) truncate_label(vals) else paste("Bin", i)
              } else if (value_type == "num") {
                bin_max <- input[[paste0("bin_", i)]]
                bin_min <- input[[paste0("bin_", i - 1)]] %||% -Inf
                if (is.infinite(bin_min)) paste0("≤ ", bin_max) else paste0(bin_min, " – ", bin_max)
              } else {
                if (i == 1) "False" else "True"
              }
            })
          }

          # Expand to full label set for uniform mode
          if (input$x_axis_display_mode == "uniform") {
            full_df <- data.frame(x_label = factor(all_x_labels, levels = all_x_labels),
                                  stringsAsFactors = FALSE)
            df <- full_df %>%
              left_join(df %>% mutate(x_label = as.character(x_label)),
                        by = "x_label") %>%
              mutate(
                Count = ifelse(is.na(Count), 0, Count),
                y_val = ifelse(is.na(y_val), 0, y_val)
              )
            df$x_label <- factor(df$x_label, levels = all_x_labels)
          }

          list(name = f$name, data = df)

        }, error = function(e) {
          warning(paste("vizData fhir_bins error for", f$name, ":", e$message))
          NULL
        })
      }
    })

    Filter(Negate(is.null), results)
  })

  output$vizPlotsUI <- renderUI({
    req(vizData())
    dl <- vizData()
    if (length(dl) == 0) return(p("No data to display.", style = "color:#999;"))

    if (input$viz_layout_mode == "overlay") {
      plotOutput("vizOverlayPlot", height = "500px")
    } else {
      tagList(lapply(seq_along(dl), function(i) {
        plotOutput(paste0("vizPlot_", i), height = "350px")
      }))
    }
  })

  observe({
    req(vizData())
    dl           <- vizData()
    display_mode <- isolate(input$viz_display_mode)
    y_label      <- if (isolate(input$viz_display_mode) == "percent") "Percentage (%)" else "Count"

    # Shared y max
    y_max <- max(unlist(lapply(dl, function(x) x$data$y_val)), na.rm = TRUE)

    for (i in seq_along(dl)) {
      local({
        idx  <- i
        d    <- dl[[idx]]

        output[[paste0("vizPlot_", idx)]] <- renderPlot({
          ggplot(d$data, aes(x = x_label, y = y_val, fill = sub(".* · ", "", as.character(x_label)))) +
            geom_bar(stat = "identity", alpha = 1, colour = "white", linewidth = 0.2) +
            scale_y_continuous(limits = c(0, y_max * 1.05)) +
            scale_x_discrete(drop = FALSE) +  # ← keep empty bins
            scale_fill_brewer(palette = "Set2") +
            theme_minimal(base_size = 14) +
            labs(
              title = d$name,
              x     = NULL,
              y     = y_label,
              fill  = "Gender"
            ) +
            theme(
              axis.text.x     = element_text(angle = 45, hjust = 1),
              legend.position = "bottom",
              plot.title      = element_text(face = "bold")
            )
        })
      })
    }
  })

  output$vizOverlayPlot <- renderPlot({
    req(vizData())
    dl           <- vizData()
    alpha        <- input$viz_overlay_alpha
    y_label      <- if (input$viz_display_mode == "percent") "Percentage (%)" else "Count"
    y_max        <- max(unlist(lapply(dl, function(x) x$data$y_val)), na.rm = TRUE)

    # Combine all sources into one data frame, keeping only needed columns
    combined <- do.call(rbind, lapply(dl, function(d) {
      data.frame(
        x_label = as.character(d$data$x_label),
        y_val   = d$data$y_val,
        source  = d$name,
        stringsAsFactors = FALSE
      )
    }))

    # Ensure x_label factor levels are consistent
    all_levels <- levels(dl[[1]]$data$x_label)
    combined$x_label <- factor(combined$x_label, levels = all_levels)

    ggplot(combined, aes(x = x_label, y = y_val, fill = source)) +
      geom_bar(stat = "identity", position = "identity",
               alpha = alpha, colour = "white", linewidth = 0.2) +
      scale_y_continuous(limits = c(0, y_max * 1.05)) +
      scale_x_discrete(drop = FALSE) +
      scale_fill_brewer(palette = "Set2") +
      theme_minimal(base_size = 14) +
      labs(
        title = "Overlay Comparison",
        x     = NULL,
        y     = y_label,
        fill  = "Source"
      ) +
      theme(
        axis.text.x     = element_text(angle = 45, hjust = 1),
        legend.position = "bottom",
        plot.title      = element_text(face = "bold")
      )
  })

  # Show format selection modal on button click
  observeEvent(input$downloadBinsReport, {
    req(input$fhir_category_col_binning, input$fhir_resource_to_viz_binning)

    showModal(modalDialog(
      title = "Download Bin Report",
      radioButtons("bins_report_format", "Report Format:",
                   choices = c("Separate" = "separate",
                               "Composite" = "composite"),
                   selected = "separate"),
      footer = tagList(
        modalButton("Cancel"),
        downloadButton("downloadBinsReportFile", "Download",
                       class = "btn btn-primary")
      )
    ))
  })

  output$downloadBinsReportFile <- downloadHandler(
    filename = function() {
      attr <- make_safe_id(input$fhir_category_col_binning)
      paste0("bin_report_", attr, "_", Sys.Date(), ".json")
    },
    content = function(file) {
      fhir_data    <- fhirDataBinning()
      n_bins       <- input$fhir_n_bins
      value_type   <- input$value_types
      selected_resource_type <- input$fhir_resource_to_viz_binning
      selected_attribute     <- input$fhir_category_col_binning
      format       <- input$bins_report_format

      # Build truncate helper
      truncate_label <- function(x, max_chars = 15) {
        ifelse(nchar(x) > max_chars, paste0(substr(x, 1, max_chars), "..."), x)
      }

      # Build bin labels
      bin_labels <- setNames(sapply(1:n_bins, function(i) {
        if (value_type == "text") {
          vals <- input[[paste0("bin_", i)]]
          if (!is.null(vals) && length(vals) > 0) truncate_label(vals) else paste("Bin", i)
        } else if (value_type == "num") {
          bin_max <- input[[paste0("bin_", i)]]
          bin_min <- input[[paste0("bin_", i - 1)]] %||% -Inf
          if (is.infinite(bin_min)) paste0("\u2264 ", bin_max) else paste0(bin_min, " \u2013 ", bin_max)
        } else {
          if (i == 1) "False" else "True"
        }
      }), paste0("Bin ", 1:n_bins))

      # Collect all data
      matching_datasets <- names(fhir_data)[grepl(
        paste0("_", selected_resource_type, "$"), names(fhir_data))]

      all_vals <- do.call(rbind, lapply(matching_datasets, function(dn) {
        d <- fhir_data[[dn]]
        if (selected_attribute %in% colnames(d)) {
          data.frame(value = d[[selected_attribute]], stringsAsFactors = FALSE)
        }
      }))

      # Assign bins
      all_vals$bin <- NA_character_
      for (i in 1:n_bins) {
        if (value_type == "text") {
          bv <- input[[paste0("bin_", i)]]
          if (!is.null(bv)) all_vals$bin[all_vals$value %in% bv] <- paste("Bin", i)
        } else if (value_type == "num") {
          bmax <- input[[paste0("bin_", i)]]
          bmin <- input[[paste0("bin_", i - 1)]] %||% -Inf
          all_vals$bin[all_vals$value <= bmax & all_vals$value > bmin] <- paste("Bin", i)
        } else {
          if (i == 1) all_vals$bin[all_vals$value == FALSE] <- paste("Bin", i)
          if (i == 2) all_vals$bin[all_vals$value == TRUE]  <- paste("Bin", i)
        }
      }

      all_vals <- all_vals[!is.na(all_vals$bin), ]

      # Count per bin
      bin_counts <- all_vals %>%
        count(bin, name = "Count") %>%
        mutate(label = bin_labels[bin]) %>%
        as.data.frame()

      total_count <- sum(bin_counts$Count)

      if (format == "separate") {
        # ── Separate format: one stratifier with one stratum per bin ──────────────
        report <- list(
          resourceType = "MeasureReport",
          status       = "complete",
          type         = "summary",
          date         = format(Sys.time(), "%Y-%m-%dT%H:%M:%S+00:00"),
          period       = list(
            start = as.character(Sys.Date()),
            end   = as.character(Sys.Date())
          ),
          group = list(list(
            population = list(list(
              code  = list(coding = list(list(
                system = "http://terminology.hl7.org/CodeSystem/measure-population",
                code   = "initial-population"
              ))),
              count = total_count
            )),
            stratifier = list(list(
              code   = list(list(text = selected_attribute)),
              stratum = lapply(seq_len(nrow(bin_counts)), function(i) {
                list(
                  value      = list(text = bin_counts$label[i]),
                  population = list(list(
                    code  = list(coding = list(list(
                      system = "http://terminology.hl7.org/CodeSystem/measure-population",
                      code   = "initial-population"
                    ))),
                    count = bin_counts$Count[i]
                  ))
                )
              })
            ))
          ))
        )

      } else {
        # ── Composite format: one stratifier with component per bin ───────────────
        report <- list(
          resourceType = "MeasureReport",
          status       = "complete",
          type         = "summary",
          date         = format(Sys.time(), "%Y-%m-%dT%H:%M:%S+00:00"),
          period       = list(
            start = as.character(Sys.Date()),
            end   = as.character(Sys.Date())
          ),
          group = list(list(
            population = list(list(
              code  = list(coding = list(list(
                system = "http://terminology.hl7.org/CodeSystem/measure-population",
                code   = "initial-population"
              ))),
              count = total_count
            )),
            stratifier = list(list(
              code   = list(list(text = selected_attribute)),
              stratum = lapply(seq_len(nrow(bin_counts)), function(i) {
                list(
                  component = list(
                    list(
                      code  = list(text = selected_attribute),
                      value = list(text = bin_counts$label[i])
                    )
                  ),
                  measureScore = list(value = bin_counts$Count[i]),
                  population   = list(list(
                    code  = list(coding = list(list(
                      system = "http://terminology.hl7.org/CodeSystem/measure-population",
                      code   = "initial-population"
                    ))),
                    count = bin_counts$Count[i]
                  ))
                )
              })
            ))
          ))
        )
      }

      jsonlite::write_json(report, file, pretty = TRUE, auto_unbox = TRUE)
      removeModal()
    }
  )
}
# end server

# 5. Launch the application
shinyApp(ui = ui, server = server)