# Sex Trafficking Simulation Explorer – Shiny App
# -----------------------------------------------------------------------------
# Sidebars scroll independently; dataset selector auto-detects files named
# `CSWOutput_<tag>.csv`; robust baseline handling & slider defaults fixed.
# -----------------------------------------------------------------------------

library(shiny)
library(shinyWidgets)
library(plotly)
library(tidyverse)
library(readr)

# ---------- STATIC CONFIG -----------------------------------------------------
independent_vars <- c(
  "pctExpungement", "seller_prosecution_culture", "prosecution_culture_v",
  "prosecution_culture_s", "trafficker_exposure", "geographic_csw_normalization",
  "crim_record_obstacle", "em_services_capacity", "st_services_capacity",
  "lt_services_capacity", "buyer_prosecution_culture", "csw_acceptance"
)

dependent_vars <- c(
  "TotalTSS", "TotalSS", "TotalYouthTSS", "pctSSCrimRecord",
  "pctExitedCrimRecord", "EmServicesAdult", "STServicesAdult",
  "LTServicesAdult", "Traffickers", "Buyers", "demand", "cost",
  "pctTraffickedVsNontrafficked"
)

base_values <- list(
  pctExpungement                 = 0,
  seller_prosecution_culture     = 0.1,
  prosecution_culture_v          = 0.301,
  prosecution_culture_s          = 0.201,
  trafficker_exposure            = 0.05,
  geographic_csw_normalization   = 0.1,
  crim_record_obstacle           = 0.5,
  em_services_capacity           = 1000,
  st_services_capacity           = 350,
  lt_services_capacity           = 100,
  buyer_prosecution_culture      = 0.001,
  csw_acceptance                 = 0.5
)

# ---------- UI ----------------------------------------------------------------
ui <- fluidPage(
  tags$head(tags$style(HTML(
    ".scroll-sidebar{overflow-y:auto; max-height:60vh;}
" 
  ))),
  
  # Header with dynamic dataset selector -------------------------------------
  fluidRow(
    column(8, h2("Sex Trafficking Simulation Explorer")),
    column(4,
           selectInput("dataset_choice", "Raw data:",
                       choices = NULL, selected = NULL, width = "100%"))
  ),
  hr(),
  
  tabsetPanel(
    tabPanel("Summary Across All Runs",
             sidebarLayout(
               sidebarPanel(class="scroll-sidebar",
                            selectInput("indep1", "Independent variable (x-axis):", choices = NULL),
                            checkboxGroupInput("dep1", "Dependent variable(s):",
                                               choices = dependent_vars, selected = dependent_vars[1])
               ),
               mainPanel(plotOutput("summaryPlot", height = "85vh"))
             )
    ),
    tabPanel("Base-Filtered Runs",
             sidebarLayout(
               sidebarPanel(class="scroll-sidebar",
                            selectInput("indep2", "Independent variable (x-axis):", choices = NULL),
                            checkboxGroupInput("dep2", "Dependent variable(s):",
                                               choices = dependent_vars, selected = dependent_vars[1]),
                            hr(), h4("Adjust baseline values"), uiOutput("baselineInputs"),
                            hr(), tableOutput("baseTable")
               ),
               mainPanel(plotOutput("basePlot", height = "85vh"))
             )
    ),
    tabPanel("3-D Scatter",
             sidebarLayout(
               sidebarPanel(class="scroll-sidebar",
                            selectInput("xvar", "X-axis independent variable:", choices = NULL),
                            selectInput("yvar", "Y-axis independent variable:", choices = NULL),
                            selectInput("dep3", "Z-axis dependent variable:",
                                        choices = dependent_vars, selected = dependent_vars[1]),
                            hr(), h4("Set baseline values for remaining parameters"),
                            uiOutput("baselineInputs3"), hr(), tableOutput("baseTable3")
               ),
               mainPanel(plotlyOutput("scatter3d", height = "85vh"))
             )
    )
  )
)

