87 lines
2.9 KiB
Factor
87 lines
2.9 KiB
Factor
! Copyright (C) 2009 Daniel Ehrenberg
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors arrays assocs combinators.short-circuit fry
|
|
hash-sets kernel locals math regexp.classes
|
|
regexp.transition-tables sequences sets sorting ;
|
|
IN: regexp.minimize
|
|
|
|
: table>state-numbers ( table -- assoc )
|
|
transitions>> keys H{ } zip-index-as ;
|
|
|
|
: number-states ( table -- newtable )
|
|
dup table>state-numbers transitions-at ;
|
|
|
|
: has-conditions? ( assoc -- ? )
|
|
values [ condition? ] any? ;
|
|
|
|
: initially-same? ( s1 s2 transition-table -- ? )
|
|
{
|
|
[ drop <= ]
|
|
[ final-states>> '[ _ in? ] bi@ = ]
|
|
[ transitions>> '[ _ at keys ] bi@ set= ]
|
|
} 3&& ;
|
|
|
|
:: initialize-partitions ( transition-table -- partitions )
|
|
! Partition table is sorted-array => ?
|
|
transition-table transitions>> keys natural-sort :> states
|
|
states length 2/ sq <hash-set> :> out
|
|
states [| s1 i1 |
|
|
states [| s2 |
|
|
s1 s2 transition-table initially-same?
|
|
[ s1 s2 2array out adjoin ] when
|
|
] i1 each-from
|
|
] each-index out ;
|
|
|
|
: same-partition? ( s1 s2 partitions -- ? )
|
|
{ [ [ sort-pair 2array ] dip in? ] [ drop = ] } 3|| ;
|
|
|
|
: stay-same? ( s1 s2 transition partitions -- ? )
|
|
[ '[ _ transitions>> at ] bi@ ] dip
|
|
'[ [ at ] dip _ same-partition? ] with assoc-all? ;
|
|
|
|
:: partition-more ( partitions transition-table -- partitions changed? )
|
|
partitions cardinality :> size
|
|
partitions members [
|
|
dup first2 transition-table partitions stay-same?
|
|
[ drop ] [ partitions delete ] if
|
|
] each partitions dup cardinality size = not ;
|
|
|
|
: partition>classes ( partitions -- synonyms ) ! old-state => new-state
|
|
members natural-sort <reversed> [ swap ] H{ } assoc-map-as ;
|
|
|
|
: (state-classes) ( transition-table -- partition )
|
|
[ initialize-partitions ] keep '[ _ partition-more ] loop ;
|
|
|
|
: assoc>set ( assoc -- keys-set )
|
|
[ drop dup ] assoc-map ;
|
|
|
|
: state-classes ( transition-table -- synonyms )
|
|
clone [ [ nip has-conditions? ] assoc-partition ] change-transitions
|
|
[ assoc>set ] [ (state-classes) partition>classes ] bi* assoc-union ;
|
|
|
|
: canonical-state? ( state transitions state-classes -- ? )
|
|
'[ dup _ at = ] swap '[ _ at has-conditions? ] bi or ;
|
|
|
|
: delete-duplicates ( transitions state-classes -- new-transitions )
|
|
dupd '[ drop _ _ canonical-state? ] assoc-filter ;
|
|
|
|
: combine-states ( table -- smaller-table )
|
|
dup state-classes
|
|
[ transitions-at ] keep
|
|
'[ _ delete-duplicates ] change-transitions ;
|
|
|
|
: combine-state-transitions ( hash -- hash )
|
|
[ H{ } clone ] dip over '[
|
|
_ [ 2array <or-class> ] change-at
|
|
] assoc-each [ swap ] assoc-map ;
|
|
|
|
: combine-transitions ( table -- table )
|
|
[ [ combine-state-transitions ] assoc-map ] change-transitions ;
|
|
|
|
: minimize ( table -- minimal-table )
|
|
clone
|
|
number-states
|
|
combine-states
|
|
combine-transitions
|
|
expand-ors ;
|