結果

問題 No.2986 Permutation Puzzle
ユーザー ID 21712
提出日時 2024-12-31 00:55:02
言語 Perl
(5.40.0)
結果
AC  
実行時間 1,155 ms / 2,000 ms
コード長 2,001 bytes
コンパイル時間 139 ms
コンパイル使用メモリ 6,820 KB
実行使用メモリ 6,820 KB
最終ジャッジ日時 2024-12-31 00:55:19
合計ジャッジ時間 14,635 ms
ジャッジサーバーID
（参考情報） 		judge3 / judge2
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 4
other AC * 40
権限があれば一括ダウンロードができます
コンパイルメッセージ
Main.pl syntax OK

ソースコード

diff # 

use v5.38.2;

sub issame {
	my $n = $_[0];
	my $b = $_[1];
	my $a = $_[2];
	my $icol = $_[3];
	my $irow = $_[4];
	for my $r ( 1 .. $n ) {
		for my $c ( 1 .. $n ) {
			if ( $b->[$r-1][$c-1] != $a->[$irow->[$r-1]-1][$icol->[$c-1]-1]) {
				return 0;
			}
		}
	}
	return 1;
}

sub search {
	my $n = $_[0];
	my $b = $_[1];
	my $k = $_[2];
	my $a = $_[3];
	my $icol = $_[4];
	my $irow = $_[5];
	my $ops = $_[6];
	my $p = $_[7];
	
	if ( $k == 0 ) {
		return issame($n, $b, $a, $icol, $irow);
	}
	
	my @itmp = ( 1 .. $n );
	
	for my $op ( 1 .. (2*$n) ) {
		$ops->[$k-1] = $op;
		if ( $op <= $n ) {
			for my $r ( 1 .. $n ) {
				$p->[$k-1][$r-1] = $a->[$irow->[$r-1]-1][$icol->[$op-1]-1];
			}
			for my $e ( 1 .. $n ) {
				$itmp[ $p->[$k-1][$e-1]-1 ] = $icol->[$e-1];
			}
			if ( search($n, $b, $k-1, $a, \@itmp, $irow, $ops, $p) ) {
				return 1;
			}
		} else {
			for my $c ( 1 .. $n ) {
				$p->[$k-1][$c-1] = $a->[$irow->[$op-1-$n]-1][$icol->[$c-1]-1];
			}
			for my $e ( 1 .. $n ) {
				$itmp[ $p->[$k-1][$e-1]-1 ] = $irow->[$e-1];
			}
			if ( search($n, $b, $k-1, $a, $icol, \@itmp, $ops, $p) ) {
				return 1;
			}		}
	}
	
	return 0;
}


sub readints { return map( int, split( /\s+/ , <> ) ); } 

my ( $n , $k ) = readints;
my @a = map( [ readints ] , ( 1 .. $n ) );
my @b = map( [ readints ] , ( 1 .. $n ) );

my @icol = ( 1 .. $n );
my @irow = ( 1 .. $n );
my @ops = ( 1 .. $k );
my @p = map( [ ( 1 .. $n ) ], ( 1 .. $k ));

search($n, \@b, $k, \@a, \@icol, \@irow, \@ops, \@p);

my @ans = ();

for my $j ( 1 .. $k ) {
	my $op = $ops[$j-1];
	my $perm = $p[$j-1];
	my @w = @$perm;
	my @t = ( 1 .. $n );
	my $z = ($op-1) % $n;
	while () {
		for my $i ( 1 .. $n ) {
			$t[$perm->[$i-1]-1] = $w[$i-1];
		}
		if ( join("",@t) eq join("",@$perm) ) {
			last;
		}
		$z = $perm->[$z]-1;
		if ( $op <= $n ) {
			push(@ans, $z+1);
		} else {
			push(@ans, $z+1+$n);
		}
		@w = @t;
	}
}

say (scalar @ans);
for my $op (@ans) {
	if ($op <= $n) {
		say "C " . ($op);
	} else {
		say "R " . ($op-$n);
	}
}
0