Haskell implementation for boolean logic simplification.

qm.hs

-- Implements (loosely) the QM method for boolean logic simplification.
--
-- Encode minterms as integers.
--
-- Implicants are sets of integers (think SOP form)
--
-- Combining two terms means that their bits differ by 1 and their don't
-- care conditions are in the same place, which translates in our model
-- to "when matched in order, every pair of elements from both sets have
-- the same XOR difference and the XOR difference is a power of two"
--
-- Finding the prime implicants means getting rid of the sets that are
-- proper subsets of larger sets
--
-- This code cuts down on a lot of liberties that are used when implemented
-- by hand, such as the grouping by number of one bits, or finding essential
-- prime implicants.

import Data.Foldable (fold)
import Data.Set (Set, powerSet, toList, fromList, union, isSubsetOf, empty,
                 singleton, size, elemAt)
import Data.List (nub, intercalate)
import Data.Bits (xor, popCount)
import Data.Char (chr)
import Control.Monad (guard)

type Implicant = Set Int

-- Detect if two implicants are mergeable (see main description)
mergeable :: Implicant -> Implicant -> Bool
mergeable a b = length (nub diffs) == 1 && popCount (head diffs) == 1
    where
        diffs = zipWith (xor) (toList a) (toList b)

-- Find available implicant merges from an input list of implicants
findMerges :: [Implicant] -> [Implicant]
findMerges l = do
    a <- l
    b <- l
    guard $ mergeable a b
    return $ a <> b

-- Find all prime implicants
primeImplicants :: Set Implicant -> Set Implicant
primeImplicants l
    | l == empty = empty
    | otherwise = notCovered <> merged
    where
        ll = toList l
        merged = primeImplicants $ fromList $ findMerges ll
        stillAPrimeImplicant x = not $ any (x `isSubsetOf`) merged
        notCovered = fromList $ filter stillAPrimeImplicant ll

-- Find a subset of given sets to cover a certain set, with the minimum sum of
-- sizes.
minSetCover :: Ord a => Set (Set a) -> Set a -> Set (Set a)
minSetCover sets target = snd $ minimum $ do
    x <- toList $ powerSet sets
    guard $ target `isSubsetOf` fold x
    return (foldl (\a b -> a + length b) 0 x, x)

-- Find a simplified Boolean expression from minterms and don't care terms.
simplify :: [Int] -> [Int] -> Set Implicant
simplify minterms dontcares = minSetCover primes (fromList minterms)
    where
        trivials = fromList $ map singleton (minterms ++ dontcares)
        primes = primeImplicants trivials

-- Functions for outputting in Sum Of Products form

getChangeBits :: Implicant -> Int
getChangeBits impl = elemAt (size impl - 1) impl - elemAt 0 impl

outputBits :: Int -> Int -> Int -> [String]
outputBits nbits control vary
    | nbits == 0            = []
    | vary `mod` 2 == 1    = rest
    | control `mod` 2 == 0 = (name ++ "'") : rest
    | control `mod` 2 == 1 = name : rest
    where
        rest = outputBits (nbits - 1) (control `div` 2) (vary `div` 2)
        name = [chr $ nbits + 64]

toSOP :: Int -> Implicant -> String
toSOP nbits impl = intercalate "." literals
    where
        term1 = elemAt 0 impl
        dontcares = getChangeBits impl
        literals = reverse $ outputBits nbits term1 dontcares

simplifyToSOP :: [Int] -> [Int] -> Int -> String
simplifyToSOP minterms dontcares nbits = intercalate " + " products
    where
        impls = toList $ simplify minterms dontcares
        products = map (toSOP nbits) impls

🥇