Baby-sitting co-op

;; A parameterized model of the Capital Hill Baby-Sitting Co-op
;; Copyright (C) 2015 Russ Abbott
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but 
;; WITHOUT ANY WARRANTY; without even the implied warranty of 
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License (http://www.gnu.org/licenses/) for more details.

turtles-own [ 
  scrip 
  
  scrip-needed
  want-sitter? 
  
  want-to-go-out? 
  enough-scrip? 
  going-out? 
  
  want-to-sit? 
  sitting? 
]

globals [ 
  aggregated-hours-out cycle-pos frustrated-want-sitter frustrated-want-to-sit going-out# 
  max-gini max-scrip my-ticks no-sitter# no-sitting-jobs# not-enough-scrip# quiet-evening# 
  sitting# sitting-as-1st-choice# sitting-as-2nd-choice# stop-run? total-hours-out 
  total-scrip want-sitter# want-to-go-out# want-to-sit# 
]

extensions [ array table ]

;;;;;;;;;;;;;;;;;;;;;

to setup
  clear-all
  create-co-op
  set aggregated-hours-out table:make
  set total-hours-out 0
  set max-scrip 0
  ;; set monthly-dues 1
  set frustrated-want-sitter no-turtles
  set frustrated-want-to-sit no-turtles
  set stop-run? false
  reset-ticks  
end 

;;;;;;;;;;;;;;;;;;;;;

to go
  reset-turtles
  ;; my-ticks is used as a settable proxy for ticks for testing
  set my-ticks ticks
  set cycle-pos (sin ( my-ticks mod 360 )) * cycle-amplitude ;; Uses a 360 day year. 
  plan-evening
  match-sitees-and-sitters
  if clear-sitter-market? [ clear-sitter-market ]
  check-consistency
  set total-scrip sum [scrip] of turtles
  let max-scrip-now max [scrip] of turtles
  set max-scrip ceiling maxi max-scrip max-scrip-now
  ;; a gross approximation of the GINI constant. It is always very low and not very useful
  let gini ifelse-value (total-scrip = 0) [0] [(max-scrip-now / total-scrip) - (1 / co-op-size)]
  set max-gini maxi max-gini gini
  tick
  ;; should the central bank adjust the monthy dues?
  if auto-adjust [ set-monthly-dues ]
  if ticks mod 12 = 0 [ ask turtles [ set scrip scrip - monthly-dues ] ]
  ;; stop-run is set to true if an internal inconsistency is noticed
  if ticks >= 365 * years or stop-run? [stop]
end 

;;;;;;;;;;;;;;;;;;;;; 

;; Performs no model function. Checks the consistency of the values computed. 
;; Essentially a continual regression test.

to check-consistency
  set frustrated-want-sitter turtles with [ want-sitter? and not going-out? and not sitting? ]
  set frustrated-want-to-sit turtles with [ want-to-sit? and not sitting? ]
  if count frustrated-want-sitter > 0 and count frustrated-want-to-sit > 0 [
    show word "No sitters: " frustrated-want-sitter 
    show word "Available sitters: " frustrated-want-to-sit 
    set stop-run? true
  ]

  set want-sitter# count turtles with [want-sitter?]
  set want-to-sit# count turtles with [want-to-sit?]
  set quiet-evening# count turtles with [not want-sitter? and not want-to-sit?]
  if want-sitter# + want-to-sit# + quiet-evening# != co-op-size [
    show "want-sitter# + want-to-sit# + quiet-evening# != co-op-size failed"
    set stop-run? true
  ]

  set want-to-go-out# count turtles with [want-to-go-out?]
  set not-enough-scrip# count turtles with [want-to-go-out? and not enough-scrip?]
  if  want-sitter# + not-enough-scrip# != want-to-go-out# [
    show "want-sitter# + not-enough-scrip# != want-to-go-out# failed"
    set stop-run? true
  ]
  
  set going-out# count turtles with [ going-out? ]
  set no-sitter# count frustrated-want-sitter
  set sitting-as-2nd-choice# count turtles with [ want-sitter? and sitting? ]
  
  if going-out# + no-sitter# + sitting-as-2nd-choice# != want-sitter# [
    show "want-to-go-out# - not-enough-scrip# != want-sitter# failed"
    set stop-run? true
  ]
  
  set sitting-as-1st-choice# count turtles with [ want-to-sit? and sitting? ]
  set no-sitting-jobs# count frustrated-want-to-sit
  if sitting-as-1st-choice# + no-sitting-jobs# != want-to-sit# [
    show "sitting-as-first-choice# + no-sitting-jobs# != want-to-sit# failed"
    set stop-run? true
  ]
  
  set sitting# count turtles with [ sitting? ]
  if not multiple-sitees? and going-out# != sitting# [
    show "going-out# = sitting# failed"
    set stop-run? true
  ]
