Simple_Demographic_and_Fiscal_Dynamics

breed [people person]
people-own [
  age
  partner-id
  generation
  gen-id
  salary
  tax
  pension
  child-allowance
]

globals [
  num-children
  num-adults
  num-seniors
  num-births-this-month
  num-deaths-this-month-based-on-probability
  generation-id-map

  total-child-allowance
  total-tax-revenue
  total-pension
  net-balance

  hazard-center-x
  hazard-center-y
  hazard-radius
  hazard-start-tick
  hazard-deaths-this-month

  num-deaths-this-month
  num-no-income-adults
  num-mid-income-adults
  num-high-income-adults
]

to setup
  clear-all
  set-default-shape people "person"

  set generation-id-map [[1 1]]  ; start generation 1 at ID 1

  ; Children
  create-people Child_0_to_12_Years [
    set age random-float 13
    set color blue
    setxy random-xcor random-ycor
    set partner-id nobody
    set generation 1
    set gen-id update-generation-id generation
    set child-allowance child-allowance-per-child
    set salary 0
    set tax 0
    set pension 0
    set num-children Child_0_to_12_Years
  ]

  ; Adults
  create-people Adult_13_to_59_Years [
    set age 13 + random-float 45 ; age gap is provided for age conversion
    set color green
    setxy random-xcor random-ycor
    set partner-id nobody
    set generation 1
    set gen-id update-generation-id generation

    ; No child allowance for adults
    set child-allowance 0

    ; Assign salary & tax
    let income-type random-float 1

    if income-type < 0.01 [
      set salary 0
    ]
    if income-type >= 0.01 and income-type < 0.96 [
      set salary random 2501 + 1500
    ]
    if income-type >= 0.96 [
      set salary random 7001 + 8000
    ]
    if salary = 0 [
      set tax 0
    ]
    if salary > 0 and salary <= 4000 [
      set tax salary * tax-percentage-income-less-than-4000 / 100
    ]
    if salary > 4000 [
      set tax salary * tax-percentage-income-higher-than-4000 / 100
    ]
    set pension 0
    set num-adults Adult_13_to_59_Years
  ]

  ; Seniors
  create-people Senior_60_plus_Years [
    set age 60 + random-float 39 ; age gap is provided for age conversion
    set color orange
    setxy random-xcor random-ycor
    set partner-id nobody
    set generation 1
    set gen-id update-generation-id generation

    set child-allowance 0
    set salary 0
    set tax 0
    set pension random 1001 + 500  ; sample average pension
    set num-seniors Senior_60_plus_Years
  ]

  ; Labels (conditionally display)
  ifelse show-id [
    ask people [
      ifelse partner-id != nobody and member? partner-id [who] of people [
        let partner turtle partner-id
        ifelse [partner-id] of partner = who [
          set label (word gen-id " → " [gen-id] of partner " | " generation)
        ] [
          set label (word gen-id " | " generation)
          set partner-id nobody
        ]
      ] [
        set label (word gen-id " | " generation)
      ]
    ]
  ] [
    ask people [ set label "" ]
  ]

  set num-births-this-month 0
  set num-deaths-this-month 0
  set hazard-deaths-this-month 0
  set num-deaths-this-month-based-on-probability 0
  set num-no-income-adults count people with [age >= 13 and age < 60 and salary = 0]
  set num-mid-income-adults count people with [age >= 13 and age < 60 and salary > 0 and salary <= 4000]
  set num-high-income-adults count people with [age >= 13 and age < 60 and salary >= 8000]

  ; Update government totals
  ; Fiscal flow and surplus are calculated per month (not cumulative across ticks)
  set total-child-allowance sum [child-allowance] of people
  set total-tax-revenue sum [tax] of people
  set total-pension sum [pension] of people
  set net-balance total-tax-revenue - total-pension - total-child-allowance
  reset-ticks
end 

