#lang scheme

(require mzlib/trace)

;;;;;Operaciones posibles
(define 1->2
  (lambda (p1 p2 p3)
    (list (rest p1) (cons (first p1) p2) p3)
    ))
(define 1->3
  (lambda (p1 p2 p3)
    (list (rest p1) p2 (cons (first p1) p3))
    ))
(define 2->3
   (lambda (p1 p2 p3)
    (list p1 (rest p2) (cons (first p2) p3))
    ))
(define 2->1
  (lambda (p1 p2 p3)
    (list (cons (first p2) p1) (rest p2) p3)
    ))
(define 3->1
  (lambda (p1 p2 p3)
    (list (cons (first p3) p1) p2  (rest p3))
    ))
(define 3->2
   (lambda (p1 p2 p3)
    (list p1 (cons (first p3) p2) (rest p3))
    ))
;;Operaciones aplicables
(define operaciones-posibles
  (lambda (estado)
    (let ((p1 (first estado))
          (p2 (second estado))
          (p3 (third estado))
          )
      (cond
        ((null? p1)
         (cond
           ((null? p2) (list 3->1 3->2))
           ((null? p3) (list 2->1 2->3))
           (else (list 2->1 2->3 3->1 3->2)) )
         )
        ((null? p2)
         (cond
           ((null? p1) (list 3->1 3->2))
           ((null? p3) (list 1->2 1->3))
           (else (list 1->2 1->3 3->1 3->2)) )
         )
        ((null? p3)
         (cond
           ((null? p1) (list 2->1 2->3))
           ((null? p2) (list 1->2 1->3))
           (else (list 1->2 1->3 2->1 2->3)) )
         )
        (else (list 1->2 1->3 2->1 2->3 3->1 3->2)
              )
        )
      )
    ))
;;Restricción: ley de Brahma
(define restriccion
  (lambda (estado mov)
    (let* ((p1 (first estado))
           (p2 (second estado))
           (p3 (third estado))
           (nudo (mov p1 p2 p3)))
      (let go ((pilas nudo)
               )
        (if (null? pilas)
            #t;nudo
            (if (cumple-brahma? (first pilas))
                (go (rest pilas))
                #f)
            )
        )
      )
    ))
(define cumple-brahma?
  (lambda (pila)
    (if (null? pila)
        #t
        (if (= (first pila) (apply min pila))
            (cumple-brahma? (rest pila))
            #f)
        )
    ))
(define es-respuesta?
  (lambda (estado)
    (equal? estado (list '() '() '(1 2 3)))
    ))
;;Operaciones legítimas
(define operaciones-legitimas
  (lambda (estado oper-posibles)
    (let go ((oper-pos oper-posibles)
             (resultado '())
             )
      (cond
        ((null? oper-pos) resultado)
        ((es-respuesta? estado) resultado)
        ((restriccion estado (first oper-pos))
         (go (rest oper-pos) (cons (first oper-pos) resultado)) )
        (else
         (go (rest oper-pos) resultado))
        )
      )
    ))
;;(mueve num-discos 1 3)

(define mueve
  (lambda (n p1 p2)
    (cond
      ((= n 1) (subproblema p1 p2) )
      (else
       (list
        (mueve (- n 1) p1 (- 6 p1 p2));subproblema inmediato
        (mueve 1 p1 p2);mueve el primero de la pila
        (mueve (- n 1) (- 6 p1 p2) p2));resto del problema
       ) 
      ) ))
;;Numeramos los postes: 1 2 3
(define subproblema
  (lambda (orig dest)
    (cond
      ((= orig 1)
;       (printf "Subproblema con origen en p~a~n" orig)
       (if (= dest 2)
           1->2
           1->3))
      ((= orig 2)
;       (printf "Subproblema con origen en p~a~n" orig)
       (if (= dest 1)
           2->1
           2->3))
      ((= orig 3)
;       (printf "Subproblema con origen en p~a~n" orig)
       (if (= dest 1)
           3->1
           3->2))
      )
    ))
(define q (mueve 8 1 3))