Epistemic Playground

  ;; all possible worlds
breed [worlds world]
worlds-own [ name prims phi ]

breed [epiagents epiagent]

epiagents-own [ awareset awaremaxops];;the formulae of which the agent is aware as a predicate

undirected-link-breed [access-links access-link]
access-links-own [ access-to ]

globals [ w;; current world
  s ;;user predicate to evaluate
  line ;;in s, for error messages
  col ;; in s, for error messages
  pos ;; in s, for error messages      "
  current-t ;;
  operatorStack ;;stack of ops for Stack-yard algorithm
  outputQueue ;;output queue for Stack-yard algorithm
  outputTree ;; holds AST while building
  parsed ;; holds the parsed expression
  models
  epi-op-list
;;model - from i
]

to setup
  clear-all
  clear-output

  set epi-op-list "ABKL"

  set-default-shape turtles "circle"
  create-epiagents 1 [
    set label "Alice"
    hide-turtle
    set awaremaxops 50
  ]

  create-epiagents 1 [
    set label "Bob"
    hide-turtle
    set awaremaxops 2
  ]

  create-ordered-worlds 1 [
    set name "w"
    set prims ["ta" "tb"]; all prims true in world w
  ]
  create-ordered-worlds 1 [
    set name "v"
    set prims ["ta"]
  ]
;  create-ordered-worlds 1 [
;    set name "vprime"
;    set prims ["ta"]
;  ]
;  create-ordered-worlds 1 [
;    set name "uprime"
;    set prims []
;  ]
  create-ordered-worlds 1 [
    set name "u"
    set prims []
  ]
  create-ordered-worlds 1 [
    set name "s"
    set prims ["tb"]
  ]

ask worlds [
    set label (word name ", {" prims "}")
  ]

  ;;set up agents
  setup-alice
  setup-bob

;  layout-circle worlds 10
; layout-radial worlds access-links (turtle 0)
  repeat 60 [ layout-spring worlds access-links 0.3 15 5 ] ;; lays the nodes in a triangle

  reset-ticks
end 

to go
  set line 1
  set col 1
  set pos 0
  set current-t ""


  set s user-phi; s is the global variable that is parsed
  let world-turtle one-of worlds with [name = current-world]; current world is where the pred is evaluated
  ask worlds [set color grey]
  ask world-turtle [ set color blue ]

  output-type "Eval: " output-type current-world output-type ", phi: " output-type user-phi output-type " |= "
  output-type eval current-world
  output-print ""
end 

to setup-alice
  linkup "Alice" "w" "v"
  linkup "Alice" "s" "u"
end 

to setup-bob
  linkup "Bob" "w" "s"
  linkup "Bob" "v" "u"
  linkup "Bob" "w" "v"
;  linkup "Bob" "v" "vprime"
;  linkup "Bob" "v" "uprime"
;  linkup "Bob" "u" "vprime"
;  linkup "Bob" "u" "uprime"
;  linkup "Bob" "vprime" "uprime"
end 

;;agent setup
;;linkup a s d agent a  from source to destination

to linkup [ agentid source dest ]
  let w1 one-of worlds with [name = source]
  let w2 one-of worlds with [name = dest]
  ask w1 [create-access-link-with w2 [
    set access-to ""
    set thickness 0.1
    ]
  ]
  ask w1 [ ask access-link-with w2
    [ set access-to (word access-to ifelse-value access-to = "" [""][", "] agentid)
      set label access-to
    ]
  ];; if link already exists add this agent to those already there
end 

;;evaluation of constructed AST

to-report eval [wld]
  let current-wld one-of worlds with [name = wld]
  let result eval-AST [] current-wld first parse
  report result
end 

