;utility library
;Bruno Figares
(use srfi-1)


(define (make-eq? tag)
  (lambda (x) (eq? tag x)))

(define (apply-with x) (lambda (f) (f x)))
(define (eq-any? set)
  (lambda (x) (any (apply-with x) (map make-eq? set))))

(define (one-step-closure set deps)
  (delete-duplicates
   (concatenate 
    (cons set
	  (map (lambda (lreq->lget)
		 (if (every (eq-any? set) (car lreq->lget))
		     (cdr lreq->lget)
		     '()))
	       deps)))))

(define (closure set deps)
  (let loop ((closure set))
    (let ((nextstep (one-step-closure closure deps)))
      (if (= (length nextstep) (length closure))
	  closure
	  (loop nextstep)))))

(define (change-deps toremove prevdeps)
  (let* ((eq-any? (eq-any? toremove))
	 (changedep 
	 (lambda (lreq->lget)
	   (if (or (every eq-any? (car lreq->lget))
		   (every eq-any? (cdr lreq->lget)))
	       '()
	       `(,(cons (lset-difference eq? (car lreq->lget) toremove)
			(lset-difference eq? (cdr lreq->lget) toremove)))))))
    (concatenate (map changedep prevdeps))))

(define (list-of-deps-arrangements avail-deps)
  (let loop 
      ((accum-lst '())
       (lst-next avail-deps))
    
    (if (null? lst-next)
	accum-lst
	(loop (cons 
	       (cons 
		(car lst-next) 
		(cdr lst-next))
	       accum-lst) 
	      (cdr lst-next)))))



(define (find-superkey relational-schema functional-dependencies)
  (letrec
      ((sol-size
	(length relational-schema))
       
       (sol-list
	(list relational-schema))
       
       (add-solution 
	(lambda (newsol) (if (< (length newsol) sol-size)
			     (begin
			       (set! sol-list (list newsol))
			       (set! sol-size (length newsol)))
			     (set! sol-list (cons newsol
						  sol-list)))))       

       (forward?
	(lambda (nextstep)
	  (<= nextstep (sol-size))))

       (init-elems
	(lset-difference eq? 
			 relational-schema 
			 (concatenate (map cdr 
					   functional-dependencies))))
       
       (temp-closure 
	(closure init-elems functional-dependencies))
       
       (init-reduced-fd 
	(change-deps temp-closure functional-dependencies))
       
       (to-determine 
	(lset-difference eq? relational-schema temp-closure))

       (list-of-deps-arrangements
	(lambda (avail-deps)
	  (let loop 
	      ((accum-lst '())
	       (lst-next avail-deps))
	    
	    (if (null? lst-next)
		accum-lst
		(loop (cons 
		       (cons 
			(car lst-next) 
			(cdr lst-next))
		       accum-lst) 
		      (cdr lst-next))))))
	
       (find-sk-internal 
	(lambda (next-dependency available-keys functional-dependencies set-to-determine preset)
	  (let* ((fd-closure 
		  (closure (car next-dependency) 
			   functional-dependencies))

		 (new-av-keys
		  (change-deps fd-closure available-keys))

		 (new-fd-keys
		  (change-deps fd-closure functional-dependencies))

		 (new-preset
		  (begin (newline) (display (car next-dependency)) 
			 (newline) (display preset) (newline)
			 (delete-duplicates 
			  eq? 
			  (concatenate (list preset
					     (car next-dependency))))))
		  
		 (new-set-to-determine (lset-difference eq? set-to-determine new-preset)))

	    (if (null? new-set-to-determine)
		(add-solution new-preset)
		(for-each
		 (lambda (key-avkeys)
		   (if (forward? (+ 
				  (length (car key-avkeys)) 
				  (length new-preset)))
		       (find-sk-internal (car key-avkeys)
					 (cdr key-avkeys)
					 new-fd-keys
					 new-set-to-determine
					 new-preset)
		       (list-of-deps-arrangements new-av-keys)))))))))

    (if 
     (null? to-determine)
     (list init-elems)
     (begin
       (for-each 
	(lambda (key-avkeys)
	  (find-sk-internal (car key-avkeys)
			    (cdr key-avkeys)
			    init-reduced-fd 
			    to-determine 
			    init-elems))
	(list-of-deps-arrangements init-reduced-fd))
       (sol-list)))))

(find-superkey '(A B C) 
	       '(
		 ((A) . (B))
		 ((B) . (A)) 
		 ((A) . (C))))


(define func-dep-1 '((A B) . (G)))
(define func-dep-2 '((B) . (C)))
(define func-dep-3 '((D) . (A)))
(define func-dep-4 '((A) . (B)))
(define fd-list `(,func-dep-1 ,func-dep-2 ,func-dep-3 ,func-dep-4))