mahjong.pl

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Array::Utils qw/:all/;

sub print_machi {
  my @hai = @_;
  my $machi = pop @hai;
  for my $ans (@hai) {
    print "($ans)";
  }
  print "[$machi]\n";
}

sub check_machi {
  my $src = shift;
  my @pair = split "", $src;
  if ($pair[0] < $pair[1]){
    if ($pair[1] - $pair[0] > 2) {
      return 0;
    }
    else {
      return 1;
    }
  }
  elsif ($pair[0] > $pair[1]){
    if ($pair[0] - $pair[1] > 2) {
      return 0;
    }
    else {
      return 1;
    }
  }
  else { # 0 == 1
    return 1;
  }
}

sub pick_atama {
  my $at = shift;
  my $all = shift;
  my $hash = {};
  for (@$all) {
    $hash->{$_}++;
  }
  $hash->{$at} = $hash->{$at} - 2;
  my $res = [];
  while (my ($k, $v) = each %$hash) {
    push(@$res, $k ) for 0..($v-1);
  }
  return $res;
}


sub atama {
  my @input = @_;
  my $hash = {};
  for (@input) {
    $hash->{$_}++;
  }
  my $atama = [];
  while (my ($k, $v) = each %$hash) {
    push( @$atama, $k ) if $v > 1;
  }
  return $atama;
}

# delete duplicate path.
sub path_uniq {
  my $deletable_paths = shift;
  my $check_h;
  for my $path (@$deletable_paths) {
    $check_h->{join "", sort {$a <=> $b} @$path} = $path;
  }
  $deletable_paths = [values %$check_h];
  return $deletable_paths;
}

sub subtraction {
  my $in = shift;
  my $pattern = shift;
  my $goal = shift;
  $goal = $goal - 1;
  my $enables;

  print "goal : $goal\n";

  return [ [join("", @$in)] ] if $goal == 0;

  for my $pat ( @$pattern ) {
    print "try $pat\n";
    my ($ret, $delete_ok) = delete_pattern($in, $pat);

    unless($delete_ok) {
      next;
    }
    else {
      for my $ppath ( @{ subtraction([ split("", $ret) ],
                                     possible_pattern(split "", $ret), $goal) } ) {
        push @$enables, [$pat, @$ppath];
      }
    }
  }
  return $enables;
}

sub delete_pattern {
  my ($in, $pat) = @_;  
  my $table = to_hash(@$in);
  my @nums = split "", $pat;

  my $expect = 3;

  while (my ($num, $am) = each %$table) {
    my $newam = $am;
    for (@nums) {
      if( $_ == $num) {
        $newam -= 1;
        $expect -= 1;
      }
    }
    # burst
    if ($newam < 0) {
      $table->{$num} = $am;
      $expect++;
    }
    else {
      $table->{$num} = $newam;
    }
  }
  my $post = "";
  my $success = 0;
  my $orig = join "", @$in;
  if ($expect == 0) {
    while (my ($num, $am) = each %$table) {
      $post .= $num x $am;
    }
    $success = 1;
    print "[$expect] delete $pat from $orig . ret: $post\n";
    return ($post, $success);
  }
  else {
    print "[$expect] delete $pat from $orig failed. $expect. ret: $orig\n";
    return ($orig, $success);
  }
} 

sub possible_pattern {
  my @in = @_;
  return [shuntsu(@in), kotsu(@in)];
}

sub shuntsu {
  my @in = @_;
  my $unique = join "", sort {$a <=> $b} unique(@in);
  my @patterns = qw/123 234 345 456 567 678 789/;
  my @shuntsu = ();
  push( @shuntsu, ($unique =~ /($_)/g) ) for @patterns;
  return @shuntsu;
}

sub kotsu {
  my @in = @_;
  my $res = [];
  my $table = to_hash(@in);
  while (my ($num, $am) = each %$table) {
    push(@$res, $num x 3 )if $am == 3;
  }
  return @$res;
}

sub to_hash {
  my $h;
  $h->{$_}++ for (@_);
  return $h;
}

sub main {
  my @input = sort {$a cmp $b} split //, $ARGV[0];
  my $paths  = path_uniq(subtraction(\@input, possible_pattern(@input), 4));

  for my $p (@$paths) {
    my $last = pop @$p;

    if (length $last == 1) { # atama-machi
      print_machi(@$p, $last);
    }
    elsif (length $last == 4) {
      if (scalar kotsu(split "", $last) == 1) {
        my $kotsu = join "" , kotsu(split "", $last);
        my ($ret, $ok) = delete_pattern([split "", $last ], $kotsu);
        print_machi($kotsu, @$p , $ret);
      }

      my $probable_atama = atama(split '', $last);
      if (scalar @$probable_atama == 1) {
        my $atama_cand = shift @$probable_atama;
        my $machi_cand = pick_atama($atama_cand, [split "", $last]);
        if (check_machi(join "", @$machi_cand)) {
          print_machi($atama_cand x 2, @$p , join "", @$machi_cand);
        }
      }
      elsif (scalar @$probable_atama > 1) {
        for my $atama (@$probable_atama) {
          my $machi_cand = pick_atama($atama, [split "", $last]);
          print_machi($atama x 2, @$p , join "", @$machi_cand);
        }
      }
    }
  }

}

# IN 1112224588899
# OUT (111)(222)(888)(99)[45]

# IN 1122335556799
# OUT (123)(123)(55)(567)[99]
# OUT (123)(123)(99)(567)[55]

main();