karnaugh.hs

import Data.List

toBool 0 = False
toBool 1 = True
fromBool True = 1
fromBool False = 0

toList (a,b) = [a,b]

prettyShow False = "0"
prettyShow _ = "*1*"

surround x xs = [x] ++ xs ++ [x]

fromBools (a,b,c,d) = ((fromBool a), (fromBool b), (fromBool c), (fromBool d))

squeeze (a,b,c,d) = concat $ map (show) [a,b,c,d]

theF ((a,b,c,d), (e,f,g,h)) = or [(and [b, c, d, e, f, g]),h,a]

toLoop = [
	(False,False,False,False),
	(False,False,False,True),
	(False,False,True,True),
	(False,False,True,False),
	(False,True,True,False),
	(False,True,True,True),
	(False,True,False,True),
	(False,True,False,False),
	(True,True,False,False),
	(True,True,False,True),
	(True,True,True,True),
	(True,True,True,False),
	(True,False,True,False),
	(True,False,True,True),
	(True,False,False,True),
	(True,False,False,False)
	]

karnaugh f = map (map (f)) (map (\e -> zip (cycle [e]) toLoop) toLoop)

showKarnaugh k =
	-- header
	let header = "|_. ? \t|_." ++ (concat $ intersperse "|_.\t" $ map (squeeze . fromBools) toLoop) ++ "\t|";
	-- rows
		rows = map (concat . toList) $ zip (map (("|_. " ++) . squeeze . fromBools) toLoop) $ map (surround '|' . concat . intersperse "\t|" . map (prettyShow)) k in
		concat $ intersperse "\n" $ (header : rows)

main = putStrLn $ showKarnaugh $ karnaugh wF

wF ((x1,x2,x3,x4), (x5,x6,x7,x8)) = x1 && (not x6) && not x7 || x1 && not x6 && x7 && not x8 || x1 && x6 && x7 && x8 || not x1 && not x5 && x6 && not x7 && x8

run.sh

ghc --make karnaugh && ./karnaugh | redcloth > wtf.html