#!/usr/bin/perl use utf8; use strict; use warnings; my $max_index = 12; my @_data = ; chomp @_data; my @data = grep {$_ ne ''} @_data; my @all_tokens; for my $line (@data) { print $line; print join "\n\t", '', machi([_split($line)], []); print "\n"; } sub _split { my $line = shift; my @nums = (sort split //, $line)[0..$max_index]; return @nums; } sub machi { my $nums = shift; my %index; for my $num (@$nums) { $index{$num} ||= 0; $index{$num}++; } my @list = gettoken(\%index, 0); my %log; my @machis; for my $l (@list) { my $s = t2s(@$l); if (!$log{$s}) { push @machis,$s; $log{$s} = 1; } } return @machis; } sub t2s { my @tokens = @_; my @sts; for my $token (@tokens) { push @sts, join('', @$token); } return join('', sort @sts); } sub gettoken { my $index = shift; my $has_atama = shift; my @tokens; my $length = 0; map {$length += $_} values %$index; for my $i (1..9) { if ($index->{$i}) { if ($index->{$i+1} && $index->{$i+2}) { my %newindex = %$index; map {$newindex{$_}--} ($i..$i+2); my @new_tokens = gettoken(\%newindex, $has_atama); map {push @tokens, [['(',$i..$i+2,')'], @$_]} @new_tokens; } if ($index->{$i} >= 3) { my %newindex = %$index; $newindex{$i}-=3; my @new_tokens = gettoken(\%newindex, $has_atama); map {push @tokens, [['(', $i, $i, $i,')'], @$_]} @new_tokens; } if (!$has_atama && $index->{$i} >= 2) { my %newindex = %$index; $newindex{$i}-=2; my @new_tokens = gettoken(\%newindex, 1); map {push @tokens, [['(',$i, $i,')'], @$_]} @new_tokens; } } } my @rests; for my $key (keys %$index) { if ($index->{$key} >= 1) { push @rests, (map {$key} (1..$index->{$key})); } } @rests = sort @rests; return (@tokens) ? @tokens : (is_machi($has_atama, @rests)) ? ([['[',@rests,']']]) : (); } sub is_machi { my $has_atama = shift; my @machi = @_; return 0 unless @machi; return 1 if (@machi == 1 && !$has_atama); return 1 if (@machi == 2 && (abs($machi[0] - $machi[1]) <= 2)); return 0; } __DATA__ 1112224588899 1122335556799 1112223335559 1223344888999 1112345678999 1231231234479