#!/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"); }