Skip to content

Instantly share code, notes, and snippets.

@bryangarza

bryangarza/cannibals.rkt

Last active October 14, 2015 00:05
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save bryangarza/6b92a3ce7889adfeee13 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save bryangarza/6b92a3ce7889adfeee13 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. bryangarza revised this gist Oct 14, 2015. 1 changed file with 11 additions and 8 deletions.
    19 changes: 11 additions & 8 deletions cannibals.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -26,12 +26,11 @@
    ;; carry :: State -> Move -> (State | '())
    (define carry
    (λ (state change)
    (match-let* ([(list m c b) state]
    [(list m-delta c-delta) change]
    [(list move-op new-b) (if b (list - #f) (list + #t))]
    [new-state (list (move-op m m-delta)
    (move-op c c-delta)
    new-b)])
    (match-let*
    ([(list m c b) state]
    [(list m-delta c-delta) change]
    [(list move-op new-b) (if b (list - #f) (list + #t))]
    [new-state (list (move-op m m-delta) (move-op c c-delta) new-b)])
    (if (valid? new-state) new-state null))))

    ;; only 5 possible state changes:
    @@ -47,11 +46,15 @@
    ['() #f]
    [_ (let* ([choice (car choices)]
    [new-state (carry state choice)])
    (if (not (null? new-state)) new-state (next-level state (cdr choices))))])))
    (if (not (null? new-state))
    new-state
    (next-level state (cdr choices))))])))

    ;; bfs :: State -> State
    (define bfs
    (λ (state)
    (let* ([b (third state)]
    [res (next-level state (if b state-change-right state-change-left))])
    (if (or (not res) (equal? res goal-state)) (list res) (cons state (bfs res))))))
    (if (or (not res) (equal? res goal-state))
    (list res)
    (cons state (bfs res))))))
  2. bryangarza revised this gist Oct 14, 2015. 1 changed file with 5 additions and 6 deletions.
    11 changes: 5 additions & 6 deletions cannibals.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -26,13 +26,12 @@
    ;; carry :: State -> Move -> (State | '())
    (define carry
    (λ (state change)
    (match-let* ([(list m c b) state]
    (match-let* ([(list m c b) state]
    [(list m-delta c-delta) change]
    [move-op (if b - +)]
    [new-m (move-op m m-delta)]
    [new-c (move-op c c-delta)]
    [new-b (if b #f #t)]
    [new-state (list new-m new-c new-b)])
    [(list move-op new-b) (if b (list - #f) (list + #t))]
    [new-state (list (move-op m m-delta)
    (move-op c c-delta)
    new-b)])
    (if (valid? new-state) new-state null))))

    ;; only 5 possible state changes:
  3. bryangarza revised this gist Oct 13, 2015. 1 changed file with 8 additions and 11 deletions.
    19 changes: 8 additions & 11 deletions cannibals.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -26,17 +26,14 @@
    ;; carry :: State -> Move -> (State | '())
    (define carry
    (λ (state change)
    (let* ([m (car state)]
    [m-delta (car change)]
    [c (second state)]
    [c-delta (second change)]
    [b (third state)]
    [move-op (if b - +)]
    [new-m (move-op m m-delta)]
    [new-c (move-op c c-delta)]
    [new-b (if b #f #t)]
    [new-state (list new-m new-c new-b)])
    (if (valid? new-state) new-state null))))
    (match-let* ([(list m c b) state]
    [(list m-delta c-delta) change]
    [move-op (if b - +)]
    [new-m (move-op m m-delta)]
    [new-c (move-op c c-delta)]
    [new-b (if b #f #t)]
    [new-state (list new-m new-c new-b)])
    (if (valid? new-state) new-state null))))

    ;; only 5 possible state changes:
    ;; state-change-{right,left} :: [(Missionaries, Cannibals)]
  4. bryangarza revised this gist Oct 13, 2015. 1 changed file with 15 additions and 13 deletions.
    28 changes: 15 additions & 13 deletions cannibals.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -1,20 +1,20 @@
    #lang racket

    (require racket/match)
    (require racket/trace)

    ;; initial-state :: State
    (define initial-state '(3 3 0))
    ;; State = (Missionaries on left, Cannibals on left, Boat on left?)
    (define initial-state '(3 3 #t))

    ;; goal-state :: State
    (define goal-state '(0 0 1))
    (define goal-state '(0 0 #f))

    ;; valid :: State -> Bool
    (define valid?
    (λ (state)
    (let* ([m (car state)]
    (let* ([m (car state)]
    [m-r (- 3 m)]
    [c (second state)]
    [c (second state)]
    [c-r (- 3 c)])
    (and (or (= m 0) (>= m c))
    (or (= m-r 0) (>= m-r c-r))
    @@ -31,29 +31,31 @@
    [c (second state)]
    [c-delta (second change)]
    [b (third state)]
    [move-op (if (= b 0) - +)]
    [move-op (if b - +)]
    [new-m (move-op m m-delta)]
    [new-c (move-op c c-delta)]
    [new-b (if (= b 0) 1 0)]
    [new-b (if b #f #t)]
    [new-state (list new-m new-c new-b)])
    (if (valid? new-state) new-state null))))

    ;; only 5 possible state changes:
    ;; state-change-{right,left} :: [(Missionaries, Cannibals)]
    (define state-change-right '((2 0) (0 2) (1 1) (1 0) (0 1)))
    (define state-change-left '((0 1) (1 0) (1 1) (0 2) (2 0)))

    ;; next-level :: State -> State
    ;; try all 5 possibilities, or at least until reaching a next state
    ;; next-level :: State -> (State | #f)
    (define next-level
    (λ (state choices)
    (match choices
    [(list) #f]
    [_ (let* ([choice (car choices)]
    ['() #f]
    [_ (let* ([choice (car choices)]
    [new-state (carry state choice)])
    (if (not (null? new-state)) new-state (next-level state (cdr choices))))])))

    ;; bfs :: State -> State
    (define bfs
    (λ (state)
    (let* ([b (third state)]
    [res (next-level state (if (= b 0) state-change-right state-change-left))])
    (if (or (not res) (equal? res goal-state)) res (bfs res)))))
    (let* ([b (third state)]
    [res (next-level state (if b state-change-right state-change-left))])
    (if (or (not res) (equal? res goal-state)) (list res) (cons state (bfs res))))))
  5. bryangarza revised this gist Oct 13, 2015. 1 changed file with 3 additions and 3 deletions.
    6 changes: 3 additions & 3 deletions cannibals.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -28,9 +28,9 @@
    (λ (state change)
    (let* ([m (car state)]
    [m-delta (car change)]
    [c (car (cdr state))]
    [c-delta (car (cdr change))]
    [b (car (cdr (cdr state)))]
    [c (second state)]
    [c-delta (second change)]
    [b (third state)]
    [move-op (if (= b 0) - +)]
    [new-m (move-op m m-delta)]
    [new-c (move-op c c-delta)]
  6. bryangarza created this gist Oct 13, 2015.
    59 changes: 59 additions & 0 deletions cannibals.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,59 @@
    #lang racket

    (require racket/match)
    (require racket/trace)

    ;; initial-state :: State
    (define initial-state '(3 3 0))

    ;; goal-state :: State
    (define goal-state '(0 0 1))

    ;; valid :: State -> Bool
    (define valid?
    (λ (state)
    (let* ([m (car state)]
    [m-r (- 3 m)]
    [c (second state)]
    [c-r (- 3 c)])
    (and (or (= m 0) (>= m c))
    (or (= m-r 0) (>= m-r c-r))
    (<= m 3)
    (<= c 3)
    (>= m 0)
    (>= c 0)))))

    ;; carry :: State -> Move -> (State | '())
    (define carry
    (λ (state change)
    (let* ([m (car state)]
    [m-delta (car change)]
    [c (car (cdr state))]
    [c-delta (car (cdr change))]
    [b (car (cdr (cdr state)))]
    [move-op (if (= b 0) - +)]
    [new-m (move-op m m-delta)]
    [new-c (move-op c c-delta)]
    [new-b (if (= b 0) 1 0)]
    [new-state (list new-m new-c new-b)])
    (if (valid? new-state) new-state null))))

    ;; only 5 possible state changes:
    (define state-change-right '((2 0) (0 2) (1 1) (1 0) (0 1)))
    (define state-change-left '((0 1) (1 0) (1 1) (0 2) (2 0)))

    ;; next-level :: State -> State
    ;; try all 5 possibilities, or at least until reaching a next state
    (define next-level
    (λ (state choices)
    (match choices
    [(list) #f]
    [_ (let* ([choice (car choices)]
    [new-state (carry state choice)])
    (if (not (null? new-state)) new-state (next-level state (cdr choices))))])))

    (define bfs
    (λ (state)
    (let* ([b (third state)]
    [res (next-level state (if (= b 0) state-change-right state-change-left))])
    (if (or (not res) (equal? res goal-state)) res (bfs res)))))