to-report eval-AST [ M wld tree ]
  debug (word "Eval-AST called with params: " M ", " [name] of wld ", " tree ".")
  let typ-n index "type" tree; type typ-n
  let val-n index "value" tree; type val-n
  (ifelse
    typ-n = "bool-tok" [ report val-n = "T" ]
    typ-n = "prim-tok" [ report member? val-n [prims] of wld ]
    typ-n = "op-tok" and val-n = "not"  [
      report not (eval-AST M wld index "arg1" tree)
    ]
    typ-n = "op-tok" and val-n = "and"  [
      let arg1 (eval-AST M wld index "arg1" tree)
      let arg2 (eval-AST M wld index "arg2" tree)
      report arg1 and arg2]
    typ-n = "op-tok" and val-n = "or"  [
      let arg1 (eval-AST M wld index "arg1" tree)
      let arg2 (eval-AST M wld index "arg2" tree)
      report arg1 or arg2]
    typ-n = "op-tok" and val-n = "impl"  [
      let arg1 (eval-AST M wld index "arg1" tree)
      let arg2 (eval-AST M wld index "arg2" tree)
      report (not arg1) or arg2]
    typ-n = "epi-op-tok"  [
      let arg index "arg1" tree debug (word "Predicate: " arg ".")
      let epi-op first val-n debug (word "Epi-op: " epi-op ".")
      let agentID but-first val-n debug (word "Agent: " agentID ".")
      (ifelse
;;original        model = "Traditional (Kripke, K)" [report reduce and map [ l -> eval-AST M l arg] (accessible2agent-reflexive agentID wld)]
        model = "Traditional (Kripke, K)" [report eval-AST-Kripke epi-op M arg agentID wld]
        model = "Levesque (B, L)" [report true]
        model = "Awareness (A, B, L)"  [report eval-AST-Awareness epi-op M arg agentID wld]
        model = "General Awareness (A, B, L)"  [report true]
        model = "Local (B, L)"  [report true]
        model = "Timed (?, ?)"  [report true]
        [croak (word "model" model "not found.")]
      )
    ]
    [ croak sentence "Node not recognised: " tree]
  )
end 

;;various sematics evaluation functions
;;Kripke

to-report eval-AST-Kripke [epi-op M arg agentID wld]
  (ifelse
    (epi-op = "K") [report reduce and map [ l -> eval-AST M l arg] (accessible2agent-reflexive agentID wld)]
    [croak (word "Epi-op: " epi-op " not supported in Kripke semantics.")])
end 

;;Levesque

to-report eval-AST-Awareness [epi-op M pred agentID wld]
  (ifelse
    (epi-op = "A") [report aware agentID pred wld]
    (epi-op = "B") [report aware agentID pred wld and reduce and map [ l -> eval-AST M l pred] (accessible2agent-reflexive agentID wld)]
    (epi-op = "L") [report reduce and map [ l -> eval-AST M l pred] (accessible2agent-reflexive agentID wld)]
    [croak (word "Epi-op: " epi-op " not supported in Awareness semantics.")])
end 

;;doesn't work: can't find agent

