# ============================================================
#  Evolutionary Game Dynamics — Interactive Shiny App
#  Replicator equation, numerical simulation
#  install.packages(c("shiny", "bslib", "ggplot2", "dplyr"))
# ============================================================

library(shiny)
library(bslib)
library(ggplot2)
library(dplyr)

# ------------------------------------------------------------
# SIMULATION FUNCTIONS
# ------------------------------------------------------------

replicator_step <- function(x, A, delta) {
  p     <- c(x, 1 - x)
  f     <- as.vector(A %*% p)
  f_bar <- sum(p * f)
  x_new <- x * (1 - delta + delta * f[1]) /
               (1 - delta + delta * f_bar)
  max(1e-6, min(1 - 1e-6, x_new))
}

run_simulation <- function(x0, A, t_max, delta) {
  x    <- numeric(t_max + 1)
  x[1] <- x0
  for (t in seq_len(t_max))
    x[t + 1] <- replicator_step(x[t], A, delta)
  p_mat  <- cbind(x, 1 - x)
  f_mat  <- t(apply(p_mat, 1, function(p) as.vector(A %*% p)))
  data.frame(
    time   = 0:t_max,
    freq_1 = x,
    freq_2 = 1 - x,
    f_mean = rowSums(p_mat * f_mat)
  )
}

# Preset matrices
presets <- list(
  "Prisoner's Dilemma" = list(
    A  = matrix(c(3, 0, 5, 1), 2, 2, byrow = TRUE),
    s1 = "Cooperate", s2 = "Defect"
  ),
  "Hawks & Doves" = list(
    A  = matrix(c(0, 3, 1, 2), 2, 2, byrow = TRUE),
    s1 = "Hawk", s2 = "Dove"
  ),
  "Stag Hunt" = list(
    A  = matrix(c(1.0, 0.0, 0.3, 0.3), 2, 2, byrow = TRUE),
    s1 = "Stag", s2 = "Hare"
  ),
  "Batesian Mimicry" = list(
    A  = matrix(c(0.85, 0.75, 1.00, 0.40), 2, 2, byrow = TRUE),
    s1 = "Model", s2 = "Mimic"
  ),
  "Müllerian Mimicry" = list(
    A  = matrix(c(0.0, 0.6, 0.2, 0.4), 2, 2, byrow = TRUE),
    s1 = "Keep", s2 = "Converge"
  ),
  "Custom" = list(
    A  = matrix(c(1, 0, 0, 1), 2, 2, byrow = TRUE),
    s1 = "Strategy 1", s2 = "Strategy 2"
  )
)

# colour palette
COL1 <- "#4E9AF1"
COL2 <- "#F17A4E"
COLM <- "#A8D8A8"

# ------------------------------------------------------------
# UI
# ------------------------------------------------------------

