হাস্কেল, 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]) স্ট্রিং ফলাফলের জন্য।
- সম্পাদনা করুন: (330 -> 323)
sএকটি অপারেটর তৈরি করেছে, নতুন লাইনের আরও ভাল পরিচালনা করা হয়েছে
- সম্পাদনা করুন: (323 -> 313) ফলাফলের অলস তালিকার প্রথম উপাদানটি একটি কাস্টম শর্ট সার্কিট অপারেটরের চেয়ে ছোট; প্রধান সলভার ফাংশনটির নামকরণ হয়েছে 'কারণ আমি
∮অপারেটর হিসাবে ব্যবহার করতে চাই !
- সম্পাদনা করুন: (313 -> 296) ধারাগুলি একক তালিকা হিসাবে রাখুন, তালিকার তালিকা নয়; এটি একবারে দুটি উপাদান প্রক্রিয়া করুন
- সম্পাদনা করুন: (296 -> 291) দুটি পারস্পরিক পুনরাবৃত্তি ফাংশন একত্রিত; এটি ইনলাইন করাতে সস্তা ছিল
★তাই এখন পরীক্ষার নামকরণ করা হয়েছে∈
- সম্পাদনা করুন: (291 -> 278) ফলাফল উত্পন্ন করার জন্য ইনিল্যান্ড আউটপুট বিন্যাস ting