CodeIQ q684 gemstrings.

gemstrings.pl

#!/bin/perl
#---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0

# $ perl gemstring.pl eagcdfbe 1 4 1 4 2 1 3

use v5.10;
use strict;
use integer;
# no Memoize; # :-)

#---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0

# 指定した宝石の個数で表現できるパターンの総数を求める
sub count (@) {

	# パターン総数の計算の場合、個数だけが重要で順番は関係ないため
	# 0 個を除外し、数の少ない順に並べて正規化する（メモ化の効率が上がる）
	my @gems = sort { $a <=> $b } grep { $_ } @_;

	# AUTOLOAD 用関数名を合成して呼び出す
	my $cache = '_' . join('_', @gems);

	no strict 'refs';
	$cache->();

}

# パターン総数の実計算は AUTOLOAD を使ってメソッドにメモ化する
# メソッド名は _3_2_1() のような感じ
# この場合 3個/2個/1個の場合のパターン総数となる
sub AUTOLOAD {

	# 呼び出されたメソッドの完全名
	my $method = our $AUTOLOAD;
	
	# メソッド名だけ抜き出す
	(my $name = $method) =~ s/.*:://o;

	# メソッド名から宝石数を得る
	my @gems = $name =~ /_(\d+)/ga;

	# 計算結果
	my $result = 0;

	if (scalar @gems == 1) {
	
		# 宝石が 1 種類しかなければ、その数がパターンの数
		$result = $gems[0];

	} else {
	
		# 宝石が 2 種類以上ある場合

		# 最初の宝石を選ぶパターンは種類数ある
		foreach (0 .. $#gems) {
		
			# 宝石を 1 つ選んでそこで終了するパターンが 1 つ
			++$result;
		
			# それに残りの宝石を使ったパターンを加算
			--$gems[$_];
			$result += count @gems;
			++$gems[$_];

		}

	}

	# 定数を返す関数を動的に生成して結果をメモ化
	# 同じ関数の次回呼び出しが速くなる
	{
		no strict 'refs';
		*$method = sub { $result };
	}

	say STDERR "Memoize: $name => $result";

	# 呼び出しを生成した関数に振り替える
	goto &$method;

}

#---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0

# 目的パターンと宝石の個数よりその出現箇所を計算する

sub solve ($@) {
	my ($goal, @gems) = @_;

	# 目的がなければ 0 を返す
	return 0 unless @$goal;

	my $result = 0;

	# 最初の宝石の種類を得る
	my $first = $goal->[0];

	# 目的パターンの前には
	# 最初の宝石より種類が若い宝石のパターンが並ぶ
	# 例えば aacd の宝石があり、目的が d... の場合
	# その前には a... のパターンと c... のパターンが並ぶ

	# 最初の宝石より若い宝石があれば
	foreach (grep { $gems[$_] } 0 .. $first - 1) {

		# 宝石を 1 つ選んでそこで終了するパターン
		++$result;
	
		# それに残りの宝石を使ったパターンを加算
		--$gems[$_];
		$result += count @gems;
		++$gems[$_];

	}

	# 最初の宝石をとり除く
	--$gems[$first];
	++$result; # 1 パターン

	# 残りに対して計算を続ける
	$goal = [ @$goal[1 .. $#$goal] ];

	$result += solve($goal, @gems);

	$result;

}

#---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0

# スタート

# 引数から目的パターンと各宝石の個数を得る
my ($goal, @gems) = @ARGV;

# 目的の並びを数値配列に ex: cacaba -> (2, 0, 2, 0, 1, 0)
my @goal = map { (ord() & 0x1f) - 1 } split //, $goal;

say solve(\@goal, @gems);