ui <- page_fillable(
  theme = bs_theme(
    bg           = "#0f1117",
    fg           = "#e8eaf0",
    primary      = "#4E9AF1",
    base_font    = font_google("IBM Plex Mono"),
    heading_font = font_google("IBM Plex Mono"),
    font_scale   = 0.92
  ),

  tags$head(tags$style(HTML("
    body { background: #0f1117; }

    .app-title {
      font-family: 'IBM Plex Mono', monospace;
      font-size: 1.3rem;
      font-weight: 700;
      letter-spacing: 0.12em;
      text-transform: uppercase;
      color: #4E9AF1;
      padding: 18px 24px 4px 24px;
      border-bottom: 1px solid #1e2230;
      margin-bottom: 0;
    }
    .app-subtitle {
      font-family: 'IBM Plex Mono', monospace;
      font-size: 0.72rem;
      color: #5a6080;
      padding: 2px 24px 14px 24px;
      letter-spacing: 0.08em;
    }

    .sidebar-panel {
      background: #13161f !important;
      border-right: 1px solid #1e2230 !important;
      padding: 18px 16px !important;
      overflow-y: auto;
    }

    .section-label {
      font-size: 0.65rem;
      letter-spacing: 0.14em;
      text-transform: uppercase;
      color: #4E9AF1;
      margin: 18px 0 8px 0;
      padding-bottom: 4px;
      border-bottom: 1px solid #1e2230;
    }

    .matrix-grid {
      display: grid;
      grid-template-columns: 1fr 1fr;
      gap: 6px;
      margin-bottom: 4px;
    }
    .matrix-grid .form-control {
      background: #1a1e2e !important;
      border: 1px solid #2a2e42 !important;
      color: #e8eaf0 !important;
      font-family: 'IBM Plex Mono', monospace !important;
      font-size: 0.85rem !important;
      text-align: center;
      padding: 5px 4px;
      border-radius: 4px;
    }
    .matrix-grid .form-control:focus {
      border-color: #4E9AF1 !important;
      box-shadow: 0 0 0 2px rgba(78,154,241,0.15) !important;
      outline: none;
    }

    .matrix-header {
      display: grid;
      grid-template-columns: 1fr 1fr;
      gap: 6px;
      margin-bottom: 3px;
    }
    .matrix-col-label {
      font-size: 0.62rem;
      color: #F17A4E;
      text-align: center;
      letter-spacing: 0.06em;
    }
    .matrix-row-labels {
      font-size: 0.62rem;
      color: #4E9AF1;
      letter-spacing: 0.06em;
      margin-bottom: 2px;
    }

    .preset-note {
      font-size: 0.62rem;
      color: #3a4060;
      margin-top: 5px;
      font-style: italic;
    }

    .selectize-input, .selectize-dropdown {
      background: #1a1e2e !important;
      border: 1px solid #2a2e42 !important;
      color: #e8eaf0 !important;
      font-family: 'IBM Plex Mono', monospace !important;
      font-size: 0.82rem !important;
    }

    .irs--shiny .irs-bar { background: #4E9AF1 !important; }
    .irs--shiny .irs-handle { background: #4E9AF1 !important; border-color: #4E9AF1 !important; }
    .irs--shiny .irs-from, .irs--shiny .irs-to, .irs--shiny .irs-single {
      background: #4E9AF1 !important;
      font-family: 'IBM Plex Mono', monospace !important;
      font-size: 0.72rem !important;
    }
    .irs--shiny .irs-line { background: #1e2230 !important; }
    .irs--shiny .irs-grid-text { color: #3a4060 !important; font-size: 0.62rem !important; }

    .form-label, label {
      font-size: 0.72rem !important;
      color: #7a8090 !important;
      letter-spacing: 0.06em;
      text-transform: uppercase;
    }

    .stat-box {
      background: #1a1e2e;
      border: 1px solid #2a2e42;
      border-radius: 6px;
      padding: 10px 14px;
      margin-bottom: 8px;
    }
    .stat-label {
      font-size: 0.60rem;
      color: #5a6080;
      letter-spacing: 0.1em;
      text-transform: uppercase;
      margin-bottom: 2px;
    }
    .stat-value {
      font-size: 1.05rem;
      font-weight: 700;
      color: #e8eaf0;
    }
    .stat-row {
      display: flex;
      gap: 8px;
      margin-bottom: 8px;
    }
    .stat-row .stat-box { flex: 1; margin-bottom: 0; }

    .plot-area {
      background: #13161f;
      border-radius: 8px;
      padding: 4px;
    }

    /* scrollbar */
    ::-webkit-scrollbar { width: 5px; }
    ::-webkit-scrollbar-track { background: #0f1117; }
    ::-webkit-scrollbar-thumb { background: #2a2e42; border-radius: 3px; }
  "))),

  div(class = "app-title",   "// EVOLUTIONARY GAME DYNAMICS"),
  div(class = "app-subtitle", "replicator equation · numerical simulation"),

  layout_sidebar(
    fillable = TRUE,

    # ---- SIDEBAR ----
    sidebar = sidebar(
      width    = 290,
      class    = "sidebar-panel",
      open     = TRUE,
      bg       = "#13161f",
      fg       = "#e8eaf0",

      div(class = "section-label", "01 / Preset"),
      selectInput("preset", NULL,
                  choices  = names(presets),
                  selected = "Prisoner's Dilemma",
                  width    = "100%"),

      div(class = "section-label", "02 / Strategy Names"),
      fluidRow(
        column(6, textInput("s1_name", "Strategy 1", value = "Cooperate", width = "100%")),
        column(6, textInput("s2_name", "Strategy 2", value = "Defect",    width = "100%"))
      ),

      div(class = "section-label", "03 / Payoff Matrix"),
      div(class = "matrix-header",
          div(class = "matrix-col-label", textOutput("col1_label", inline = TRUE)),
          div(class = "matrix-col-label", textOutput("col2_label", inline = TRUE))),
      div(class = "matrix-row-labels", textOutput("row1_label", inline = TRUE)),
      div(class = "matrix-grid",
          numericInput("a11", NULL, value = 3,    step = 0.1, width = "100%"),
          numericInput("a12", NULL, value = 0,    step = 0.1, width = "100%")),
      div(class = "matrix-row-labels", textOutput("row2_label", inline = TRUE)),
      div(class = "matrix-grid",
          numericInput("a21", NULL, value = 5,    step = 0.1, width = "100%"),
          numericInput("a22", NULL, value = 1,    step = 0.1, width = "100%")),
      div(class = "preset-note", "edit values to switch to Custom"),

      div(class = "section-label", "04 / Initial Conditions"),
      sliderInput("x0", paste("Initial freq. of Strategy 1"),
                  min = 0.01, max = 0.99, value = 0.8, step = 0.01, width = "100%"),

      div(class = "section-label", "05 / Dynamics"),
      sliderInput("delta", "Selection strength (δ)",
                  min = 0.01, max = 1, value = 0.5, step = 0.01, width = "100%"),
      sliderInput("t_max", "Generations",
                  min = 50, max = 1000, value = 200, step = 50, width = "100%")
    ),

    # ---- MAIN PANEL ----
    div(
      style = "padding: 16px; height: 100%; display: flex; flex-direction: column; gap: 12px;",

      # stat row
      div(class = "stat-row",
          div(class = "stat-box",
              div(class = "stat-label", "Final freq. S1"),
              div(class = "stat-value", style = paste0("color:", COL1),
                  textOutput("final_s1", inline = TRUE))),
          div(class = "stat-box",
              div(class = "stat-label", "Final freq. S2"),
              div(class = "stat-value", style = paste0("color:", COL2),
                  textOutput("final_s2", inline = TRUE))),
          div(class = "stat-box",
              div(class = "stat-label", "Equilibrium type"),
              div(class = "stat-value", style = "font-size:0.82rem",
                  textOutput("eq_type", inline = TRUE))),
          div(class = "stat-box",
              div(class = "stat-label", "Mean fitness (final)"),
              div(class = "stat-value", style = paste0("color:", COLM),
                  textOutput("final_fitness", inline = TRUE)))
      ),

      # plots
      div(class = "plot-area", style = "flex: 1;",
          plotOutput("main_plot", height = "100%")
      )
    )
  )
)

# ------------------------------------------------------------
# SERVER
# ------------------------------------------------------------

server <- function(input, output, session) {

  # Load preset values into inputs
  observeEvent(input$preset, {
    req(input$preset != "Custom")
    p <- presets[[input$preset]]
    updateNumericInput(session, "a11", value = p$A[1,1])
    updateNumericInput(session, "a12", value = p$A[1,2])
    updateNumericInput(session, "a21", value = p$A[2,1])
    updateNumericInput(session, "a22", value = p$A[2,2])
    updateTextInput(session,   "s1_name", value = p$s1)
    updateTextInput(session,   "s2_name", value = p$s2)
  })

  # Matrix labels
  output$col1_label <- renderText({ paste0("vs ", input$s1_name) })
  output$col2_label <- renderText({ paste0("vs ", input$s2_name) })
  output$row1_label <- renderText({ input$s1_name })
  output$row2_label <- renderText({ input$s2_name })

  # Build matrix
  A_mat <- reactive({
    matrix(c(input$a11, input$a12,
             input$a21, input$a22),
           nrow = 2, byrow = TRUE)
  })

  # Run simulation
  sim <- reactive({
    run_simulation(input$x0, A_mat(), input$t_max, input$delta)
  })

  # Stats
  output$final_s1 <- renderText({
    sprintf("%.3f", tail(sim()$freq_1, 1))
  })
  output$final_s2 <- renderText({
    sprintf("%.3f", tail(sim()$freq_2, 1))
  })
  output$final_fitness <- renderText({
    sprintf("%.3f", tail(sim()$f_mean, 1))
  })
  output$eq_type <- renderText({
    f1 <- tail(sim()$freq_1, 1)
    if (f1 > 0.99)       "S1 fixates"
    else if (f1 < 0.01)  "S2 fixates"
    else                  sprintf("interior ~%.2f", f1)
  })

  # Main plot
  output$main_plot <- renderPlot(bg = "#13161f", {
    df  <- sim()
    s1  <- input$s1_name
    s2  <- input$s2_name

    # long format for frequencies
    df_long <- data.frame(
      time     = rep(df$time, 3),
      value    = c(df$freq_1, df$freq_2, df$f_mean),
      variable = rep(c(s1, s2, "Mean fitness"), each = nrow(df))
    )
    df_long$variable <- factor(df_long$variable,
                                levels = c(s1, s2, "Mean fitness"))

    cols <- c(COL1, COL2, COLM)
    names(cols) <- c(s1, s2, "Mean fitness")
    ltys <- c(s1 = "solid", s2 = "solid", "Mean fitness" = "dashed")
    names(ltys) <- c(s1, s2, "Mean fitness")
    sizes <- c(1.4, 1.4, 0.9)
    names(sizes) <- c(s1, s2, "Mean fitness")

    ggplot(df_long, aes(x = time, y = value,
                        colour = variable,
                        linetype = variable,
                        linewidth = variable)) +
      geom_hline(yintercept = c(0, 0.5, 1),
                 colour = "#1e2230", linewidth = 0.4) +
      geom_line() +
      scale_colour_manual(values = cols) +
      scale_linetype_manual(values = c("solid", "solid", "dashed")) +
      scale_linewidth_manual(values = sizes) +
      scale_x_continuous(expand = c(0.01, 0)) +
      scale_y_continuous(limits = c(
        min(0, min(df_long$value)) - 0.05,
        max(1, max(df_long$value)) + 0.05),
        breaks = seq(0, 1, 0.25)) +
      labs(x = "Generation", y = "Frequency / Fitness",
           colour = NULL, linetype = NULL, linewidth = NULL) +
      theme_minimal(base_family = "IBM Plex Mono") +
      theme(
        plot.background    = element_rect(fill = "#13161f", colour = NA),
        panel.background   = element_rect(fill = "#13161f", colour = NA),
        panel.grid.major   = element_line(colour = "#1a1e2e", linewidth = 0.4),
        panel.grid.minor   = element_blank(),
        axis.text          = element_text(colour = "#5a6080", size = 11),
        axis.title         = element_text(colour = "#7a8090", size = 12,
                                          margin = margin(t = 8, r = 8)),
        axis.line          = element_line(colour = "#2a2e42", linewidth = 0.6),
        legend.position    = "bottom",
        legend.background  = element_rect(fill = "#13161f", colour = NA),
        legend.text        = element_text(colour = "#a0a8c0", size = 11,
                                          family = "IBM Plex Mono"),
        legend.key         = element_rect(fill = "#13161f", colour = NA),
        legend.key.width   = unit(2.2, "cm"),
        legend.spacing.x   = unit(0.6, "cm"),
        plot.margin        = margin(16, 24, 8, 16)
      ) +
      guides(linewidth = "none")
  }, res = 110)
}

# ------------------------------------------------------------
# RUN
# ------------------------------------------------------------
shinyApp(ui, server)