end 

;; If more members want to go out than sit, the extras sit for each other if they are willing.

to clear-sitter-market 
  ;; Don't look at turtles that just want-to-go-out. They may not have enough scrip, 
  ;; in which case they were already asked if they want to sit.
  ;; uncleared-turtles are those who can't find sitters through the first step of the planning process.
  let uncleared-turtles turtles with [ want-sitter? and not going-out? ] 
  
  ;; sitters-set are willing to sit
  let sitters-set uncleared-turtles with [ random-probability < willing-to-sit? ]
  
  ;; sittees is a list unwilling to sit
  let sittees [ self ] of uncleared-turtles with [ not member? self sitters-set ]
  
  ;; sitters is a list willing to sit. It's just a copy of sitter-set.
  let sitters [ self ] of sitters-set    ;; [self] of  turns the AgentSet into a List

  if-else length sitters > length sittees [
    set sitters n-of length sittees sitters 
  ] [
    set sittees n-of length sitters sittees 
  ]
  (foreach sittees sitters [ pay-sitter ?1 ?2 "clear-sitters1" ] )
  
  ;; Any sitters left over can sit for each other.
  let extra-sitters [ self ] of sitters-set with [ not sitting? ]
  set sittees n-of ((length extra-sitters) / 2) extra-sitters
  set sitters n-of length sittees filter [not member? ? sittees] extra-sitters 
  (foreach sittees sitters [ pay-sitter ?1 ?2 "clear-sitters2" ] )  
end 

to create-co-op
  create-turtles co-op-size [ 
    set scrip initial-scrip 
    set hidden? true
  ] 
  reset-turtles
end 

;; Determine the time this member will go out this day.

to-report get-event-length  
  if random-probability > get-want-to-go-out-probability [ report 0 ]
  if hours-out-distribution = "uniform"      [ report (random (mean-hours-out + mean-hours-out / 2)) + 1 ]
  if hours-out-distribution = "poisson"      [ report (random-poisson (mean-hours-out - 1)) + 1 ] 
  if hours-out-distribution = "none"         [ report mean-hours-out ] 
end 

;; Determine the probability that this member wants to go out

to-report get-want-to-go-out-probability
  report seasonally-adjusted-prob (mini percent-of-desired-times-out-reserve want-to-go-out-probability) cycle-pos
end 

;; Determine the probability that this member wants to sit

to-report get-want-to-sit-probability
  report seasonally-adjusted-prob (maxi (1 - percent-of-desired-times-out-reserve) want-to-sit-probability) ((-1) * cycle-pos)
end 

;; Used to keep track of the distribution of event lengths

to increment-table [ table instance ]
  let current-value ifelse-value table:has-key? table instance [table:get table instance] [0]
  table:put table instance current-value + 1
end 

;; By this time the members have want-sitter or want-to-sit set of they want to go out or want to sit

to match-sitees-and-sitters
  let want-sitters [self] of turtles with [ want-sitter? ]
  let available-sitters [self] of turtles with [ want-to-sit? ]
  if length want-sitters < length available-sitters [ set available-sitters n-of length want-sitters available-sitters ]
  if length want-sitters > length available-sitters [ 
    if-else multiple-sitees? and length available-sitters > 0 [
      set available-sitters repeat-to available-sitters length want-sitters
    ]
    [ set want-sitters n-of length available-sitters want-sitters ]
  ]
  ( foreach want-sitters available-sitters [ pay-sitter ?1 ?2  "match-sitees-and-sitters" ] )
end 

;; max with 2 parameters

to-report maxi [a b]
  report max list a b
end 

;; min with 2 parameters

to-report mini [a b]
  report min list a b
end 

;; transfer scrip from sittee to sitter. 

to pay-sitter [sittee sitter source] 
  if [going-out?] of sittee [ show (sentence source " " sittee " sittee going out twice")   set stop-run? true ]  
  if [sitting?]   of sittee [ show (sentence source " " sittee " sittee already sitting")   set stop-run? true]  
  if [going-out?] of sitter [ show (sentence source " " sitter " sitter already going out") set stop-run? true ]  
  if not multiple-sitees? and 
     [sitting?]   of sitter [ show (sentence source " " sitter " sitter sitting twice ")    set stop-run? true ] 
     
  let payment [scrip-needed] of sittee
  ask sittee [
    set scrip scrip - payment
    set going-out? true
  ]
  ask sitter [ 
    set scrip scrip + payment
    set sitting? true
    set total-hours-out total-hours-out + payment
  ]
