Project Euler 問題32

pe_32.pl

#!/usr/bin/perl

use strict;
use warnings;
use Math::Combinatorics;

my @digits = (1,2,3,4,5,6,7,8,9);
my %ans = ();

#＜事前調査その１＞
#n*mの積は 最小n+m-1桁, 最大n+m桁 になることがわかっている
#(1..9)の異なる数字を使った2項間の積の計算式が成立するのは積の値が4桁の時しかない
#4桁の積の候補を取得する（順列組み合わせ）
my @mul = map { join("", @$_) } (map { permute(@$_) } combine(4, @digits));
foreach my $mul (@mul)
{
  #print "[$mul]\n";
  #残った数字を取得（5個）
  my @remain = split(//, $mul);
  @remain = arr_subtract(\@digits, \@remain);

  #＜事前調査その2＞
  #残った5個の数字からn桁とm桁の2項を生成する
  #(n, m) = (1, 4), (2, 3)の時のみ4桁の数値になることが判明している
  foreach (1..2)
  {
    my @e1 = combine($_, @remain);  #項1を構成する数字のグループ
    foreach my $_e1 (@e1)
    {
      my @e2 = arr_subtract(\@remain, $_e1);
      my @_e1 = permute(@$_e1); #項1：順列組み合わせ
      my @_e2 = permute(@e2);   #項2：順列組み合わせ
      #項1、項2の候補をしらみ潰しに探索
      foreach (@_e1)
      {
        my $v1 = join("", @$_);
        my $v2;
        #乗数1は入力した値がそのまま出てくるのでパス
        not ($v1 == 1) or next;
        foreach (@_e2)
        {
          $v2 = join("", @$_);
          not ($v1*$v2 == $mul) or $ans{$mul} = 1;
        }
      }
    }
  }
}
my $sum = 0;
map { $sum += $_ } keys %ans;
print "Ans: $sum\n";
exit;

#
# 配列の残りの要素を取得
#
sub arr_subtract
{
  my $arr1 = shift;
  my $arr2 = shift;

  my %d = map { $_ => 1 } @$arr1;
  map { delete $d{$_} } @$arr2;
  return (sort keys %d);
}

# Ans: 45228

遅い