# ---------- SERVER -----------------------------------------------------------
server <- function(input, output, session) {
  
  # ---- Discover available data files and populate selector ------------------
  available_tags <- reactiveVal(character())
  
  observe({
    files <- list.files(pattern = "^CSWOutput_(.+)\\.csv$")
    tags  <- unique(sub("^CSWOutput_(.+)\\.csv$", "\\1", files))
    # Order: prefer General, Policy first if present, then alphabetical
    special <- intersect(c("General", "Policy"), tags)
    ordered <- c(special, sort(setdiff(tags, special)))
    available_tags(ordered)
    sel <- input$dataset_choice
    if (is.null(sel) || !(sel %in% ordered)) sel <- if (length(ordered)>0) ordered[1] else NA
    updateSelectInput(session, "dataset_choice", choices = ordered, selected = sel)
  })
  
  # ---- Load selected data set ----------------------------------------------
  data_raw <- reactive({
    tags <- available_tags()
    validate(need(length(tags) > 0, "No CSWOutput_<tag>.csv files found in the app directory."))
    req(input$dataset_choice)
    file <- paste0("CSWOutput_", input$dataset_choice, ".csv")
    validate(need(file.exists(file), paste("File", file, "not found.")))
    read_csv(file, show_col_types = FALSE)
  })
  
  # ---- Unique values per independent var -----------------------------------
  unique_vals <- reactive({
    df <- data_raw()
    setNames(lapply(independent_vars, function(p) {
      if (p %in% names(df)) sort(unique(na.omit(df[[p]]))) else numeric(0)
    }), independent_vars)
  })
  
  # ---- Independent vars that actually vary (≥ 2 unique values) -------------
  varying_inds <- reactive({
    names(Filter(function(v) length(v) > 1, unique_vals()))
  })
  
  # ---- Helper to pick a safe default from choices ---------------------------
  choose_selected <- function(vals, base) {
    if (length(vals) == 0) return(NULL)
    # Exact match first
    if (!is.null(base) && base %in% vals) return(base)
    # If numeric, pick nearest value
    if (is.numeric(vals) && !is.null(base) && is.finite(base)) {
      return(vals[which.min(abs(vals - base))])
    }
    # Fallback: first value
    vals[1]
  }
  
  # ---- Update selectors when data set changes -------------------------------
  observe({
    inds <- varying_inds()
    if (length(inds) == 0) {
      updateSelectInput(session, "indep1", choices = character(0))
      updateSelectInput(session, "indep2", choices = character(0))
      updateSelectInput(session, "xvar",   choices = character(0))
    } else {
      updateSelectInput(session, "indep1", choices = inds, selected = inds[1])
      updateSelectInput(session, "indep2", choices = inds, selected = inds[1])
      updateSelectInput(session, "xvar",   choices = inds, selected = inds[1])
    }
  })
  
  # ---- Keep X & Y distinct on 3-D tab --------------------------------------
  observeEvent(c(input$xvar, varying_inds()), {
    inds <- varying_inds()
    others <- setdiff(inds, input$xvar)
    sel <- if (length(others) > 0 && input$yvar %in% others) input$yvar else if (length(others)>0) others[1] else NULL
    updateSelectInput(session, "yvar", choices = others, selected = sel)
  })
  
  # ---- Baseline value getters (guarantee scalar) ----------------------------
  baseline_value <- function(p) {
    vals <- unique_vals()[[p]]
    # Read from slider if present
    id <- paste0("baseline_", p)
    chosen <- input[[id]]
    if (!is.null(chosen)) {
      num <- suppressWarnings(as.numeric(chosen))
      if (length(num) == 1 && !is.na(num)) return(num)
    }
    # Otherwise choose from base_values aligned to available values
    sel <- choose_selected(vals, base_values[[p]])
    suppressWarnings(as.numeric(sel))
  }
  baseline3_value <- function(p) {
    vals <- unique_vals()[[p]]
    id <- paste0("baseline3_", p)
    chosen <- input[[id]]
    if (!is.null(chosen)) {
      num <- suppressWarnings(as.numeric(chosen))
      if (length(num) == 1 && !is.na(num)) return(num)
    }
    sel <- choose_selected(vals, base_values[[p]])
    suppressWarnings(as.numeric(sel))
  }
  
  # ---- Baseline sliders (Tab 2) --------------------------------------------
  output$baselineInputs <- renderUI({
    lapply(independent_vars, function(p) {
      vals <- unique_vals()[[p]]
      if (length(vals) == 0) return(NULL)
      sliderTextInput(inputId = paste0("baseline_", p), label = p,
                      choices = vals,
                      selected = choose_selected(vals, base_values[[p]]),
                      grid = TRUE, hide_min_max = TRUE)
    })
  })
  
  baseline_tbl <- reactive({
    tibble(
      Parameter = independent_vars,
      Baseline  = vapply(independent_vars, function(p) baseline_value(p), numeric(1))
    )
  })
  output$baseTable <- renderTable(baseline_tbl(), striped = TRUE, bordered = TRUE)
  
  # ---- Helper: Mean & SD summariser ----------------------------------------
  summarise_ms <- function(df, indep, deps){
    df %>% select(all_of(c(indep,deps))) %>%
      pivot_longer(-all_of(indep), names_to="metric", values_to="value") %>%
      group_by(metric, .data[[indep]]) %>%
      summarise(mean=mean(value,na.rm=TRUE), sd=sd(value,na.rm=TRUE), .groups="drop")
  }
  
  # ---- Tab 1: Summary plot --------------------------------------------------
  plot1_data <- reactive({ req(input$indep1, input$dep1); summarise_ms(data_raw(), input$indep1, input$dep1) })
  output$summaryPlot <- renderPlot({
    ggplot(plot1_data(), aes(x=.data[[input$indep1]], y=mean, colour=metric, group=metric))+
      geom_line()+geom_point(size = 4)+geom_errorbar(aes(ymin=mean-sd,ymax=mean+sd), width=.1)+
      labs(x=input$indep1, y="Mean value", colour="Dependent variable")+
      theme_minimal(base_size = 16) +
      theme(legend.title = element_text(size = 16),
            legend.text  = element_text(size = 14),
            axis.title   = element_text(size = 16),
            axis.text    = element_text(size = 14))
  }, res=96)
  
  # ---- Tab 2: Base-filtered plot -------------------------------------------
  plot2_data <- reactive({
    req(input$indep2, input$dep2)
    df <- data_raw()
    # Only filter on columns actually present in the data
    present_inds <- intersect(independent_vars, names(df))
    others <- setdiff(present_inds, input$indep2)
    for (p in others) {
      bv <- baseline_value(p)
      df <- df %>% filter(.data[[p]] == bv)
    }
    summarise_ms(df, input$indep2, input$dep2)
  })
  output$basePlot <- renderPlot({
    ggplot(plot2_data(), aes(x=.data[[input$indep2]], y=mean, colour=metric, group=metric))+
      geom_line()+geom_point(size = 4)+geom_errorbar(aes(ymin=mean-sd,ymax=mean+sd), width=.1)+
      labs(x=input$indep2, y="Mean value (baseline-filtered)", colour="Dependent variable")+
      theme_minimal(base_size = 16) +
      theme(legend.title = element_text(size = 16),
            legend.text  = element_text(size = 14),
            axis.title   = element_text(size = 16),
            axis.text    = element_text(size = 14))
  }, res=128)
  
  # ---- Tab 3: Baseline sliders & table -------------------------------------
  output$baselineInputs3 <- renderUI({
    keep <- setdiff(independent_vars, c(input$xvar,input$yvar))
    lapply(keep, function(p){
      vals <- unique_vals()[[p]]; if (length(vals) == 0) return(NULL)
      sliderTextInput(paste0("baseline3_",p), p, choices = vals,
                      selected = choose_selected(vals, base_values[[p]]),
                      grid = TRUE, hide_min_max = TRUE)
    })
  })
  baseline_tbl3 <- reactive({
    keep <- setdiff(independent_vars, c(input$xvar,input$yvar))
    tibble(Parameter = keep,
           Baseline  = vapply(keep, function(p) baseline3_value(p), numeric(1)))
  })
  output$baseTable3 <- renderTable(baseline_tbl3(), striped = TRUE, bordered = TRUE)
  
  # ---- Tab 3: 3-D Scatter ---------------------------------------------------
  scatter_data <- reactive({ req(input$xvar,input$yvar,input$dep3)
    df <- data_raw()
    present_inds <- intersect(independent_vars, names(df))
    for (p in setdiff(present_inds, c(input$xvar, input$yvar))) {
      bv <- baseline3_value(p)
      df <- df %>% filter(.data[[p]] == bv)
    }
    df %>% group_by(x = .data[[input$xvar]], y = .data[[input$yvar]]) %>%
      summarise(z = mean(.data[[input$dep3]], na.rm = TRUE), .groups = "drop")
  })
  output$scatter3d <- renderPlotly({
    df <- scatter_data()
    plot_ly(df, x = ~x, y = ~y, z = ~z) %>%
      add_markers(color = ~x, showscale = TRUE,
                  marker = list(size = 8, colorbar = list(title = list(text = input$xvar, font = list(size = 16))))) %>%
      layout(font = list(size = 16),
             scene = list(xaxis = list(title = list(text = input$xvar, font = list(size = 18)),
                                       tickfont = list(size = 14), titlefont = list(size = 18)),
                          yaxis = list(title = list(text = input$yvar, font = list(size = 18)),
                                       tickfont = list(size = 14), titlefont = list(size = 18)),
                          zaxis = list(title = list(text = input$dep3, font = list(size = 18)),
                                       tickfont = list(size = 14), titlefont = list(size = 18))))
  })
}

shinyApp(ui, server)
