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, satisfyvà formatđã đượ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ả