# Copyright 2016, 2017, 2018, 2019, 2020, 2021 Kevin Ryde
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# This file is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file.  See the file COPYING.  If not, see
# <http://www.gnu.org/licenses/>.


# Some miscellaneous functions related FLAT.pm automatons.

package MyFLAT;
use 5.010;
use strict;
use warnings;
use Carp 'croak';
use List::Util 'max','sum';
use Scalar::Util 'looks_like_number';
use Regexp::Common 'balanced';

# uncomment this to run the ### lines
# use Smart::Comments;

use base 'Exporter';
our @EXPORT_OK
  = (
     # generic, methods
     # 'get_non_accepting','num_accepting','num_non_accepting',
     # 'eventually_accepting', 'get_eventually_accepting',
     # 'get_eventually_accepting_info',
     # 'prefix',
     # 'prefix_accepting','get_prefix_accepting','get_prefix_accepting_info',
     # 'separate_sinks','add_sink',
     # 'rename_accepting_last',
     # 'is_accepting_sink',
     # 'blocks','binary_to_base4',
     # 'transmute',

     # generic functions
     'fraction_digits',

     # fairly specific
     'zero_digits_flat','one_bits_flat',
     'bits_N_even_flat','bits_N_odd_flat','bits_of_length_flat',
     'aref_to_FLAT_DFA',

     # temporary
     # 'as_nfa','concat','minimize','reverse,  # methods

     # misc
     'FLAT_count_contains',
     'FLAT_rename',
     'FLAT_to_perl_re',


     # personal preferences
     'view',
     'FLAT_check_is_equal','FLAT_check_is_subset',
     'FLAT_show_breadth',
     'FLAT_print_perl_table',
     'FLAT_print_perl_accepting',
     'FLAT_print_gp_inline_table',
     'FLAT_print_gp_inline_accepting',
     'FLAT_print_tikz',
    );
our %EXPORT_TAGS = (all => \@EXPORT_OK);


#------------------------------------------------------------------------------

=pod

=over

=item C<@states = $fa-E<gt>MyFLAT::get_non_accepting>

Return a list of all the non-accepting states in C<$fa>.

=back

=cut

sub get_non_accepting {
  my ($fa) = @_;
  return grep {! $fa->is_accepting($_)} $fa->get_states;
}

#------------------------------------------------------------------------------

=pod

=over

=item C<$count = num_accepting($fa)>

=item C<$count = num_non_accepting($fa)>

Return the number of accepting or non-accepting states in C<$fa>.

=back

=cut

sub num_accepting {
  my ($fa) = @_;
  my @states = $fa->get_accepting;
  return scalar(@states);
}
sub num_non_accepting {
  my ($fa) = @_;
  my @states = $fa->MyFLAT::get_non_accepting;
  return scalar(@states);
}

sub num_symbols {
  my ($fa) = @_;
  my @alphabet = $fa->alphabet;
  return scalar(@alphabet);
}

#------------------------------------------------------------------------------

sub descendants {
  my ($self, $state, $symb) = @_;

  my %try;
  @try{ref $state eq 'ARRAY' ? @$state : $state} = ();  # hash slice
  my %seen;
  my %ret;
  while (%try) {
    foreach my $from (keys %try) {
      delete $try{$from};
      $seen{$from} = 1;
      foreach my $to ($self->successors($from,$symb)) {
        $ret{$to} = 1;
        unless ($seen{$to}++) {
          $try{$to} = undef;
        }
      }
    }
  }
  return keys %ret;
}


#------------------------------------------------------------------------------
# Prefixes

=pod

=over

=item C<$new_lang = $lang-E<gt>prefix>

=item C<$new_lang = $lang-E<gt>prefix ($proper)>

Return a new regular language object for prefixes of C<$lang>.  This means
all strings S for which there exists some T where S.T is in C<$lang>.  For
example if "abc" is in C<$lang> then C<$new_lang> has all prefixes "", "a",
"ab", "abc".

The default is to allow T empty, so all strings of C<$lang> are included in
C<$new_lang>.  Optional parameter C<$proper> true means T must be non-empty
so only proper prefixes S are accepted.

In both cases prefix S can be the empty string, if suitable T exists.  For
C<$proper> false this means if C<$lang> accepts anything at all (C<!
$lang-E<gt>is_empty>).  For C<$proper> true it means if C<$lang> accepts
some non-empty string.

=back

=cut

sub prefix {
  my ($self, $proper) = @_;
  $self = $self->clone;
  my @ancestors = $self->MyFLAT::ancestors([$self->get_accepting]);
  if ($proper) {
    $self->unset_accepting($self->get_accepting);
  }
  $self->set_accepting(@ancestors);
  return $self;
}

sub ancestors {
  my ($self, $state, $symb) = @_;

  # "targets" are the states sought as successors.  Initially given $state,
  # then the immediate successors of those, successors of successors,
  # etc.
  # "ret" is those successors.  It does not include the initial $state,
  # unless a cycle comes back around to some of $state.
  # "try" are states to look at for a successor target.  Initially
  # everything, then when a state is put in "ret" don't try it again.

  my %targets;
  @targets{ref $state eq 'ARRAY' ? @$state : $state} = ();  # hash slice
  my %try;
  @try{$self->get_states} = (); # hash slice
  my %ret;
  my $more;
  do {
    $more = 0;
    foreach my $from (keys %try) {
      foreach my $to ($self->successors($from,$symb)) {
        if (exists $targets{$to}) {
          delete $try{$from};
          $ret{$from} = 1;
          $targets{$from} = 1;
          $more = 1;
        }
      }
    }
  } while ($more);
  return keys %ret;
}

# UNTESTED
# like successors, but the one-step preceding
sub predecessors {
  my ($self, $state, $symb) = @_;
  my %targets;
  @targets{ref $state eq 'ARRAY' ? @$state : $state} = ();  # hash slice
  ### %targets
  my @ret;
  foreach my $from ($self->get_states) {
    foreach my $to ($self->successors($from,$symb)) {
      if (exists $targets{$to}) {
        push @ret, $from;
      }
    }
  }
  return @ret;
}

=pod

=over

=item C<@states = $fa-E<gt>get_prefix_states ()>

=item C<@states = $fa-E<gt>get_prefix_states ($proper)>

Return a list of those states which C<prefix()> would make accepting (and
all other states non-accepting).

This is all ancestor states of the accepting states in C<$fa>, so the
predecessors of accepting, the predecessors of them, etc.  The default
C<$proper> false includes the original accepting states (so all original
strings of C<$fa>).  For C<$proper> the original accepting states are not
included, unless they occur as ancestors.  (If they do, and are reachable
from starting states, then it means there are already some prefixes accepted
by C<$fa>.)

No attention is paid to start states and what might be reached from them.
This allows prefixing to be found or manipulated before setting starts.

C<$fa> can be modified to accept also its prefixes like a non-copying form
of C<$fa-E<gt>prefix()> by

    $fa->set_accepting($fa->get_prefix_states);



=item C<@states = get_prefix_accepting($fa)>

=item C<$fa = prefix_accepting($fa)>

C<get_prefix_accepting> returns states which are not accepting but which by
some sequence of symbols are able to reach accepting.

Some states of C<$fa> may be non-accepting, but able to reach an accepting
state by some sequence of symbols.  C<get_prefix_accepting()> returns a list
of those states.

C<prefix_accepting()> returns a new FLAT which has these "prefix accepting"
states set as accepting.  The effect is to accept all strings C<$fa> does,
and in addition accept all prefixes of strings accepted by C<$fa>, including
the empty string.

Prefix accepting states are the predecessors of accepting states, and
predecessors of those prefix states, etc.  This usually extends back to
starting states, and includes those states.  But no attention is paid to
starting-ness, the process just continues back by predecessors, irrespective
of what might be actually reachable from a starting state.

=back

=cut

# Return depth=>$depth,states=>$aref.
sub get_prefix_accepting_info {
  my ($fa) = @_;
  my $alphabet_aref = [ $fa->alphabet ];
  my %non_accepting;
  @non_accepting{$fa->MyFLAT::get_non_accepting} = ();  # hash slice
  my $depth = -1;
  my %prefixes;
  my $more;
  do {
    $depth++;
  STATE: while (my ($state) = each %non_accepting) {
      # if any successor is an accepting or accepting prefix then this state
      # is an accepting prefix too
      if (grep
          {$prefixes{$_} || $fa->is_accepting($_)}
          $fa->successors([$fa->epsilon_closure($state)], $alphabet_aref)) {
        $prefixes{$state} = 1;
        delete $non_accepting{$state};
        $more = 1;
      }
    }
  } while ($more--);
  return (depth => $depth, states => [ keys %prefixes ]);
}

sub get_prefix_accepting {
  my ($fa) = @_;
  my %info = get_prefix_accepting_info($fa);
  return @{$info{'states'}};
}

# Return a new FLAT (a clone) which accepts any initial prefix of the
# strings accepted by $fa.
# Each state is set to accepting if it has any accepting successor (some
# symbol leads to accepting), and repeating until no more such can be found.
#
sub prefix_accepting {
  my ($fa, %options) = @_;
  my %info = get_prefix_accepting_info($fa);
  my $states = $info{'states'};
  my $depth  = $info{'depth'};
  if ($options{'verbose'}) {
    print $fa->{name}//'',
      " accepting prefixes, count ",scalar(@$states)," more, depth=$depth\n";
  }

  $fa = $fa->clone;
  $fa->set_accepting(@$states);
  if (defined (my $name = $fa->{'name'})) {
    if ($depth) { $name .= ' prefixes'; }
    $fa->{'name'} = $name;
  }
  return $fa;
}

