use strict; use warnings; my $data = { A => [qw/B C D E F I G J/], B => [qw/A C D E F H J I/], C => [qw/A B F I D E/], D => [qw/A C B G J E/], E => [qw/A D C B G H I J/], F => [qw/A C B I H J/], G => [qw/D A E H I J/], H => [qw/F B I J G E/], I => [qw/B F C A H G E J/], J => [qw/A B F H I E/], }; my $line = qr/[ACFI]{3}|[ADGJ]{3}|[BCDE]{3}|[BFHJ]{3}|[EGHI]{3}/; my $triangles = {}; for my $p1 (keys %$data) { for my $p2 (@{$data->{$p1}}) { for my $p3 (@{$data->{$p2}}) { next if $p3 eq $p1; for my $p4 (@{$data->{$p3}}) { if ($p4 eq $p1) { my $tri = join( "", sort @{[$p1,$p2, $p3]}); $triangles->{$tri}++ unless $tri =~ $line; } } } } } print $_,"\n" for sort keys %$triangles; print 0+keys %$triangles;