４人将棋対戦ソフト

駒をなる時は、最後に - をつけます。例えば、５五の飛車が５三に成る時は、5553- とします。
持ち駒を打つときは、１七歩打ちの場合は、 0117 とします。最初の01が歩を示し、次の17が打つ場所を示します。
その他の操作方法は、？ で表示されます。
４人将棋ダブルスソフト

#４人将棋

#　駒の番号　　1歩 2銀 3金 4飛 5と 6成銀(全) 7× 8龍 9玉

#　手番　　　　1(玉が５九の人),2(玉が９五の人),3,4

#　その枡の周囲番号　  

#　                　6 4 1

#                    7◎ 2

#                    8 5 3

#

#大域変数

#  @MAN[1..4]	各対局者をどちらが受け持つか  1:人  0:コンピュータ

#  $DEPTH	コンピュータの思考深さ

#  $TEBAN	次の手番(基本的に人のメインのみで使う）

#

#内部変数

#  @KATI[1..9]



#盤面変数

#  @BAN[11..99]	駒番号   盤の右上から下に11,12,,,,

#  @MKI[0..110]	駒の向き  1,2,3,4:対局者    0:駒なし -1:盤外

#  @MTI[1..4]	持ち駒   各駒の枚数を４桁で表す　(歩銀金飛)

#  @KKI[11..99]	枡に対して周囲の誰の駒が利いているか

#                8桁 (右上,右,右下,上,下,左上,左,左下)  

#               例：初期状態の２八にはＡ(左下)とＤ(右上)の駒が利いている

#                     $KKI[28]="4      1"

#  @OU[1..4]    各人の玉の位置　　２桁　　例：５九にいるなら"59"

#

#  @SASITE[1..99]　指し手   "13928"等  1番が３九の銀を２八に動かした



#王手かのチェックが不十分（飛車の王手が未対応）



srand time;

&init;					#現在の局面

@KATI[1..9] = (1, 5, 5, 8, 6, 5, 0, 10, 969);	#駒の価値

@MAN[1..4] = (1,0,0,0);			#人が指すかＰＣが指すか

$DEPTH = 2;				#コンピュータの読み深さ

$msg = "あなたの番です";

@SASITE = ();

