-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathpar2_cnf.pl
104 lines (86 loc) · 1.9 KB
/
par2_cnf.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
#! /usr/bin/perl
use warnings;
use strict;
my $vars;
sub clause { print "@_ 0\n" }
sub a_var() { ++$vars }
sub imp { clause (map (-$_, @_[0..$#_-1]), $_[-1]) } # $_0 & $_1 .. => $_-1
sub c_eq($$) { imp (@_); imp (map -$_, @_); }
sub one ($) { imp ( $_[0]) }
sub zero($) { imp (-$_[0]) }
sub cell {
my $old = $_[4];
my @nei = @_[0..3,5..8];
my @d8 = 0..7;
@nei==@d8 or die;
# B3/S23
my $new = a_var ();
# <=1 -> D (8)
for my $i (@d8) {
imp (map (-$nei[$_], grep $_ != $i, @d8), -$new);
}
# 2 & D -> D (28)
# 2 & A -> A (28)
for my $i (@d8) {
for my $j (@d8) { next if $j <= $i;
my @f = map /$i|$j/ ? $nei[$_] : -$nei[$_], @d8;
imp (@f, -$old, -$new);
imp (@f, $old, $new);
}}
# 3 -> A (56)
for my $i (@d8) {
for my $j (@d8) { next if $j <= $i;
for my $k (@d8) { next if $k <= $j;
my @f = map /$i|$j|$k/ ? $nei[$_] : -$nei[$_], @d8;
imp (@f, $new);
}}}
# >=4 -> D (70)
for my $i (@d8) {
for my $j (@d8) { next if $j <= $i;
for my $k (@d8) { next if $k <= $j;
for my $l (@d8) { next if $l <= $k;
imp (@nei[$i,$j,$k,$l], -$new);
}}}}
return $new;
}
my ($g0, $g1);
sub var0 {
my ($y, $x) = @_;
$g0->{$y}{$x} ||= do {
my $var = a_var ();
print "c g0 y=$y x=$x var=$var\n";
$var;
}
}
sub var {
my ($y, $x) = @_;
$g1->{$y}{$x} ||= do {
my $var = cell (
var0 ($y-1, $x-1), var0 ($y-1, $x), var0 ($y-1, $x+1),
var0 ($y , $x-1), var0 ($y , $x), var0 ($y , $x+1),
var0 ($y+1, $x-1), var0 ($y+1, $x), var0 ($y+1, $x+1),
);
print "c g1 y=$y x=$x var=$var\n";
$var;
}
}
sub gen {
my ($y, $x, $v) = @_;
my $c = cell (
var ($y-1, $x-1), var ($y-1, $x), var ($y-1, $x+1),
var ($y , $x-1), var ($y , $x), var ($y , $x+1),
var ($y+1, $x-1), var ($y+1, $x), var ($y+1, $x+1),
);
$v ? one ($c) : zero ($c);
}
my ($x, $y);
$y = 2;
while (<>) {
$x = 2;
for (/./g) {
die "bad char $_" if !/[01.X?]/;
gen ($y, $x, /1|X/) if !/\?/;
$x++;
}
$y++;
}