Paste: DFA minimization
Author: | littledan |
Mode: | factor |
Date: | Thu, 19 Feb 2009 08:09:32 |
Plain Text |
USING: kernel sequences regexp.transition-tables fry assocs
accessors locals math sorting arrays sets hashtables regexp.dfa
combinators.short-circuit ;
IN: regexp.minimize
: number-transitions
dup '[
[ _ at ]
[ [ first _ at ] assoc-map ] bi*
] assoc-map ;
: table>state-numbers
transitions>> keys <enum> [ swap ] H{ } assoc-map-as ;
: map-set
'[ drop @ dup ] assoc-map ; inline
: rewrite-transitions
[
[ '[ _ at ] change-start-state ]
[ '[ [ _ at ] map-set ] change-final-states ]
[ ] tri
] dip '[ _ @ ] change-transitions ; inline
: number-states
dup table>state-numbers
[ number-transitions ] rewrite-transitions ;
: initially-same?
{
[ drop <= ]
[ transitions>> '[ _ at keys ] bi@ set= ]
[ final-states>> '[ _ key? ] bi@ = ]
} 3&& ;
:: initialize-partitions
H{ } clone :> out
transition-table transitions>> keys :> states
states [| s1 |
states [| s2 |
s1 s2 transition-table initially-same?
[ s1 s2 2array out conjoin ] when
] each
] each out ;
: same-partition?
[ 2array natural-sort ] dip key? ;
: assemble-values
dup keys '[ _ swap [ at ] curry map ] bi@ zip ;
: stay-same?
[ '[ _ transitions>> at ] bi@ assemble-values ] dip
'[ _ same-partition? ] assoc-all? ;
: partition-more
over '[ drop first2 _ _ stay-same? ] assoc-filter ;
: partition>classes
>alist sort-keys
[ drop first2 swap ] assoc-map
<reversed>
>hashtable ;
: state-classes
[ initialize-partitions ] keep
'[ _ partition-more ] [ assoc-size ] while-changes
partition>classes ;
: canonical-state?
dupd at = ;
: delete-duplicates
'[ drop _ canonical-state? ] assoc-filter ;
: rewrite-duplicates
'[ [ _ at ] assoc-map ] assoc-map ;
: combine-transitions
[ delete-duplicates ] [ rewrite-duplicates ] bi ;
: combine-states
dup state-classes
[ combine-transitions ] rewrite-transitions ;
: minimize
clone number-states combine-states ;
New Annotation