Math::Group::Thompson - OO methods that calculates the cardinality

  use Math::Group::Thompson;

  my $F = Math::Group::Thompson->new( VERBOSE => 0 );
  my $card = $F->cardBn(3,'');

  print "#B(3) = $card\n";

#
# OO methods that calculates #B(n) on Thompson group F
#
# Author: Roberto Alamos Moreno <ralamosm@cpan.org>
#
# Copyright (c) 2004 Roberto Alamos Moreno. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# November 2004. Antofagasta, Chile.
#
package Math::Group::Thompson;

$VERSION = '0.96';

use strict;
use warnings;

use FileHandle;

sub new {
  my $class = shift || undef;
  if(!defined $class) {
    return undef;
  }

  my %args = ( VERBOSE => 0, # By default don't print anything
	       @_ );

  # Inverse elements
  my $inv = { B => 'D', # B is the inverse of B^(-1)
	      A => 'C', # A is the inverse of A^(-1)
	      D => 'B', # B^(-1) is the inverse of B
	      C => 'A', # A^(-1) is the inverse of A
  };

  # Prohibited words
  # Words of length 5
  my @rel5 = (
		'BAADC',
		'ABCCD',
		'AADCD',
		'BABCC',
		'ADCDA',
		'CBABC',
		'DCDAB',
		'DCBAB',
		'CDABC',
		'ADCBA',
	     );

  # Words of length 6
  my @rel6 = (
		'AADCBA',
                'DAADCB',
                'CBAADC',
                'BAADCD',
                'DABCCB',
                'CDABCC',
                'BABCCD',
                'ABCCDA',
                'CDAADC',
                'AADCDA',
                'ABCCBA',
                'CBABCC',
                'CCDAAD',
                'ADCDAB',
                'BCCBAA',
                'DCBABC',
                'BCCDAA',
                'DCDABC',
                'CCBAAD',
                'ADCBAB',
 	     );

  # Words of length 7
  my @rel7 = (
                'CBAAADC',
                'ABCCCDA',
                'BAAADCC',
                'AABCCCD',
                'AAADCCD',
                'BAABCCC',
                'AADCCDA',
                'CBAABCC',
                'ADCCDAA',
                'CCBAABC',
                'DCCDAAB',
                'DCCBAAB',
                'CCDAABC',
                'ADCCBAA',
	     );

  # Words of length 8
  my @rel8 = (
                'AADCCBAA',
                'AAADCCBA',
                'CCBAAADC',
                'CBAAADCC',
                'CDAABCCC',
                'CCDAABCC',
                'AABCCCDA',
                'ABCCCDAA',
                'DAAADCCB',
                'BAAADCCD',
                'DAABCCCB',
                'BAABCCCD',
                'CDAAADCC',
                'AAADCCDA',
                'AABCCCBA',
                'CBAABCCC',
                'CCDAAADC',
                'AADCCDAA',
                'ABCCCBAA',
                'CCBAABCC',
                'CCCDAAAD',
                'ADCCDAAB',
                'BCCCBAAA',
                'DCCBAABC',
                'BCCCDAAA',
                'DCCDAABC',
                'CCCBAAAD',
                'ADCCBAAB',
	     );


  # Define the generator set S = { A,B,A^(-1),B^(-1) }
  my @generators = ('B','A','D','C');

  # Open filehandle if we have to
  my $fh;
  if($args{VERBOSE}) {
    if($args{VERBOSE} ne '1') {
      $fh = new FileHandle ">".$args{VERBOSE} || undef;
    }
  }

  return bless { INV => $inv,                          # Inverse relations
		 REL => [\@rel5,\@rel6,\@rel7,\@rel8], # Prohibited words
		 GEN => \@generators,                  # Generator set
		 COUNTER => 0,                         # Element counter
		 FIRST_ELEMENT => '',		       # F's element passed to the firs call of method cardBn
		 FIRST_CALL => 1,                      # Flag of first call to method cardBn
		 VERBOSE => $args{VERBOSE},            # Verbose mode
                 FILEHANDLE => \$fh,                   # Filehandler
	       }, $class;
}

