Shared Narrow Reflective Equilibrium

extensions [matrix]
globals [
  total-cases
  global-rule
  equilibria-upper-bound
  equilibria-lower-bound
]
turtles-own [
  rule
  accept
  reject
  ignore
  turtle-tolerance
  current-rule
  test-case
  initial-rule
  turtle-cases
  turtle-disposition
]

breed [randos rando]
breed [peelers peeler]
breed [shelvers shelver]
breed [tol-changers tol-changer]
breed [rule-changers rule-changer]

to setup
 clear-all
  ifelse primed? [set total-cases (primed-intuitions (possible-cases rule-length))] [set total-cases (assign-intuitive-random (possible-cases rule-length))]
  ifelse global-shuffle [set total-cases shuffle total-cases] [set total-cases total-cases]
  set global-rule []
  repeat rule-length [set global-rule fput random 2 global-rule]
 crt 10 [
    if agent-type = "randos" [set breed randos]
    if agent-type = "peelers" [set breed peelers]
    if agent-type = "shelvers" [set breed shelvers]
    if agent-type = "tol-changers" [set breed tol-changers]
    if agent-type = "rule-changers" [set breed rule-changers]
    set test-case [] ;; this will be the case that an agent is considering
    ifelse rule-shuffle [set rule shuffle global-rule] [set rule global-rule]
    set current-rule [] ;; distinguishing between the agent's rule and its current rule. This helps avoid accepting changes that should be rejected (and vice versa).
    set accept []
    set reject []
    set ignore []
    set turtle-tolerance tolerance
    set initial-rule rule
    ifelse agent-shuffle [set turtle-cases shuffle total-cases] [set turtle-cases total-cases]
    set turtle-disposition disposition
  ]
  set equilibria-upper-bound upper-bound
  reset-ticks
end 

to-report possible-cases [howbig] ;; universe of possible cases. generates a list of lists of 1's and 0's for a given list size
  let universe [[]]
  repeat howbig [
    let old-u universe
    let new-u []
    while [not empty? old-u] [
      let new-case1 item 0 old-u
      let new-case2 item 0 old-u
      set new-case1 fput 0 new-case1
      set new-case2 fput 1 new-case2
      set new-u fput new-case1 new-u
      set new-u fput new-case2 new-u
      set old-u remove-item 0 old-u
    ]
    set universe new-u
  ]
  report universe
end 

to go
  ask turtles [
    set-rule
    ifelse not empty? turtle-cases [get-case-uni] [get-case-ignore]
    do-test
  ]
  if length reduce sentence [turtle-cases] of turtles = 0 and length reduce sentence [ignore] of turtles = 0 [
    final-measures
    stop]
  tick
end 

to get-case-uni
    set test-case item 0 turtle-cases
    set turtle-cases remove-item 0 turtle-cases
end 

to get-case-ignore
  ifelse not empty? ignore [
    set test-case item 0 ignore
    set ignore remove-item 0 ignore
    set test-case fput "NI" test-case]
  [setxy xcor + .1 ycor + .1] ;; some agents sort their lists before others, and this procedure gives them something to do in case they're waiting for the others
end 

to final-measures
  set equilibria-lower-bound length remove-duplicates [rule] of turtles
  let temp-upper []
  ask turtles [
    let case-thr-pair [ ]
    set case-thr-pair fput turtle-tolerance case-thr-pair
    set case-thr-pair fput current-rule case-thr-pair
    set temp-upper fput case-thr-pair temp-upper
  ]
  set equilibria-upper-bound length remove-duplicates temp-upper
end 

to-report upper-bound ;; convenience reporter for interface plot
  let temp-upper []
  ask turtles [
    let case-thr-pair [ ]
    set case-thr-pair fput turtle-tolerance case-thr-pair
    set case-thr-pair fput current-rule case-thr-pair
    set temp-upper fput case-thr-pair temp-upper
  ]
  report length remove-duplicates temp-upper
end 

;;NI -- not intuitive, IA -- intuitive accept, IR -- intuitive reject

to-report assign-intuitive-random [all-cases]
  let temp []
  let NI-cases []
  let IA-cases []
  let IR-cases []
  foreach all-cases [ ac ->
    let value random 100
    ifelse value >= I-NI-ratio [
      set ac fput "NI" ac
      set NI-cases fput ac NI-cases  ][
      set ac fput one-of ["IA" "IR"] ac
      ifelse item 0 ac = "IA" [set IA-cases fput ac IA-cases][set IR-cases fput ac IR-cases]
    ]
  ]
     report reduce sentence (list IA-cases NI-cases IR-cases)
end 

