in reply to finding tuples
The following finds a solution in O(1) time after a very quick O(N) setup:
#!/usr/bin/perl use strict; use warnings; my $alphabet = uc('ADEFGMSTV'); my $N = length($alphabet); my $L = $N - 1; my @ltr_lkup = $alphabet =~ /./g; my %idx_lkup = map { substr($alphabet, $_, 1) => $_ } 0..$L; sub tupple { return join '', @ltr_lkup[ sort { $a <=> $b } @_ ]; } { my ($input) = @ARGV or die("usage: $0 string\n"); $input = uc($input); my @counts; while ($input =~ /(.)/g) { defined($idx_lkup{$1}) or die("'$1' not in alphabet\n"); ++$counts[ $idx_lkup{$1} ]; } $counts[$_] ||= 0 for 0..$L; # Avoid warnings. my @extracted; for my $i (0..$L) { if ($counts[$i] >= 4) { $counts[$i] %= 4; push @extracted, tupple( ($i) x 4 ); } if ($counts[$i] > 0) { die("No solution\n") if $i+3 > $L; my $instances = $counts[$i]; for (0..3) { die("No solution\n") if $counts[$i+$_] < $instances; $counts[$i+$_] -= $instances; } push @extracted, tupple( $i+0 .. $i+3 ); } } print(join(';', @extracted), "\n"); }
$ perl single.pl AAAAADDDDDEFFGMMSSTVVVVV AAAA;ADEF;DDDD;FGMS;MSTV;VVVV $ perl single.pl AADDDEEEEFFFFGGMMMMMMMMMMSTV ADEF;DEFG;EFGM;MMMM;MSTV $ perl single.pl AAAADDDDEEEEFFFFGGGG AAAA;DDDD;EEEE;FFFF;GGGG
It wouldn't take that much work to make this find all the permutations because the only time you'll have permutations is when you have something of the form
nnnnooooppppqqqq Solution 1: (nnnn,oooo,pppp,qqqq) Solution 2: (nopq)
|
|---|