to-report aware [agentID pred wld]
  ;;an agent is aware if
  ;; version 0.1: the pred tree is below a certain complexity (<#agentmaxops)
  let predcomplexity ASTOps pred
  let agentcapability [awaremaxops] of one-of epiagents with [label = agentID]
  debug (word "aware called with params AgentID: " agentID ", pred: " pred ", and world: " wld ". Result: " predcomplexity ".")
  debug (word "Agent's capability: " agentcapability ".")
  report predcomplexity <= agentcapability
end 

to-report ASTOps [pred]
  debug (word "ASTOps called with params: " pred ".")
  let typ-n index "type" pred; type typ-n
  let val-n index "value" pred; type val-n
  (ifelse
    typ-n = "bool-tok" [ report 0 ]
    typ-n = "prim-tok" [ report 0 ]
    typ-n = "op-tok" and val-n = "not"[
      report 1 + ASTOps index "arg1" pred
    ]
    typ-n = "op-tok" and not (val-n = "not")[
      report 1 + ASTOps index "arg1" pred + ASTOps index "arg2" pred
    ]
    typ-n = "epi-op-tok"  [
      report 1 + ASTOps index "arg1" pred
    ]
    [ croak sentence "Node not recognised: " pred]
  )
end 

;;index returns elemtns of lst with name i

to-report index [i lst]
;  type (word "Index called with i: " i ", lst: " lst "\n")
  while [not empty? lst][
    let elem first lst
    if first elem = i [report last elem]
    set lst but-first lst
  ]
  croak (sentence "Index" i "not found in" lst)
end 


;;auxilliary evaluation functions

to-report accessible2agent-reflexive [agentid wld]
  let t1 nobody;; so that w can be a string (initial invocation) or a world (subsequent invocations)
  ifelse not is-string? wld [set t1 wld]
  [set t1 one-of worlds with [name = wld]]
  let l1 ([end1] of access-links with [ end2 = t1 and member? agentid access-to ]);;all turtles ending a link linked to turtle n with correct agentid
  let l2 ([end2] of access-links with [ end1 = t1 and member? agentid access-to ]);; adds others
  let l (sentence t1 l1 l2) ;; include 'reflexive' link
  report l
end 

;;auxilliary evaluation functions

to-report accessible2agent-irreflexive [agentid wld]
  let t1 nobody;; so that w can be a string (initial invocation) or a world (subsequent invocations)
  ifelse not is-string? wld [set t1 wld]
  [set t1 one-of worlds with [name = wld]]
  let l1 ([end1] of access-links with [ end2 = t1 and member? agentid access-to ]);;all turtles ending a link linked to turtle n with correct agentid
  let l2 ([end2] of access-links with [ end1 = t1 and member? agentid access-to ]);; adds others
  let l (sentence l1 l2) ;; exclude 'reflexive' link
  report l
end 

;; pred      [ type "pred" pred AST eval evaluation in M w s]

;; Abstract Syntax Tree no postfix implies AST element
;; bool      [ type: "bool" value: "true" or "false") eval: true or false]
;; prim      [ type: "prim" value: primNAME eval: evaluation in M w s]
;; and       [ type: "pred-2" value: "and" arg1: pred arg2: pred eval: evaluation in M w s]
;; or          "
;; impl        "
;; not       [ type: "pred-1" value: "not" arg1: pred eval: evaluation in M w s]
;; knows     [ type: "pred-epi" value: "knows" agentID: agent arg1: pred eval: evaluation in M w s]

;;----------
;; agentID   [ type "agent" value agentNAME ]

;;original parse

to-report parse
  report parse-infix-pred
end 

;;;parse-pred - parse the top-level object
;to-report parse-pred
;  ;;top- (and lower-)level predicate(s)
;  let tok next-t
;  let typ-t type-t tok; type typ-t
;  let val-t value-t tok; type val-t
;  (ifelse
;    typ-t = "punc-tok" and val-t = "(" [ let parse-temp parse skip-kw ")" report parse-temp ]
;    typ-t = "bool-tok" [ report list list "type" "bool" list "value" val-t]
;    typ-t = "prim-tok" [ report list list "type" "prim" list "value" val-t ]
;    typ-t = "op-tok" and val-t = "not" [ report parse-op-unary "not" ]
;    typ-t = "op-tok" and val-t = "and" [ report parse-op-binary "and" ]
;    typ-t = "op-tok" and val-t = "or" [ report parse-op-binary "or" ]
;    typ-t = "op-tok" and val-t = "impl" [ report parse-op-binary "impl" ]
;    typ-t = "epi-op-tok" and val-t = "knows" [ report parse-epi ]
;    [croak (sentence "Unrecognised token: type: " typ-t val-t)]
;    )
;end
;

