;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A random problem generator for the bounded blocks world.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (random-bounded-blocks limit space)
  "Returns a list of space towers, each tower is a list that might be nil.
  (A B C) means on(A B) and on(B C), () means an empty spot on table."
  (let ((blocks-list '(a b c d e f g h i j k l m n o p q r s t u v
			 w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1
                       m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1
                       a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 l2
                       m2 n2 o2 p2 q2 r2 s2 t2 u2 v2 w2 x2 y2 z2
                       a3 b3 c3 d3 e3 f3 g3 h3 i3 j3 k3 l3
                       m3 n3 o3 p3 q3 r3 s3 t3 u3 v3 w3 x3 y3 z3
                       a4 b4 c4 d4 e4 f4 g4 h4 i4 j4 k4 l4
                       m4 n4 o4 p4 q4 r4 s4 t4 u4 v4 w4 x4 y4 z4))
	(towers '())
        (result '())
        (blocks '()))
    (set! blocks (sublist blocks-list 0 limit))
    (do ((i 0 (+ 1 i)))
	((>= i space))
      (set! towers (cons '() towers)))
    (for-each (lambda (block) 
		;; push the bloc in (nth (random space) towers)
		(do ((i (random space))
		     (done '()))
		    ((= i 0) 
		     (set! done (cons (cons block (car towers)) done))
		     (set! towers (append! (reverse done) (rest towers))))
		  (set! i (- i 1))
		  (set! done (cons (car towers) done))
		  (set! towers (rest towers))))
	      blocks)
    (for-each (lambda (tower)
		(set! result (cons (permute-list tower) result)))
	      towers)
    result))

(define (permute-list old-list)
  "Return a random permutation of the list."
  (let ((new-list '()))
    (do ((i 0 (+ 1 i)))
	((>= i (length old-list)))
      (set! new-list (cons (nth (random (length old-list)) old-list)
                           new-list))
      (set! old-list (remove-if (lambda (x) (eq? x (first new-list)))
				old-list)))
    new-list))
    
(define (make-literals towers)
  "Returns a list of literals representing the state of the blocks."
  (let ((table-space 0)
        (literals '()))
    (set! literals (cons '(handempty) literals))
    (for-each (lambda (tower)
		(if tower
		    (set! literals 
			  (append! (make-tower-literals tower) literals))
		    (set! table-space (+ 1 table-space))))
	      towers)
    (set! literals (cons (list 'table-space table-space) literals))
    literals))

(define (make-tower-literals tower)
  (let ((literals '())
        (tower-copy tower))
    (set! literals (cons (list 'ontable (first tower)) literals))
    (for-each (lambda (block)
		(if (second tower-copy)
		    (set! literals (cons (list 'on (second tower-copy) block) 
					 literals))
		    (set! literals (cons (list 'clear block) literals)))
		(set! tower-copy (rest tower-copy)))
	      tower)
    literals))

(define (random-world number space)
  (make-literals (random-bounded-blocks number space)))

(define (random-goal number space)
  (rest (random-world number space)))