Edit page
  ;; John could either be a giraffe or a person.
  (define categories (list 'giraffe 'person))
  
  ;; It is extremely unlikely that John is actually a giraffe.
  (define (categories-prior) (multinomial categories '(0.001 0.999)))
  
  ;; The speaker could either say "John is a giraffe" or "John is a person."
  (define utterances (list 'giraffe 'person))
  
  ;; The utterances are equally costly.
  (define (utterance-prior) (multinomial utterances '(0.1 0.1)))
  
  ;; The only feature being considered is height
  (define heights (list 160 180 200 220 240 260 280 300)) 
  (define height-prior 
    (list
     (list 0.01 0.01 0.05 0.05 0.1 0.1 0.8 0.5)
     (list 0.4 0.4 0.1 0.05 0.01 0.01 0.01 0.01)
     ))
  
  ;; Speaker's possible goals are to communicate whether John is tall or his actual height
  (define goals (list 'tall? 'height?))
  (define threshold 180)
  
  ;; Prior probability of speaker's goal is set to uniform but can
  ;; change with context/QUD.
  (define (goal-prior) (uniform-draw goals))
  
  ;; Speaker optimality parameter
  (define alpha 1)
  
  ;; Sample John's height given that he is a member of category
  (define (sample-height category prior all-categories)
    (if (equal? category (first all-categories))
        (multinomial heights (first prior))
        (sample-height category (rest prior) (rest all-categories))))
        
  ;; Check if interpreted categroy is identical to utterance
  (define (literal-interpretation utterance category)
    (equal? utterance category))
  
  ;; Check if goal is satisfied
  (define (goal-satisfied? goal listener-category-height speaker-category-height)
    (case goal
      (('category?) (equal? (first listener-category-height) (first speaker-category-height)))
      (('tall?) (equal? (> (second listener-category-height) threshold) 
                         (> (second speaker-category-height) threshold)))
      (('height?) (equal? (second listener-category-height) (second speaker-category-height)))
          ))
  
  ;; Speaker model
  (define speaker
    (mem
     (lambda (category height goal depth)
       (enumeration-query
        (define utterance (utterance-prior))
        utterance
        (goal-satisfied? goal
                         (apply multinomial (listener utterance depth))
                         (list category height))))))
  
  ;; Listener model
  (define listener
    (mem 
     (lambda (utterance depth)
       (enumeration-query
        (define category (categories-prior))
        (define height (sample-height category height-prior categories))
        (define speaker-goal (goal-prior))
        (list category height)
        (if (equal? depth 0)
            (literal-interpretation utterance category)
            (equal? utterance
                    (apply multinomial
                           (raise-to-power (speaker category height speaker-goal (- depth 1))
                                           alpha))))))))
  
  (define (raise-to-power speaker-dist alpha)
    (list (first speaker-dist)
          (map (lambda (x) (pow x alpha)) (second speaker-dist))))
  
  ;; Recursive depth
  (define depth 1)
  
  (define (sample-one utterance)
    (listener utterance depth))
  (barplot (sample-one 'giraffe))