to go
  if not any? people [ stop ]

  ; Labels (conditionally display)
  ifelse show-id [
    ask people [
      ifelse partner-id != nobody and member? partner-id [who] of people [
        let partner turtle partner-id
        ifelse [partner-id] of partner = who [
          set label (word gen-id " → " [gen-id] of partner " | " generation)
        ] [
          set label (word gen-id " | " generation)
          set partner-id nobody
        ]
      ] [
        set label (word gen-id " | " generation)
      ]
    ]
  ] [
    ask people [ set label "" ]
  ]

  ; Age update and lifecycle transitions
  ask people [
    set age age + 1 / 12

    ; Update color by age
    ifelse age < 13 [ set color blue ]
    [ ifelse age < 60 [ set color green ] [ set color orange ] ]

    ; Transition from child to adult
    if age >= 13 and age < 13 + 1 / 12 [
      set child-allowance 0

      let income-type random-float 1

      if income-type < 0.01 [
        set salary 0
      ]
      if income-type >= 0.01 and income-type < 0.96 [
        set salary random 2501 + 1500
      ]
      if income-type >= 0.96 [
        set salary random 7001 + 8000
      ]

      if salary = 0 [
        set tax 0
      ]
      if salary > 0 and salary <= 4000 [
        set tax salary * tax-percentage-income-less-than-4000 / 100
      ]
      if salary > 4000 [
        set tax salary * tax-percentage-income-higher-than-4000 / 100
      ]
    ]

    ; Transition from adult to senior
    if age >= 60 and age < 60 + 1 / 12 [
      set pension salary * pension-percentage / 100
      set salary 0
      set tax 0
    ]
  ]

  ask people with [partner-id != nobody] [
  if not member? partner-id [who] of people [
    set partner-id nobody
  ]
  ]

  ; Pair up unpartnered fertile adults of the same generation
  let unpartnered people with [
    age >= marriage-minimum-age and age <= marriage-maximum-age and partner-id = nobody
  ]

  let shuffled shuffle sort unpartnered
  let pair-count floor (length shuffled / 2)

  repeat pair-count [
    let a1 item 0 shuffled
    let a2 item 1 shuffled

    ; Remove them from pool now to avoid reuse
    set shuffled remove a1 shuffled
    set shuffled remove a2 shuffled

    ; Only allow same-generation pairing
    if ([generation] of a1 = [generation] of a2) and
    ([partner-id] of a1 = nobody) and
    ([partner-id] of a2 = nobody) [
      ask a1 [ set partner-id [who] of a2 ]
      ask a2 [ set partner-id [who] of a1 ]
    ]
  ]

  ; === Births ===
  set num-births-this-month 0
  let birth-count 0

  ask people with [partner-id != nobody and age >= fertility-minimum-age and age <= fertility-maximum-age] [
    let mate turtle partner-id
    if mate != nobody and [partner-id] of mate = who [
      if [age] of mate >= fertility-minimum-age and [age] of mate <= fertility-maximum-age [
        if random-float 1 < birth-probability [
          set birth-count birth-count + 1
        ]
      ]
    ]
  ]

  create-people birth-count [
    set age 0
    set color blue
    setxy random-xcor random-ycor
    set partner-id nobody

    ; Generation and ID logic
    let parent one-of people with [
      partner-id != nobody and age >= fertility-minimum-age and age <= fertility-maximum-age
    ]
    ifelse parent != nobody [
      set generation [generation] of parent + 1
    ][
      set generation 1
    ]
    set gen-id update-generation-id generation
    set child-allowance child-allowance-per-child
  ]

  set num-births-this-month birth-count

  ; === Deaths ===
  set num-deaths-this-month-based-on-probability 0
  ask people [
    if (age < 13 and random-float 1 < child-death-probability) or
       (age >= 13 and age < 60 and random-float 1 < adult-death-probability) or
       (age >= 60 and random-float 1 < senior-death-probability) or
       (age >= 100) [
      set num-deaths-this-month-based-on-probability num-deaths-this-month-based-on-probability + 1
      die
    ]
  ]

  if ticks mod 120 = 0 [
    ; Create a new hazard zone
    set hazard-center-x random-xcor
    set hazard-center-y random-ycor
    set hazard-radius 5 + random 5  ; radius between 5 and 10
    set hazard-start-tick ticks
  ]

  set hazard-deaths-this-month 0  ; at start of go

  if hazard-death and ticks = hazard-start-tick + 12 [
    let dying-people people with [distancexy hazard-center-x hazard-center-y <= hazard-radius]
    set hazard-deaths-this-month count dying-people
    ask dying-people [ die ]
  ]

  ask patches [
    let dist distancexy hazard-center-x hazard-center-y
    if abs (ticks - hazard-start-tick) < 12 and dist <= hazard-radius [
      ; Create smooth gradient: red at center to white at edge
      let norm-dist dist / hazard-radius  ; 0 at center, 1 at edge
      set pcolor scale-color red (1 - norm-dist) 0 1
    ]
    if ticks - hazard-start-tick >= 12 [
      set pcolor black  ; reset after hazard ends
    ]
  ]

  set num-deaths-this-month hazard-deaths-this-month + num-deaths-this-month-based-on-probability

  ; Count by group
  set num-children count people with [age < 13]
  set num-adults   count people with [age >= 13 and age < 60]
  set num-seniors  count people with [age >= 60]

  set num-no-income-adults count people with [age >= 13 and age < 60 and salary = 0]
  set num-mid-income-adults count people with [age >= 13 and age < 60 and salary > 0 and salary <= 4000]
  set num-high-income-adults count people with [age >= 13 and age < 60 and salary >= 8000]

  ; Update government totals
  ; Fiscal flow and surplus are calculated per month (not cumulative across ticks)
  set total-child-allowance sum [child-allowance] of people
  set total-tax-revenue sum [tax] of people
  set total-pension sum [pension] of people
  set net-balance total-tax-revenue - total-pension - total-child-allowance

  tick
end 

to-report update-generation-id [gen]
  let next-id 1
  let found? false
  let new-map []

  ; Scan existing generation-id-map
  foreach generation-id-map [
    gen-pair ->
    ifelse item 0 gen-pair = gen [
      set next-id item 1 gen-pair
      set new-map lput (list gen (next-id + 1)) new-map
      set found? true
    ]
    [ set new-map lput gen-pair new-map ]
  ]

  ; If generation was new, initialize it
  if not found? [
    set new-map lput (list gen 2) new-map
    set next-id 1
  ]

  set generation-id-map new-map
  report next-id
end