for(;;){

	$TEBAN = &tugi($TEBAN);

	if(@MAN[$TEBAN]){			#人が指す

		$msg .= "王手がかかっています" if(&is_oute($TEBAN));

		$te = &man_input($msg);

		if($te<0){		#待った

			if($#SASITE+$te>=-1){

				@SASITE = @SASITE[0..$#SASITE+$te];

				&init;

				for ($i=0; $i<=$#SASITE ; $i++){

					&move($SASITE[$i]);

				}

				$TEBAN = ($#SASITE<0)?0:substr($SASITE[$#SASITE], 0, 1);

				$msg = "待ったしました";

			}else{

				$msg = "待ったできません";

			}

			next;

		}elsif($te == 1){

			last;

		}else{

			&move($te);

			$msg = &jp($te)." ";

		}

	}else{					#コンピュータが指す

		print "#####  ".substr("ABCD",$TEBAN-1,1).":思考中です #### ";

		($te, $v) = &solve($TEBAN);

		&move($te);

		print &jp($te), " [$te]\n";

		$msg .= &jp($te)." ";

		if($te == 1){&ban_disp; last};

	}

	push(@SASITE, $te);

}



#盤の初期状態作成

sub init{

	@BAN[11..19] = (0, 0, 2, 3, 9, 3, 2, 0, 0);

	@BAN[21..29] = (0, 0, 0, 1, 4, 1, 0, 0, 0);

	@BAN[31..39] = (2, 0, 0, 0, 1, 0, 0, 0, 2);

	@BAN[41..49] = (3, 1, 0, 0, 0, 0, 0, 1, 3);

	@BAN[51..59] = (9, 4, 1, 0, 0, 0, 1, 4, 9);

	@BAN[61..69] = (3, 1, 0, 0, 0, 0, 0, 1, 3);

	@BAN[71..79] = (2, 0, 0, 0, 1, 0, 0, 0, 2);

	@BAN[81..89] = (0, 0, 0, 1, 4, 1, 0, 0, 0);

	@BAN[91..99] = (0, 0, 2, 3, 9, 3, 2, 0, 0);

	@MKI[ 0.. 9] = (-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);

	@MKI[10..19] = (-1, 0, 0, 4, 4, 4, 4, 4, 0, 0);

	@MKI[20..29] = (-1, 0, 0, 0, 4, 4, 4, 0, 0, 0);

	@MKI[30..39] = (-1, 3, 0, 0, 0, 4, 0, 0, 0, 1);

	@MKI[40..49] = (-1, 3, 3, 0, 0, 0, 0, 0, 1, 1);

	@MKI[50..59] = (-1, 3, 3, 3, 0, 0, 0, 1, 1, 1);

	@MKI[60..69] = (-1, 3, 3, 0, 0, 0, 0, 0, 1, 1);

	@MKI[70..79] = (-1, 3, 0, 0, 0, 2, 0, 0, 0, 1);

	@MKI[80..89] = (-1, 0, 0, 0, 2, 2, 2, 0, 0, 0);

	@MKI[90..99] = (-1, 0, 0, 2, 2, 2, 2, 2, 0, 0);

	@MKI[100..109]=(-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);

	@MTI[1..4]  = ("0000","0000","0000","0000");

	@OU[1..4] = (59, 95, 51, 15);

	&make_kki;

}



#@BANと@MKIから@KKIを作成する

sub make_kki{

	my($teban, $i);

	for $i (0..109){

		$KKI[$i] = "        ";

	}

	for $i (11..99){

		add_kki($i) if($MKI[$i]>0);	#その枡の駒の利きを追加

	}

}



#指定した枡にある駒の利き(飛車の飛び以外)を追加

#指定した枡には駒があること

sub add_kki{

	my($xy) = @_;

	my($teban, $i);

	$teban = $MKI[$xy];	

	for $i (&ugoki($xy)){

		substr($KKI[$i], 9-&shui($i-$xy)-1, 1) = $teban;

	}

}



#指定した枡にある駒の利きを削除

#指定した枡には駒があること

sub del_kki{

	my($xy) = @_;

	my($i);

	for $i (&ugoki($xy)){

		substr($KKI[$i], 9-&shui($i-$xy)-1, 1) = " ";

	}

}



#飛車の隣枡以外で利いている枡を求める

#引数：(枡位置,方向)  方向(1:上、2:下、3:右、4:下）

#戻り値：飛車が利いている枡の座標のリスト

sub hisha{

	my($xy,$dir) = @_;

	my($teban) = $MKI[$xy];

	my($step) = (0,-1, 1,-10, 10)[$dir];

	my(@m) = ();

	if($step==0){

		return (&hisha($xy,1),&hisha($xy,2),&hisha($xy,3),&hisha($xy,4));

	}

	if(!$MKI[$xy+$step]){				#隣に駒があれば終わり

		for($xy += 2*$step;; $xy += $step){	#隣の隣から検索開始

			last if($MKI[$xy]<0);		#盤外なら終わり

			@m = (@m, $xy);

			last if($MKI[$xy]);			#駒があれば終わり

		}	

	}

	return @m;

}



#指定した駒が利いている枡位置を求める(盤外も求めてしまう)

#飛車、龍では隣以外の枡は返さない

#引数：駒位置

#戻り値：指定した駒の利いている枡位置のリスト

sub ugoki{

	my ($xy) = @_;

	my ($i);

	my (@m) = &ugoki0($MKI[$xy], $BAN[$xy]);

	for ($i=0; $i<=$#m; $i++){ $m[$i] += $xy;}

	return @m;

}



sub ugoki0{

	my($teban, $koma) = @_;

	if($koma == 1){				#歩

		return  -1 if($teban == 1);

		return -10 if($teban == 2);

		return   1 if($teban == 3);

		return  10 if($teban == 4);

	}elsif($koma == 2){			#銀

		return (-11,-9, -1,9,11) if($teban==1);

		return (-11,-9,-10,9,11) if($teban==2);

		return (-11,-9,  1,9,11) if($teban==3);

		return (-11,-9, 10,9,11) if($teban==4);

	}elsif($koma =~ /^[356]$/){		#金と全

		return (-11,-10,-1, 1, 9,10) if($teban==1);

		return (-11,-10,-9,-1, 1,10) if($teban==2);

		return (-10, -9,-1, 1,10,11) if($teban==3);

		return (-10, -1, 1, 9,10,11) if($teban==4);

	}elsif($koma == 4){			#飛

		return (-10,-1,1,10);

	}elsif($koma =~ /^[89]$/){		#龍玉

		return (-11,-10,-9,-1,1,9,10,11);

	}else{

		print "******  おかしな駒 $koma *******";

	}

}



#枡の相対位置から周囲番号(1..8)を求める

#引数：枡の相対位置

#戻り値：周囲番号

sub shui{

	my($xy)=@_;

	return $xy+12 if($xy <=-9);

	return 4 if($xy == -1);

	return 5 if($xy == 1);

	return $xy-3 if($xy >=9);

}



#枡の周囲の番号(1..8)から相対位置を求める

#引数：枡の周囲番号

#戻り値：枡の相対番号

sub soutai{

	my($shui) = @_;

	my(@a) = (-11, -10, -9, -1, 1, 9,10,11);

	return $a[$shui-1];

}



#盤面の駒の移動

#引数：指し手

#戻り値：  0:正常 1:玉を取った 2:それ以外

sub move{

	my ($a) = @_;

	my ($teban, $moto, $ato, $naru) = ( $a =~ /^(\d)(\d\d)(\d\d)(-?)/ );

	my ($ban, $koma );

	return 2 if($teban == 0); 

	if($koma = $BAN[$ato]){			#移動先に駒が有れば持駒にする

		return 1 if($koma==9);

		&del_kki($ato) if($BAN[$ato]);	#とられる駒の利きをなくす

		$koma -= 4 if(4 < $koma);

		substr($MTI[$teban], $koma-1, 1)++;

	}

	if($moto <= 9){				#駒を打つ場合

		$BAN[$ato] = $moto+0;

		$MKI[$ato] = $teban+0;

		&add_kki($ato);

		substr($MTI[$teban], $moto-1, 1)--;

	}else{					#駒を移動する場合

		&del_kki($moto);	#元の位置の利きをなくす

		$BAN[$ato] = $BAN[$moto];

		$BAN[$ato] += 4 if($naru);

		$MKI[$ato] = $MKI[$moto];

		&add_kki($ato);

		$BAN[$moto] = 0;

		$MKI[$moto] = 0;	

		$OU[$teban] = $ato if($BAN[$ato] == 9); #玉の位置

	}

	return 0;

}



#指し手チェックの結果

sub NGmsg{

	my($a) = @_;

	my(@b) = qw(持ち駒なし 自分の駒でない 変な動き 成れない 自分の駒を取る ２歩 . . その他);

	return $b[$a-1];

}



#指し手が正しいかのチェック

#  引数である指し手そのもののフォーマットは正しいものとする。

#引数：指し手のリスト

#戻り値：  0:正常

#          1:持ち駒にない 2:自分の駒でない  3:変な動き  4:成れない 5:自分の駒を取る

#          6:２歩 9:それ以外

sub is_NG{

	my ($teban, $moto, $ato, $naru) = @_;

	my ($i,$j,$koma);

	if($moto!~/^0?[1234]$|^[1-9][1-9]$/ || $ato!~/^[1-9][1-9]$/){	#範囲チェック

		return 9;

	}elsif($moto <= 4){									#駒を打つ場合

		return 1 if(substr($MTI[$teban], $moto-1, 1)==0);	#持駒にあるか

		return 3 if($MKI[$ato]);							#打つ先に駒がある

		return 4 if($naru);									#成って打とうとする

		return 6 if(&nifu($teban, $ato));					#２歩

		return 3 if($moto == 1 && &saigo($teban, $ato));	#行き所のない場所に歩を打つ

	}else{

		return 2 if($teban != $MKI[$moto]);		#元の駒が自分のかの確認

		return 5 if($MKI[$ato] == $teban);		#自分の駒を取る

		$koma = $BAN[$moto];

		is_NG3:{

			for $i (&ugoki($moto)){last is_NG3 if($ato == $i)}	#駒の動き

			if($koma==4 || $koma == 8){				#飛車の飛び動きの確認

				for $i (&hisha($moto, 0)){last is_NG3 if($i==$ato);};

			}

			return 3;				#動きが変

		}

		return 3 if($koma==1 && &saigo($teban,$ato) && !$naru);	#歩が進めない

		return 4 if($naru && !nareru($moto,$ato));		#駒が成れる位置にあるか

	}

	return 0;

}



#駒が成れるかのチェック

#戻り値：1:成れる  0:成れない

sub nareru{

	my($moto, $ato)=@_;

	my($teban)= $MKI[$moto];

	my($koma) = $BAN[$moto];

	return 0 if($koma =~ /^[356789]$/);

	return 0 if($teban==1 && $ato !~ /[123]$/ && $moto !~ /[123]$/);

	return 0 if($teban==2 && $ato !~ /^[123]/ && $moto !~ /^[123]/);

	return 0 if($teban==3 && $ato !~ /[789]$/ && $moto !~ /[789]$/);

	return 0 if($teban==4 && $ato !~ /^[789]/ && $moto !~ /^[789]/);

	return 1;

}



#王手が掛かっているかのチェック

#引数:手番

#戻り値：1:王手がかかっている　　0:王手が掛かっていない

sub is_oute{

	my ($teban) = @_;

	my($c);

	$c = $KKI[$OU[$teban]];			#隣の枡のチェック

	$c =~ s/$teban//g;

	return 1 if($c>0);

	for $i (&hisha($OU[$teban], 0)){	#遠距離の飛車のチェック

		return 1 if($BAN[$i]=~/[48]/ && $MKI[$i]!=$teban);

	};

	return 0;

}



#次の手番を返す

sub tugi{

	my ($teban) = @_;

	for (1..3){

		$teban = ($teban % 4)+1;

		return $teban if(&is_oute($teban));

	}

	return ($teban+1) % 4 + 1;

}



#人間の入力

#引数：表示メッセージ

#戻り値：指し手         @##%%(成らず) or @##%%-(成)  or 1(投了） or 9(待った)

#        指し手の意味   @:対局者  ##:元の位置  %%:移動後の位置

sub man_input{

	my ($msg) = @_;

	my $a,$te;

	print "\n";

	for(;;){

		if($msg){

			&ban_disp;

			print "$msg:形勢=".&hyouka."\n";

			print $#SASITE+2 , "手目です。";

		}

		printf(" %sの手番です 入力 or ?=>", substr("ABCD", $TEBAN-1, 1));

		chop($te=<>);

		if($te =~ /\?/){		#ヘルプ

			print " ##%% (##元の位置 %%移動後の位置 成る時は最後に-をつける\n";

			print " 打つ時は元の位置の代わりに、01歩 02銀 03金 04飛とする\n";

			print " 他の入力 1:投了, -#:待った, .#:思考レベルの変更(現在:$DEPTH)\n";

			print "          /#:手番を#にする\n";

			next;

		}

		if($te =~ /KKI(..)/){print "KKI=$KKI[$1]:\n"; $te=="";}

		if($te =~ /\./){				#思考レベルの変更

			($te , $a) = split(/\./, $te);

			$DEPTH = $a if($a > 0);

		}

		if($te =~ /\/([1-4])/){				#手番変更

			$TEBAN = $1;

			$te =~ s/$1//;

		}			

		return($te) if($te == 1 || $te < 0);		#投了・待った

		if($te =~ /(.*)\*$/){				#指し手チェックを行わない

			return $TEBAN.$1;

		}elsif($te =~ /^(\d\d)(\d\d)(-?)$/){		#指し手のチェック

			$a = &is_NG($TEBAN, $1, $2, $3);

			return $TEBAN.$te if(!$a);

			$msg = "その手はさせません(".substr("ABCD",$TEBAN-1,1).&NGmsg($a).")";

			next;

		}

		$msg = "入力が違っています";

		$msg = "" if(!$te);

	}

}



#盤の表示

sub ban_disp{

	my (@mes1,@mes2,$i);

	$mes1[4] = "B:";

	$mes1[5] = &motikoma(2);

	$mes2[4] = "D:";

	$mes2[5] = &motikoma(4);

	printf("%20s  C:%s\n", "", &motikoma(3));

	printf("%20s  9  8  7  6  5  4  3  2  1\n");

	printf("%20s+----------------------------\n");

	for($i=1; $i<=9; $i++){

		printf("%-20s%s %s\n", $mes1[$i], &ban_1($i), $mes2[$i]);

	}

	printf "%20s+----------------------------\n";

	printf "%20s  A:%s\n", "", &motikoma(1);

}



#表示持ち駒

sub motikoma{

	my ($teban) = @_;

	my ($koma) = $MTI[$teban];

	$koma =~ s/(.)(.)(.)(.)/飛\4 金\3 銀\2 歩\1/;

	return $koma;

}



#盤の１行を返す

# ban_disp で使用

#引数：盤の縦座標

sub ban_1{

	my ($y) = @_;

	my ($a, $b, $c,$i);

	$c = "|";

	for($i=9; $i>=1; $i--){

		$a = $i*10 + $y;

		$b = $MKI[$a];

		$c .= " ".&koma($BAN[$a]) if($b == 1);

		$c .= &koma($BAN[$a]).">" if($b == 2);

		$c .= "v".&koma($BAN[$a]) if($b == 3);

		$c .= "<".&koma($BAN[$a]) if($b == 4);

		$c .= " ・"               if($b == 0);

	}

	return $c."|".substr("一二三四五六七八九", $y*2-2, 2);

}



#駒番号から駒名を返す

sub koma{

	my($n) = @_;

	return substr("・歩銀金飛と全金龍玉", $n*2, 2);

}

#与えられた配列の順番をでたらめにする

sub rnd_array{

	my(@a) = @_;

	my($b);

	for($i=0; $i<=$#a; $i++){

		$b = int(rand($#a+1));

		($a[i],$a[$b]) = ($a[$b], $a[i]);

	}

	return @a;

}



#指し手の日本語

sub jp{

	my($te) = @_;

	return "負けました" if($te==1);

	my($koma);

	my($teban,$moto,$ato,$naru) = ($te =~ /(.)(..)(..)(.?)/);

	$teban = ((A,B,C,D)[$teban-1]);

	$koma = &koma($naru?$BAN[$ato]-4:$BAN[$ato]);

	$naru = "成" if($naru);

	$moto = "打" if($moto<10);

	return "$teban:$ato$koma$naru($moto)";

}



#候補手を出す

#引数：手番

#戻り値：(候補１、候補２、・・・)

sub kouho{

	my ($teban) = @_;

	my (@k, @b, $xy, $xy2);

	for($xy=11; $xy<=99; $xy++){		#空いている枡

		@b = (@b, $xy) if(!$MKI[$xy]);

	}

	for $xy (1,2,3,4){					#駒打ち

		if($a = substr($MTI[$teban],$xy-1,1)){

			for $xy2 (@b){

				next if($xy == 1 && (&nifu($teban, $xy2)||&saigo($teban,$xy2)));

				@k = (@k, $teban."0$xy".$xy2);

			}

		}

	}

	for($xy=11;$xy<=99;$xy++){			#普通の場合の盤上の駒を動かす

		next if($MKI[$xy] != $teban);

		@b = &ugoki($xy);

		@b = (@b, &hisha($xy, 0)) if($BAN[$xy] =~ /[48]/);

		for $xy2 (@b){

			next if($MKI[$xy2] == $teban || $MKI[$xy2] < 0);

			@k = (@k, $teban.$xy.$xy2) if($BAN[$xy]!=1 || !&saigo($teban,$xy));

			@k = (@k, $teban.$xy.$xy2."-") if(nareru($xy,$xy2));

		}

	}

	return @k;

}



#指定した枡に利いている自分の駒の座標を求める

#戻り値：座標のリスト

sub kiki0{

	my($xy, $teban) = @_;

	my($b, $i);

	my(@k)=();

	$b = $KKI[$xy];

	for($i=1; $i<=8; $i++){

		@k = (@k, &soutai($i)+$xy) if(substr($b, $i-1, 1)==$teban);

	}

	return @k;

}



#指定した枡に利いている他人の駒の座標を求める

#戻り値：座標のリスト

sub kiki1{

	my($xy, $teban) = @_;

	my($b, $i);

	my(@k)=();

	$b = $KKI[$xy];

	$b =~ s/$teban/ /g;

	for($i=1; $i<=8; $i++){

		@k = (@k, &soutai($i)+$xy) if(substr($b, $i-1, 1)>0);

	}

	return @k;

}



#２歩のチェック

sub nifu{

	my($teban, $xy)=@_;

	my($i);

	if($teban =~ /[13]/){

		$xy = int($xy/10)*10;

		for($i=1; $i<=9; $i++){

			return 1 if($BAN[$xy+$i] == 1 && $MKI[$xy+$i]==$teban);

		}

	}else{

		$xy = $xy - int($xy/10)*10;

		for($i=10; $i<=90; $i+=10){

			return 1 if($BAN[$xy+$i] == 1 && $MKI[$xy+$i]==$teban);

		}

	}

}



#歩が進めないことのチェック

sub saigo{

	my($teban, $xy)=@_;

	return 1 if($teban == 1 && $xy =~ /1$/);

	return 1 if($teban == 2 && $xy =~ /^1/);

	return 1 if($teban == 3 && $xy =~ /9$/);

	return 1 if($teban == 4 && $xy =~ /^9/);

}



#考える

#引数：（手番、読む深さ）

#戻り値：(次の手,その評価値)

sub solve0{

	my ($teban, $fukasa) = @_;

	my ($i, $te, @k);

	my ($teban2, %new_v, $best_v, $best_te);

	my ($te2);

	@k = &kouho($teban);			#候補手を探す

#	@k = @k[0..1];

	for($i=$#k; $i>=0;$i--){

		$te = $k[$i];

		push(@BAN_STACK, join(":", @BAN));

		push(@MKI_STACK, join(":", @MKI));

		push(@MTI_STACK, join(":", @MTI));

		push(@KKI_STACK, join(":", @KKI));

		push(@OU_STACK , join(":", @OU));

		&move($te);						#次の局面を作成

		if(&is_oute($teban)){			#王手が回避できない手は駄目

			splice(@k, $i, 1);

		}elsif(&is_oute((($teban+1)%4)+1)){	#相棒に王手するのは駄目

			splice(@k, $i, 1);

		}else{

			if($fukasa <= 1){			#次の局面の評価を行う

				$new_v{$te} = &hyouka;

			}else{					#ｎ手先の局面の評価を行う

				$teban2 = &tugi($teban);

				($te2, $new_v{$te}) = &solve0($teban2, $fukasa-1);

			}

		}

		@BAN = split(/:/, pop(@BAN_STACK));

		@MKI = split(/:/, pop(@MKI_STACK));

		@KKI = split(/:/, pop(@KKI_STACK));

		@MTI = split(/:/, pop(@MTI_STACK));

		@OU  = split(/:/, pop(@OU_STACK));

	}

	if($teban =~ /[13]/){

		$best_v = -9999; $best_te = "1";

		foreach $te (@k){

			if($new_v{$te} > $best_v){ $best_v = $new_v{$te}; $best_te=$te; } 

		}

	}else{

		$best_v = 9999; $best_te = "1";

		foreach $te (@k){

			if($new_v{$te} < $best_v){ $best_v = $new_v{$te}; $best_te=$te; } 

		}

	}

#print " #$best_te:$best_v# ";

	return ($best_te, $best_v);

}





#局面の評価

#手番１・３組みが優勢なほど大きい値を返す

#引数：なし

#戻り値：評価値\

sub hyouka{

	my(@ko);

	#駒得のチェック

	for $i (11..99){

		$ko[$MKI[$i]] += $KATI[@BAN[$i]];

	}

	for $i (1..4){

		for $j (1..4){

			$ko[$i] += $KATI[$j] * substr($MTI[$i], $j-1, 1);

	}}

	return $ko[1]-$ko[2]+$ko[3]-$ko[4];

}





#考える

#引数：（手番）

#戻り値：(指し手、その評価値)

sub solve{

	my ($teban) = @_;

	($te, $v) = &solve0($teban, $DEPTH);

	return ($te, $v);

}