Giải quyết 2-SAT (thỏa mãn boolean)


16

Vấn đề SAT chung (thỏa mãn boolean) là NP-Complete. Nhưng 2-SAT , trong đó mỗi khoản chỉ có 2 biến, là trong P . Viết một người giải cho 2-SAT.

Đầu vào:

Ví dụ 2-SAT, được mã hóa trong CNF như sau. Dòng đầu tiên chứa V, số lượng biến boolean và N, số mệnh đề. Sau đó, N dòng tiếp theo, mỗi dòng có 2 số nguyên khác không đại diện cho nghĩa đen của mệnh đề. Các số nguyên dương đại diện cho biến boolean đã cho và các số nguyên âm biểu thị cho phủ định của biến.

ví dụ 1

đầu vào

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

mã hóa công thức (x 1 hoặc x 2 ) và (x 2 hoặc x 3 ) và (x 3 hoặc x 4 ) và (không phải x 1 hoặc không x 3 ) và (không phải x 2 hoặc không x 4 ) .

Cài đặt duy nhất của 4 biến làm cho toàn bộ công thức đúng là x 1 = false, x 2 = true, x 3 = true, x 4 = false , vì vậy chương trình của bạn sẽ xuất ra một dòng

đầu ra

0 1 1 0

đại diện cho các giá trị thật của các biến V (theo thứ tự từ x 1 đến x V ). Nếu có nhiều giải pháp, bạn có thể xuất ra bất kỳ tập hợp con không trống nào của chúng, mỗi tập hợp trên mỗi dòng. Nếu không có giải pháp, bạn phải xuất ra UNSOLVABLE.

Ví dụ 2

đầu vào

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

đầu ra

UNSOLVABLE

Ví dụ 3

đầu vào

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

đầu ra

0 1

Ví dụ 4

đầu vào

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

đầu ra

1 1 1 1 1 1 0 0
0 1 0 1 1 0 1 0
0 1 0 1 1 1 1 0

(hoặc bất kỳ tập hợp con không trống của 3 dòng đó)

Chương trình của bạn phải xử lý tất cả N, V ​​<100 trong thời gian hợp lý. Hãy thử ví dụ này để đảm bảo chương trình của bạn có thể xử lý một ví dụ lớn. Chương trình nhỏ nhất chiến thắng.


Bạn đề cập rằng 2-SAT nằm trong P, nhưng không phải là yêu cầu mà giải pháp phải chạy trong thời gian đa thức ;-)
Timwi

@Timwi: Không, nhưng nó phải xử lý V = 99 trong một thời gian hợp lý ...
Keith Randall

Câu trả lời:


4

Haskell, 278 ký tự

(∈)=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

Không vũ phu. Chạy trong thời gian đa thức. Giải quyết vấn đề khó khăn (60 biến, 99 mệnh đề) một cách nhanh chóng:

> 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

Và thực sự, phần lớn thời gian đó là dành cho việc biên dịch mã!

Tập tin nguồn đầy đủ, với các trường hợp kiểm tra và kiểm tra nhanh có sẵn .

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

Trong phiên bản golf, satisfyformatđã được đưa vào reduce, mặc dù để tránh vượt qua n, reducetrả về một hàm từ danh sách các biến ( [1..n]) cho kết quả chuỗi.


  • Chỉnh sửa: (330 -> 323) đã tạo smột nhà điều hành, xử lý tốt hơn dòng mới
  • Chỉnh sửa: (323 -> 313) phần tử đầu tiên từ danh sách kết quả lười biếng nhỏ hơn toán tử ngắn mạch tùy chỉnh; đổi tên hàm giải quyết chính vì tôi thích sử dụng như một toán tử!
  • Chỉnh sửa: (313 -> 296) giữ các mệnh đề dưới dạng một danh sách, không phải là danh sách các danh sách; xử lý hai yếu tố cùng một lúc
  • Chỉnh sửa: (296 -> 291) hợp nhất hai hàm đệ quy lẫn nhau; Nó rẻ hơn để nội tuyến vì vậy thử nghiệm bây giờ đổi tên
  • Chỉnh sửa: (291 -> 278) định dạng đầu ra được nội tuyến thành thế hệ kết quả

4

J, 119 103