{
  package FLAT::Regex;
  sub MyFLAT_prefix {
    my $self = shift;
    $self->_from_op($self->op->MyFLAT_prefix(@_));
  }
  sub MyFLAT_suffix {
    my $self = shift;
    $self->_from_op($self->op->MyFLAT_suffix(@_));
  }
}
{
  package FLAT::Regex::Op::atomic;
  sub MyFLAT_prefix {
    my ($self, $proper) = @_;
    my $member = $self->members;
    return (! defined $member
            ? $self   # null regex, unchanged

            : $proper
            # symbol becomes empty string, # empty string becomes null regexp
            ? (ref $self)->new(length($member) ? '' : undef)

            : length($member)
            # symbol, accept it and also empty string
            ? FLAT::Regex::Op::alt->new((ref $self)->new(''), $self)

            # empty string, unchanged
            : $self);
  }
  *MyFLAT_suffix = \&MyFLAT_prefix;
}
{
  package FLAT::Regex::Op::star;
  sub MyFLAT_prefix {
    my ($self, $proper) = @_;
    my $member = $self->members;

    # M* -> M* properprefix(M)
    # Can be proper prefix always since a itself covered by M*.
    # But must check M has a non-empty string before doing that.
    # Otherwise get (M* #) which doesn't match anything at all, but for
    # $proper==0 want to match the empty string (unless M is_empty).

    return ($member->has_nonempty_string
            ? FLAT::Regex::Op::concat->new($self, $member->MyFLAT_prefix(1))

            : $proper ? FLAT::Regex::Op::atomic->new(undef)
            :           $member);  # empty string or null regex remains so
  }
  sub MyFLAT_suffix {
    my ($self, $proper) = @_;
    my $member = $self->members;

    # like prefix but reverse

    return ($member->has_nonempty_string
            ? FLAT::Regex::Op::concat->new($member->MyFLAT_suffix(1), $self)

            : $proper ? FLAT::Regex::Op::atomic->new(undef)
            :           $member);  # empty string or null regex remains so
  }
}
{
  package FLAT::Regex::Op::concat;
  sub MyFLAT_prefix {
    my ($self,$proper) = @_;

    # B C -> properprefix(B) | B prefix(C)
    #
    # If prefix(C) is not null then it includes the empty string and can go
    # to properprefix(B) since whole B is covered by (B []).
    #
    # If C is the empty string and $proper==1 then prefix(C) is null so get
    # (B #) which matches nothing and thus doesn't give whole C.  This is as
    # desired, since it is not a proper prefix in that case.
    #
    # For 3 or more concat members, nest like
    # A B C -> properprefix(A) | A ( properprefix(B) | B prefix(C) )
    #
    # properprefix() is allowed for the earlier parts once a non-null prefix
    # is seen.
    #
    # An empty $member means the whole concat matches nothing.  Watch for
    # that explicitly since B=# would give prefix(A) | (A #) which would
    # wrongly accept prefix(A).

    my $ret;
    foreach my $member (CORE::reverse $self->members) {
      if ($member->is_empty) { return $member; }
      my $prefix = $member->MyFLAT_prefix($proper);
      $ret = (defined $ret
              ? FLAT::Regex::Op::alt->new ($prefix,
                                           __PACKAGE__->new($member, $ret))
              : $prefix);
      $proper ||= ! $prefix->is_empty;
    }
    return $ret;
  }
  sub MyFLAT_suffix {
    my ($self,$proper) = @_;

    # similar to prefix, working forwards through members for the nesting
    # A B   ->   suffix(A) B | propersuffix(B)
    # A B C -> ( suffix(A) B | propersuffix(B)) C ) | propersuffix(C)

    my $ret;
    foreach my $member ($self->members) {
      if ($member->is_empty) { return $member; }
      my $suffix = $member->MyFLAT_suffix($proper);
      $ret = (defined $ret
              ? FLAT::Regex::Op::alt->new (__PACKAGE__->new($ret, $member),
                                           $suffix)
              : $suffix);
      $proper ||= ! $suffix->is_empty;
    }
    return $ret;
  }
}
{
  package FLAT::Regex::Op;
  # return new op of $self members transformed by $member->$method on each
  sub MyFLAT__map_method {
    my $self = shift;
    my $method = shift;
    return (ref $self)->new(map {$_->$method(@_)} $self->members);
  }
}
{
  package FLAT::Regex::Op::alt;
  # prefix(X|Y) = prefix(X) | prefix(Y)
  # suffix(X|Y) = suffix(X) | suffix(Y)
  sub MyFLAT_prefix {
    my $self = shift;
    return $self->MyFLAT__map_method('MyFLAT_prefix',@_);
  }
  sub MyFLAT_suffix {
    my $self = shift;
    return $self->MyFLAT__map_method('MyFLAT_suffix',@_);
  }
}
{
  package FLAT::Regex::Op::shuffle;
  *MyFLAT_prefix = \&FLAT::Regex::Op::alt::MyFLAT_prefix;
  *MyFLAT_suffix = \&FLAT::Regex::Op::alt::MyFLAT_suffix;
}



#------------------------------------------------------------------------------
# Eventually Accepting

=pod

=over

=item C<@states = get_eventually_accepting($fa)>

=item C<$fa = eventually_accepting($fa)>

Some states of C<$fa> may be "eventually accepting" in the sense that after
more symbols they are certain to reach accepting, for all possible further
symbol values.

For example suppose alphabet a,b,c.  If bba, bbb and bbc are all accepted by
C<$fa> then string "bb" is reckoned as eventually accepted since one further
symbol, any of a,b,c, goes to accepting.

C<get_eventually_accepting()> returns a list of states which are eventually
accepting.  C<eventually_accepting()> returns a clone of C<$fa> which has
those states set as accepting.

Eventually accepting states are found first as any state with all symbols
going to accepting, then any state with all symbols going to either
accepting or eventually accepting, and so on until no more such further
states.

In an NFA, any epsilon transitions are crossed in the usual way, but there
should be just one starting state (or just one which ever leads to
accepting).  If multiple starting states then the simple rule used will
sometimes fail to find all eventually accepting states and hence strings.
C<as_dfa> will collapse multiple starts.

=back

=cut

# Return depth=>$depth,states=>$aref.
sub get_eventually_accepting_info {
  my ($fa) = @_;
  my $alphabet_aref = [ $fa->alphabet ];
  my %non_accepting;
  @non_accepting{$fa->MyFLAT::get_non_accepting} = ();  # hash slice
  my %eventually;
  my $depth = -1;
  my $more;
  do {
    $depth++;
    my @new_eventually;
  STATE: while (my ($state) = each %non_accepting) {
      ### $state
      foreach my $to_state ($fa->successors([$fa->epsilon_closure($state)],
                                            $alphabet_aref)) {
        ### $to_state
        unless ($eventually{$to_state} || $fa->is_accepting($to_state)) {
          next STATE;
        }
      }
      push @new_eventually, $state;
    }
    foreach my $state (@new_eventually) {
      $eventually{$state} = 1;
      delete $non_accepting{$state};
      $more = 1;
    }
  } while ($more--);
  return (depth => $depth, states => [ keys %eventually ]);
}

sub get_eventually_accepting {
  my ($fa) = @_;
  my %info = get_eventually_accepting_info($fa);
  return @{$info{'states'}};
}

# Return a new FLAT (a clone) which accepts strings eventually accepted by $fa.
sub eventually_accepting {
  my ($fa, %options) = @_;
  my %info = get_eventually_accepting_info($fa);
  my $states = $info{'states'};
  my $depth  = $info{'depth'};
  if ($options{'verbose'}) {
    print $fa->{name}//'',
      " eventually accepting, count ",scalar(@$states)," more, depth=$depth\n";
  }

  $fa = $fa->clone;
  $fa->set_accepting(@$states);
  if (defined (my $name = $fa->{'name'})) {
    if ($depth) { $name .= ' eventually'; }
    $fa->{'name'} = $name;
  }
  return $fa;
}


#------------------------------------------------------------------------------

=pod

=over

=item C<$fa = fraction_digits($num,$den, %options)>

Return a C<FLAT::DFA> which matches digits of fraction C<$num/$den>.
The DFA remains accepting as long as it is given successive digits of the
fraction, and goes non-accepting (and remains so) on a wrong digit.

The default is decimal digits, or optional key/value

    radix  => integer>=2

If C<$num/$den> is an exact fraction in C<$radix>, meaning C<$num/$den ==
n/$radix**k> for some integer n,k, then it has two different
representations.  Firstly terminating digits followed by trailing 0s,
secondly C<$n-1> followed by trailing C<$radix-1> digits.

For example 42/100 is 420000... and 419999...  Both digit sequences converge
to 42/100.  For fractions not an exact power of C<$radix> there is just one
digit sequence which converges to C<$num/$den>.

C<$num == 0> gives a DFA matching 000..., or C<$num==$den> for fraction
C<$num/$den == 1> gives a DFA matching 9999... (or whatever C<$radix-1>).

In all cases the C<$fa-E<gt>alphabet> is all the digits 0 to C<$radix-1>.
Those which are "wrong" digits at a given point go to a non-accepting sink
state.  This is designed so that C<$fa-E<gt>complement> gives all digit
strings except fraction C<$num/$den>.

MAYBE: Option to omit wrong digits in an NFA, so transitions only for the
accepted digits.

MAYBE: Currently the symbols for digits in a radix 11 or higher are decimal
strings, but that might change.  Could have an option for hex or a table or
func.  Decimal strings are easy to work with their values in Perl if a
further func might act on the resulting FLAT.  C<FLAT_rename> can always
change for final result if desired.

=back

=cut

sub fraction_digits {
  my ($num, $den, %options) = @_;
  ### fraction_digits(): "$num / $den"

  require FLAT::DFA;
  my $f = FLAT::DFA->new;

  my $radix = $options{'radix'} || 10;
  ### $radix

  my $not_accept = $f->add_states(1);
  $f->add_transition ($not_accept,$not_accept, 0..$radix-1);

  unless ($num >=0 && $num <= $den) {
    croak "fraction_digits() must have 0<=num<=den";
  }
  unless ($radix >= 2) {
    croak "fraction_digits() must have radix>=2";
  }

  my %num_to_state;
  my $prev_state = $f->add_states(1);
  $f->set_starting ($prev_state);
  $f->set_accepting ($prev_state);
  $num_to_state{$num} = $prev_state;
  my $prev_digit;
  my $prev_prev_state;

  if ($num == $den) {
    # 1/1 match .9999...
    $f->add_transition ($prev_state,$prev_state,      $radix-1);
    $f->add_transition ($prev_state,$not_accept, 0..$radix-2);
    return $f;
  }

  for (;;) {
    ### $num

    $num *= $radix;
    my $digit = int($num / $den);
    $num %= $den;
    if ($digit >= 10) { $digit = chr(ord('A')+$digit-10); }
    ### $digit

    my $cycle_state = $num_to_state{$num};
    my $state = $cycle_state // $f->add_states(1);
    $f->set_accepting ($state);
    $f->add_transition ($prev_state,$state, $digit);
    $f->add_transition ($prev_state,$not_accept,
                        grep {$_!=$digit} 0..$radix-1);

    if (defined $cycle_state) {
      if ($num == 0 && $prev_digit) {
        $state = $f->add_states(1);
        $f->set_accepting ($state);
        $f->set_transition ($prev_prev_state, $not_accept,
                            grep {$_!=$prev_digit-1 && $_!=$prev_digit}
                            0..$radix-1);
        $f->add_transition ($prev_prev_state,$state, $prev_digit-1);
        $f->add_transition ($state,$state,      $radix-1);
        $f->add_transition ($state,$not_accept, 0..$radix-2);
      }
      return $f;
    }

    $num_to_state{$num} = $state;
    $prev_digit = $digit;
    $prev_prev_state = $prev_state;
    $prev_state = $state;
  }
}

  # $radix ||= 10;
  # unless ($num >=0 && $num < $den) {
  #   croak "fraction_digits() must have 0<=num<den";
  # }
  # my @digits;  # the successive digits of $num/$den
  # my %seen;    # $digit=>$index of digits in @digits
  # my $pos = 0;
  # for (;;) {
  #   if (defined(my $rpos = $seen{$num})) {
  #     # this numerator is a repeat of what was at $rpos, so cycle back to there
  #     require FLAT::DFA;
  #     my $f = FLAT::DFA->new;
  #     my @states = $f->add_states($pos+1);
  #     $f->set_starting($states[0]);
  #     $f->set_accepting(@states[0..$pos-1]);
  #     foreach my $i (0 .. $pos) {
  #       foreach my $d (0 .. $radix-1) {
  #         my $to = ($i==$pos || $d != $digits[$i] ? $pos   # not accept
  #                   : $i == $pos-1 ? $rpos                 # cycle back
  #                   : $i+1);                               # next
  #         $f->add_transition ($states[$i],$states[$to]);
  #       }
  #     }
  #     $f->{'name'} = "$num/$den radix $radix";
  #     return $f;
  #   }
  #
  #   ### $num
  #   ### assert: $num >= 0
  #   ### assert: $num < $den
  #   $seen{$num} = $pos++;
  #   $num *= $radix;
  #   my $digit = int($num / $den);
  #   $num %= $den;
  #   if ($digit >= 10) { $digit = chr(ord('A')+$digit-10); }
  #   push @digits, $digit;
  # }

#
# my $str;
#   $str .= $digit;
# my $re = substr($str,0,$rpos) . "(".substr($str,$rpos) . ")*";
# ### $str
# ### $rpos
# ### $re
# my $f = FLAT::Regex->new($re)->as_dfa;
# $f->{'name'} = "$num/$den radix $radix";
# $f = prefix($f);
# return $f;