to-report parse-infix-pred
  set outputTree [] ;; pop top of stack to outputQueue = set outputQueue fput first operatorStack outputQueue set operatorStack but-first operatorStack
  set operatorStack [] ;; fput is used to add to queue so it grows as a parsetree would

  while [not eof-t?][
    let currentToken next-t
;    debug (word "Current token: " currentToken ".")
    let typ-t type-t currentToken
    let val-t value-t currentToken
    (ifelse
      typ-t = "bool-tok" [ set outputTree fput currentToken outputTree ]
      typ-t = "prim-tok" [ set outputTree fput currentToken outputTree ]
      typ-t = "agentID-tok" [ set outputTree fput currentToken outputTree ]
      typ-t = "epi-op-tok" [ set operatorStack fput currentToken operatorStack ]
      typ-t = "op-tok" and val-t = "not" [ set operatorStack fput currentToken operatorStack ]
      typ-t = "op-tok" [
        while [not empty? operatorStack and not (value-t first operatorStack = "(") and
          ((associativity currentToken = "left" and precedence currentToken <= precedence first operatorStack)
            or (associativity currentToken = "right" and precedence currentToken < precedence first operatorStack))]
        [
;         set outputQueue fput first operatorStack outputQueue;; create node here
          makeASTNode first operatorStack
          set operatorStack but-first operatorStack
        ]
        set operatorStack fput currentToken operatorStack
      ]
      typ-t = "punc-tok" and val-t = "(" [ set operatorStack fput currentToken operatorStack]
      typ-t = "punc-tok" and val-t = ")" [
        while [not empty? operatorStack and not (value-t first operatorStack = "(")][ ;; wikipedia: while top opStack not "("
;          set outputQueue fput first operatorStack outputQueue; outputQueue create node here
          makeASTNode first operatorStack
          set operatorStack but-first operatorStack
        ]
        if empty? operatorStack [croak "Mismatched parentheses"] ;; Wikipedia updated: assert opStack is not empty
                                                                 ;; assert there is a left parenthesis at the top of the operator stack
        set operatorStack but-first operatorStack ;; pop "(" and discard
      ]
      [ croak (sentence "Token not recognised" currentToken) ]
    )
  ]
  ;  print "Finished parse-infix, prepare output"
  while [not empty? operatorStack][
    if value-t first operatorStack = "(" or value-t first operatorStack = ")" [croak "Mismatched parentheses"]
    makeASTNode first operatorStack
    set operatorStack but-first operatorStack
    debug (word "outputTree: " outputTree ".")
  ]
;  print (word  "OutputTree: " outputTree ".")

  report outputTree
end 

to makeASTNode [node]
;  debug (word "makeASTNode called with param: " node " ")
  let arityTemp arity node
;  let assocTemp associativity node
  let precTemp precedence node
;  debug (word "whose arity is: " arityTemp ", and whose precedence is " precTemp ".")
;  debug (word "(outputTree is currently: " outputTree ") ")
  while [arityTemp > 0][
;    debug (word "Next in output tree is: " first outputTree)
    let argName (word "arg" arityTemp)
    set node lput (list argName first outputTree) node
    set outputTree but-first outputTree
    set arityTemp arityTemp - 1
  ]
  set outputTree fput node outputTree
;  debug (word "resulting in: " outputTree ".")
end 

to-report associativity [tok]
;  print tok
  let op index "value" tok
  (ifelse
    member? op [ "and" "or" "impl" ] [report "left"]
    [croak (word "Associativity of unknown operator" tok "requested.")]
  )
end 

to-report arity [tok]
  let op index "value" tok
;  print (sentence "Arity called with arg " tok "...")
  (ifelse
    member? first op epi-op-list  [report 1]
    member? op [ "not" ] [report 1]
    member? op [ "and" "or" "impl" ] [report 2]
    [croak (word "Arity of unknown operator" tok "requested.")]
  )
end 

to-report precedence [tok]
  let op index "value" tok;;added first so that kAlice is handled correctly
  (ifelse
    member? first op epi-op-list   [report 8] ;for epi operators which have complex names
    member? op "not"   [report 9]
    member? op "impl"  [report 7]
    member? op "and"   [report 6]
    member? op "or"    [report 5]
    [croak (word "Precedence of unknown operator" tok "requested.")]
  )
