All pastes #1856492 Raw Edit

machi2.pl

public text v1 · immutable
#1856492 ·published 2010-04-04 11:48 UTC
rendered paste body
#!/usr/bin/perl
use utf8;
use strict;
use warnings;

my $max_index = 12;

my @_data = <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