# $fa is a FLAT::DFA which matches fractions represented as strings of digits.
# Return a new FLAT::DFA which matches any terminating fraction like 10111
# also as its non-terminating equivalent 101101111...
# FIXME: currently only works for binary, and only when terminating
# fractions end with a 1, not with low 0s.
sub fraction_also_nines {
  my ($fa, %options) = @_;

  # FLAT::Regex->new ('(0|1)* 1 0*')->as_nfa;

  my $binary_odd_flat = FLAT::Regex->new ('(0|1)* 1')->as_dfa;
  return $fa->as_dfa
    ->intersect($binary_odd_flat)
    ->MyFLAT::skip_final
    ->MyFLAT::concat(FLAT::Regex->new ('01*')->as_dfa)
    ->union($fa)
    ->MyFLAT::set_name($fa->{'name'});
}

# $fa is a FLAT::NFA or FLAT::DFA accepting strings of digits.
# Those strings are interpreted as fractional numbers .ddddd...
# Return a new FLAT (same DFA or NFA) which accepts these same strings and
# also representations ending 999...
# For example if 321 is accepted then 3209999... is also accepted.
#
# The radix is taken from $fa->alphabet, or option radix=>$r can be given if
# $fa might not have all digits appearing.
#
# The digit strings read high to low by default.  Option
# direction=>"lowtohigh" can interpret them low to high instead.  Low to
# high will be more efficient since manipulations are at the low end
# (propagate a carry up through low "9"s), but both work.
#
# sub fraction_nines {
#   my ($fa, %options) = @_;
#   ### digits_increment() ...
#
#   # starting state is flip
#   # in flip 0-bit successor as a 1-bit, and thereafter unchanged
#   #         1-bit successor as a 0-bit, continue flip
#
#   my $direction = $options{'direction'} || 'hightolow';
#   my $radix     = $options{'radix'} || max($fa->alphabet)+1;
#   my $nine      = $radix-1;
#
#   my $is_dfa = $fa->isa('FLAT::DFA');
#   $fa = $fa->clone->MyFLAT::as_nfa;
#   if ($direction eq 'hightolow') { $fa = $fa->reverse; }
#
#   my %flipped_states;
#   {
#     # states reachable by runs of 9s from starting states
#     my @pending = $fa->get_starting;
#     while (defined (my $state = shift @pending)) {
#       unless (exists $flipped_states{$state}) {
#         my ($new_state) = $fa->add_states(1);
#         ### add: "state=$state new=$new_state"
#         $flipped_states{$state} = $new_state;
#
#         if ($fa->is_starting($state)) {
#           $fa->set_starting($new_state);
#           $fa->unset_starting($state);
#         }
#         push @pending, $fa->successors($state, $nine);
#       }
#     }
#   }
#
#   while (my ($state, $flipped_state) = each %flipped_states) {
#     ### setup: "$state nines becomes $flipped_state"
#
#     foreach my $digit (0 .. $nine-1) {
#       foreach my $successor ($fa->successors($state, $digit)) {
#         ### digit: "digit=$digit  $flipped_state -> $successor on 1"
#         $fa->add_transition($flipped_state, $successor, $digit+1);
#       }
#     }
#     if ($fa->is_accepting($state)) {
#       # 99...99 accepting becomes 00..00 1 accepting, with a new state for
#       # the additional 1-bit to go to
#       my ($new_state) = $fa->add_states(1);
#       $fa->set_accepting($new_state);
#       $fa->add_transition($flipped_state, $new_state, 1);
#       ### carry above accepting: $new_state
#     }
#
#     foreach my $successor ($fa->successors($state, $nine)) {
#       ### nine: "$flipped_state -> $flipped_states{$successor} on 0"
#       $fa->add_transition($flipped_state, $flipped_states{$successor}, 0);
#     }
#   }
#
#   if (defined $fa->{'name'}) {
#     $fa->{'name'} =~ s{\+(\d+)$}{'+'.($1+1)}e
#       or $fa->{'name'} .= '+1';
#   }
#
#   if ($direction eq 'hightolow') { $fa = $fa->reverse; }
#   if ($is_dfa) { $fa = $fa->as_dfa; }
#   return $fa;
# }


#------------------------------------------------------------------------------

=pod

=over

=item C<$new_fa = $fa-E<gt>MyFLAT::separate_sinks>

Return a copy of C<$fa> which has separate sink states.

A sink state is where all out transitions loop back to itself.  If two or
more states go to the same sink then the return has new states so that each
goes to its own such sink.  The new sinks are the same accepting or not as
each original sink.

This does not change the strings accepted, but can help viewing a big
diagram where many long range transitions go to a single accepting and/or
non-accepting sink.

Only single sink states are sought.  Multiple states cycling among
themselves all the same accepting or non-accepting are sinks, but they can
be merged by an C<as_min_dfa>.

=item C<$bool = $fa-E<gt>MyFLAT::is_sink($state)>

Return true if C<$state> has all transitions go to itself.

=back

=cut

sub separate_sinks {
  my ($fa) = @_;
  $fa = $fa->clone;
  my %sink_used;
  my @alphabet = $fa->alphabet;
  foreach my $from_state ($fa->get_states) {
    foreach my $to_state ($fa->successors($from_state)) {
      next unless $fa->MyFLAT::is_sink($to_state);
      next if $from_state==$to_state;
      next unless $sink_used{$to_state}++;

      my $new_state = $fa->MyFLAT::copy_state($to_state);
      my @labels = FLAT_get_transition_labels($fa,$from_state,$to_state);

      ### common sink: "$from_state to $to_state, new $new_state, labels ".join(' ',@labels)

      # when $fa is an NFA add_transition() accumulates, so for it must
      # remove old transitions
      $fa->remove_transition($from_state,$to_state);

      $fa->add_transition($from_state,$new_state,@labels);
    }
  }
  return $fa;
}

# $fa is a FLAT::FA.
# FIXME: what about cycles of mutual transitions among accepting states?
sub is_sink {
  my ($fa, $state) = @_;
  my @next = $fa->successors($state);
  return @next==1 && $next[0]==$state;
}
sub get_sink_states {
  my ($fa) = @_;
  return grep {$fa->MyFLAT::is_sink($_)} $fa->get_states;
}

sub is_accepting_sink {
  my ($fa, $state) = @_;
  $fa->MyFLAT::is_sink($state) && $fa->is_accepting($state);
}
sub get_accepting_sinks {
  my ($fa) = @_;
  return grep {$fa->MyFLAT::is_accepting_sink($_)} $fa->get_states;
}
sub num_accepting_sinks {
  my ($fa) = @_;
  # this depends on use of grep in get_accepting_sinks()
  return scalar($fa->MyFLAT::get_accepting_sinks);
}

=pod

=over

=item C<$new_state = $fa-E<gt>MyFLAT::copy_state ($state)>

Add a state to C<$fa> which is a copy of C<$state>.  Transitions out and
accepting-ness of C<$new_state> and the same as C<$state>.  Return the new
state number.

=back

=cut

sub copy_state {
  my ($fa, $state) = @_;
  ### copy_state(): $state

  my ($new_state) = $fa->add_states(1);
  if ($fa->is_accepting ($state)) {
    $fa->set_accepting($new_state);
  }
  # ENHANCE-ME: transition can be copied more efficiently?
  foreach my $symbol ($fa->alphabet) {
    foreach my $next ($fa->successors($state, $symbol)) {
      my $new_next = ($next == $state ? $new_state : $next);
      $fa->add_transition($new_state,$new_next, $symbol);
    }
  }
  return $new_state;
}

#------------------------------------------------------------------------------

# $fa is a FLAT::FA.
# Return a new FLAT with some of its states or symbols renamed.
#
#     symbols_func => $coderef called $new_symbol = $coderef->($old_symbol)
#     symbols_map  => $hashref of $old_symbol => $new_symbol
#     states_map   => $hashref of $old_state  => $new_state
#     states_list  => arrayref of existing states in order for the new
#
# Any states or symbols in $fa unmentioned in these mappings are unchanged,
# so some can be changed and the rest left alone.
#
# Symbols can be swapped or cycled by for example {'A'=>'B', 'B'=>'A'}.
# States similarly.
#
sub FLAT_rename {
  my ($fa, %options) = @_;
  my @alphabet = $fa->alphabet;

  my $symbols_func = $options{'symbols_func'}
    // do {
      my $symbols_map  = $options{'symbols_map'} // {};
      sub {
        my ($symbol) = @_;
        return $symbols_map->{$symbol};
      }
    };

  my $states_map  = $options{'states_map'}  // {};
  if (defined(my $states_list = $options{'states_list'})) {
    $states_map = { map {$_ => $states_list->[$_]} 0 .. $#$states_list };
  }

  my $new = (ref $fa)->new;
  $new->add_states($fa->num_states);

  foreach my $old_state ($fa->get_states) {
    my $new_state = $states_map->{$old_state} // $old_state;
    if ($fa->is_accepting($old_state)) { $new->set_accepting($new_state); }
    if ($fa->is_starting ($old_state)) { $new->set_starting ($new_state); }

    foreach my $symbol (@alphabet) {
      my $new_symbol = $symbols_func->($symbol) // $symbol;
      foreach my $old_next ($fa->successors($old_state, $symbol)) {
        my $new_next = $states_map->{$old_next} // $old_next;
        $new->add_transition($new_state, $new_next, $new_symbol);
      }
    }
  }
  $new->{'name'} = $fa->{'name'};
  return $new;
}

# Return a new FLAT::FA of the same type as $fa but where any accepting
# states are numbered last.
sub rename_accepting_last {
  my ($fa, %options) = @_;
  return FLAT_rename($fa, states_list =>
                     [ $fa->MyFLAT::get_non_accepting, $fa->get_accepting ]);
}

sub _sort_sensibly {
  if (grep {!looks_like_number($_)} @_) {
    return sort @_;
  } else {
    return sort {$a<=>$b} @_;
  }
}

sub alphabet_sorted {
  my ($fa) = @_;
  return _sort_sensibly($fa->alphabet);
}

sub states_breadth_first {
  my ($fa) = @_;
  my @ret;
  my $upto = 0;
  my @alphabet = $fa->MyFLAT::alphabet_sorted;
  my @pending = sort {$a<=>$b} $fa->get_starting;
  while (@pending) {
    my $state = shift @pending;
    next if defined $ret[$state];
    $ret[$state] = $upto++;
    foreach my $symbol (@alphabet) {
      push @pending, sort {$a<=>$b} $fa->successors($state, $symbol);
    }    
  }    
  return @ret;
}

sub rename_breadth_first {
  my ($fa) = @_;
  return FLAT_rename($fa, states_list => [$fa->MyFLAT::states_breadth_first]);
}


#------------------------------------------------------------------------------

# zero_digits_flat() returns a FLAT::DFA matching a run of 0 digits,
# possibly an empty run.  This is regex "0*", but with alphabet 0 .. $radix-1.
sub zero_digits_flat {
  my ($radix) = @_;
  my $f = FLAT::DFA->new;
  $f->add_states(2);
  $f->set_starting(0);
  $f->set_accepting(0);
  $f->add_transition(0,0, 0);                # state 0 accept 0s
  $f->add_transition(0,1, 1 .. $radix-1);
  $f->add_transition(1,1, 0 .. $radix-1);    # state 1 non-accepting sink
  return $f;
}

# one_bits_flat() returns a FLAT::DFA matching a run of 1 bits, possibly an
# empty run.  This is regex "1*", but with alphabet 0,1.
use constant::defer one_bits_flat => sub {
  require FLAT::DFA;
  my $f = FLAT::DFA->new;
  $f->add_states(2);
  $f->set_starting(0);
  $f->set_accepting(0);
  $f->add_transition(0,0, 1);
  $f->add_transition(0,1, 0);
  $f->add_transition(1,1, 1);
  $f->add_transition(1,1, 0);
  return $f;
};