end 

;;is-op-t - is token an operator token?
;;TODO: should have ? appended

to-report is-op-t [op]
  let tok peek-t
  (ifelse
    op = "" [report type-t tok = "op-tok"]
    [report type-t tok = "op" and value-t tok = op]
  )
end 

;;is-prim-t - is the token a primitive?
;;TODO: should have ? appended

to-report is-prim-t [prim]
  let tok peek-t
  (ifelse
    prim = "" [report type-t tok = "prim-tok"]
    [report type-t tok = "prim-tok" and value-t tok = prim]
  )
end 

;;skip-kw - (destructively) reads kw from character stream or error if not found
;;auxiliary function

to skip-kw [kw]
  ;;aux: skips past keyword kw
  let temp kw
  while [not empty? kw] [
    ifelse peek = first kw [
      set kw but-first kw
      do-next
    ][
      croak (word "Expecting keyword \"" temp "\"")
      stop
    ]
  ]
end 

;;skip-op - (destructively) reads op from character stream or error if not found
;;auxiliary function

to skip-op [op]
  ;;aux: skips past keyword op
  let temp op
  while [not empty? op] [
    ifelse peek = first op [
      set op but-first op
      do-next
    ][
      croak (word "Expecting operator \"" temp "\"")
    ]
  ]
end 

;;type-t - tokens are type/value pairs; returns the type part

to-report type-t [tok]
  report last first tok
end 

;; value-t - tokens are type/value pairs; returns the value part

to-report value-t [tok]
  report last last tok
end 


;;token stream - tokenise stream, types are postfixed by -tok to distinguish from chars and AST objects
;; token          example value
;; type "prim-tok" value "p33" ;; primitives
;; type "op-tok" value "and" ;; logical ops
;; type "epis-tok" value "knows" ;; epistemological ops

;;read-next-t - does the heavy lifting of reading and returning the next token

to-report read-next-t
  while [peek = " "] [ set s but-first s ]
  let ch peek
  (ifelse
    is-punc         ch [ report list list "type" "punc-tok" list "value" next ]
    is-op-start     ch [ report read-op ]
    is-epi-op-start ch [ report read-epi-op ]
    is-bool-start   ch [ report list list "type" "bool-tok" list "value" is-bool ]
    is-prim-start   ch [ report list list "type" "prim-tok" list "value" is-prim ]
    [croak sentence "Can't handle character: " ch ]
  )
end 

;; read-op - auxiliary for read-next-t which eats two char op names and checks syntax

to-report read-op
  let ch next
  (ifelse
    ch = "&" [ ifelse next = "&" [report list list "type" "op-tok" list "value" "and"][croak "Unknown op"]]
    ch = "|" [ ifelse next = "|" [report list list "type" "op-tok" list "value" "or"][croak "Unknown op"]]
    ch = "=" [ ifelse next = ">" [report list list "type" "op-tok" list "value" "impl"][croak "Unknown op"]]
    ch = "-" [ report list list "type" "op-tok" list "value" "not"]
    [croak "Unknown op"]
  )
end 

;; read-op - auxiliary for read-next-t which eats two char op names and checks syntax

to-report read-epi-op
  let ch next ;; we know this is an epi op
  (ifelse
    is-epi-op-start ch [
      ifelse next = " "
      [report list list "type" "epi-op-tok" list "value" (word ch is-agent) ]
      [croak (word "Unknown epi op: " ch ".")] ]
    [croak (word "Unknown epi op: " ch ".")]
  )
end 

;;peek-t - non-destructively return next token in token stream, which is also stored in current-t

to-report peek-t
  ;;token peek
  ifelse current-t = "" [
    set current-t read-next-t
    report current-t
  ][
    report current-t
  ]
end 

;;next-t - destructively read next token, which is also stored in current-t

