हास्केल, 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 संस्करण में, satisfyऔर formatमें ला दिया जाएगा reduce, हालांकि बचने के निधन के क्रम में n, reduceचर (की एक सूची से एक फ़ंक्शन [1..n]) स्ट्रिंग परिणाम के लिए।
- संपादित करें: (३३० -> ३२३) ने
sएक ऑपरेटर बना दिया , नई लाइन की बेहतर हैंडलिंग
- संपादित करें: (323 -> 313) परिणामों की एक आलसी सूची से पहला तत्व एक कस्टम शॉर्ट-सर्किट ऑपरेटर से छोटा है; मुख्य सॉल्वर फ़ंक्शन का नाम बदला गया क्योंकि मैं
∮ऑपरेटर के रूप में उपयोग करना पसंद करता हूं !
- संपादित करें: (313 -> 296) एक सूची के रूप में खंडों को रखें, सूचियों की सूची नहीं; एक बार में दो तत्वों को संसाधित करें
- संपादित करें: (296 -> 291) दो परस्पर पुनरावर्ती कार्यों को मिला दिया; यह इनलाइन सस्ता था
★इसलिए अब नाम बदला गया∈
- संपादित करें: (291 -> 278) परिणाम जनरेशन में आउटपुट स्वरूपण का निर्माण