echo'UNSOLVABLE'"_`(#&c)@.(*@+/)(3 :'*./+./"1(*>:*}.i)=y{~"1 0<:|}.i')"1 c=:#:i.2^{.,i=:0&".;._2(1!:1)3
  • Vượt qua tất cả các trường hợp thử nghiệm. Không có thời gian chạy đáng chú ý.
  • Lực lượng vũ phu. Vượt qua các trường hợp thử nghiệm dưới đây, oh, N = 20 hoặc 30. Không chắc chắn.
  • Thử nghiệm thông qua kịch bản thử nghiệm hoàn toàn chết não (Bằng cách kiểm tra trực quan)

Chỉnh sửa: Loại bỏ (n#2)và do đó n=:, cũng như loại bỏ một số parens xếp hạng (cảm ơn, isawdrones). Tacit-> tường minh và dyadic-> monadic, loại bỏ thêm một vài ký tự. }.}.để }.,.

Chỉnh sửa: Rất tiếc. Đây không chỉ là một giải pháp cho N lớn, mà i. 2^99x-> "lỗi miền" để thêm sự xúc phạm đến sự ngu ngốc.

Đây là phiên bản gốc không được giải thích và giải thích ngắn gọn.

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 cắt đầu vào trên dòng mới và phân tích số trên mỗi dòng (tích lũy kết quả vào đầu vào).
  • n được gán cho n, ma trận mệnh đề được gán cho clauses(không cần số mệnh đề)
  • caseslà 0..2 n -1 được chuyển đổi thành chữ số nhị phân (tất cả các trường hợp kiểm tra)
  • (Long tacit function)"(_,1)được áp dụng cho từng trường hợp casesvới tất cả clauses.
  • <:@|@[{"(0,1)] lấy một ma trận các toán hạng của mệnh đề (bằng cách lấy abs (số op) - 1 và hội nghị từ trường hợp, đó là một mảng)
  • *@>:@*@[ được mảng hình mệnh đề của các bit 'không phải không' (0 không) thông qua việc lạm dụng dấu hiệu.
  • = áp dụng các bit không cho toán hạng.
  • [:*./[:+./"1áp dụng +.(và) trên các hàng của ma trận kết quả và *.(hoặc) trên kết quả của ma trận đó.
  • Tất cả những kết quả đó kết thúc dưới dạng một mảng nhị phân 'câu trả lời' cho mỗi trường hợp.
  • *@+/ áp dụng cho kết quả cho 0 nếu có kết quả và 1 nếu không có kết quả.
  • ('UNSOLVABLE'"_) `(#&cases) @.(*@+/) results chạy hàm không đổi cho 'UNSOLVABLE' nếu 0 và một bản sao của từng phần tử 'giải pháp' của các trường hợp nếu 1.
  • echo ma thuật in kết quả.

Bạn có thể loại bỏ các parens xung quanh các đối số xếp hạng. "(_,1)để "_ 1. #:sẽ làm việc mà không có đối số trái.
isawdrones

@isawdrones: Tôi nghĩ rằng phản ứng truyền thống sẽ làm tan nát tinh thần của tôi bằng cách tạo ra một câu trả lời dài bằng một nửa. "Hét lên và nhảy vọt", như Kzin sẽ nói. Mặc dù vậy, cảm ơn, điều đó đã loại bỏ 10 ký tự lẻ ... Tôi có thể nhận được dưới 100 khi tôi quay lại.
Jesse Millikan

+1 cho lời giải thích hay và chi tiết, đọc rất hấp dẫn!
Timwi

Có lẽ sẽ không xử lý N = V = 99 trong một thời gian hợp lý. Hãy thử ví dụ lớn tôi vừa thêm.
Keith Randall

3

K - 89

Phương pháp tương tự như giải pháp J.

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

Thật tuyệt, tôi không biết đã có một triển khai K miễn phí.
Jesse Millikan

Có lẽ sẽ không xử lý N = V = 99 trong một thời gian hợp lý. Hãy thử ví dụ lớn tôi vừa thêm.
Keith Randall

2

Ruby, 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'

Nhưng nó chậm :(

Khá dễ đọc khi được mở rộng:

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'

Có lẽ sẽ không xử lý N = V = 99 trong một thời gian hợp lý. Hãy thử ví dụ lớn tôi vừa thêm.
Keith Randall

1

Pin OCaml +, 438 436 ký tự

Yêu cầu Pin OCaml Bao gồm cấp cao nhất:

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

Tôi phải thú nhận, đây là bản dịch trực tiếp của giải pháp Haskell. Trong phòng của tôi, mà lần lượt là trực tiếp mã hóa của thuật toán trình bày ở đây [PDF], với sự lẫn nhau satisfy- eliminateđệ quy cuộn lại thành một chức năng duy nhất. Một phiên bản chưa được chỉnh sửa của mã, trừ việc sử dụng Pin, là:

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 kcách chơi chữ tôi hy vọng bạn sẽ tha thứ).


Rất vui khi thấy phiên bản OCaml! Nó làm cho sự khởi đầu của Rosetta Stone đẹp cho các chương trình chức năng. Bây giờ nếu chúng ta có thể có phiên bản Scala và F # ... - Về thuật toán - Tôi đã không thấy bản PDF đó cho đến khi bạn đề cập đến nó ở đây! Tôi dựa trên việc thực hiện mô tả của trang Wikipedia về "Quay lui có giới hạn".
MtnViewMark
Khi sử dụng trang web của chúng tôi, bạn xác nhận rằng bạn đã đọc và hiểu Chính sách cookieChính sách bảo mật của chúng tôi.
Licensed under cc by-sa 3.0 with attribution required.