end 

;; Append the list xs to itself until the total length is = n

to-report repeat-to [xs n]
  if-else length xs < n [ report repeat-to sentence xs xs n ] [ report n-of n xs ]
end 

;; Returns the percent of the desired times-out reserve this member has in scrip
;; The desired times-out reserve is the number of times the member can afford to 
;; go out without additional sitting

to-report percent-of-desired-times-out-reserve  
  report ifelse-value (desired-times-out-reserve = 0)  [ 1 ]
;    ifelse-value (scrip <= 0) [0] [1] 
;  ] 
  [ percent-of-limit scrip mean-hours-out * desired-times-out-reserve ]  ;;[ mini 1 maxi 0 ( scrip / ( mean-hours-out * desired-times-out-reserve ) ) ]
end 

;; Amount is what percent of limit. Constrain result to be between 0 and 1.

to-report percent-of-limit [amount limit]
  report mini 1 maxi 0 ( amount / limit ) 
end 

;; Determine what, if anything each member wants to do and set their flags accordingly

to plan-evening
  ask turtles [
    let hours-out-wanted get-event-length
    if hours-out-wanted > 0 [ increment-table aggregated-hours-out hours-out-wanted ]
    ;; In this model each unit of scrip buys a full hour of sitting. In the original
    ;; each unit bought half an hour.
    set scrip-needed hours-out-wanted   
    ;; scrip-needed = 0 indicates that the member doesn't want to go out. 
    if scrip-needed > 0 [ 
      set want-to-go-out? true
      ;; can go out only if member posesses enough scrip
      if scrip >= scrip-needed [ set want-sitter? true set enough-scrip? true ]
    ] 
    ;; Member who don't want to go out or don't have enough scrip are asked if they want to sit.
    set want-to-sit? not want-sitter? and random-probability < get-want-to-sit-probability  
  ]
end 

;; Plots the hours-out histogram

to plot-table-as-percentages [tab]
  let pct-list table-as-pct-list tab
  if length pct-list > 0 [ 
    plot-pen-reset  ;; erase what we plotted before   
    let keys table:keys tab
    set-plot-x-range min keys - 1 (max keys + 1)
    set-plot-y-range 0 ceiling max pct-list + 1
    ;; Not clear why fput 0 is needed. If not done, first value is not plotted.
    ;; With it, the extra initial zero is not plotted.
    foreach fput 0 pct-list plot
  ]
end 

;; All NetLogo arithmetic is done if floating point.

to-report random-probability
  report (random 100) / 100
end 

;; Unset all flags

to reset-turtles
  ask turtles [ 
    set going-out? false
    set enough-scrip? false
    set sitting? false
    set want-sitter? false
    set want-to-go-out? false  
    set want-to-sit? false 
  ]
end 

;; Adjust want-to-go-out and want-to-sit for the season.
;; If aren't using seasons, cycle-p will be 0 and no change will occur.
;; Otherwise increase toward 1 or decrease toward 0 the input probability
;; based on the cycle value.

to-report seasonally-adjusted-prob [p cycle-p]
  let diff ifelse-value (cycle-p > 0) [1 - p] [
    ifelse-value (cycle-p = 0) [0] [p]]
  report p + diff * cycle-p
end 

;; Sets the monthly dues to control the money supply

to set-monthly-dues
  if no-sitting-jobs# > max-no-sitting [set monthly-dues -0.3]
  if no-sitting-jobs# < min-no-sitting [set monthly-dues 0.6]
end 

;; Converts a table into an array of percentages to make a histogram.
;; Requires that the keys of the table be integers. 
;; They become the indices of an array in which the corresponding values are stored
;; Then a list is created and returned with each value replaced by its pct (0 to 100) of the sum of all values

to-report table-as-pct-list [tab]
  let keys table:keys tab   ;; The keys are the indices of the array/list (zero-based). (max keys) is the index of the last element.
  if length keys = 0 [ report [ ] ]
  let min-key min keys
  let arr array:from-list n-values (1 + max keys - min-key) [0]  
  foreach keys [array:set arr (? - min-key) table:get tab ?]
  let list-arr array:to-list arr
  let sum-of-elements sum list-arr  ;; Compute the sum only once
  report map [ round ( 100 * ? / sum-of-elements ) ] list-arr
end