;; slowfib
;; (slowfib 1) (slowfib 2) ... (slowfib 22)
(define slowfib
  (lambda (n)
    (if (= 1 n)
        1
        (if (= 0 n)
            1
            (+ (slowfib (- n 1)) (slowfib (- n 2)))))))

(define add1
  (lambda (x)
    (+ x 1)))

(define sub1
  (lambda (x)
    (- x 1)))

(define alt
  (lambda (ls)
    (letrec
      ((alt-row
	(lambda (j k ls)
	  (if (null? ls)
	      ()
	      (cons (* j (* k (car ls)))
		    (alt-row j (* -1 k) (cdr ls))))))
       (alt-col
	(lambda (l m ls)
	  (if (null? ls)
	      ()
	      (cons (alt-row l m (car ls))
		    (alt-col (* -1 l) m (cdr ls)))))))
      (if (pair? (car ls))
	  (alt-col 1 1 ls)
	  (alt-row 1 1 ls)))))

(define sublist
  (lambda (ls n m)
    (letrec 
      ((tail
	(lambda (ls n)
	  (if (= n 0)
	      ls
	      (tail (cdr ls) (sub1 n)))))
       (head
	(lambda (ls m)
	  (if (= m 0)
	      ()
	      (cons (car ls) (head (cdr ls) (sub1 m)))))))
      (head (tail ls n) (- m n)))))

(define kill-row
  (lambda (A r)
    (append (sublist A 0 r)
	    (sublist A (add1 r) (length A)))))

(define kill-col
  (lambda (A c)
    (map (lambda (x) (kill-row x c)) A)))

(define iota
  (lambda (n)
    (letrec
      ((loop 
	(lambda (m acc)
	  (if (= m 0)
	      acc
	      (loop (sub1 m) (cons m acc))))))
      (loop n ()))))

(define minors
  (lambda (A)
    (let ((n (length A)))
      (map (lambda (x) (kill-col (cdr A) (sub1 x)))
	   (iota n)))))
;; detA
;; (determinant A)
;; detB
;; (determinant B)
;; detC
;; (determinant C)
;; detD
;; (determinant D)
(define determinant
  (lambda (A)
    (if (null? (cdr A))
	(car (car A))
	(let ((cofactors (map determinant (minors A))))
	  (apply + (map * (alt (car A)) cofactors))))))

(define A '((1  2  3  4  5) 
            (6 -5  4 -3  2) 
            (1  3  6  2  4) 
            (3  4  5 -1 -3) 
	    (1  0 -1  0 -1)))

(define B '((1  2  3  4  5  6)
	    (6 -5  4 -3  2 -1)
	    (1  3  6  2  4  7)
	    (3  4  5 -1 -3 -4)
	    (1  0 -1  0 -1  0)
	    (6  5  4 -3 -2 -1)))

(define C '((1  2  3  4  5  6  7)
	    (7  6 -5  4 -3  2 -1)
	    (1  3  6  2  4  7  9)
	    (1  3  0  4  7  9  2)
	    (3  4  5 -1 -3 -4 -3)
	    (1  0 -1  0 -1  0  1)
	    (6  5  4 -3 -2 -1  0)))

(define D '((1  2  3  4  5  6  7  8)
	    (7  6 -5  4 -3  2 -1  0)
	    (1  3  6  2  4  7  9  8)
	    (1  3  0  4  7  9  2  5)
	    (3  4  5 -1 -3 -5 -4 -3)
	    (1  0 -1  0 -1  0  1  0)
	    (0 -1  0 -1  0  1  0 -1)
	    (6  5  4 -3 -2 -1  0  1)))

(define powerset
  (lambda (set)
    (if (null? set)
	'(())
	(let ((element (car set))
	      (half (powerset (cdr set))))
	  (append (map (lambda (x) (cons element x)) half)
		  half)))))

;; foo
;; (foo 16)
;; foo17
;; (foo 17)
;; foo18
;; (foo 18)
(define foo
  (lambda (n)
    (map (lambda (x) (apply + (map (lambda (x) (apply + x)) (powerset (iota x))))) (iota n))))

;; prime5000
;; (prime 5000)
(define primes
  (lambda (n)
    (letrec
      ((loop
	(lambda (m acc)
	  (if (= m n)
	      acc
	      (if (zero? (apply min (map (lambda (x) (remainder m x)) acc)))
		  (loop (+ m 1) acc)
		  (loop (+ m 1) (cons m acc)))))))
      (loop 2 '(2)))))


;; callcc
;; (color-europe)

(define initialize-amb-fail
  (lambda ()
    (set! amb-fail
      (lambda ()
        (error "amb tree exhausted")))))

(initialize-amb-fail)

(define-macro amb
  (lambda alts
    `(let ((+prev-amb-fail amb-fail))
       (call/cc
        (lambda (+sk)
          ,@(map (lambda (alt)
                   `(call/cc
                     (lambda (+fk)
                       (set! amb-fail
                         (lambda ()
                           (set! amb-fail +prev-amb-fail)
                           (+fk 'fail)))
                       (+sk ,alt))))
                 alts)
          (+prev-amb-fail))))))

(define assert
  (lambda (pred)
    (if (not pred) (amb))))

(define color-europe
  (lambda ()
    (let ((p (choose-color))
          (e (choose-color))
          (f (choose-color))
          (b (choose-color))
          (h (choose-color))
          (g (choose-color))
          (l (choose-color))
          (i (choose-color))
          (s (choose-color))
          (a (choose-color))
          )
      (let ((portugal
             (list 'portugal p
                   (list e)))
            (spain
             (list 'spain e
                   (list f p)))
            (france
             (list 'france f
                   (list e i s b g l)))
            (belgium
             (list 'belgium b
                   (list f h l g)))
            (holland
             (list 'holland h
                   (list b g)))
            (germany
             (list 'germany g
                   (list f a s h b l)))
            (luxembourg
             (list 'luxembourg l
                   (list f b g)))
            (italy
             (list 'italy i
                   (list f a s)))
            (switzerland
             (list 'switzerland s
                   (list f i a g)))
            (austria
             (list 'austria a
                   (list i s g))))
        (let ((countries
               (list portugal spain
                     france belgium
                     holland germany
                     luxembourg
                     italy switzerland
                     austria)))
          (for-each
           (lambda (c)
             (assert
              (not (memq (cadr c)
                         (caddr c)))))
           countries)
          (for-each
           (lambda (c)
             (display (car c))
             (display " ")
             (display (cadr c))
             (newline))
           countries))))))

(define choose-color
  (lambda ()
    (amb 'red 'yellow 'blue 'white)))