view release on metacpan or  search on metacpan

lib/Math/Groups.pm  view on Meta::CPAN

     }
   }
  identity($g);                                                                 # Check that the group has an identity
  for my $a(keys %$𝗲)                                                           # Find the identity and confirm that there is only one
   {confess "No inverse for: $a" unless defined inverse($g, $a);                # Helpfully indicate element with no inverse
   }
  orders($g);                                                                   # Order if each element
  1                                                                             # It is a group
 }

sub Group(&@)                                                                   # Create a group
 {my $sub = shift;                                                              # Operator, elements
  my $g = bless {&Elements=>{}, &Inverses=>{}, &Orders=>{}};                    # Empty group
  for   my $a(@_)                                                               # Create multiplication table
   {for my $b(@_)
     {$g->{&Elements}{$a}{$b} = &$sub($a, $b);
	   }
	 }
	check($g);                                                                    # Check we have a group
	$g                                                                            # Return results
 }

lib/Math/Groups.pm  view on Meta::CPAN

sub isoMorphic($$@)                                                             # Isomorphic
 {my $g = shift;                                                                # First group
	my $𝗴 = shift;                                                                # Second group
  ref($𝗴) eq __PACKAGE__ or confess "Second parameter must be a group too!";    # Check it is a group isomorphism
  my %m = @_;                                                                   # Mapping between groups
  my %𝗺 = reverse %m;                                                           # Mapping between groups
  keys(%m) == keys(%𝗺) or confess "Please supply a bijective mapping!";         # Check that the mapping is bijective
	$g->homoMorphic($𝗴, %m) && $𝗴->homoMorphic($g, %𝗺)                            # Bijective homomorphism is an isomorphism
 }

sub isoMorphisms(&$$)                                                           # Find all the isomorphisms between two groups
 {my ($sub, $g, $𝗴) = @_;                                                       # Sub to call to process found isomorphisms, first group, second group
  ref($𝗴) eq __PACKAGE__ or confess "Second parameter must be a group too!";    # Check it is a group
  order($g) == order($𝗴) or confess "Groups have different orders!";            # Check groups have same order
  my $i = e($g);                                                                # Identity of first group
  my $𝗶 = e($𝗴);                                                                # Identity of second group
  my $e = [grep {$_ ne $i} sort keys %{𝗲($g)}];                                 # Elements of first group in fixed order without identity
  my $𝗲 = [grep {$_ ne $𝗶} sort keys %{𝗲($𝗴)}];                                 # Elements of second group in fixed order without identity
  permute                                                                       # Permute the elements to obtain all possible mappings
   {my %m = map {$$e[$_]=>$$𝗲[$_[$_]]} 0..$#_;                                  # Mapping to test
    &$sub(%m) if isoMorphic($g, $𝗴, %m);                                        # Process mapping if isomorphic
	 } 0..$#$e;                                                                   # Elements to permute
 }

sub autoMorphic($@)                                                             # Automorphic
 {my $g = shift;                                                                # Group
	$g->isoMorphic($g, @_)                                                        # Check
 }

sub autoMorphisms(&$)                                                           # Find all the automorphisms of a group
 {my ($sub, $g) = @_;                                                           # Sub to call to process found automorphisms, group
  &isoMorphisms($sub,$g,$g)
 }

# Export details

require 5;
require Exporter;

use vars qw(@ISA @EXPORT $VERSION);