# Return a FLAT::DFA which matches bit strings which are an even number N.
# An empty string "" is reckoned as 0 and so is matched.
use constant::defer bits_N_even_flat => sub {
  require FLAT::Regex;
  my $f = FLAT::Regex->new('(0|1)* 0 | []')->as_dfa;
  $f->{'name'} = 'even N';
  return $f;
};
# Return a FLAT::DFA which matches bit strings which are an odd number N.
use constant::defer bits_N_odd_flat => sub {
  require FLAT::Regex;
  my $f = FLAT::Regex->new('(0|1)* 1')->as_dfa;
  $f->{'name'} = 'odd N';
  return $f;
};

# Return a FLAT::DFA which matches exactly $len many bits 0,1.
sub bits_of_length_flat {
  my ($len) = @_;
  my $f = FLAT::DFA->new;
  if ($len < 0) { $len = -1; }
  $f->add_states($len+2);
  $f->set_starting(0);
  if ($len >= 0) {
    $f->set_accepting($len);
  }
  foreach my $state (0 .. $len) {
    $f->add_transition($state,$state+1, 0);
    $f->add_transition($state,$state+1, 1);
  }
  my $non = $len+1;
  $f->add_transition($non,$non, 0);
  $f->add_transition($non,$non, 1);
  return $f->MyFLAT::set_name("$len bits");

  # return FLAT::Regex->new('(0|1)' x $len)
  #   ->as_dfa
  #   ->MyFLAT::minimize
  #   ->MyFLAT::set_name("$len bits");
}
sub bits_of_length_or_more_flat {
  my ($len) = @_;
  require FLAT::Regex;
  return FLAT::Regex->new(('(0|1)' x $len) . '(0|1)*')
    ->as_dfa
    ->MyFLAT::minimize
    ->MyFLAT::set_name(">=$len bits");
}

#------------------------------------------------------------------------------

# Return all the labels which transition $from_state to $to_state.
sub FLAT_get_transition_labels {
  my ($fa, $from_state, $to_state) = @_;
  ### FLAT_get_transition_labels(): "$from_state to $to_state"
  my @ret;
  foreach my $symbol ($fa->alphabet) {
    ### $symbol
    my $next;
    if ((($next) = $fa->successors($from_state, $symbol))
        && $next==$to_state) {
      push @ret, $symbol;
    }
    ### $next
  }
  ### @ret
  return @ret;
}

#------------------------------------------------------------------------------
# printouts

sub FLAT_varname {
  my ($fa) = @_;
  my $name = $fa->{'name'};
  if (defined $name) {
    $name =~ tr/a-zA-Z0-9_/_/c;
  }
  return $name;
}