sub cardBn {
  my ($self,$n,$g) = @_;
  if(!defined $g) { $g = ""; }
  if(!defined $self || !ref $self || !defined $n || $n < 0 || $n =~ /\D/ || $g =~ /[^ABCD]/) {
    return undef;
  }
  if($n == 0) {
    # We have to calculate #B(0) or #(gB(0) - B(0)). In any case is 1
    return 1;
  }

  # Check if we are in the first call of cardBn
  if($self->{FIRST_CALL}) {
    # The first element passed to cardBn is $g. Keep it
    $self->{FIRST_ELEMENT} = $g || '';
    $self->{FIRST_CALL} = 0;
    if($self->{FIRST_ELEMENT} eq '') {
      $self->note('e');
    }
  }

  # For every element A,B,A^(-1) and B^(-1)
  for(0..3) {
    my $aux_g = $self->multiply($g,$self->{GEN}->[$_]) || ''; # Multiple $g by one of the generators
    my $i = 0; # Flag that say if the new word contains

    # Check if the new word is one letter larger than the previous one
    my ($length_g,$length_auxg) = (0,0);
    if($g ne '') {
      $length_g += length($g);
    }
    if($aux_g ne '') {
      $length_auxg += length($aux_g);
    }
    if($length_auxg == ($length_g + 1)) {
      # Check if some prohibited word is in $aux_g
      LOOP: for(5..8) {
	if($length_auxg >= $_) {
	  # Check if the word contains any prohibited relation
	  foreach my $rel (@{$self->{REL}->[$_-5]}) {
	    if($aux_g =~ /$rel$/) {
	      # Prohibited word found
	      $i++;
	      last LOOP;
	    }
	  }
	}
      }

      # Check if we foun any prohibited word
      if($i == 0) {
	# Determine if we are calculating #B(n) or #(gB(n) - B(n)) where g is the first argument received by cardBn
	if($self->{FIRST_ELEMENT} ne '') {
	  # First element wasn't ''. We are calculating #(gB(n) - B(n))
	  if(length($aux_g) < ($n + length($self->{FIRST_ELEMENT}))) {
	    $self->cardBn($n,$aux_g);
	  } else {
            # Count this element
	    # Print word if VERBOSE == 1
	    $self->note($aux_g);
	    $self->{COUNTER}++;
	  }
	} else {
	  # Count this element
	  # Print word if VERBOSE == 1
	  $self->note($aux_g);
	  $self->{COUNTER}++;

	  # First element was empty. We are calculating #B(n)
	  if(length($aux_g) < $n) {
	    # Word's length is < $n, continue
	    $self->cardBn($n,$aux_g);
	  }
	}
      }
    }
  }

  # Return
  if($self->{FIRST_ELEMENT} eq '') {
    return $self->{COUNTER} + 1; # Returns #B(n). The 1 is for the identity element
  } else {
    return $self->{COUNTER};     # Returns #(gB(n)-B(n).
  }
}

sub reset {
  my $self = shift || undef;
  if(!defined $self) {
    return;
  }

  $self->{COUNTER} = 0;
  $self->{FIRST_ELEMENT} = '';
  $self->{FIRST_CALL} = 1;

  return 1;
}

sub multiply {
  my ($self,$g,$h) = @_;
  if(!defined $self) {
    return;
  }
  if(!defined $g && !defined $h) {
    return undef;
  } elsif($g eq '' && $h eq '') {
    return undef;
  }
  if(!defined $h) {
    return $g;
  } elsif ($h eq '') {
    return $g;
  }
  if(!defined $g) {
    return $h;
  } elsif($g eq '') {
    return $h;
  }

  # Get inverse relations
  my %inv = $self->get_inv;

  # Multiply
  my @h = split(//,$h);
  foreach my $el (@h) {
    $g =~ /(.)$/;
    if($1 ne $inv{$el}) {
      return $g.$h;
    } else {
      $g =~ s/.$//;
      $h =~ s/^.//;
    }

    if($g eq '' && $h ne '') {
      return $h
    } elsif($h eq '' && $g ne '') {
      return $g;
    } elsif($g eq '' && $h eq '') {
      return undef;
    }
  }
}

sub rotate {
  my ($self,$word) = @_;
  if(!defined $self || !defined $word) {
    return undef;
  }

  $word =~ s/(.)$//;
  return $1.$word;
}

sub inverse {
  my ($self,$word) = @_;
  if(!defined $self || !defined $word) {
    return undef;
  }

  my %inv = $self->get_inv;
  my @word = split(//,$word);

  for(0..$#word) {
    $word[$_] = $inv{$word[$_]};
  }

  $word = join('',@word);
  return reverse $word;
}

sub divide {
  my ($self,$word) = @_;
  if(!defined $self || !defined $word) {
    return undef;
  }

  my $largo = length($word);
  my @word = split(//,$word);
  $word = join('',@word[0..($largo/2)-1]);
  my $word2 = join('',@word[($largo/2)..$#word]);
  $word2 = $self->inverse($word2);

  return ($word,$word2);
}

sub get_inv {
  my $self = shift || undef;
  if(!defined $self) {
    return undef;
  }

  return %{$self->{INV}};
}

sub note {
  my $self = shift || undef;
  if(!defined $self) {
    return undef;
  }

  my $g = shift || return undef;

  if($self->{VERBOSE}) {
    if($self->{VERBOSE} eq '1') {
      # Print word to STDERR
      print STDERR $g,"\n";
    } else {
      # Put word on the correspondent file
      if($self->{FILEHANDLE} && ref(${$self->{FILEHANDLE}}) eq 'FileHandle') {
        my $fh = ${$self->{FILEHANDLE}};
        print $fh $g,"\n";
      }
    }
  }
}

# Destroy function. Closes the filehandle opened in 'new' method (if it was opened).
sub DESTROY {
  my $self = shift || undef;
  if(!defined $self) {
    return undef;
  }

  if($self->{VERBOSE}) {
    if($self->{VERBOSE} ne '1' && ref(${$self->{FILEHANDLE}}) eq 'FileHandle') {
      ${$self->{FILEHANDLE}}->close if $self->{FILEHANDLE};
    }
  }
}

1;