ひとりにしてくれが好きだ

以前、こんな↓記事を書きました。

https://mainasuyon.hatenadiary.org/entries/2010/02/07


簡単に言うと、「ひとりにしてくれを作る時の数字を埋める作業が面倒なので、パソコンさんに任せるのはどうでしょう。Sugar制約ソルバーを利用すると簡単ですよ。数字は入れ替わっちゃいますけど」という話です。

PencilBox形式からSugar入力形式に変換するawkスクリプトも公開してたんですが、ジオシティーズのサービス終了に伴い見られなくなっています。

じゃあブログに直接書いちゃうか、というのが今回の記事。

Sugarが導入されている仮定なんで、Perlで書くのが筋かなと思い、そうしてみました。

#!/usr/bin/env perl
use strict;
use warnings;



my $file = shift; 

open(my $fh, "<", $file) or die("Error");

my @lines = <$fh>;

### 盤面の格納 ###
my $ymax = $lines[0];
my $xmax = $lines[1];

my @parr = ();

for(my $j=0;$j<$ymax;$j++){
 my @tmparr = split(" " , $lines[2+$j] );
 for(my $i=0;$i<$xmax;$i++){
  $parr[$j*$xmax+$i] = $tmparr[$i];
 }
}


### Sugar変数定義 ###
for(my $j=0;$j<$ymax;$j++){
 for(my $i=0;$i<$xmax;$i++){
  printf("( int a_%02d_%02d 1 %d )\n",$i,$j,$xmax);
 }
}


### ヨコ方向 ###

#  左からn番目の数字が、
#   他に重複したものがあり、しかもそのグループの中で左端ではない → tmparr[n]が1
#   それ以外                                                     → tmparr[n]が0

for(my $j=0;$j<$ymax;$j++){
 my @tmparr = (0) x $xmax;
 for(my $i=0;$i<$xmax;$i++){
  for(my $u=$i+1;$u<$xmax;$u++){
   if(($parr[$j*$xmax+$i]!=0)&&($parr[$j*$xmax+$i]==$parr[$j*$xmax+$u])){
    printf("( = a_%02d_%02d a_%02d_%02d )\n",$i,$j,$u,$j);
    $tmparr[$u] = 1;
   }
  }
 }

 printf("( alldifferent ");
 for(my $i=0;$i<$xmax;$i++){
  if($tmparr[$i] != 1){
   printf("a_%02d_%02d ",$i,$j);
  }
 }
 printf(")\n");
}


### タテ方向 ###

#  上からn番目の数字が、
#   他に重複したものがあり、しかもそのグループの中で上端ではない → tmparr[n]が1
#   それ以外                                                     → tmparr[n]が0

for(my $i=0;$i<$xmax;$i++){
 my @tmparr = (0) x $xmax;
 for(my $j=0;$j<$ymax;$j++){
  for(my $u=$j+1;$u<$ymax;$u++){
   if(($parr[$j*$xmax+$i]!=0)&&($parr[$j*$xmax+$i]==$parr[$u*$xmax+$i])){
    printf("( = a_%02d_%02d a_%02d_%02d )\n",$i,$j,$i,$u);
    $tmparr[$u] = 1;
   }
  }
 }

 printf("( alldifferent ");
 for(my $j=0;$j<$ymax;$j++){
  if($tmparr[$j] != 1){
   printf("a_%02d_%02d ",$i,$j);
  }
 }
 printf(")\n");
}

close($fh);

もうひとつ、めでたくSugarが成功の出力を返してくれた場合、それをPencilBox形式に変換するスクリプト
盤面サイズは自動検出に対応していないので、個別に my $size = 8; のところを適宜変更してください。

#!/usr/bin/env perl
use strict;
use warnings;

### 盤面サイズの指定 ###
my $size = 8;


my %parr = ();

while(<>){
 my @tarr = split(/\s+/,$_);
 if($#tarr+1==3){
  $parr{$tarr[1]} = $tarr[2];
 }
}

print $size . "\n";
print $size . "\n";
for(my $j=0;$j<$size;$j++){
 for(my $i=0;$i<$size;$i++){
  my $pos = sprintf("a_%02d_%02d",$i,$j);
  printf $parr{$pos} . " ";
 }
 printf "\n";
}


スクリプトに責任などもちろん持ちませんけど、普段この程度のスクリプトを書くならawkで書くので、perlのお作法的に変なことをしてるかもです。
適宜修正して使っていただければ。

Sugarの導入は大変なので、minisatさえ導入できれば使えるように、なんてことも考えるんですけれども。
希望がありましたら、まいなすよんの生活に余裕ができるように星に祈っておいてください。よろしくお願いします。