# reflexive transitive and antisymmetric. my @s = 1..4; my @p = map { $l=$_; map { "($l,$_)" } @s } @s; my $k = @p; my %P; for (my $i=0;$i<2**$k;$i++) { my %R; for (my $j=0;$j<$k;$j++) { $R{$p[$j]} = 1 if ($i & (1<<$j)); } next unless reflexive(\%R); next unless transitive(\%R); next unless antisymmetric(\%R); $P{$i} = "{".join(",",sort keys %R)."}"; } my %E; my $n = @s; my @r = allperms(0..$n-1); my $t = 0; foreach my $i (keys %P) { next if $E{$i}; print $P{$i},"\n"; $t++; foreach my $o (@r) { my $l = 0; for (my $j=0;$j<$k;$j++) { $l += (1<<($o->[$j/$n]*$n + $o->[$j%$n])) if ($i & (1<<$j)) } $E{$l} = 1; } } print "$t total\n"; sub reflexive($) { my $r = shift; foreach my $a (@s) { return 0 unless $r->{"($a,$a)"}; } return 1; } sub transitive($) { my $r = shift; foreach my $a (@s) { foreach my $b (@s) { next unless $r->{"($a,$b)"}; foreach my $c (@s) { next unless $r->{"($b,$c)"}; return 0 unless $r->{"($a,$c)"}; } } } return 1; } sub antisymmetric($) { my $r = shift; foreach my $a (@s) { foreach my $b (@s) { next unless $r->{"($a,$b)"}; next unless $r->{"($b,$a)"}; return 0 unless $a==$b; } } return 1; } sub allperms(@) { my @l = @_; my $n=$#l; return \@l if ($n<1); my @perms = (); for (my $i=0;$i<=$n;$i++) { my $c = $l[$i]; my @r = @l[0..($i-1),($i+1)..$n]; push @perms, map { [$c,@$_] } allperms(@r); } return @perms; }