# 解决2-SAT（布尔可满足性）

16

2-SAT实例，在CNF中编码如下。第一行包含V（布尔变量的数量）和N（子句的数量）。然后，紧接着N行，每行都有2个非零整数，表示子句的文字。正整数表示给定的布尔变量，负整数表示变量的取反。

## 例子1

### 输入

``````4 5
1 2
2 3
3 4
-1 -3
-2 -4
``````

### 输出

``````0 1 1 0
``````

## 例子2

### 输入

``````2 4
1 2
-1 2
-2 1
-1 -2
``````

### 输出

``````UNSOLVABLE
``````

## 例子3

### 输入

``````2 4
1 2
-1 2
2 -1
-1 -2
``````

### 输出

``````0 1
``````

## 例子4

### 输入

``````8 12
1 4
-2 5
3 7
2 -5
-8 -2
3 -1
4 -3
5 -4
-3 -7
6 7
1 7
-7 -1
``````

### 输出

``````1 1 1 1 1 1 0 0
0 1 0 1 1 0 1 0
0 1 0 1 1 1 1 0
``````

（或这3行的任何非空子集）

Timwi

@Timwi：不，但是它必须在合理的时间内处理V = 99 ...
Keith Randall

4

``````(∈)=elem
r v[]c@(a:b:_)=r(a:v)c[]++r(-a:v)c[]++[const"UNSOLVABLE"]
r v(a:b:c)d|a∈v||b∈v=r v c d|(-a)∈v=i b|(-b)∈v=i a|1<3=r v c(a:b:d)where i w|(-w)∈v=[]|1<3=r(w:v)(c++d)[]
t(n:_:c)=(r[][]c!!0)[1..n]++"\n"
``````

``````> time (runhaskell 1933-2Sat.hs < 1933-hard2sat.txt)
1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 1 0

real 0m0.593s
user 0m0.502s
sys  0m0.074s
``````

``````-- | A variable or its negation
-- Note that applying unary negation (-) to a term inverts it.
type Term = Int

-- | A set of terms taken to be true.
-- Should only contain  a variable or its negation, never both.
type TruthAssignment = [Term]

-- | Special value indicating that no consistent truth assignment is possible.
unsolvable :: TruthAssignment
unsolvable = 

-- | Clauses are a list of terms, taken in pairs.
-- Each pair is a disjunction (or), the list as a whole the conjuction (and)
-- of the pairs.
type Clauses = [Term]

-- | Test to see if a term is in an assignment
(∈) :: Term -> TruthAssignment -> Bool
a∈v = a `elem` v;

-- | Satisfy a set of clauses, from a starting assignment.
-- Returns a non-exhaustive list of possible assignments, followed by
-- unsolvable. If unsolvable is first, there is no possible assignment.
satisfy :: TruthAssignment -> Clauses -> [TruthAssignment]
satisfy v c@(a:b:_) = reduce (a:v) c ++ reduce (-a:v) c ++ [unsolvable]
-- pick a term from the first clause, either it or its negation must be true;
-- if neither produces a viable result, then the clauses are unsolvable
satisfy v [] = [v]
-- if there are no clauses, then the starting assignment is a solution!

-- | Reduce a set of clauses, given a starting assignment, then solve that
reduce :: TruthAssignment -> Clauses -> [TruthAssignment]
reduce v c = reduce' v c []
where
reduce' v (a:b:c) d
| a∈v || b∈v = reduce' v c d
-- if the clause is already satisfied, then just drop it
| (-a)∈v = imply b
| (-b)∈v = imply a
-- if either term is not true, the other term must be true
| otherwise = reduce' v c (a:b:d)
-- this clause is still undetermined, save it for later
where
imply w
| (-w)∈v = []  -- if w is also false, there is no possible solution
| otherwise = reduce (w:v) (c++d)
-- otherwise, set w true, and reduce again
reduce' v [] d = satisfy v d
-- once all caluses have been reduced, satisfy the remaining

-- | Format a solution. Terms not assigned are choosen to be false
format :: Int -> TruthAssignment -> String
format n v
| v == unsolvable = "UNSOLVABLE"
| otherwise = unwords . map (bit.(∈v)) \$ [1..n]
where
bit False = "0"
bit True = "1"

main = interact \$ run . map read . words
where
run (n:_:c) = (format n \$ head \$ satisfy [] c) ++ "\n"
-- first number of input is number of variables
-- second number of input is number of claues, ignored
-- remaining numbers are the clauses, taken two at a time
``````

• 编辑：（330-> 323）作了`s`一个运算符，对换行符的更好处理
• 编辑：（323-> 313）懒惰结果列表中的第一个元素小于自定义短路运算符；重命名了主求解器函数，因为我喜欢`∮`用作运算符！
• 编辑：（313-> 296）keep子句作为单个列表，而不是列表列表；一次处理两个元素
• 编辑：（296-> 291）合并了两个相互递归的函数；内联比较便宜，`★`因此测试现在已重命名`∈`
• 编辑：（291-> 278）将输出格式内联到结果生成中

4

# Ĵ，119 103

