今週のアルゴリズム：最短経路の計算！(PHP/Python/Ruby/HSPでnext_permutation、Perlでpermutation iterator)

Permutation Iterator	next_permutation	URL
C#/Go/Python/Ruby/VB		まとめ含む http://qiita.com/cielavenir/items/ac96da5e3040c2edb78c
	Boo/C#/Nemerle/VB	http://qiita.com/cielavenir/items/0e07a024049017f7dea2
	Java/Groovy/Scala/Fortran/Pascal	http://qiita.com/cielavenir/items/4347fd0c6c69fa60804a
	D/Go/JavaScript/Lua/R	http://qiita.com/cielavenir/items/9e821d04f574a6623d03
Perl	HSP/PHP/Python/Ruby	http://qiita.com/cielavenir/items/006a878292c5be209231
Go2/Crystal/Kotlin/Nim/Julia		http://qiita.com/cielavenir/items/74f8d547437154c14e72
	V/Rust	http://qiita.com/cielavenir/items/cec1812999547909a9e4
D/Nemerle/JavaScript/Perl6/PHP	C/C++/Crystal/Go2/Julia Kotlin/Nim/Perl/Perl6	(github参照)

PHP

#!/usr/bin/php
<?php
function reverse(&$a,$start,$size){
	$end=$start+$size-1;
	for(;$start<$end;$start++){
		$z=$a[$start];$a[$start]=$a[$end];$a[$end]=$z;
		$end--;
	}
}
function next_permutation(&$a,$_n=null){
	$siz=count($a);
	$n=$_n || $siz;
	if($n<0||$siz<$n)return false;
	$i=0;
	reverse($a,$n,$siz-$n);
	for($i=$siz-2;$i>=0;$i--)if($a[$i]<$a[$i+1])break;
	if($i<0){
		reverse($a,0,$siz);
		return false;
	}
	$k=$i;
	for($i=$siz-1;$i>=$k+1;$i--)if($a[$k]<$a[$i])break;
	$l=$i;
	$z=$a[$k];$a[$k]=$a[$l];$a[$l]=$z;
	reverse($a,$k+1,$siz-($k+1));
	return true;
}

$N=6;
$e0=array_fill(0,$N*2,0);$f0=array_fill(0,$N*2,0);$i=0;$r=0;
for($i=0;$i<$N;$i++)$e0[$N+$i]=$f0[$N+$i]=1;
$e=array(0);
$f=array(0);
do{
	for($i=0;$i<$N*2;$i++)$e[$i+1]=$e[$i]+$e0[$i];
	do{
		for($i=0;$i<$N*2;$i++){
			$f[$i+1]=$f[$i]+$f0[$i];
			if($e[$i]==$f[$i]&&$e[$i+1]==$f[$i+1])break;
		}
		if($i==$N*2)$r++;
	}while(next_permutation($f0));
}while(next_permutation($e0));
echo $r.PHP_EOL;
?>

Python
配列の破壊的変更でちょっと手間取った。

#!/usr/bin/python
#coding:utf-8
import sys
if sys.version_info[0]>=3: from functools import reduce

def find(cond,a):
	for e in a:
		if cond(e): return e
	return None
def next_permutation(a,n=None):
	if n==None: n=len(a)
	if n<0 or len(a)<n: return False
	a[0:len(a)]=a[0:n]+a[len(a)-1:n-1:-1]
	k=find(lambda i: a[i]<a[i+1], range(len(a)-2,-1,-1))
	if k==None:
		a.reverse()
		return False
	l=find(lambda i: a[k]<a[i], range(len(a)-1,k,-1))
	a[k],a[l]=a[l],a[k]
	a[0:len(a)]=a[0:k+1]+a[len(a)-1:k:-1]
	return True

N=6
e0=sorted([0]*N+[1]*N)
f0=sorted([0]*N+[1]*N)
#各Pは経路を表す。1が縦、0が横を表す。
r=0
i=0
e=[0]*(N*2+1)
f=[0]*(N*2+1)
while True:
	for i in range(N*2): e[i+1]=e[i]+e0[i]
	#e=reduce(lambda s,_: (s.append(s[-1:][0]+_),s)[1],e0,[0])
	#数学の座標系のように左下をA、右上をBとすると、eの各インデックスiにおいて、x座標がi-e[i]、y座標がe[i]となる。
	while True:
		for i in range(N*2): f[i+1]=f[i]+f0[i]
		#f=reduce(lambda s,_: (s.append(s[-1:][0]+_),s)[1],f0,[0])
		if all(e[i]!=f[i] or e[i+1]!=f[i+1] for i in range(N*2)): r+=1
		#i番目の座標とi+1番目の座標が等しければ、「道に重複がある」とみなせる。
		if not next_permutation(f0): break
	if not next_permutation(e0): break
print(r) # 100360

