;;; FSA optimisation.
;;; The transformations herein should not affect the language accepted by
;;; a FSA; only make the FSA more efficient.

;; determinisation

(define (fsa-determinise fsa)
  "given a (possibly indeterministic) automaton fsa, gives an equivalent
  deterministic automaton.  The new automaton does not share states with the
  original automaton."

  ; this is effected by the "powerset construction"
  (let* ((statemap (make-statemap))
	 (visited '())
	 (goals '()))

    (define (fsa-stateset-successors stateset input)
      "gives all states reachable from any of states in stateset by input"
      (delete-duplicates
	(append-map (lambda (state)
		      (fsa-state-successors fsa state input)) stateset)))

    (define (possible-transitions-from stateset)
      "gives a list of (stateset, transition) pairs; stateset is a set of
      states reachable by some input from the parameter stateset, and
      transition is the transition that does so (with statesets mapped into new
      states by statemap)."
      (let* ((trans (fsa-transitions-from fsa stateset))
	     (inputs (delete-duplicates (append-map transition-lexicon trans))))
	(filter-map
	  (lambda (input)
	    (let ((newstates (fsa-stateset-successors stateset input))
		  (inputset (if (other-input? input)
			      (input-set-complement
				(list->input-set (delete other-input inputs)))
			      (make-input input))))
	      (and (not (null? newstates))
		   (list newstates
			 (make-transition (statemap stateset) inputset
					  (statemap newstates))))))
	  inputs)))

    (define (visit!? state)
      "marks state visited and tells if it was visited before"
      (let ((visited? (state-in? state visited)))
	(set! visited (cons state visited))
	visited?))

    (define (traverse-transitions-from! stateset)
      "recursively produces all transitions reachable from stateset.  As
      a side effect, also marks all states that are goal states (i.e. the
      stateset has at least one goal state in the original automaton)."
      (if (visit!? (statemap stateset)) '()
	(let ((transitions (possible-transitions-from stateset)))
	  (if (any (lambda (state) (state-in? state (fsa-goal-states fsa)))
		   stateset)
	    (set! goals (cons (statemap stateset) goals)))
	  (append (map cadr transitions)
		  (append-map (lambda (trans)
				(traverse-transitions-from! (car trans)))
			      transitions)))))

    (let* ((start-stateset (list (fsa-start-state fsa)))
	   (new-transitions (traverse-transitions-from! start-stateset)))
      (make-fsa (statemap start-stateset) goals new-transitions))))

;; minimisation

(define (fsa-reverse fsa)
  "give a fsa that accepts for every input of fsa, that input reversed"
  (let* ((start-state (make-combined-state (fsa-goal-states fsa) "/"))
	 (goals (list (fsa-start-state fsa)))
	 (goal-states (if (state-in? (fsa-start-state fsa) (fsa-goal-states fsa))
			(cons start-state goals) goals))
	 (new-fsa (make-fsa start-state goal-states
			    (map transition-reverse (fsa-transitions fsa))))
	 (new-transitions (fsa-transitions-project new-fsa (fsa-goal-states fsa)
						   (list start-state))))
    (make-fsa start-state goal-states
	      (append new-transitions (fsa-transitions new-fsa)))))

(define (fsa-minimise fsa)
  "gives an automaton equivalent to fsa, but deterministic and without
  redundant states or transitions"
  (fsa-determinise (fsa-reverse (fsa-determinise (fsa-reverse fsa)))))