#lang scheme

(require mzlib/trace)

; combinatoria-modos.
(define gen-2
  (lambda (l1 l2)
    (cond
      ((null? l1) '())
      (else
       (append
        (map
         (lambda (x)
           (if (list? x)
               (cons (car l1) x)
               (list (car l1) x))) 
         l2)
        (gen-2 (cdr l1) l2) ) ) 
      ) ))
(define genera
  (lambda (lst)
    (gen-2 lst (gen-2 lst lst)) ))

;(genera '(a e i o))
;; Modos posibles de una figura según combinatoria
(define modos-posibles-figura
  (lambda (lst f)
    (cond
      ((null? lst) '())
      ((= f 1)
        (cons (figura-1 (car lst))
              (modos-posibles-figura (cdr lst) f)))
      ((= f 2)
       (cons (figura-2 (car lst))
             (modos-posibles-figura (cdr lst) f)))
      ((= f 3)
       (cons (figura-3 (car lst))
             (modos-posibles-figura (cdr lst) f)))
      ((= f 4)
       (cons (figura-4 (car lst))
             (modos-posibles-figura (cdr lst) f))) ) ))
;;;;;;;
(define figura-1
  (lambda (modo)
    (do
        ((modo modo (cdr modo))
         (c 1 (+ c 1))
         (enunciado '())
         (salida '()))
      ((null? modo) (reverse salida))
      (set! enunciado (silogismo-1-enunciado (car modo) c))
      (set! salida (cons enunciado salida)) )))
(define silogismo-1-enunciado
  (lambda (enunciado n)
    (cond
      ((eq? enunciado 'a)
       (cond
         ((= n 1) "aMP")
         ((= n 2) "aSM")
         ((= n 3) "aSP")))
      ((eq? enunciado 'e)
       (cond
         ((= n 1) "eMP")
         ((= n 2) "eSM")
         ((= n 3) "eSP")))
      ((eq? enunciado 'i)
       (cond
         ((= n 1) "iMP")
         ((= n 2) "iSM")
         ((= n 3) "iSP")))
      ((eq? enunciado 'o)
       (cond
         ((= n 1) "oMP")
         ((= n 2) "oSM")
         ((= n 3) "oSP"))) ) ))
(define figura-2
  (lambda (modo)
    (do
        ((modo modo (cdr modo))
         (c 1 (+ c 1))
         (salida '()))
      ((null? modo) (reverse salida))
      (set! salida (cons (silogismo-2-enunciado (car modo) c) salida)) )))
(define silogismo-2-enunciado
  (lambda (enunciado n)
    (cond
      ((eq? enunciado 'a)
       (cond
         ((= n 1) "aPM")
         ((= n 2) "aSM")
         ((= n 3) "aSP")))
      ((eq? enunciado 'e)
       (cond
         ((= n 1) "ePM")
         ((= n 2) "eSM")
         ((= n 3) "eSP")))
      ((eq? enunciado 'i)
       (cond
         ((= n 1) "iPM")
         ((= n 2) "iSM")
         ((= n 3) "iSP")))
      ((eq? enunciado 'o)
       (cond
         ((= n 1) "oPM")
         ((= n 2) "oSM")
         ((= n 3) "oSP"))) ) ))
(define figura-3
  (lambda (modo)
    (do
        ((modo modo (cdr modo))
         (c 1 (+ c 1))
         (salida '()))
      ((null? modo) (reverse salida))
      (set! salida (cons (silogismo-3-enunciado (car modo) c) salida)) )))
(define silogismo-3-enunciado
  (lambda (enunciado n)
    (cond
      ((eq? enunciado 'a)
       (cond
         ((= n 1) "aMP")
         ((= n 2) "aMS")
         ((= n 3) "aSP")))
      ((eq? enunciado 'e)
       (cond
         ((= n 1) "eMP")
         ((= n 2) "eMS")
         ((= n 3) "eSP")))
      ((eq? enunciado 'i)
       (cond
         ((= n 1) "iMP")
         ((= n 2) "iMS")
         ((= n 3) "iSP")))
      ((eq? enunciado 'o)
       (cond
         ((= n 1) "oMP")
         ((= n 2) "oMS")
         ((= n 3) "oSP"))) ) ))
(define figura-4
  (lambda (modo)
    (do
        ((modo modo (cdr modo))
         (c 1 (+ c 1))
         (salida '()))
      ((null? modo) (reverse salida))
      (set! salida (cons (silogismo-4-enunciado (car modo) c) salida)) )))
(define silogismo-4-enunciado
  (lambda (enunciado n)
    (cond
      ((eq? enunciado 'a)
       (cond
         ((= n 1) "aPM")
         ((= n 2) "aMS")
         ((= n 3) "aSP")))
      ((eq? enunciado 'e)
       (cond
         ((= n 1) "ePM")
         ((= n 2) "eMS")
         ((= n 3) "eSP")))
      ((eq? enunciado 'i)
       (cond
         ((= n 1) "iPM")
         ((= n 2) "iMS")
         ((= n 3) "iSP")))
      ((eq? enunciado 'o)
       (cond
         ((= n 1) "oPM")
         ((= n 2) "oMS")
         ((= n 3) "oSP"))) ) ))
;(modos-posibles-figura (genera '(a e i o)) 1)
;
(define matching
  (lambda (lst figura legitimos)
    (append-map
     (lambda (m)
      (filter-map 
       (lambda (valido legitimo) 
         (match m valido legitimo)) 
       figura legitimos))
     lst) ))

(define match
  (lambda (p1 p2 id)
    (if (null? p1)
        id
        (if (string=? (car p1) (car p2))
            (cons
             (car p1)
             (match (cdr p1) (cdr p2) id))
            #f))
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 1ª Figura, modos válidos
(define barbara '("aMP" "aSM" "aSP"))
(define celarent '("eMP" "aSM" "eSP"))
(define darii '("aMP" "iSM" "iSP"))
(define ferio '("eMP" "iSM" "oSP"))
(define sub1-AAI '("aMP" "aSM" "iSP"))
(define sub2-EAO '("eMP" "aSM" "oSP"))
; 2ª Figura, modos válidos
(define cesare '("ePM" "aSM" "eSP"))
(define camestre '("aPM" "eSM" "eSP"))
(define festino '("ePM" "iSM" "oSP"))
(define baroco '("aPM" "oSM" "oSP"))
(define octavo-2ª-AEO '("aPM" "eSM" "oSP"))
(define vigesimo-2ª-EAO '("ePM" "aSM" "oSP"))
;; 3ª Figura, modos válidos
(define darapti '("aMP" "aMS" "iSP"))
(define disamis '("iMP" "aMS" "iSP"))
(define datisi '("aMP" "iMS" "iSP"))
(define bocardo '("oMP" "aMS" "oSP"))
(define ferison '("eMP" "iMS" "oSP"))
(define felapton '("eMP" "aMS" "oSP"))
;; 4ª Figura, galénica, modos válidos
(define bramantip '("aPM" "aMS" "iSP"))
(define camenes '("aPM" "eMS" "eSP"))
(define dimaris '("iPM" "aMS" "iSP"))
(define fesapo '("ePM" "aMS" "oSP"))
(define fresison '("ePM" "iMS" "oSP"));
(define octava-4ª-AEO '("aPM" "eMS" "oSP"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define primera (list barbara celarent darii ferio sub1-AAI sub2-EAO))
(define primera-id '(barbara celarent darii ferio sub1-AAI sub2-EAO))
(define segunda (list cesare camestre festino baroco octavo-2ª-AEO vigesimo-2ª-EAO))
(define segunda-id '(cesare camestre festino baroco octavo-2ª-AEO vigesimo-2ª-EAO))
(define tercera (list darapti disamis datisi bocardo ferison felapton))
(define tercera-id '(darapti disamis datisi bocardo ferison felapton))
(define cuarta (list bramantip camenes dimaris fesapo fresison octava-4ª-AEO))
(define cuarta-id '(bramantip camenes dimaris fesapo fresison octava-4ª-AEO))


;(matching (modos-posibles-figura (genera '(a e i o)) 1) primera)
;(matching (modos-posibles-figura (genera '(a e i o)) 2) segunda)
;(matching (modos-posibles-figura (genera '(a e i o)) 3) tercera)
;(matching (modos-posibles-figura (genera '(a e i o)) 4) cuarta)

(provide modos-posibles-figura genera)

;(define q (modos-posibles-figura (genera '(a e i o)) 1))