2-SAT(ブール充足可能性)を解く


16

一般的なSAT(ブール充足可能性)問題はNP完全です。ただし、各句に2つの変数しかない2-SATPにあります。2-SATのソルバーを作成します。

入力:

次のようにCNFでエンコードされた2-SATインスタンス。最初の行には、ブール変数の数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

式全体を真にする4つの変数の設定は、x 1 = false、x 2 = true、x 3 = true、x 4 = falseのみであるため、プログラムは1行を出力する必要があります。

出力

0 1 1 0

V変数の真理値を表します(x 1からx Vの順に)。複数のソリューションがある場合、それらの空でないサブセットを1行に1つずつ出力できます。解決策がない場合は、を出力する必要があります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に持ってい...
キース・ランドール

回答:


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

実際、その時間の大部分はコードのコンパイルに費やされています!

テストケースとクイックチェックテストが利用可能な完全なソースファイル。

Ungolf'd:

-- | 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)節をリストのリストではなく、単一のリストとして保持します。一度に2つの要素を処理する
  • 編集:(296-> 291)2つの相互再帰関数をマージしました。インラインの方が安かったので、テストの名前が変更されました
  • 編集:(291-> 278)結果生成へのインライン出力フォーマット

4

J、119 103

echo'UNSOLVABLE'"_`(#&c)@.(*@+/)(3 :'*./+./"1(*>:*}.i)=y{~"1 0<:|}.i')"1 c=:#:i.2^{.,i=:0&".;._2(1!:1)3
  • すべてのテストケースに合格します。顕著なランタイムはありません。
  • 強引な。以下のテストケースに合格、ああ、N = 20または30。不明。
  • 完全に脳死したテストスクリプトを介してテスト(目視検査による)

編集:排除し(n#2)、したがってn=:、いくつかのランクの括弧(おかげで、isawdrones)を排除します。Tacit-> explicitおよびdyadic-> monadic。それぞれいくつかの文字を削除します。}.}.}.,

編集:おっと。これは大きなNの非解決策であるだけでなくi. 2^99x、愚かさにto辱を加えるための「ドメインエラー」です。

これは、オリジナル版の無料版と簡単な説明です。

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(句カウントは不要です)
  • cases0..2 n -1 は2進数に変換されます(すべてのテストケース)
  • (Long tacit function)"(_,1)casesすべてのケースに適用されますclauses
  • <:@|@[{"(0,1)] 句のオペランドの行列を取得します(abs(op number)-1を取得し、配列であるcaseを逆参照します)
  • *@>:@*@[ signumの不正使用により、「not not」ビットの句状の配列(notの場合は0)を取得します。
  • = オペランドにnotビットを適用します。
  • [:*./[:+./"1+.結果のマトリックスの行全体に適用されます(および)その結果全体に適用さ*.れます。
  • これらの結果はすべて、各ケースの「回答」のバイナリ配列になります。
  • *@+/ 結果に適用すると、結果がある場合は0、結果がない場合は1が得られます。
  • ('UNSOLVABLE'"_) `(#&cases) @.(*@+/) results 0の場合は「UNSOLVABLE」、1の場合はケースの「ソリューション」要素のコピーを指定して定数関数を実行します。
  • echo 結果をマジックプリントします。

ランク引数の周りの括弧を削除できます。"(_,1)"_ 1#:左引数なしで動作します。
isawdrones

@isawdrones:伝統的な反応は、半分の長さの答えを出すことで私の精神を潰すことだと思います。クジンが言うように、「悲鳴を上げて跳躍する」。しかし、おかげで10奇数文字がなくなりました...戻ったときに100未満になるかもしれません。
ジェシーミリカン

素敵で詳細な説明のための+1、非常に魅力的な読書!
ティムウィ

おそらく、妥当な時間内に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 +バッテリー、438 436文字

トップレベルに含まれる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バージョンを見るのは嬉しいです!機能的なプログラムのための素敵なロゼッタストーンの始まりになります。ScalaとF#のバージョンを入手できたら...-アルゴリズムについては、ここで言及するまでそのPDFは表示されませんでした!ウィキペディアのページの「制限付きバックトラッキング」の説明に基づいて実装を行いました。
MtnViewMark
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.