``````echo'UNSOLVABLE'"_`(#&c)@.(*@+/)(3 :'*./+./"1(*>:*}.i)=y{~"1 0<:|}.i')"1 c=:#:i.2^{.,i=:0&".;._2(1!:1)3
``````

``````input=:0&".;._2(1!:1)3
n =:{.{.input
clauses=:}.input
cases=:(n#2)#:i.2^n
results =: clauses ([:*./[:+./"1*@>:@*@[=<:@|@[{"(0,1)])"(_,1) cases
echo ('UNSOLVABLE'"_)`(#&cases) @.(*@+/) results
``````
• `input=:0&".;._2(1!:1)3` 剪切换行符上的输入并解析每行上的数字（将结果累加到输入中）。
• n分配给`n`，子句矩阵分配给`clauses`（不需要子句计数）
• `cases`是0..2 n -1转换为二进制数字（所有测试用例）
• `(Long tacit function)"(_,1)`适用于`cases`的所有情况`clauses`
• `<:@|@[{"(0,1)]` 获取子句操作数的矩阵（通过采用abs（op number）-1并从case取消引用，这是一个数组）
• `*@>:@*@[` 通过滥用符号获取子句状的“非非”位数组（非0表示）。
• `=` 将not位应用于操作数。
• `[:*./[:+./"1``+.`在结果矩阵的行上应用（和），并`*.`在结果中应用（或）。
• 所有这些结果最终以每种情况的“答案”的二进制数组的形式出现。
• `*@+/` 如果有结果，则将结果应用于0，否则将返回1。
• `('UNSOLVABLE'"_)` ``(#&cases) @.(*@+/) results` 运行常量函数，如果为0，则给出“ UNSOLVABLE”，如果为1，则给出case的每个“ solution”元素的副本。
• `echo` 魔术打印结果。

isawdrones

@isawdrones：我认为传统的回应是通过给出一半的答案来粉碎我的精神。正如克津所说的那样，“尖叫和跳跃”。不过，谢谢，这消除了10多个字符...当我回到它时，我可能会得到不到100个字符。

+1的详细解释非常有趣，非常有趣！
Timwi

3

## K -89

``````n:**c:.:'0:`;`0::[#b:t@&&/+|/''(0<'c)=/:(t:+2_vs!_2^n)@\:-1+_abs c:1_ c;5:b;"UNSOLVABLE"]
``````

2

## 红宝石253

``````n,v=gets.split;d=[];v.to_i.times{d<<(gets.split.map &:to_i)};n=n.to_i;r=[1,!1]*n;r.permutation(n){|x|y=x[0,n];x=+y;puts y.map{|z|z||0}.join ' 'or exit if d.inject(1){|t,w|t and(w<0?!x[-w]:x[w])||(w<0?!x[-w]:x[w])}};puts 'UNSOLVABLE'
``````

``````n,v=gets.split
d=[]
n=n.to_i
r=[1,!1]*n # create an array of n trues and n falses
r.permutation(n){|x| # for each permutation of length n
y=x[0,n]
x=+y
puts y.map{|z| z||0}.join ' ' or exit if d.inject(1){|t,w| # evaluate the data (magic!)
t and (w<0 ? !x[-w] : x[w]) || (w<0 ? !x[-w] : x[w])
}
}
puts 'UNSOLVABLE'
``````

1

# OCaml +电池，438436个字符

``````module L=List
let(%)=L.mem
let rec r v d c n=match d,c with[],[]->[String.join" "[?L:if x%v
then"1"else"0"|x<-1--n?]]|[],(x,_)::_->r(x::v)c[]n@r(-x::v)c[]n@["UNSOLVABLE"]|(x,y)::c,d->let(!)w=if-w%v
then[]else r(w::v)(c@d)[]n in if x%v||y%v then r v c d n else if-x%v then!y else if-y%v then!x else r v c((x,y)::d)n
let(v,_)::l=L.of_enum(IO.lines_of stdin|>map(fun s->Scanf.sscanf s"%d %d"(fun x y->x,y)))in print_endline(L.hd(r[][]l v))
``````

``````let rec satisfy v c d = match c, d with
| (x, y) :: c, d ->
let imply w = if List.mem (-w) v then raise Exit else satisfy (w :: v) (c @ d) [] in
if List.mem x v || List.mem y v then satisfy v c d else
if List.mem (-x) v then imply y else
if List.mem (-y) v then imply x else
satisfy v c ((x, y) :: d)
| [], [] -> v
| [], (x, _) :: _ -> try satisfy (x :: v) d [] with Exit -> satisfy (-x :: v) d []

let rec iota i =
if i = 0 then [] else
iota (i - 1) @ [i]

let () = Scanf.scanf "%d %d\n" (fun k n ->
let l = ref [] in
for i = 1 to n do
Scanf.scanf "%d %d\n" (fun x y -> l := (x, y) :: !l)
done;
print_endline (try let v = satisfy [] [] !l in
String.concat " " (List.map (fun x -> if List.mem x v then "1" else "0") (iota k))
with Exit -> "UNSOLVABLE") )
``````

`iota k`双关语，我希望你能原谅）。

MtnViewMark 2011年