sub FLAT_print_perl_table {
  my ($fa, $name) = @_;
  $name //= FLAT_varname($fa);
  my @alphabet = sort {$a<=>$b} $fa->alphabet;
  print "# alphabet ",join(',',@alphabet),"\n";
  require MyPrintwrap;
  print "\@$name = (\n";
  MyPrintwrap::printwrap_indent("  ");
  my @states = $fa->get_states;
  foreach my $state (@states) {
    my @row = map { my $symbol = $_;
                    my @next = $fa->successors($state,$symbol);
                    if (@next != 1) {
                      croak "Not single next for $state symbol $symbol";
                    }
                    $next[0]
                  } @alphabet;
    MyPrintwrap::printwrap(" [".join(',',@row)."]"
                           . ($state == $#states ? "" : ','));
  }
  print ");\n";
}
sub FLAT_print_perl_accepting {
  my ($fa, $name) = @_;
  $name //= FLAT_varname($fa);
  my @accepting = $fa->get_accepting;
  my $start = "\@$name = (";
  my $end = ");\n";
  my $line = $start . join(',',@accepting) . $end;
  if (length $line < 79) {
    print "$line\n";
    return;
  }
  require MyPrintwrap;
  MyPrintwrap::printwrap_indent("  ");
  print $start,"\n";
  foreach my $i (0 .. $#accepting) {
    MyPrintwrap::printwrap("$accepting[$i]"
                           . ($i == $#accepting ? "" : ','));
  }
  MyPrintwrap::printwrap($end);
}

sub FLAT_print_gp_inline_table {
  my ($fa, $name) = @_;
  require MyPrintwrap;
  MyPrintwrap::printwrap_indent("% GP-DEFINE  ");
  $MyPrintwrap::Printwrap = 0;
  MyPrintwrap::printwrap("$name = {[");
  $MyPrintwrap::Printwrap += 2;
  my @alphabet = sort {$a<=>$b} $fa->alphabet;
  my @states = $fa->get_states;
  foreach my $state (@states) {
    my @row = map { my @to = $fa->successors($state,$_);
                    @to<=1 or die "oops, not a DFA";
                    @to ? $to[0]+1 : "'none" } @alphabet;
    MyPrintwrap::printwrap(join(',',@row)
                           . ($state == $#states ? '' : ';'));
  }
  MyPrintwrap::printwrap("]};\n");
}
sub FLAT_print_gp_inline_accepting {
  my ($fa, $name) = @_;
  require MyPrintwrap;
  MyPrintwrap::printwrap_indent("% GP-DEFINE  ");
  $MyPrintwrap::Printwrap = 0;
  MyPrintwrap::printwrap("$name = {[");
  $MyPrintwrap::Printwrap += 2;
  my $join = '';
  my @accepting = $fa->get_accepting;
  foreach my $i (0 .. $#accepting) {
    MyPrintwrap::printwrap(($accepting[$i]+1) . ($i == $#accepting ? '' : ','));
  }
  MyPrintwrap::printwrap("]};\n");
}

sub FLAT_print_tikz {
  my ($fa, %options) = @_;
  my $node_prefix = $options{'node_prefix'} // 's';
  my $flow = $options{'flow'} // $fa->{'flow'} // 'east';
  my $state_labels = $options{'state_labels'};

  print "% accepting ", join(',',$fa->get_accepting), "\n";

  my @column_to_states;
  my @state_to_column;
  my $put_state = sub {
    my ($state, $column) = @_;
    $state_to_column[$state] = $column;
    push @{$column_to_states[$column]}, $state;
  };

  foreach my $state ($fa->get_starting) {
    $put_state->($state, 0);
  }
  for (my $c = 0; $c <= $#column_to_states; $c++) {
    foreach my $from_state (@{$column_to_states[$c]}) {
      next unless defined $state_to_column[$from_state];
      my $to_column = $state_to_column[$from_state] + 1;
      foreach my $to_state (sort $fa->successors($from_state)) {
        next if defined $state_to_column[$to_state];
        $put_state->($to_state, $to_column);
      }
    }
  }
  # unreached states at end
  foreach my $state ($fa->get_states) {
    next if defined $state_to_column[$state];
    $put_state->($state, scalar(@column_to_states));
  }

  foreach my $column (0 .. $#column_to_states) {
    my $states = $column_to_states[$column];
    foreach my $i (0 .. $#$states) {
      my $state = $states->[$i];
      my $x = $column;
      my $y = $i - int(scalar(@$states)/2);
      if ($flow eq 'west') { $x = -$x; }
      if ($flow eq 'north') { ($x,$y) = ($y,$x); }
      if ($flow eq 'south') { ($x,$y) = ($y,-$x); }
      my $state_name = "$node_prefix$state";
      my $state_str = ($state_labels ? $state_labels->[$state] : $state);
      print "  \\node ($state_name) at ($x,$y) [my box] {$state_str};\n";
    }
  }
  print "\n";

  my @alphabet = sort {$a<=>$b} $fa->alphabet;
  foreach my $from_state ($fa->get_states) {
    my $from_state_name = "$node_prefix$from_state";
    print "  % $from_state_name\n";
    require Tie::IxHash;
    my %to_lists;
    tie %to_lists, 'Tie::IxHash';
    foreach my $symbol (@alphabet) {
      if (my ($to_state) = $fa->successors($from_state, $symbol)) {
        push @{$to_lists{$to_state}}, $symbol;
      }
    }
    while (my ($to_state, $labels) = each %to_lists) {
      my $to_state_name = "$node_prefix$to_state";
      $labels = join(',', @$labels);
      if ($from_state eq $to_state) {
        print "  \\draw [->,loop below] ($from_state_name) to node[pos=.12,auto=left] {$labels} ();\n";
      } else {
        my $bend = '';
        my $pos = '.45';
        if ($fa->get_transition($to_state,$from_state)) {
          $bend = ',bend left=10';
          $pos = '.5';
        }
        print "  \\draw [->$bend] ($from_state_name) to node[pos=$pos,auto=left] {$labels} ($to_state_name);\n";
      }
    }
    print "\n";
  }
}


#------------------------------------------------------------------------------

# $aref is an arrayref of arrayrefs which is a state table.
#         [ [1,2],
#           [2,0],
#           [0,1] ]
# States are numbered C<0> to C<$#$aref> inclusive.
# The table has C<$new_state = $aref-E<gt>[$state]-E<gt>[$digit]>.
# Return a FLAT::DFA of this state table.
#
# Optional further key/value arguments are
#     starting         => $state
#     accepting        => $state
#     accepting_list   => arrayref [ $state, $state, ... ]
#     name             => $string
#
# C<starting> is the starting state, or default 0.
#
# C<accepting> or C<accepting_list> are the state or states which are accepting.
# If both C<accepting> and C<accepting_list> are given then both their states
# specified are made accepting.
#
sub aref_to_FLAT_DFA {
  my ($aref, %options) = @_;
  require FLAT::DFA;
  my $f = FLAT::DFA->new;
  my @fstates = $f->add_states(scalar(@$aref));

  my $starting = $options{'starting'} // 0;
  $f->set_starting($fstates[$starting]);
  ### starting: "$starting (= $fstates[$starting])"

  my @accepting = (@{$options{'accepting_list'} // []},
                   $options{'accepting'} // ());
  if (! @accepting) { @accepting = $#$aref; }
  $f->set_accepting(map {$fstates[$_]} @accepting);

  my $width = @{$aref->[0]};
  foreach my $state (0 .. $#$aref) {
    my $row = $aref->[$state];
    if (@$row != $width) {
      croak "state row $state doesn't have $width entries";
    }
    foreach my $digit (0 .. $#$row) {
      my $to_state = $row->[$digit]
        // next; # croak "state $state digit $digit destination undef";
      ($to_state >= 0 && $to_state <= $#$aref)
        or croak "state $state digit $digit destination $to_state out of range";
      ### transition: "$state(=$fstates[$state]) digit=$digit -> $to_state($fstates[$to_state])"
      $f->add_transition($fstates[$state], $fstates[$to_state], $digit);
    }
  }

  $f->{'name'} = $options{'name'};
  return $f;
}


#------------------------------------------------------------------------------

# $fa is a FLAT::NFA or FLAT::DFA.
# Return a list of how many strings of length $len are accepted, for $len
# running 0 to $max_len inclusive.
# The counts can become large, especially when $fa has a lot of symbols.
# The numeric type of the return is inherited from $max_len, so for example
# if it is a Math::BigInt then that is used for the returns.
# In general, the counts are a linear recurrences with order at most the number
# of states in $fa.  Such recurrences include constants (like one string of
# each length), and polynomials.
#
# MAYBE: length => $len          count strings = $len accepted
# MAYBE: max_length => $len      count strings <= $len accepted
# MAYBE: by_length_upto => $len  counts of strings each length <= $len
#
# count_matrix($fa) = [],[]  $array[$row]->[$col]  with M*initcol = counts
# count_recurrence($fa)
#
sub FLAT_count_contains {
  my ($fa, $max_len, %options) = @_;
  my @states    = $fa->get_states;
  my @accepting = $fa->get_accepting;
  my @alphabet  = $fa->alphabet;
  my $zero = $max_len*0;  # inherit bignum from $max_len
  my $ret_type = $options{'ret_type'} || 'accepting';
  my @counts = map {$zero} 0 .. $#states;

  ### starting: $fa->get_starting
  ### @accepting
  ### @counts
  foreach my $state ($fa->get_starting) {
    $counts[$state]++;
  }

  my @ret;
  if ($ret_type eq 'rows') {
    @ret = map {[]} 0 .. $#counts;
  }

  foreach my $k (0 .. $max_len) {
    ### at: "k=$k  ".join(',',map{$_//'_'}@counts)." total ".sum(0,map{$_//0}@counts)." accepting ".sum(0,map{$counts[$_]//0}@accepting)

    {
      my $accepting_count = $zero;
      foreach my $state (@accepting) {
        if ($counts[$state]) {
          $accepting_count += $counts[$state];
        }
      }
      if ($ret_type eq 'accepting') {
        push @ret, $accepting_count;
      } elsif ($ret_type eq 'columns') {
        push @ret, \@counts;
      } elsif ($ret_type eq 'rows') {
        foreach my $i (0 .. $#counts) {
          push @{$ret[$i]}, $counts[$i];
        }
      }
    }
    last if $k == $max_len;

    my @new_counts = map {$zero} 0 .. $#states;
    foreach my $from_state (@states) {
      my $from_count = $counts[$from_state] || next;
      foreach my $symbol (@alphabet) {
        foreach my $to_state ($fa->successors($from_state, $symbol)) {
          ### add: "$from_count  $from_state -> $to_state"
          $new_counts[$to_state] += $from_count;
        }
      }
    }
    @counts = @new_counts;
  }
  return @ret;
}

sub counts_starting {
  my ($fa, $zero) = @_;
  if (! defined $zero) { $zero = 0; }
  return [ map { $zero + ($fa->is_starting($_) ? 1 : 0) }
           0 .. $fa->num_states-1 ];
}
sub counts_next {
  my ($fa, $aref) = @_;

  # ENHANCE-ME: This is a bit slow.  What's the right way to iterate all
  # transitions?

  my $zero = $aref->[0] * 0;
  my @new_counts = ($zero) x scalar(@$aref);
  my @alphabet  = $fa->alphabet;
  foreach my $from_state ($fa->get_states) {
    my $from_count = $aref->[$from_state] || next;
    foreach my $symbol (@alphabet) {
      foreach my $to_state ($fa->epsilon_closure
                            ($fa->successors($from_state, $symbol))) {
        $new_counts[$to_state] += $from_count;
      }
    }
  }
  return \@new_counts;
}
sub counts_accepting {
  my ($fa, $aref) = @_;
  my $ret = $aref->[0] * 0;
  foreach my $state ($fa->get_accepting) {
    $ret += $aref->[$state];
  }
  return $ret;
}

# FIXME: Not right for non-accepting cycles.
sub finite_max_length {
  my ($fa) = @_;
  ### finite_max_length() ...
  my @pending = $fa->get_starting;
  my %seen = map {$_=>1} @pending;
  my $ret = -1;
  my $len = 0;
  while (@pending) {
    if (grep {$fa->is_accepting($_)} @pending) {
      ### accepting ...
      $ret = $len;
    }
    $len++;
    @pending = $fa->epsilon_closure($fa->successors(\@pending));
    ### to: @pending
    @pending = grep {! $seen{$_}++} @pending;
  }
  ### $ret
  return $ret;
}


#------------------------------------------------------------------------------
# FLAT temporary

sub minimize {
  my ($flat, %options) = @_;
  my $name = eval { $flat->{'name'} };
  if ($options{'verbose'}) {
    print "minimize ",$flat->{'name'}//''," ",$flat->num_states," states ...";
  }
  $flat = $flat->as_dfa;
  $flat = $flat->as_min_dfa;
  if ($options{'verbose'}) {
    print "done, num states ",$flat->num_states,"\n";
  }
  $flat->{'name'} = $name;
  return $flat;
}

# workaround for FLAT::DFA ->as_nfa() leaving itself blessed down in FLAT::DFA
sub as_nfa {
  my ($fa) = @_;
  $fa = $fa->as_nfa;
  if ($fa->isa('FLAT::DFA')) { bless $fa, 'FLAT::NFA'; }
  return $fa;
}
# workaround for FLAT::DFA ->reverse() infinite recursion, can reverse in NFA
sub reverse {
  my ($fa) = @_;
  if ($fa->isa('FLAT::DFA')) {
    $fa->MyFLAT::as_nfa($fa)->reverse->as_dfa;
  } else {
    $fa->reverse;
  }
}
# workaround for FLAT::DFA ->concat() infinite recursion, can reverse in NFA
sub concat {
  my $fa = shift @_;
  my $want_dfa = $fa->isa('FLAT::DFA');
  foreach my $f2 (@_) {
    $fa = $fa->MyFLAT::as_nfa->concat($f2->MyFLAT::as_nfa);
  }
  if ($want_dfa) {
    $fa = $fa->as_dfa;
  }
  return $fa;
}
# workaround for FLAT::DFA ->star() infinite recursion, can star in NFA
sub star {
  my ($fa) = @_;
  if ($fa->isa('FLAT::DFA')) {
    $fa->MyFLAT::as_nfa($fa)->star->as_dfa;
  } else {
    $fa->star;
  }
}

#------------------------------------------------------------------------------
sub view {
  my ($fa) = @_;
  require MyGraphs;
  if ($fa->can('as_graphviz')) {   # in FLAT::FA, not in FLAT::Regex
    MyGraphs::graphviz_view($fa->as_graphviz);
  } else {
    print $fa->as_string;
  }
}
sub FLAT_to_perl_re {
  my ($fa) = @_;
  my $str = $fa->as_perl_regex;
  $str =~ s/\Q?://g;
  return $str;
}

sub FLAT_check_is_equal {
  my ($f1, $f2, %options) = @_;
  my @names = ($f1->{'name'} // 'first',
               $f2->{'name'} // 'second');
  if ($f1->equals($f2)) {
    print "$names[0] = $names[1], ok\n";
    return;
  }
  {
    my $a1 = join(',',sort $f1->alphabet);
    my $a2 = join(',',sort $f2->alphabet);
    unless ($a1 eq $a2) {
      print "different alphabet: $a1\n";
      print "          alphabet: $a2\n";
    }
  }
  my $radix = $options{'radix'}
    // do { my @labels = $f1->alphabet; scalar(@labels) };
  print "$names[0] not equal $names[1]\n";
  foreach my $which (1, 2) {
    my $extra = $f1->as_dfa->difference($f2->as_dfa);
    print "extra in $names[0] over $names[1]\n";
    if ($extra->is_empty) {
      print "  is_empty()\n";
    } else {
      if ($extra->is_finite) {
        print "  is_finite()\n";
      }
      require Math::BaseCnv;

      if ($extra->contains('')) {
        print "  []  zero length string\n";
      }

      my $it = $extra->new_acyclic_string_generator;
      # my $it = $extra->new_deepdft_string_generator(20);
      my $count = 0;
      while (my $str = $it->()) {
        if (++$count > 20) {
          print "  ... and more\n";
          last;
        }
        my $n = Math::BaseCnv::cnv($str,$radix,10);
        print "  $str  N=$n\n";
      }
    }
    @names = CORE::reverse @names;
    ($f1,$f2) = ($f2,$f1);
  }
  exit 1;
}

sub FLAT_check_is_subset {
  my ($fsub, $fsuper) = @_;
  if (! $fsub->as_dfa->is_subset_of($fsuper->as_dfa)) {
    my $f = $fsub->as_dfa->difference($fsuper->as_dfa);
    my $it = $f->new_acyclic_string_generator;
    if (defined(my $sub_name = $fsub->{'name'})
        && defined(my $super_name = $fsuper->{'name'})) {
      print "$sub_name not subset of $super_name, ";
    }
    print "extras in supposed subset\n";
    my $count = 0;
    while (my $str = $it->()) {
      if (++$count > 20) {
        print "  ... and more\n";
        last;
      }
      print "  $str\n";
    }
    exit 1;
  }
  my $fsub_name = $fsub->{'name'} // 'subset';
  my $fsuper_name = $fsuper->{'name'} // 'superset';
  print "$fsub_name subset of $fsuper_name, ok\n";
}

sub FLAT_show_breadth {
  my ($flat, $width, $direction) = @_;
  $direction //= 'hightolow';
  if (defined (my $name = $flat->{'name'})) {
    print "$name ";
  }
  print "contains ($direction, by breadth)\n";
  if ($flat->is_empty) {
    print "  is_empty()\n";
  } elsif ($flat->is_finite) {
    print "  is_finite()\n";
  }
  my $count = 0;
  my $total = 0;

  my @alphabet = sort $flat->alphabet;
  my $radix = @alphabet;

  $total++;
  if ($flat->contains('')) {
    print "  [empty string]\n";
    $count++;
  }
  require Math::BaseCnv;
  foreach my $k (1 .. $width) {
    foreach my $n (0 .. $radix**$k-1) {
      my $str = Math::BaseCnv::cnv($n,10,$radix);
      $str = sprintf '%0*s', $k, $str;
      if ($direction eq 'lowtohigh') { $str = CORE::reverse $str; }
      $total++;
      if ($flat->contains($str)) {
        print "  $str  N=$n\n";
        $count++;
      }
    }
  }
  print "  count $count / $total\n";
}

sub FLAT_show_transitions {
  my ($flat,$str) = @_;
  my @str = split //, $str;
  my $print_states = sub {
    if (@_ == 0) {
      print "(none)";
      return;
    }
    my $join = '';
    foreach my $state (@_) {
      print $join, $state, $flat->is_accepting($state) ? "*" : '';
      $join = ',';
    }
  };
  foreach my $initial ($flat->get_starting) {
    my $state = $initial;
    $print_states->($state);
    foreach my $char (@str) {
      print " ($char)";
      my @next = $flat->successors($state,$char);
      if (! @next) {
        last;
      }
      $state = $next[0];
      print "-> ";
      $print_states->(@next);
    }
    print "\n";
  }
}
sub FLAT_check_accepting_remain_so {
  my ($flat) = @_;
  my @accepting = $flat->get_accepting;
  my @alphabet = $flat->alphabet;
  my $bad = 0;
  my $name = $flat->{'name'} // '';
  foreach my $state (@accepting) {
    foreach my $char (@alphabet) {
      my @next = $flat->successors($state,$char);
      foreach my $to (@next) {
        if (! $flat->is_accepting($to)) {
          print "$name $state ($char) -> $to is no longer accepting\n";
          $bad++;
        }
      }
    }
  }
  if ($bad) { exit 1; }
  print "$name accepting remain so, ok\n";
}

sub FLAT_show_acyclics {
  my ($flat) = @_;
  my $it = $flat->new_acyclic_string_generator;
  if (defined (my $name = $flat->{'name'})) {
    print "$name ";
  }
  print "acyclics\n";
  if ($flat->is_empty) {
    print "  empty\n";
  }
  my $count = 0;
  while (my $str = $it->()) {
    if (++$count > 8) {
      print "  ... and more\n";
      last;
    }
    print "  $str\n";
  }
}
sub FLAT_show_deep {
  my ($flat, $depth) = @_;
  my $it = $flat->new_deepdft_string_generator($depth // 5);
  print "depth $depth\n";
  my $count = 0;
  while (my $str = $it->()) {
    if (++$count > 8) {
      print "  ... and more\n";
      last;
    }
    print "  $str\n";
  }
}

#------------------------------------------------------------------------------

sub set_name {
  my ($flat, $name) = @_;
  $flat->{'name'} = $name;
  return $flat;
}

#------------------------------------------------------------------------------

=pod

=over

=item C<$new_fa = $fa-E<gt>digits_increment (key =E<gt> value, ...)>

C<$fa> is a C<FLAT::NFA> or C<FLAT::DFA> accepting digit strings.  Return a
new FLAT (same DFA or NFA) which accepts numbers +1, or +/- a given
increment.  Key/value options are

    add       => integer, default 1
    radix     => integer>=2, default from alphabet
    direction => "hightolow" (default) or "lowtohigh"

Option C<add =E<gt> $add> is the increment to apply (default 1).  This can
be negative too.

Option C<radix =E<gt> $radix> is the digit radix.  The default is taken from
the digits appearing in C<$fa-E<gt>alphabet> which is usually enough.  The
option can be used if C<$fa> might not have all digits appearing in its
alphabet.

Digit strings are taken as high to low.  Option C<direction =E<gt>
"lowtohigh"> takes them low to high instead.  Low to high is more efficient
here since manipulations are at the low end (add the increment and carry up
through low digits), but both work.

An increment can increase string length, for example 999 -E<gt> 1000.  If
there are high 0s on a string then the carry propagates into them and does
not change the length, so 00999 -E<gt> 01000.

Negative increments do not decrease string length, so 1000 -> 0999.  If
C<$add> reduces a number below 0 then that string is quietly dropped.

If the strings matched by C<$fa> represent a predicate, numbers with some
property, then the returned C<$new_fa> is those N for which N-add has the
property.  This is since C<$new_fa> is +add from the originals.  So to get a
predicate testing whether N+1 has the property, apply an C<add =E<gt> -1>.
An C<intersect()> of that and the original becomes a predicate for a pair N
and N+1 both with the property and longer runs can be made by further
intersects.

ENHANCE-ME: Maybe a width option to stay in given number of digits, discard
anything which would increment to bigger.  Or a wraparound option to ignore
carry above width for modulo radix^width.

ENHANCE-ME: Maybe decrement should trim a high 0 digit.  That would mean a
set of strings without high 0s remains so on decrement.  But if say infinite
high 0s are present then wouldn't want to remove them.  Perhaps when a
decrement goes to 0 it could be checked for an all-0s accepting state above,
and merge with it.

This function works by modifying the digits matched in C<$fa>, low to high.
For example if the starting state has a transition for low digit 4 then the
C<$new_fa> has starting state with transition for digit 5 instead.  At a
given state there is a certain carry to propagate.  At the starting states
this is C<$add>, and later it will be smaller.  Existing states are reckoned
as carry 0.  A new state is introduced for combinations of state and
non-zero carry reached.  Transitions in those new states are based on the
originals.  Where the original state has digit d the new state has (d+carry)
mod 10 and goes to the original successor and new_carry =
floor((4+carry)/10).  If that new_carry is zero then this is the original
successor state since the increment is now fully applied.  If new_carry is
non-zero then it's another new state for combination of state and carry.  In
a C<FLAT::NFA> any epsilon transitions are stepped across to find what
digits in fact occur at the given state.  In general an increment +1
propagates only up through digit 9s so that say 991 -> 002 (low to high).
Often C<$fa> might match only a few initial 9s and so only a few new states
introduced.

ENHANCE-ME: Could have some generality by reckoning the carry as an
arbitrary key or transform state, and go through $fa by a composition.  Any
such transformation can be made with a finite set of possible keys.

=back

=cut

sub digits_increment {
  my ($fa, %options) = @_;
  ### digits_increment() ...

  # starting state is flip
  # in flip 0-bit successor as a 1-bit, and thereafter unchanged
  #         1-bit successor as a 0-bit, continue flip

  my $direction = $options{'direction'} || 'hightolow';
  my $radix     = $options{'radix'} || max($fa->alphabet)+1;
  my $nine      = $radix-1;
  my $add       = $options{'add'} // 1;
  ### $radix
  ### $nine

  my $is_dfa = $fa->isa('FLAT::DFA');
  $fa = $fa->MyFLAT::as_nfa->clone;
  if ($direction eq 'hightolow') { $fa = $fa->reverse; }

  my %state_and_carry_to_new_state;
  require Tie::IxHash;
  tie %state_and_carry_to_new_state, 'Tie::IxHash';
  {
    # states reachable by runs of 9s from starting states
    my @pending = map {[$_,$add]} $fa->get_starting;
    while (my $elem = shift @pending) {
      my ($state, $carry) = @$elem;
      unless (exists $state_and_carry_to_new_state{"$state,$carry"}) {
        my ($new_state) = $fa->add_states(1);
        ### reach: "state=$state  new_state=$new_state carry=$carry"
        $state_and_carry_to_new_state{"$state,$carry"} = $new_state;
        if ($fa->is_starting($state) && $carry==$add) {
          $fa->set_starting($new_state);
          $fa->unset_starting($state);
        }

        foreach my $digit (0 .. $nine) {
          my ($new_carry,$new_digit) = _divrem($digit+$carry, $radix);
          if ($new_carry) {
            push @pending, map {[$_,$new_carry]}
              $fa->successors([$fa->epsilon_closure($state)],$digit);
          }
        }
      }
    }
  }
  ### %state_and_carry_to_new_state

  while (my ($state_and_carry, $new_state)
         = each %state_and_carry_to_new_state) {
    my ($state,$carry) = split /,/, $state_and_carry;
    ### setup: "state=$state carry=$carry   new_state=$new_state"

    foreach my $digit (0 .. $nine) {
      my ($new_carry,$new_digit) = _divrem($digit+$carry, $radix);
      foreach my $successor ($fa->successors([$fa->epsilon_closure($state)],
                                             $digit)) {
        my $new_successor
          = ($new_carry
             ? $state_and_carry_to_new_state{"$successor,$new_carry"}
             : $successor);
        ### digit: "state=$state carry=$carry digit=$digit successor $successor"
        ### new  : " new state $new_state new_digit=$new_digit with new_carry=$new_carry  new_successor=$new_successor"
        $fa->add_transition ($new_state, $new_successor, $new_digit);
      }
    }

    if ($carry > 0 && $fa->is_accepting($state)) {
      # 99...99 accepting becomes 00..00 1 accepting, with a new state for
      # the additional carry
      ### carry above accepting: "carry=$carry"
      my $from_state;
      while ($carry) {
        $from_state = $new_state;
        ($new_state) = $fa->add_states(1);
        ($carry, my $digit) = _divrem($carry, $radix);
        $fa->add_transition($from_state, $new_state, $digit);
        ### transition: "$from_state -> $new_state"
      }
      $fa->set_accepting($new_state);
      ### accepting: $new_state
    }
  }

  if (defined $fa->{'name'}) {
    $fa->{'name'} =~ s{\+(\d+)$}{'+'.($1+1)}e
      or $fa->{'name'} .= '+1';
  }

  if ($direction eq 'hightolow') { $fa = $fa->reverse; }
  if ($is_dfa) { $fa = $fa->as_dfa; }
  return $fa;
}

# sub successors_through_epsilon {
#   my ($fa, $state, $symbol) = @_;
#   return $fa->epsilon_closure($fa->successors($state,$symbol));
# }

sub _divrem {
  my ($n,$d) = @_;
  my $r = $n % $d;
  return (($n-$r)/$d, $r);
}

#------------------------------------------------------------------------------

=item C<$new_lang = $lang-E<gt>skip_initial ()>

=item C<$new_lang = $lang-E<gt>skip_final ()>

Return a new regular language object, of the same type as C<$lang>, which
matches the strings of C<$lang> with 1 initial or final symbol skipped.

A string of 1 symbol in C<$lang> becomes the empty string in C<$new_lang>.
The empty string in C<$lang> cannot have 1 symbol skipped so is ignored when
forming C<$new_lang>.

In a C<FLAT::FA>, C<skip_initial()> works by changing the starting states to
the immediate successors of the current starting states.  For a
C<FLAT::DFA>, if this results in multiple starts then they are converted to
a single start by the usual C<as_dfa()>.  C<skip_final()> works by changing
the accepting states to their immediate predecessors.

No minimization is performed.  It's possible changed starts might leave some
states unreachable.  It's possible changed accepting could leave various
states never reaching an accept.

ENHANCE-ME: maybe parameter $n to skip how many.

=back

=cut

sub skip_initial {
  my ($fa) = @_;
  ### skip_initial(): $fa
  my $name = $fa->{'name'};
  my $is_dfa = $fa->isa('FLAT::DFA');

  $fa = $fa->MyFLAT::as_nfa->clone;    # need NFA for new multiple starts
  my @states = $fa->get_starting;
  $fa->unset_starting(@states);
  ### starting: @states
  $fa->set_starting($fa->successors([$fa->epsilon_closure(@states)]));
  ### new starting: [ $fa->get_starting ]

  if ($is_dfa) { $fa = $fa->as_dfa; }
  if (defined $name) {
    $name =~ s{ skip initial( (\d+))?$}{' skip initial '.(($2||0)+1)}e
      or $name .= ' skip initial';
    $fa->{'name'} = $name;
  }
  return $fa;
}

{
  package FLAT::Regex;
  sub MyFLAT_skip_initial {
    my $self = shift;
    $self->_from_op($self->op->MyFLAT_skip_initial(@_));
  }
  sub MyFLAT_skip_final {
    my $self = shift;
    $self->_from_op($self->op->MyFLAT_skip_final(@_));
  }
}
{
  package FLAT::Regex::Op::atomic;
  sub MyFLAT_skip_initial {
    my ($self) = @_;
    ### atomic MyFLAT_skip_initial: $self
    my $member = $self->members;
    return __PACKAGE__->new(defined $member && length($member)
                            ? ''      # symbol, becomes empty string
                            : undef); # empty str or null regex, becomes null
  }
  *MyFLAT_skip_final = \&MyFLAT_skip_initial;

  # return a list of the initial symbols accepted
  sub MyFLAT_initial_symbols {
    my ($self) = @_;
    my $member = $self->members;
    return (defined $member && length($member) ? $member : ());
  }
}
{
  package FLAT::Regex::Op::star;
  # skip_initial(X*) = skip_initial(X) X*
  # skip_final(X*)   = X* skip_final(X)
  # or if X has no non-empty strings then return has no non-empty
  sub MyFLAT_skip_initial {
    my ($self) = @_;
    my $member = $self->members;
    return ($member->has_nonempty_string
            ? FLAT::Regex::Op::concat->new($member->MyFLAT_skip_initial, $self)
            : $member);
  }
  sub MyFLAT_skip_final {
    my ($self) = @_;
    my $member = $self->members;
    return ($member->has_nonempty_string
            ? FLAT::Regex::Op::concat->new($self, $member->MyFLAT_skip_final)
            : $member);
  }

  # initial_symbols(X*) = initial_symbols(X)
  sub MyFLAT_initial_symbols {
    my ($self) = @_;
    return $self->members->MyFLAT_initial_symbols;
  }
}
{
  package FLAT::Regex::Op::concat;
  # skip_initial(X Y Z) = skip_initial(X) Y Z
  # skip_final(X Y Z)   = X Y skip_initial(Z)
  # any X, or Z, without a non-empty string is skipped
  sub MyFLAT_skip_initial {
    my ($self) = @_;
    my @members = $self->members;

    # skip initial members which are the empty string and nothing else
    while (@members >= 2
           && ! $members[0]->is_empty
           && ! $members[0]->has_nonempty_string) {
      shift @members;
    }
    $members[0] = $members[0]->MyFLAT_skip_initial;
    return (ref $self)->new(@members);
  }
  sub MyFLAT_skip_final {
    my ($self) = @_;
    my @members = $self->members;
    # skip trailing members which are the empty string and nothing else
    while (@members >= 2
           && ! $members[-1]->is_empty
           && ! $members[-1]->has_nonempty_string) {
      pop @members;
    }
    $members[-1] = $members[-1]->MyFLAT_skip_final;
    return (ref $self)->new(@members);
  }

  # initial_symbols(X Y Z) = initial_symbols(X)
  # or whichever of X,Y,Z first has a non-empty string
  sub MyFLAT_initial_symbols {
    my $self = shift;
    my @ret;
    foreach my $member ($self->members) {
      @ret = $member->MyFLAT_initial_symbols and last;
    }
    return @ret;
  }
}
{
  package FLAT::Regex::Op::alt;
  # skip_initial(X | Y) = skip_initial(X) | skip_initial(Y)
  # skip_final(X | Y)   = skip_final(X)   | skip_final(Y)
  sub MyFLAT_skip_initial {
    my $self = shift;
    return $self->MyFLAT__map_method('MyFLAT_skip_initial',@_);
  }
  sub MyFLAT_skip_final {
    my $self = shift;
    return $self->MyFLAT__map_method('MyFLAT_skip_final',@_);
  }

  # initial_symbols(X|Y) = union(initial_symbols(X), initial_symbols(Y))
  sub MyFLAT_initial_symbols {
    my $self = shift;
    my %ret;
    foreach my $member ($self->members) {
      foreach my $symbol ($member->MyFLAT_initial_symbols) {
        $ret{$symbol} = 1;
      }
    }
    return keys %ret;
  }
}
{
  package FLAT::Regex::Op::shuffle;
  # can this be done better?
  sub MyFLAT__map_skip {
    my $self = shift;
    my $method = shift;
    my @members = $self->members;
    my @alts;
    foreach my $i (0 .. $#members) {
      if ($members[$i]->has_nonempty_string) {
        my @skip = @members;
        $skip[$i] = $skip[$i]->MyFLAT_skip_initial(@_);
        push @alts, __PACKAGE__->new(@skip);
      }
    }
    return (@alts
            ? FLAT::Regex::Op::alt->new (@alts)
            : FLAT::Regex::Op::atomic->new(undef));
  }
  sub MyFLAT_skip_initial {
    my $self = shift;
    return $self->MyFLAT__map_skip('MyFLAT_skip_final',@_);
  }
  sub MyFLAT_skip_final {
    my $self = shift;
    return $self->MyFLAT__map_skip('MyFLAT_skip_final',@_);
  }

  # wrong
  # sub MyFLAT_skip_initial {
  #   my $self = shift;
  #   my %initial;
  #   my @members = $self->members;
  #   foreach $member (@members) {
  #     my @symbols = $members[$i]->MyFLAT_initial_symbols or next;
  #     @initial{@symbols} = (); # hash slice
  #     $member = $member->MyFLAT_skip_initial(@_);  # mutate array
  #   }
  #   if (%initial) {
  #
  #   return (%initial
  #           ? FLAT::Regex::Op::concat->new
  #           (FLAT::Regex::Op::alt->new
  #            (map {FLAT::Regex::Op::atomic->new($_)} keys %initial),
  #           __PACKAGE__->new(@members))
  #
  #           : FLAT::Regex::Op::atomic->new(undef))
  #
  #   return $self->MyFLAT__map_skip('MyFLAT_skip_final',@_);
  # }
}

sub skip_final {
  my ($fa, %options) = @_;
  my $name = $fa->{'name'};
  my $is_dfa = $fa->isa('FLAT::DFA');

  $fa = $fa->MyFLAT::as_nfa
    ->MyFLAT::reverse
    ->MyFLAT::skip_initial(%options)
    ->MyFLAT::reverse;
  if ($is_dfa) { $fa = $fa->as_dfa; }

  if (defined $name) {
    $name =~ s{ skip final( (\d+))?$}{' skip final '.(($1||0)+1)}e
      or $name .= ' skip final';
    $fa->{'name'} = $name;
  }
  return $fa;
}

# sub skip_initial_0s {
#   my ($fa) = @_;
#   my $s = $fa->MyFLAT::skip_initial;
# }


#------------------------------------------------------------------------------

# $fa is a FLAT::NFA or FLAT::DFA which matches strings of bits.
# Return a new FLAT (same DFA or NFA) which accepts the same in base-4.
#
# MAYBE: a general transform of list of symbols -> single symbol
#
# lowtohigh or hightolow only affects how a high 0-bit
#
sub binary_to_base4 {
  my ($fa, %options) = @_;
  my $direction = $options{'direction'} || 'hightolow';
  ### binary_to_base4(): $direction

  my $name = $fa->{'name'};
  my $is_dfa = $fa->isa('FLAT::DFA');

  if ($direction eq 'hightolow') { $fa = $fa->reverse; }
  my $new_fa = FLAT::DFA->new;

  my @state_to_new_state;
  my $state_to_new_state = sub {
    my ($state) = @_;
    my $new_state = $state_to_new_state[$state];
    if (! defined $new_state) {
      ($new_state) = $new_fa->add_states(1);
      ### $new_state
      $state_to_new_state[$state] = $new_state;
      if ($fa->is_accepting($state)) {
        $new_fa->set_accepting($new_state);
      }
    }
    return $new_state;
  };

  my @pending = $fa->get_starting;
  $new_fa->set_starting(map {$state_to_new_state->($_)}
                        $fa->epsilon_closure(@pending));

  my @state_done;
  while (@pending) {
    my $state = pop @pending;
    next if $state_done[$state]++;
    my $new_state = $state_to_new_state->($state);

    foreach my $bit0 (0,1) {
      my @successors = $fa->successors([$fa->epsilon_closure($state)],
                                       $bit0);
      foreach my $bit1 (0,1) {
        my @successors = $fa->successors([$fa->epsilon_closure(@successors)],
                                         $bit1);
        my $digit = $bit0 + 2*$bit1;
        foreach my $successor (@successors) {
          my $new_successor = $state_to_new_state->($successor);
          ### old: "bit0=$bit0 bit1=$bit1   $state to $successor"
          ### new: "digit=$digit   $new_state to $new_successor"
          $new_fa->add_transition($new_state, $new_successor, $digit);
          push @pending, $successor;
        }
      }
    }
  }
  if ($direction eq 'hightolow') { $new_fa = $new_fa->reverse; }

  if ($is_dfa) { $new_fa = $new_fa->as_dfa; }
  if (defined $name) {
    $name =~ s{ skip final( (\d+))?$}{' skip final '.(($2||0)+1)}e
      or $name .= ' base-4';
    $new_fa->{'name'} = $name;
  }
  return $new_fa;
}

# $fa is a FLAT::NFA or FLAT::DFA.
# Return a new FLAT (same DFA or NFA) which accepts blocks of $n many symbols.
#
# New symbols are string concatenation of the existing, so for example
# symbols a,b,c in blocks of 2 would have symbols aa,ab,ba,bb,etc.
#
# ENHANCE-ME: A separator string, or mapper func for blocks to new symbol.
#
sub blocks {
  my ($fa, $n, %options) = @_;

  my @alphabet = $fa->alphabet;
  my $num_symbols = scalar(@alphabet);
  my $num_blocks = $num_symbols ** $n;
  my @states = $fa->get_states;

  # clone with no transitions
  my $new_fa = (ref $fa)->new;
  $new_fa->add_states($fa->num_states);
  $new_fa->set_starting($fa->get_starting);
  $new_fa->set_accepting($fa->get_accepting);

  foreach my $state (@states) {
    ### $state
    foreach my $i (0 .. $num_blocks-1) {
      ### $i
      my $q = $i;
      my $block_symbol = '';
      my @successors = ($state);
      foreach (1 .. $n) {
        my $r = $q % $num_symbols;
        $q = ($q-$r) / $num_symbols;
        my $symbol = $alphabet[$r];
        $block_symbol .= $symbol;
        @successors = $fa->successors([$fa->epsilon_closure(@successors)],
                                      $symbol);
      }
      foreach my $successor (@successors) {
        ### new transition: "$state -> $successor label $block_symbol"
        $new_fa->add_transition($state, $successor, $block_symbol);
      }
    }
  }

  if (defined(my $name = $fa->{'name'})) {
    $name .= " blocks $n";
    $new_fa->{'name'} = $name;
  }
  return $new_fa;
}


#------------------------------------------------------------------------------
sub as_perl {
  my ($fa, %options) = @_;
  my $str = '';
  my $varname = $options{'varname'} // 'fa';
  $str .= "my \$$varname = " . ref($fa) . "->new;\n";
  my @states = sort {$a<=>$b} $fa->get_states;
  $str .= "\$$varname->add_states(" . scalar(@states) . ");\n";
  $str .= "\$$varname->set_starting(" . join(',',$fa->get_starting) . ");\n";
  $str .= "\$$varname->set_accepting(" . join(',',$fa->get_accepting) . ");\n";
  foreach my $from (@states) {
    foreach my $to (@states) {
      my $t = $fa->get_transition($from,$to) // next;
      my @symbols = map {"'$_'"} $t->alphabet;
      $str .= "\$$varname->add_transition($from,$to,".join(',',@symbols).");\n";
    }
  }
}
sub print_perl {
  my $fa = shift;
  print $fa->MyFLAT::as_perl(@_);
}

# $re is a Perl regexp, usually a qr/.../ form.
# Return a string which is a FLAT style regexp.
# Each char matched by $re is matched by the flat.
# There's no scope for multi-char symbols in the flat.
# Whitespace chars should not be matched by $re.
# Regexp::Common::balanced used here probably needs new enough Perl.
#
sub perl_regexp_to_flat_regex {
  my ($re) = @_;
  my $str = "$re";

  # (?opts:...)
  # x = ignore whitespace and comments
  # Assume for now that if present then it's whitespace everywhere,
  # which is not quite right.
  if ($str =~ s/\(\?\^([a-z]*):/(/) {
    my $opts = $1;
    if ($opts =~ /x/) {
      $str =~ tr/ \t\r\n//d;
    }
  }

  # ^ $ assumed always for now
  # would need a good idea of the alphabet
  $str =~ s/[\^\$]//g;

  # [123] char classes
  $str =~ s{\[([^\]]*)\]}{ '(' . join('|',split //, $1) . ')' }eg;

  # (| or |) empty alternative
  $str =~ s/\(\|/([]|/g;
  $str =~ s/\|\)/|[])/g;

  # X+ repeats, possibly nested
  while ($str =~ s{($RE{'balanced'}{-parens=>'()'}|[^)])\+}{$1$1*}o) {}

  # X? optional, possibly nested
  while ($str =~ s{($RE{'balanced'}{-parens=>'()'}|[^)])\?}{($1|[])}o) {}

  ### $str
  return $str;
}

sub flat_regex_to_perl_regexp {
  my ($str) = @_;
  $str =~ s/\[\]//g;
  return qr/^$str$/x;
}


#------------------------------------------------------------------------------
# Read and Write AT&T FSM Format
#
# AT&T format is transitions in lines like (and in no particular order)
#
#     FromState  ToState  InputSymbol  OutputSymbol
#
# States are numbered 0 upwards.  0 is the starting state.  The accepting
# states are one per line after the transition lines.
#
# The symbols are non-whitespace, and normally 0 means the "epsilon"
# transition of an NFA.
#

sub ensure_states {
  my $fa = shift;
  foreach my $state (@_) {
    if ((my $more = ($state+1 - $fa->num_states)) > 0) {
      $fa->add_states($more);
    }
  }
}

# $filename contains an "AT&T" format finite state machine or finite state
# transducer.  Return a FLAT::NFA of it.  Key/value options are
#
#     epsilon_symbol    => string, default 0
#     no_epsilon_symbol => boolean, default false
#
# Symbol 0 in the file means an epsilon transition for the NFA and becomes
# the FLAT style empty symbol ''.  Another symbol can be given with
# "epsilon_symbol", or no_epsilon_symbol => 1 for no epsilon.
#
sub read_att_file {
  my ($class, $filename, %options) = @_;
  open my $fh, '<', $filename
    or croak "Cannot read $filename: $!";
  my $fa = $class->MyFLAT::read_att_fh($fh, %options);
  close $fh
    or croak "Error reading $filename: $!";
  return $fa;
}
sub read_att_fh {
  my ($class, $fh, %options) = @_;
  ### $fh
  my $fa = $class->new;
  $fa->add_states(1);
  $fa->set_starting(0);
  my $epsilon_symbol = '0';
  if (defined $options{'epsilon_symbol'}) {
    $epsilon_symbol = $options{'epsilon_symbol'};
  }
  if ($options{'no_epsilon_symbol'}) {
    $epsilon_symbol = undef;
  }

  while (defined(my $line = readline $fh)) {
    chomp $line;
    if (my ($from,$to,$symbol) = $line =~ /^(\d+)\s+(\d+)\s+(\S+)/) {
      # next if $symbol eq '@_IDENTITY_SYMBOL_@';
      $fa->MyFLAT::ensure_states($from, $to);
      if (defined $epsilon_symbol && $symbol eq $epsilon_symbol) {
        $symbol = '';  # FLAT epsilon transition
      }
      $symbol =~ s/\./_/g;
      $symbol =~ s/@/flag/g;
      ### transition: "$from $to $symbol"
      $fa->add_transition($from,$to,$symbol);
    } elsif (my ($state) = $line =~ /^(\d+)$/) {
      $fa->set_accepting($state);
    } else {
      croak "Unrecognised AT&T line: ",$line;
    }
  }
  return $fa;
}

# $fa is a FLAT::NFA or FLAT::DFA.
# Write it in "AT&T" format finite state machine format to $filename.
#
# $fa must have a single starting state 0, since that is all the file format
# allows.  Apply some renumbering if necessary before calling here.  For an
# NFA, there's no need to convert entirely to a DFA, just renumber and make
# state 0 have epsilon transitions to the actual desired start states.
#
# The key/value options are
#
#     epsilon_symbol    => string, default 0
#
# Epsilon transitions are written to the file as symbol 0 in the usual way
# for the file format, by default.  The epsilon_symbol option can write
# something else.  If $fa is a DFA, or if it's an NFA without epsilons, then
# this has no effect.
#
sub write_att_file {
  my ($fa, $filename, %options) = @_;
  open my $fh, '>', $filename
    or croak "Cannot write $filename: $!";
  $fa->MyFLAT::write_att_fh ($fh, %options);
  close $fh
    or croak "Error writing $filename: $!";
  return $fa;
}
sub write_att_fh {
  my ($fa, $fh, %options) = @_;
  my $epsilon_symbol = '0';
  if (defined $options{'epsilon_symbol'}) {
    $epsilon_symbol = $options{'epsilon_symbol'};
  }
  my @states = sort {$a<=>$b} $fa->get_states;
  my @starting = $fa->get_starting;
  unless (@starting==1 && $starting[0]==0) {
    croak "AT&T format must be single starting state 0";
  }
  foreach my $from (@states) {
    foreach my $symbol (sort $fa->alphabet, '') {
      my $att_symbol = ($symbol eq '' ? $epsilon_symbol : $symbol);
      foreach my $to (sort {$a<=>$b} $fa->successors($from,$symbol)) {
        print $fh "$from\t$to\t$att_symbol\t$att_symbol\n";
      }
    }
  }
  foreach my $state (sort {$a<=>$b} $fa->get_accepting) {
    print $fh $state,"\n";
  }
}


#------------------------------------------------------------------------------

sub _DFA_to_Regex_union {
  return join('|', grep {defined} @_);
}
sub _DFA_to_Regex_parens {
  my ($re) = @_;
  return ($re eq '' ? '' : "($re)");
}
sub _DFA_to_Regex_star {
  my ($re) = @_;
  return (defined $re && $re ne '' ? "($re)*" : '');
}

# FLAT::DFA
sub DFA_to_Regex {
  my ($fa) = @_;
  my @edges;
  my @states = $fa->get_states;
  my $starting = $states[-1]+1;
  my $accepting = $states[-1]+2;
  ### $starting
  ### $accepting
  foreach my $to ($fa->get_starting) {
    $edges[$starting]->[$to] = '';
  }
  foreach my $from ($fa->get_accepting) {
    $edges[$from]->[$accepting] = '';
  }
  foreach my $symbol ($fa->alphabet) {
    foreach my $from (@states) {
      foreach my $to ($fa->successors([$fa->epsilon_closure($from)],
                                      $symbol)) {
        $edges[$from]->[$to] = _DFA_to_Regex_union($edges[$from]->[$to],
                                                   $symbol);
      }
    }
  }

  unshift @states, $starting, $accepting;
  ### @states
  ### @edges
  while (@states > 2) {
    my $s = pop @states;
    my $star = _DFA_to_Regex_star($edges[$s]->[$s]);
    ### $s
    ### $star
    foreach my $pre_state (@states) {
      my $pre_re = $edges[$pre_state]->[$s];
      ### $pre_state
      ### $pre_re
      next unless defined $pre_re;
      $pre_re = _DFA_to_Regex_parens($pre_re);
      foreach my $post_state (@states) {
        my $post_re = $edges[$s]->[$post_state];
        ### $post_state
        ### $post_re
        next unless defined $post_re;
        $post_re = _DFA_to_Regex_parens($post_re);
        $edges[$pre_state]->[$post_state]
          = _DFA_to_Regex_union($edges[$pre_state]->[$post_state],
                                "$pre_re $star $post_re");
        ### now: "$pre_state to $post_state is ".$edges[$pre_state]->[$post_state]
      }
    }
    undef $edges[$s];
  }

  ### stop ...
  ### @states
  ### return: $edges[$starting]->[$accepting]
  my $ret = $edges[$starting]->[$accepting];
  return (! defined $ret ? '#' : $ret);
}

sub FLAT_re_to_xfsm_re {
  my ($str) = @_;
  $str =~ tr/()0/[]z/;
  return $str;
}


#------------------------------------------------------------------------------

sub FLAT_transition_split {
  my ($fa, %options) = @_;
  my @alphabet = $fa->alphabet;

  my $symbols_func = $options{'symbols_func'}
    // do {
      my $symbols_map  = $options{'symbols_map'} // {};
      sub {
        my ($symbol) = @_;
        my $aref = $symbols_map->{$symbol};
        return ($aref ? @$aref : ());
      }
    };

  my $new = (ref $fa)->new;
  $new->add_states($fa->num_states);
  $new->{'name'} = $fa->{'name'};

  $new->set_accepting($fa->get_accepting);
  $new->set_starting($fa->get_starting);
  foreach my $symbol (@alphabet) {
    my @new_symbols = $symbols_func->($symbol);
    if (! @new_symbols) {
      @new_symbols = ($symbol);  # unchanged
    }
    foreach my $state ($fa->get_states) {
      foreach my $old_to ($fa->successors($state, $symbol)) {
        ### split: "$state to $old_to symbol $symbol becomes ".join(' ',@new_symbols)
        my $from = $state;
        foreach my $i (0 .. $#new_symbols - 1) {
          my ($to) = $new->add_states(1);
          if ($options{'new_accepting_to'} && $fa->is_accepting($old_to)) {
            ### new accepting: $to
            $new->set_accepting($to);
          }
          $new->add_transition($from, $to, $new_symbols[$i]);
          $from = $to;
        }
        $new->add_transition($from, $old_to, $new_symbols[-1]);
      }
    }
  }
  return $new;
}



#------------------------------------------------------------------------------


sub optional_leading_0s {
  my ($f) = @_;
  $f = $f->MyFLAT::as_nfa;
  my $count = 0;
  for (;;) {
    my @starting = $f->get_starting;
    ### $count
    ### @starting
    last if $count == scalar(@starting);
    $count = scalar(@starting);
    my @new_starting = $f->successors([$f->epsilon_closure(@starting)],'0');
    ### @new_starting
    $f->set_starting(@new_starting);
  }
  return $f->as_dfa;
}



# func => $func called
#   ($new_transmute,$new_symbol) = $func->($transmute,$symbol)
#
# $transmute is a string representing the current transmutation conditions.
#
sub transmute {
  my ($fa, %options) = @_;
  ### transmute() ...

  my $direction = $options{'direction'} || 'forward';
  my $func    = $options{'func'};
  my $initial = $options{'initial'};
  if (! defined $initial) { $initial = ''; }

  my $is_dfa = $fa->isa('FLAT::DFA');
  $fa = $fa->MyFLAT::as_nfa->clone;
  if ($direction eq 'reverse') { $fa = $fa->reverse; }
  my @alphabet = $fa->alphabet;

  my $new_fa = (ref $fa)->new;
  my @state_and_transmute_to_new_state;
  my $find_new_state = sub {
    my ($state, $transmute) = @_;
    return ($state_and_transmute_to_new_state[$state]->{$transmute} //= do {
      my ($new_state) = $new_fa->add_states(1);
      if ($fa->is_starting($state) && $transmute eq $initial) {
        $new_fa->set_starting($new_state);
      }
      if ($fa->is_accepting($state)) {
        $new_fa->set_accepting($new_state);
      }
      $new_state;
    });
  };

  my @state_and_transmute_done;
  my @pending = map {[$_,$initial]} $fa->get_starting;
  while (my $elem = shift @pending) {
    my ($state,$transmute) = @$elem;
    ### elem: "state=$state transmute=$transmute"
    if ($state_and_transmute_done[$state]->{$transmute}++) {
      ### already seen ...
      next;
    }
    my $new_from = $find_new_state->($state,$transmute);

    foreach my $symbol (@alphabet) {
      my @to = $fa->successors([$fa->epsilon_closure($state)],$symbol) or next;
      my ($new_transmute,$new_symbol) = $func->($transmute,$symbol) or next;
      ### for transition: "symbol=$symbol  new_symbol=$new_symbol new_transmute=$new_transmute"
      foreach my $to (@to) {
        my $new_to = $find_new_state->($to,$new_transmute);
        $new_fa->add_transition($new_from, $new_to, $new_symbol);
        push @pending, [$to, $new_transmute];
        ### add new: "new_symbol=$new_symbol  $new_from -> $new_to"
      }
    }
  }

  if ($direction eq 'reverse') { $new_fa = $new_fa->reverse; }
  if ($is_dfa) { $new_fa = $new_fa->as_dfa; }
  if (defined(my $name = $options{'name'})) {
    $new_fa->MyFLAT::set_name($name);
  }
  return $new_fa;
}

# add       => integer, default 1
# radix     => integer>=2, default from alphabet
# direction => "hightolow" (default) or "lowtohigh"
sub digits_multiply {
  my ($fa, %options) = @_;

  my $direction = $options{'direction'} || 'hightolow';
  my $radix     = $options{'radix'} || max($fa->alphabet)+1;
  my $mul       = $options{'mul'} // 1;
  my $carry     = $options{'add'} // 0;
  ### $radix
  ### $mul
  ### $carry

  return $fa->MyFLAT::transmute(initial => 0,
                                direction => ($direction eq 'lowtohigh'
                                              ? 'forward'
                                              : 'reverse'),
                                func => sub {
                                  my ($carry,$symbol) = @_;
                                  ### func: "carry=$carry symbol $symbol"
                                  return _divrem ($symbol*$mul+$carry, $radix);
                                });
}

#------------------------------------------------------------------------------
1;
__END__