to-report primed-intuitions [all-cases] ;; strategy is to generate a list of intuition labels and then assign them to strings meeting particular conditions
  let temp []
  let tempIA []
  let tempIR []
  let tempNI []
  repeat round ((I-NI-ratio / 100) * (2 ^ rule-length)) / 2 [set tempIA fput "IA" tempIA] ;; IA's to assign
  repeat round ((I-NI-ratio / 100) * (2 ^ rule-length)) / 2 [set tempIR fput "IR" tempIR] ;; IR's to assign
  let tl (length tempIA + length tempIR)
  repeat (2 ^ rule-length) - tl [set tempNI fput "NI" tempNI] ;; NI's to assign
  let subIA [] ;; to pick out strings to be tagged as IA
  repeat cond [set subIA lput 1 subIA]
  let subIR [] ;; to pick out strings to be tagged as IR
  repeat cond [set subIR lput 0 subIR]
  foreach all-cases [ac ->
    if (subIA = (sublist ac (length ac - cond) (length ac))) and not empty? tempIA [set ac fput "IA" ac set tempIA but-first tempIA]
    if (subIR = (sublist ac (length ac - cond) (length ac))) and not empty? tempIR [set ac fput "IR" ac set tempIR but-first tempIR]
    if item 0 ac != "IR" and item 0 ac != "IA" [set ac fput "NI" ac ]
    set temp fput ac temp]
  report temp
end 

to set-rule
  set current-rule rule
end 

to do-test
    ifelse ((item 0 test-case) = "NI") [check-non-intuitive-case ] [check-intuitive-case]
end 

to-report matchy-matchy [r c]
  let z (map [[i j] -> i = j] r c) ;; get matches between rule and case
  report (length (filter [i -> i = true] z) / length r) ;; how many matches out of total number of possible matches
end 

to check-non-intuitive-case
  ifelse matchy-matchy current-rule but-first test-case >= (1 - turtle-tolerance) [
    set accept fput test-case accept  ] [
    set reject fput test-case reject  ] ;;accept or reject relative to tolerance
end 

to check-intuitive-case
ifelse item 0 test-case = "IA"[
    ifelse matchy-matchy current-rule but-first test-case >= (1 - turtle-tolerance) [set accept fput test-case accept ] [ deliberate ]
  ]
  [
    ifelse matchy-matchy current-rule but-first test-case >= (1 - turtle-tolerance) [deliberate ] [ set reject fput test-case reject ]
  ]
end 

to deliberate
  if breed = peelers [ ifelse random 100 < turtle-disposition  [ peel ] [ pick-one ] ]
  if breed = shelvers [ ifelse random 100 < turtle-disposition [ do-ignore ] [pick-one ] ]
  if breed = tol-changers [ ifelse random 100 < turtle-disposition [ change-tolerance ] [ pick-one ] ]
  if breed = rule-changers [ ifelse random 100 < turtle-disposition [ change-rule ] [ pick-one] ]
  if breed = randos [ pick-one ]
end 

to peel
  set test-case but-first test-case
  set test-case fput "NI" test-case
  check-non-intuitive-case
end 

to do-ignore
  set ignore fput but-first test-case ignore
end 

to change-tolerance
  ifelse item 0 test-case = "IA" [
    let needed-tol precision (1 - (matchy-matchy current-rule but-first test-case)) 4 ;; this is the turtle-tolerance needed to accept the test case.
    let temp-reject item 1 (check-cases reject current-rule needed-tol) ;; these are the cases from the reject bin that are still rejected with the new tolerance level
    ifelse length temp-reject = length reject [ ;; if these lists are the same length
      set turtle-tolerance needed-tol ;; change the tolerance to the needed tolerance
      set accept fput test-case accept] [
      set ignore fput but-first test-case ignore ]
  ][
    let needed-tol precision ((1 - (matchy-matchy current-rule but-first test-case)) - 0.01) 4
    let temp-accept item 0 (check-cases accept current-rule needed-tol)
    ifelse length temp-accept = length accept [
      set turtle-tolerance needed-tol
      set reject fput test-case reject] [
      set ignore fput but-first test-case ignore ]
]
  if turtle-tolerance < 0 [set turtle-tolerance 0]
  if turtle-tolerance > 1 [set turtle-tolerance 1]
end 

