A week ago I got the following email from Trevor Hill:
I have enjoyed reading some of your bonsai code postings on the Internet, thank you for posting these examples.
At present I am teaching myself Haskell programming. I thought that writing a boolean expression minimizing program would be a good exercise and found an interesting technique in a paper by Adrian Duşa, University of Bucharest titled “A mathematical approach to the boolean minimization problem” at http://www.compasss.org/files/WPfiles/Dusa2007.pdf
My Haskell skills are still very basic. I managed to write some Haskell to generate Adrian’s “Difference Matrix” but the rest of the implementation evades my current Haskell skills.
I was wondering if this problem may be something that you would enjoy using in one of your Haskell postings. I am sure that a really elegant Haskell program can be written to implement Dusa’s technique.
My crude implementation of a difference matrix generator and code to input a truth table is in the attached file.
Boolean minimization is a technique that takes a logic circuit and tries to find a smaller circuit that produces the same output. You can find a more detailed description here. Among others, it is used in circuit design. So let’s get started, shall we?
First, some imports:
import qualified Data.List.Key as K
The algorithm we’re going to be using is the Quine McCluckey minimization algorithm. The first step is to convert a list of minterms (the inputs for which the circuit produces 1, written as integers) to disjunctive normal form (the same thing, but written as the required state for each input).
dnf :: Int -> [Int] -> [[(Char, Bool)]]
dnf n = map (\m -> [(['a'..] !! (n - 1 - y), testBit m y)
| y <- [n-1, n-2..0]])
The principle behind the Quine McCluckey algorithm is to repeatedly use complementation to reduce the total number of terms in the expression. If only one variable differs between two terms, this variable can be eliminated, since its state has no influence on the result in that situation.
combine :: (Eq a, Eq b) => [(a, b)] -> [(a, b)] -> [(a, b)]
combine a@((x,onx):xs) ((y,ony):ys)
| onx /= ony = if x == y && xs == ys then xs else a
| x == y = (x,onx) : combine xs ys
combine a _ = a
A single pass consists of trying to combine all the terms in the expression to end up with a simpler expression. Often, there are multiple candidates. This version takes the naive approach of evaluating all possibilities, since some may be reduced further than others in subsequent passes. This does make the algorithm rather inefficient when there are a lot of variables. To speed this up, some kind of heuristic would have to be used to reduce the solution space.
pass :: (Eq a, Eq b) => [[(a, b)]] -> [[(a, b)]] -> [[[(a, b)]]]
pass _  = []
pass b (x:xs) = case filter ((< length x) . length . combine x) (xs ++ b) of
 -> map (x :) $ pass (x:b) xs
ys -> (\y -> map (combine x y :) $ pass (x:y:b) (delete y xs)) =<< ys
Minimizing is just applying multiple passes until we’ve ended up with the minimum expressions and then choosing the shortest one out of all the options.
minimize :: [[(Char, Bool)]] -> [[(Char, Bool)]]
minimize = K.minimum (length . concat) . untilRepeat .
iterate (pass  =<<) . return where
untilRepeat ~(x:y:xs) = if x == y then x else untilRepeat (y:xs)
To make the output a bit easier to read, we make a prettyprinting function. An apostrophe after a value negates the value, subsequent variables are ANDed together and + means OR.
pretty :: [[(Char, Bool)]] -> String
pretty = intercalate " + " . sort . map (prettyVar =<<) where
prettyVar (var, on) = var : if on then "" else "'"
For the sake of convenience, we make a function that combines all the steps, printing the minimized expression for a series of minterms.
run :: Int -> [Int] -> IO ()
run n = putStrLn . pretty . minimize . dnf n
All that’s left is to test our algorithm:
main :: IO ()
main = do run 3 [1,2,4,5,6,7]
run 5 [7,8,9,10,23,24,25,26]
let test n xs r = print $ pretty (minimize $ dnf n xs) == r
test 3 [1,2,4,5,6,7] "a + b'c + bc'"
test 5 [7,8,9,10,23,24,25,26] "b'cde + bc'd' + bc'e'"
test 3 [0,1,4,5] "b'"
Everything seems to be working properly, albeit not terribly fast for larger inputs. Thanks for the exercise, Trevor.