to-report next-t
  ;;token next
  let tok current-t
  set current-t ""
  ifelse tok = "" [
    report read-next-t
  ][
    report tok
  ]
end 

;; eof-t? - eof of token stream

to-report eof-t?
  report ifelse-value s = "" [true][false]
end 

;;is-epi-op-start - a unary epi-op starts with a K or ...
;;TODO: should have ? appended

to-report is-epi-op-start [ch]
  report member? ch epi-op-list ;; A for awareness, B for Belief; K for Knowledge (Kripke)/L (Awareness)
end 

;;is-op start - an operator begins with &|= or -
;;TODO: should have ? appended to name

to-report is-op-start [ch]
  report member? ch "&|=-"
end 

;;is-agent - (destructively) reads an agent from the character stream
;;TODO: should be renamed read-agent

to-report is-agent
  ;;agent id like Alice5
  ;;called when next is-agent-start
  let agentID next
  while [member? peek "abcdefghijklmnopqrstuvwxyz0123456789"] [
    set agentID word agentID next
    if eof? [report agentID]
  ]
  report agentID
end 

;;is-agent-start - an agent starts with an upper case letter which is not F or T
;;TODO: should have ? appended

to-report is-agent-start [ch]
  report member? ch "ABCDEGHIJKLMNOPQRSUVWXYZ";; no F(alse), no T(rue)
end 

;;is-bool-start - a boolean is either F (false) or T (true)
;;TODO: should have ? appended

to-report is-bool-start [ch]
;  print (word "is-bool-start" member? ch "TF")
  report member? ch "TF"
end 

;;is-bool - (destructively) reads a boolean from the character stream
;;TODO: should be renamed read bool

to-report is-bool
  ;;boolean is F|T
  ;;called when next is-bool-start
;  let bool ""
  if eof? [croak "Boolean expected, eof reached."]
  report next
end 

;;is-prim - (destructively) reads a primitve from character stream
;;TODO: rename as read-prim

to-report is-prim
  ;;primitive like p100
  ;;called when next is-prim-start
  let primID ""
  if eof? [croak word "Malformed primitive: " primID]
  while [member? peek "abcdefghijklmnopqrstuvwxyz0123456789"] [
    set primID word primID next
    if eof? [report primID]
  ]
  report primID
end 

;;is-prim-start - a primitive starts with a lower case letter
;;TODO: should have ? appended

to-report is-prim-start [ch]
  report member? ch "abcdefghijklmnopqrstuvwxyz"
end 

;; is-white-space true if arg is white space, currently just " "
;;TODO: should have ? appended

to-report is-white-space [ch]
  report member? ch " "
end 

;; is-punc - test for punctuation, currently just parentheses
;;TODO: should have ? appended

to-report is-punc [ch]
  report member? ch "()"
end 

;; read from s non-destructively while pred true

to-report read-while [pred]
  ;pred is an anonoymous report , i.e., has form [ -> reporter]
  let str ""
  while [not eof? and runresult pred][
   set str word str next
  ]
 report str
end 

;;input stream - characters read from string

to do-next
  ifelse not eof? [ set s but-first s]
  [croak "eof reached"]
end 

;;next – return next character from character stream s, which should not be empty,
;;       updating position indicators (line, col) for errors

to-report next
  let ch first s
  set s but-first s
  ifelse ch = "\n" [
    set line line + 1
    set col 0
  ][
    set col col + 1
  ]
  report ch
end 

;; peek next character, throwing error is character stream s empty

to-report peek
  if eof? [ croak "Input empty" ]
  report first s
end 

;;eof? end of character stream?

to-report eof?
  report empty? s
end 

;;errors stop execution passing back message to NetLogo

to croak [msg]
  error (sentence "Error:" msg "(" line ":" col ")")
end 

to debug [lst]
  if debugStatus [
    print lst
    while [not mouse-down?] []
    while [mouse-down?] []
  ]
end