missionaries and cannibals + snake cube puzzle solutions

missionaries-cannibals-snakes.rkt

#lang racket
(require "../connive/connive.rkt")
(require "./searchpaths.rkt") ; http://gist.github.com/4074309


; missionaries and cannibals puzzle solution
(:= (m-c)
    
    ;; represent placement of missionaries, cannibals, and the boat (all fields are integers)
    (struct mc (m1 c1 b1 m2 c2 b2) #:transparent)
    
    (:= start (list (mc 3 3 1 0 0 0) "start"))
    
    ;; :: state -> bool
    (:== goal? (state) 
         ((list placement _)) (equal? placement (mc 0 0 0 3 3 1))) 
    
    ;; :: state -> [state]
    (:== successors (state) 
         
         ((list (mc m1 c1 b1 m2 c2 b2) _))
         
         (?? ; disallow more cannibals than missionaries on a side (when some missionaries)
             (or (> c1 m1 0) (> c2 m2 0)) empty
             
             ; boatloads going ->
             (= b1 1) (<- (list (mc (- m1 m) (- c1 c) 0 (+ m2 m) (+ c2 c) 1) (list m 'm c 'c '->))
                          m (.. 0 m1) 
                          c (.. 0 c1) 
                          (> 3 (+ m c) 0)) ; restrict boatloads to 1 or 2 people
             
             ; boatloads going <-
             (= b2 1) (<- (list (mc (+ m1 m) (+ c1 c) 1 (- m2 m) (- c2 c) 0) (list m 'm c 'c '<-))
                          m (.. 0 m2) 
                          c (.. 0 c2) 
                          (> 3 (+ m c) 0)) 
             empty))
    
    (blocking-path successors goal? start))



; snake cube puzzle
(:= (snakes)
    
    (:= directions '((1 0 0) (-1 0 0) (0 1 0) (0 -1 0) (0 0 1) (0 0 -1)))
    
    (:= (out-of-bounds? c) (or (< c 0) (> c 2)))
    
    (:= (get-swivel dir)
        (<- d d directions
            (not (or (equal? d dir) (equal? d (map - dir))))))
    
    (:= blocks '(0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0))
    (:= facing '(1 0 0))
    (:= pos    '(0 0 0))
    
    (:= start (list pos (list facing blocks)))
    
    (:== goal? (state)
         ((list point (list dir blocks))) (= 1 (length blocks)))
    
    (:== successors (state)
         ((list point (list dir (cons b blocks))))  
         (?? (any? out-of-bounds? point) empty
             (<- (list (zip-with + point d) (list d blocks)) 
                 d (case b ((0) (list dir)) ((1) (get-swivel dir))))))
    
    (blocking-path successors goal? start))