Ruby

#!/usr/bin/ruby
def next_permutation(a,n=a.size)
	return if n<0||a.size<n
	a.replace(a[0,n]+a[n..-1].reverse)
	k=(a.size-2).downto(0).find{|i|a[i]<a[i+1]}
	if !k
		a.reverse!
		return false
	end
	l=(a.size-1).downto(k+1).find{|i|a[k]<a[i]}
	a[k],a[l]=a[l],a[k]
	a.replace(a[0,k+1]+a[k+1..-1].reverse)
	return true
end

N=6
#P=([0]*N+[1]*N).permutation2.to_a # N=5のとき、permutation.to_a.uniqの70倍速
e0=([0]*N+[1]*N).sort
f0=([0]*N+[1]*N).sort
#各Pは経路を表す。1が縦、0が横を表す。
r=0
i=0
e=[0]*(N*2+1)
f=[0]*(N*2+1)
begin
	(N*2).times{|i|e[i+1]=e[i]+e0[i]}
	#数学の座標系のように左下をA、右上をBとすると、eの各インデックスiにおいて、x座標がi-e[i]、y座標がe[i]となる。
	begin
		r+=1 if (N*2).times.none?{|i|
			f[i+1]=f[i]+f0[i]
			#i番目の座標とi+1番目の座標が等しければ、「道に重複がある」とみなせる。
			e[i]==f[i] && e[i+1]==f[i+1]
		}
	end while(next_permutation(f0))
end while(next_permutation(e0))
p r # 100360

HSP

#module
#deffunc reverse array a_,int start_,int size_
	end_=start_+size_-1
	i_=0
	repeat
		if i_>size_/2-1: break
		z_=a_(start_+i_)
		a_(start_+i_)=a_(end_-i_)
		a_(end_-i_)=z_
		i_++
	loop
	return

#defcfunc next_permutation array a_,int n_
	if n_<0||length(a_)<n_ : return 0
	i_=0
	reverse a_,n_,length(a_)-n_
	i_=length(a_)-2
	repeat
		if i_<0: break
		if a_(i_)<a_(i_+1): break
		i_--
	loop
	if i_<0{
		reverse a_,0,length(a_)
		return 0
	}
	k_=i_
	i_=length(a_)-1
	repeat
		if i_<k_+1: break
		if a_(k_)<a_(i_): break
		i_--
	loop
	l_=i_
	z_=a_(k_):a_(k_)=a_(l_):a_(l_)=z_
	reverse a_,k_+1,length(a_)-(k_+1)
	return 1

#global
N=6
dim e0,N*2
dim f0,N*2
i=0
repeat
	if i==N: break
	e0(N+i)=1
	f0(N+i)=1
	i++
loop
;sort e0,f0 ;not required, since we have already sorted form
r=0
dim e,N*2+1
dim f,N*2+1
repeat
	i=0
	repeat
		if i==N*2: break
		e(i+1)=e(i)+e0(i)
		i++
	loop
	repeat
		i=0
		repeat
			if i==N*2: break
			f(i+1)=f(i)+f0(i)
			if e(i)==f(i)&e(i+1)==f(i+1): break
			i++
		loop
		if i==N*2: r++
		z=next_permutation(f0,length(f0))
		if z=0: break
	loop
	z=next_permutation(e0,length(e0))
	if z=0: break
loop
mes r
end

Perl

240721: インターフェース直しました。

ltと<の問題はPerl6にもあったため今回は触りませんでした。

#!/usr/bin/perl
use strict;
sub permute(&@){
	my $code = shift;
	my @a = sort @_;
	for(;;){
		$code->(@a);
		my $i;
		#push(@a,reverse splice @a, $n);
		for($i=$#a-1;$i>=0;$i--){if($a[$i]<$a[$i+1]){last;}}
		if($i<0){return;}
		my $k=$i;
		for($i=$#a;$i>=$k+1;$i--){if($a[$k]<$a[$i]){last;}}
		my $l=$i;
		@a[$k,$l]=@a[$l,$k];
		push(@a, reverse splice @a, $k+1);
	}
}

my $N=6;
my @e0;
my @f0;
my $i;
my $r=0;
for($i=0;$i<$N;$i++){$e0[$i]=$f0[$i]=0;}
for($i=0;$i<$N;$i++){$e0[$N+$i]=$f0[$N+$i]=1;}
my @e=(0);
my @f=(0);
permute {
	for($i=0;$i<$N*2;$i++){$e[$i+1]=$e[$i]+$_[$i];}
	permute {
		for($i=0;$i<$N*2;$i++){
			$f[$i+1]=$f[$i]+$_[$i];
			if($e[$i]==$f[$i]&&$e[$i+1]==$f[$i+1]){last;}
		}
		if($i==$N*2){$r++;}
	} @f0;
} @e0;
print $r."\n";