to change-rule;; strategy is to find how many sites need changing and then choosing sites to be changed
  let gap precision ((1 - turtle-tolerance) - (matchy-matchy but-first test-case rule)) 2 ;; find the gap between my threshold and the rule/case match.
  let needs-changing 0
  ifelse gap > 0 [ set needs-changing ceiling (length current-rule * gap)] [set needs-changing abs (floor (length current-rule * gap) - 1)] ;; identifies number of sites needing changing
  ifelse item 0 test-case = "IA" [
    let a current-rule
    let b but-first test-case
    let zz (map [[i j] -> i = j] a b ) ;; find where there are matches and misses
    let locations list-locations false zz  ;; get the indices of the misses
    let spot []
    if needs-changing > length locations [set needs-changing length locations]
    ifelse coordinated-change [set spot sublist locations 0 needs-changing] [set spot up-to-n-of needs-changing locations] ;; set places to change the rule
    foreach spot [s ->
      ifelse item s current-rule = 0 [
        set current-rule remove-item s current-rule
        set current-rule insert-item s current-rule 1 ] [
        set current-rule remove-item s current-rule
        set current-rule insert-item s current-rule 0]
    ]
    let temp-accept item 0 (check-cases accept current-rule turtle-tolerance) ;; these are the cases from the accept bin that are still accepted with the new rule
    ifelse length temp-accept = length accept [ ;; if these lists are the same length
      set rule current-rule
      set accept fput test-case accept] [
      set ignore fput but-first test-case ignore ]
  ]
  [
    let a current-rule
    let b but-first test-case
    let zz (map [[i j] -> i = j] a b ) ;; find where there's no match
    let locations list-locations true zz  ;; get the indices of the matches
    let spot []
    if needs-changing > length locations [set needs-changing length locations]
    ifelse coordinated-change [set spot sublist locations 0 needs-changing] [set spot up-to-n-of needs-changing locations]
    foreach spot [s ->
      ifelse item s current-rule = 0 [
        set current-rule remove-item s current-rule
        set current-rule insert-item s current-rule 1 ] [
        set current-rule remove-item s current-rule
        set current-rule insert-item s current-rule 0]
    ]
    let temp-reject item 1 (check-cases reject current-rule turtle-tolerance)
    ifelse length temp-reject = length reject [
      set rule current-rule
      set reject fput test-case reject] [
      set ignore fput but-first test-case ignore ]

  ]
end 

to pick-one
  let p random 4
  if p = 0 [ifelse breed != peelers [ peel ] [pick-one]]
  if p = 1 [ifelse breed != shelvers [ do-ignore] [pick-one]]
  if p = 2 [ifelse breed != tol-changers [ change-tolerance ] [pick-one]]
  if p = 3 [ifelse breed != rule-changers [ change-rule] [pick-one]]
end 

to-report hammy-matrix [h-list] ;; given a list of list of 0/1's, converts to
 ;; matrix with each cell specifying the hammy-distance, where 0 is least similar, and 1 is most similar
  let l length h-list
  let m matrix:make-constant l l 9
  let i 0
  repeat l [
    let j l - i
    let r (range (l - j) l)
    foreach r [ k ->
      let case-i item i h-list
      let case-k item k h-list
      set case-i butfirst case-i ;; this strips the "I" or "NI" marker at the beginning of the case
      set case-k butfirst case-k
      let cell-value matchy-matchy case-i case-k
      matrix:set m i k cell-value
    ]
    set i i + 1
  ]
  report m
end 

to-report width-of-case-list [c-list] ;;finds the min value in a hammy-matrix, which represents the least similarity between two cases
  let m "empty"
  if not empty? c-list [
    set m min reduce sentence matrix:to-row-list hammy-matrix c-list
  ]
  report m
end 

to-report similarity-to-rule [r-rule c-list]
  let d [];;this will be the list of similarity distances between the rule and the cases, where 1 is perfect similarity and 0 is least
  let l length c-list
  let i 0
  repeat l [
    let case-i item i c-list
    set case-i butfirst case-i
    let v matchy-matchy r-rule case-i
    set d lput v d
    set i i + 1
  ]
  report d
end 

to-report rule-case-similarity
  let l []
  foreach (range 0 count turtles) [r ->
    let temp []
    set temp similarity-to-rule [rule] of turtle r [accept] of turtle r
    set l lput temp l]
  report l
end 

to-report accept-width-turtles
  let awl []
  set awl map width-of-case-list [accept] of turtles
  report awl
end 

to-report check-cases [list-of-list turt-rule turt-tol]
  let temp-accept []
  let temp-reject []
    foreach list-of-list [ a ->
      ifelse matchy-matchy turt-rule (but-first a) >= (1 - turt-tol) [
        set temp-accept lput a temp-accept  ] [
        set temp-reject lput a temp-reject
      ]
    ]
  report (list temp-accept temp-reject)
end 

to-report list-locations [an-item a-list]
  let temp []
   foreach (range 0 length a-list) [i ->
    if item i a-list = an-item [
      set temp lput i temp ]]
  report temp
end