解决2-SAT(布尔可满足性)


16

一般的SAT(布尔可满足性)问题都是NP完全的。但是2-SAT(其中每个子句只有2个变量)位于P中。写一个2-SAT的求解器。

输入:

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

例子1

输入

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

它编码公式(x 1或x 2)和(x 2或x 3)和(x 3或x 4)和(不是x 1或不是x 3)和(不是x 2或不是x 4

使整个公式为true的4个变量的唯一设置是x 1 = false,x 2 = true,x 3 = true,x 4 = false,因此您的程序应输出单行

输出

0 1 1 0

表示V变量的真值(从x 1x V的顺序)。如果有多个解决方案,则可以输出它们的任何非空子集,每行一个。如果没有解决方案,则必须输出UNSOLVABLE

例子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行的任何非空子集)

您的程序必须在合理的时间内处理所有N,V <100。请尝试以下示例,以确保您的程序可以处理大实例。最小的程序获胜。


您提到2-SAT在P中,但不是要求解决方案必须在多项式时间内运行;-)
Timwi

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

Answers:


4

Haskell,278个字符

(∈)=elem
r v[][]=[(>>=(++" ").show.fromEnum.(∈v))]
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"
main=interact$t.map read.words

不蛮力。在多项式时间内运行。快速解决难题(60个变量,99个子句):

> 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 = [0]

-- | 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

在golf'd版本,satisfyformat已经滚进reduce,但为了避免传球nreduce从变量(列表返回函数[1..n])的字符串结果。


  • 编辑:(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

编辑:取消(n#2),因此n=:,以及消除一些等级parens(谢谢,isawdrones)。隐性->显式和二进->单子,每个消除几个字符。}.}.}.,

编辑:哎呀。这不仅不是解决大N问题的方法,而且i. 2^99x->“ domain error”会增加对愚蠢的侮辱。

这是原始版本和简要说明。

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 魔术打印结果。

您可以删除等级参数周围的括号。"(_,1)"_ 1#:没有左参数就可以工作。
isawdrones

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

+1的详细解释非常有趣,非常有趣!
Timwi

可能不会在合理的时间内处理N = V = 99。尝试我刚刚添加的大示例。
基思·兰德尔

3

K -89

与J解决方案相同的方法。

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

很好,我不知道有没有免费的K实现。
杰西·米利坎

可能不会在合理的时间内处理N = V = 99。尝试我刚刚添加的大示例。
基思·兰德尔

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=[0]+y;puts y.map{|z|z||0}.join ' 'or exit if d.inject(1){|t,w|t and(w[0]<0?!x[-w[0]]:x[w[0]])||(w[1]<0?!x[-w[1]]:x[w[1]])}};puts 'UNSOLVABLE'

但这很慢:(

展开后非常可读:

n,v=gets.split
d=[]
v.to_i.times{d<<(gets.split.map &:to_i)} # read data
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=[0]+y
    puts y.map{|z| z||0}.join ' ' or exit if d.inject(1){|t,w| # evaluate the data (magic!)
        t and (w[0]<0 ? !x[-w[0]] : x[w[0]]) || (w[1]<0 ? !x[-w[1]] : x[w[1]])
    }
}
puts 'UNSOLVABLE'

可能不会在合理的时间内处理N = V = 99。尝试我刚刚添加的大示例。
基思·兰德尔

1

OCaml +电池,438436个字符

需要顶级的OCaml电池:

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))

我必须承认,这是Haskell解决方案的直接翻译。在我的防守,这又是一个直接的算法编码这里介绍 [PDF],与相互satisfy- eliminate递归卷成单一的功能。该代码的完整版本(减去电池的使用)为:

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双关语,我希望你能原谅)。


很高兴看到OCaml版本!它为功能性程序奠定了一个不错的Rosetta Stone的起点。现在,如果我们可以得到Scala和F#版本...-至于算法-在您提到它之前,我没有看到PDF!我基于Wikipedia页面对“有限回溯”的描述来实现。
MtnViewMark 2011年
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.