Click here to go to the Church ‘play space’

Click here for details on Church syntax

Exercises

Making functions

Write a function called times-three that takes in a single argument and multiplies it by three:

(define (times-three x)
  ...
  )

(times-three 4)

Challenge problem

Building multiplication functions is boring work, so now let’s make a function that makes those functions. This multiplication function machine will take one argument multiplicand and return a function that itself takes a single argument and multiplies the argument by that number.

(define (multiplication-function-machine multiplicand)
  ...
)

(define times-four (multiplication-function-machine 4))
(display (times-four 5)) ;; This should be 20

The broken soda machine

You come upon the worst soda machine in the world: 40% of the time when you push the button it gives you nothing, and the remaining portion of the time it randomly spits out either Coke, Sprite, or root beer.

Complete the function below (filling in the ... section) so you can determine the distribution of sodas that you are likely to get out of this machine.

(define soda-machine
  (lambda ()
    (if ...
        'nothing
        (uniform-draw '(coke sprite root-beer)))))

(hist (repeat 5000 soda-machine) "What you get from the machine")

Challenge problem

Now let’s say these horrible soda machines are at least consistent – 40% are broken and will never dispense anything, while the rest will only dispense a single type of soda (chosen at random).

Modify your existing soda-machine code so that it now takes in a single argument representing the name of the soda machine, and consistently returns the same thing for each machine. You should be able to run the code below after your soda-machine function and get the same thing for both draws from machine1 and machine2.

(display "Machine 1:")
(display (soda-machine 'machine1))
(display (soda-machine 'machine1))

(display "Machine 2:")
(display (soda-machine 'machine2))
(display (soda-machine 'machine2))

Feps and Pimwits

You arrive on an alien planet with two different species that are about equally populous: the Feps are docile race that love Humans, but the Pimwits are savage creatures with poisonous fangs. They look the same except for the fact that they have different heights. Feps on average are 1.6m tall, with a standard deviation of 0.2m. Pimwits are taller: 2.0m on average, with a standard deviation of 0.3m.

You see off in the distance that there is a creature, but you can only tell that it is at least 1.8m tall. What is the probability that you are looking at a Pimwit? Fill in the ... areas below to run this query.

(define height-cond
  (mh-query
   1000 10
   
   (define pimwit? (flip))
   (define height
     (if pimwit?
       (gaussian 2.0 0.3)
       (gaussian 1.6 0.2))
     )
   
   ...
   
   ...
   )
  )

(display (hist height-cond 
               "Is this creature a Pimwit?"))

Challenge problem

It turns out only 60% of Pimwits are poisonous, but 20% of Feps are savage poisonous creatures. Now what is the probability that the creature you are looking at is poisonous?

Code snippets

Below are code snippets that are used as examples in the tutorial. It is better if you do not copy and paste this code into the play space so that you have more practice writing the code yourself. However, it can serve as a useful reference to go back to when doing the exercises.

Intro to Church commands

Arithmetic

Addition

(+ 2 2)

Subtraction

(- 3 2)

Multiplication

(* 3 2)

Division

(/ 3 2)

Tests, logic, and conditionals

Equality tests

(equal? 3 2)
(equal? 2 2)

Greater-than / less-than

(> 3 2)
(< 3 2)

Boolean logic

(and (< 4 1) (> 3 2))
(or (< 4 1) (> 3 2))

Conditionals

The if function takes three arguments: (1) a conditional, (2) the code to run if the conditional is true, and (3) the code to run if the conditional is false

(if (> 3 2)
  (display "This is true")
  (display "This is false")
  )
(if (> 2 3)
  (display "This is true")
  (display "This is false")
  )

Variable assignment

Assigning numbers or strings to a variable name is easy with the define function

(define x 5)
(display x)
(define me "Kevin")
(display me)

Lists

You can define lists either using the list function or the “`” operator (there are slight differences, but see the syntax guide for further information)

(define L1
  (list 1 2 3 4))
(display L1)
(define L1
  `(1 2 3 4))
(display L1)

Elements of lists can be accessed with commands like first, second, third, etc.

(define L1
  `(1 2 3 4))
(display (first L1))
(display (third L1))

Functions

Functions can be defined by creating a function with lambda and assigning it to a variable

(define square
  (lambda (x) (* x x))
  )
(display (square 5))

However, there is “syntactic sugar” so you can skip the lambda call if you define the function name with arguments like so:

(define (square x)
  (* x x)
  )
(display (square 5))

Functions can take multiple arguments

(define (add-together x y)
  (+ x y))
(display (add-together 3 4))

Anonymous functions

An anonymous function is one that is created but not directly bound to a variable. The two code snippets below should do the same thing, but the top one keeps the function around bound to add-three while the bottom one runs the function on the 2 argument then no longer remembers the function.

(define add-three
  (lambda (x) (+ x 3)))
(add-three 2)
((lambda (x) (+ x 3)) 2)

Functions of functions

Functions can both take in functions as arguments and return them. For instance, do-twice takes in a function as an argument and returns another function that calls the original argument twice (so doing add-two twice is add-four)

(define (add-two x) (+ x 2))

(define (do-twice f)
  (lambda (x) (f (f x))))
  
(define add-four (do-twice add-two))

(display (add-four 5))

Mapping functions

The map function takes a function and a list and returns a list where that function has been applied to each element

(define (add-two x) (+ x 2))

(define my-list `(1 2 3 4))

(map add-two my-list)

Recursion

You can call a function from within itself – this is called ‘recursion’ (note that you will always need a stopping condition)

(define (countdown x)
  (display x)
  (if (= x 0) 
      '()
      (countdown (- x 1)))
  )

(countdown 4)

Forward sampling

Flip

The flip function randomly returns #t or #f – by default with a 50/50 chance.

(display (flip))
(display (flip))
(display (flip))
(display (flip))
(hist (repeat 1000 flip) "1000 flips")

flip can also take an argument that is the probability that it will return #t if you don’t want it to be 50%

(define (flip-biased) (flip 0.8))
(display (flip-biased))
(display (flip-biased))
(display (flip-biased))
(display (flip-biased))
(define (flip-biased) (flip 0.8))
(hist (repeat 1000 flip-biased) "1000 flips of a biased coin")

Gaussians

The gaussian function takes two arguments – a mean and a standard deviation – and returns a random draw from that Gaussian

(display (gaussian 0.0 1.0))
(display (gaussian 0.0 1.0))
(display (gaussian 0.0 1.0))
(display (gaussian 0.0 1.0))
(define (standard-normal) (gaussian 0.0 1.0))
(hist (repeat 1000 standard-normal) "1000 draws from a standard normal distribution")

Structured forward models

XRPs can be combined to make complex forward models, e.g. a mixture of Gaussians

(define (mix-gauss)
  (if (flip)
      (gaussian 0.0 1.0)
      (gaussian 3.0 0.5)))

(hist (repeat 5000 mix-gauss)
      "Mixture of Gaussians")

Memoization

By default every draw from an XRP will be different every time a function is called. But if you want to set an attribute of a person/object, this is a bad thing. For instance, we can have a function that returns a person’s favorite color:

(define favorite-color
  (lambda (person)
    (uniform-draw '(black blue yellow red))))

(display "Alice's favorite color:")
(display (favorite-color 'alice))

(display "Bob's favorite color:")
(display (favorite-color 'bob))

If you call this function twice on the same person, you can get two different answers.

(define favorite-color
  (lambda (person)
    (uniform-draw '(black blue yellow red))))

(display "Alice's favorite color:")
(display (favorite-color 'alice))

(display "Alice's favorite color again:")
(display (favorite-color 'alice))

By using the mem function, Church will store the result of an XRP so that when you call that function again on the same object, the exact same result will be returned.

(define favorite-color
  (mem (lambda (person)
    (uniform-draw '(black blue yellow red)))))

(display "Alice's favorite color:")
(display (favorite-color 'alice))

(display "Alice's favorite color again:")
(display (favorite-color 'alice))

Inference

The Battle of the Two Towers

You are studying the historical Battle of the Two Towers. Suppose a-priori you assume Legolas, Gimli and Eowyn each took out somewhere between 0 and 19 orcs. How many orcs did Gimli take out?

(define (two-towers)
   (define Legolas (random-integer 20))
   (define Gimli (random-integer 20))
   (define Eowyn (random-integer  20))
   Gimli)

(hist (repeat 5000 two-towers)
      "Number of orcs Gimli took out")

Someone tells you that together, they took out at least 45 orcs. What is your belief about how many orcs Gimli took out?

(define (two-towers)
   (define Legolas (random-integer 20))
   (define Gimli (random-integer 20))
   (define Eowyn (random-integer  20))
   (define total (+ Legolas Gimli Eowyn))
   (if (>= total 45) Gimli (two-towers)))

(hist (repeat 5000 two-towers)
      "Number of orcs Gimli took out given everyone took out at least 45")

The function above is doing rejection sampling. There is a bulit-in function in Church to do this: rejection-query

(define (two-towers)
  (rejection-query

   (define Legolas (random-integer 20))
   (define Gimli (random-integer 20))
   (define Eowyn (random-integer  20))
   (define total (+ Legolas Gimli Eowyn))

   Gimli

   (>= total 45)
   )
  )

(hist (repeat 5000 two-towers)
      "Number of orcs Gimli took out given everyone took out at least 45")

In many cases, rejection sampling can be extremely inefficient. A better sampling method is mh-query. Unlike rejection-query this returns a list of the queried items.

(define (two-towers)
  (mh-query
   1000 10

   (define Legolas (random-integer 20))
   (define Gimli (random-integer 20))
   (define Eowyn (random-integer  20))
   (define total (+ Legolas Gimli Eowyn))

   Gimli

   (>= total 45)
   )
  )

(hist (two-towers) "Number of orcs Gimli took out given everyone took out at least 45")

This allows us to do inference even when the conditional is rare – for instance if the team took out at least 55 orcs. This is not code you would want to run using rejection sampling since you will so rarely satisfy the conditional.

(define (two-towers)
  (mh-query
   1000 10

   (define Legolas (random-integer 20))
   (define Gimli (random-integer 20))
   (define Eowyn (random-integer  20))
   (define total (+ Legolas Gimli Eowyn))

   Gimli

   (>= total 55)
   )
  )

(hist (two-towers) "Number of orcs Gimli took out given everyone took out at least 55")

Example applications

Theory of mind

Deciding which action to take given a goal and choice of actions.

;; a function for planning
(define (choose-action goal? transition state)
  (rejection-query
   (define action (action-prior))
   ;; what action to take?
   action
   ;; conditioned on achieving the goal
   (goal? (transition state action))))

;; without any specific goal, choose a uniform prior
(define (action-prior) (uniform-draw '(left right)))

;; A simple world, apple on the left, banana on the right
(define (lift-box state action)
  (case action
        (('left) 'apple)
        (('right) 'banana)
        (else 'nothing)))

; a simple goal
(define (got-apple? state) 
  (equal? state 'apple))

(choose-action got-apple? lift-box 'start)

Infering an agents goal from its infered action

(define (choose-action goal? transition state)
  (rejection-query
   (define action (action-prior))
   ;; what action to take?
   action
   ;; conditioned on achieving the goal
   (goal? (transition state action))))

;; without any specific goal, choose a uniform prior
(define (action-prior) (uniform-draw '(left right)))

;; A simple world, apple on the left, banana on the right
(define (lift-box state action)
  (case action
        (('left) 'apple)
        (('right) 'banana)
        (else 'nothing)))

(define observed-action 'right)

(define (infer-goal)
 (rejection-query
  (define goal-food (uniform-draw '(banana apple)))
  (define goal? (lambda (outcome) (equal? outcome goal-food)))
  
  goal-food
  
  (equal? (choose-action goal? lift-box 'start) observed-action)))

(infer-goal)

Infering an agents beliefs about the world if you know their goals and observe their actions

;; a function for planning
(define (choose-action goal? transition state world)
  (rejection-query
   (define action (action-prior))
   ;; what action to take?
   action
   ;; conditioned on achieving the goal
   (goal? (transition state action world))))

;; without any specific goal, choose a uniform prior
(define (action-prior) (uniform-draw '(left right)))

;; the agent likes apples
(define (got-apple? state)
  (equal? state 'apple))

;; A simple world, but we don’t where where the food is
(define worldA '(apple banana))
(define worldB '(banana apple))

(define (lift-box state action world)
  (case action
        (('left) (first world))
        (('right) (second world))
        (else 'nothing)))

(define observed-action 'right)

(define (infer-belief)
  (mh-query 4 1
            (define world (if (flip) worldA worldB))
            
            ; query on what world the agent thinks we're in
            world
            
            ; conditioned on their action
            (equal? 
             (choose-action got-apple? lift-box 'start world) 
                    observed-action)))

(infer-belief)

Spatial pragmatics

Here we apply the Rational Speech Act model to spatial pragmatics – given the question “Where is Josh?” a speaker will answer with the statement that gives the listener the best chance of inferring the speaker’s intention.

;; Prior belief is uniform across the map
(define (state-prior) 
  (list (uniform 0 1) (uniform 0 1)))

;; Euclidean distance function
(define (dist p1 p2) 
  (sqrt (+ (pow (- (first p1) (first p2)) 2) 
           (pow (- (second p1) (second p2)) 2))))

;; All sentences are equally likely a priori
(define (sentence-prior) 
  (uniform-draw (list in-woods-hole in-town in-pie)))

;; Defining which sentences are true
(define (in-woods-hole state) 
  (or (< (first state) 1) (< (second state) 1)))

(define (in-town state) 
  (and (> (first state) .25) (< (second state) .33)))

(define (in-pie state)
  (and (> (first state) .833) (< (second state) .167)))

;; Speaker model
(define (speaker state depth)
  (rejection-query
   (define words (sentence-prior))
   words
   (< (dist state (listener words depth)) 0.05)))

;; Listener model
(define (listener words depth)
  (rejection-query
   (define state (state-prior))
   state
   (if (= depth 0)
       (words state)
       (equal? words (speaker state (- depth 1))))))

;; Run the model
(define depth 1)
(scatter (repeat 40 (lambda () (listener in-town depth))))