2-SAT (부울 만족도) 해결


16

일반적인 SAT (부울 만족도) 문제는 NP 완료입니다. 그러나 각 절에 2 개의 변수 만있는 2-SATP에 있습니다. 2-SAT에 대한 솔버를 작성하십시오.

입력:

다음과 같이 CNF 로 인코딩 된 2-SAT 인스턴스 입니다. 첫 번째 줄에는 부울 변수 수인 V, 절 수인 N이 포함됩니다. 그런 다음 N 개의 행이 이어지며, 각 절의 리터럴을 나타내는 0이 아닌 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 1 ~ x 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

(또는이 세 줄의 비어 있지 않은 하위 집합)

프로그램은 합리적인 시간에 모든 N, V ​​<100을 처리해야합니다. 보십시오 이 예제를 확인 프로그램이 큰 인스턴스를 처리 할 수 있도록. 가장 작은 프로그램이 이깁니다.


2-SAT는 P에 있지만 솔루션이 다항식 시간에 실행되어야한다는 것은 아닙니다. ;-)
Timwi

@Timwi : 아니요,하지만 합리적인 시간에 V = 99를 처리해야합니다 ...
Keith Randall

답변:


4

하스켈, 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피 전달하기 위해서이지만 n, reduce변수 (목록에서 함수를 리턴 [1..n]스트링 결과로).


  • 편집 : (330-> 323) s연산자를 사용하여 줄 바꿈을보다 잘 처리했습니다.
  • 편집 : (323-> 313) 게으른 결과 목록의 첫 번째 요소가 사용자 정의 단락 연산자보다 작습니다. 연산자로 사용 하는 것이 좋기 때문에 메인 솔버 기능의 이름이 바뀌 었습니다 !
  • 편집 : (313-> 296) 절을 목록 목록이 아닌 단일 목록으로 유지하십시오. 한 번에 두 가지 요소를 처리
  • 편집 : (296-> 291) 두 상호 재귀 함수를 병합; 인라인하는 것이 더 저렴해서 테스트 이름이 바뀌 었습니다.
  • 편집 : 결과 생성에 (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)을 제거합니다. 암시 적-> 명시 적 및 이진-> 모노 딕, 각각 몇 문자 더 제거. }.}.}.,.

편집 : 으악. 이것은 큰 N에 대한 해결책이 아니라 i. 2^99x어리 석음에 모욕을 더하는 "도메인 오류"입니다.

다음은 ungolfed 원본 버전과 간단한 설명입니다.

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 인 배열을 역 참조하여)
  • *@>:@*@[ signum의 남용을 통해 'not not'비트 (0이 아닌 경우)의 절 모양 배열을 가져옵니다.
  • = 피연산자에 not 비트를 적용합니다.
  • [:*./[:+./"1적용 +.생성 행렬 및의 행에 걸쳐 (그리고) *.그 결과 전체 (또는).
  • 이러한 모든 결과는 각 사례에 대한 이진 배열 '답변'으로 끝납니다.
  • *@+/ 결과에 적용하면 결과가있는 경우 0을,없는 경우 1을 제공합니다.
  • ('UNSOLVABLE'"_) `(#&cases) @.(*@+/) results 0 인 경우 'UNSOLVABLE'을 제공하고 1 인 경우 각 'solution'요소의 사본을 제공하는 상수 함수를 실행합니다.
  • echo 결과를 마술로 인쇄합니다.

순위 인수 주위의 파 렌스를 제거 할 수 있습니다. "(_,1)"_ 1. #:왼쪽 주장없이 작동합니다.
isawdrones

@isawdrones : 나는 전통적인 응답이 절반의 응답을함으로써 내 영혼을 망치는 것이라고 생각합니다. 크진이 말한 것처럼 "비명과 도약". 고마워, 그러나 그것은 10 홀수 문자를 제거합니다 ... 다시 돌아올 때 100 미만이 될 수 있습니다.
Jesse Millikan

훌륭하고 자세한 설명을 위해 +1, 매우 매혹적인 읽기!
Timwi

아마도 적절한 시간에 N = V = 99를 처리하지 못할 것입니다. 방금 추가 한 큰 예를보십시오.
Keith Randall

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 구현이 있는지 몰랐습니다.
Jesse Millikan

아마도 적절한 시간에 N = V = 99를 처리하지 못할 것입니다. 방금 추가 한 큰 예를보십시오.
Keith Randall

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를 처리하지 못할 것입니다. 방금 추가 한 큰 예를보십시오.
Keith Randall

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 버전을 만나서 반갑습니다! 기능적인 프로그램을위한 멋진 Rosetta Stone을 시작합니다. 이제 Scala 및 F # 버전을 얻을 수 있다면 ...-알고리즘에 관해서는-여기서 언급 할 때까지 해당 PDF를 보지 못했습니다! 필자는 Wikipedia 페이지의 "제한된 역 추적"에 대한 설명을 바탕으로 구현했습니다.
MtnViewMark
당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.