Created
October 21, 2011 11:59
-
-
Save metaxy/1303657 to your computer and use it in GitHub Desktop.
Quine McCluskey
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import List | |
import Maybe | |
type Var = (Int, Bool) | |
type Minterm = [Var] | |
type Tabelle = [Zelle] | |
type Zelle = (Minterm,[Int]) | |
type Table a b = [[(a,b)]] | |
data In a = W | F | N | |
instance Show a => Show (In a) where | |
show W = "W" | |
show F = "F" | |
show N = "-" | |
m = col (dominanz $ primtermtable $ primes $ (tabelle input)) 0 | |
input :: [Minterm] | |
input = create ( | |
[[F,F,F,F,W], | |
[F,F,F,W,W], | |
[F,F,W,F,W], | |
[F,F,W,W,W], | |
[F,W,F,F,W], | |
[F,W,F,W,W], | |
[F,W,W,F,W], | |
[F,W,W,W,W], | |
[W,F,F,F,W], | |
[W,F,F,W,W], | |
[W,F,W,F,W], | |
[W,F,W,W,W], | |
[W,W,F,F,W], | |
[W,W,F,W,W], | |
[W,W,W,F,W], | |
[W,W,W,W,W], | |
[F,F,W,W,F], | |
[F,W,F,W,F], | |
[F,W,W,W,F], | |
[W,F,F,W,F], | |
[W,F,W,W,F], | |
[W,W,F,W,F], | |
[W,W,W,F,F], | |
[W,W,W,W,F]]) | |
-- klasse eines mintermes | |
cl :: Minterm -> Int | |
cl x = length (filter ((== True).snd) x) | |
primes :: Tabelle -> Tabelle | |
primes = nub. primes' [] | |
primes' p before | |
| next == [([],[])] || next == [] = (p ++ before ) | |
| otherwise = primes' (p ++ left) next | |
where | |
next = nub (fst u) | |
left = nub (snd u) | |
u = umformen before before [] [] | |
umformen :: Tabelle -> Tabelle -> Tabelle -> Tabelle -> (Tabelle,Tabelle) | |
umformen all (x:xs) newPairs used | |
| found == True = umformen all xs (newPairs ++ new) (used ++ u) | |
| found == False = umformen all xs newPairs used | |
where | |
y' = findSomeone all x [] [] | |
u = fst y' | |
new = snd y' | |
found = not(new == []) | |
umformen all [] newPairs used = (newPairs, all \\ used) | |
findSomeone all x = findSomeone' (filter (clOK x) all) x | |
findSomeone' (y:ys) x used new | |
| (differ (fst x) (fst y)) == 1 && onSame (fst x) (fst y) = findSomeone' ys x (used ++ [x] ++ [y]) (new ++ [(n x y)]) | |
| otherwise = findSomeone' ys x used new | |
where | |
n x y = ((zipWith rm (fst x) (fst y)), sort((snd x) ++ (snd y) ++ (add x) ++ (add y))) | |
findSomeone' [] x used new = (used, new) | |
clOK x y = abs (cl(fst x) - cl(fst y)) == 1 | |
add a | |
| pos (fst a) /= -1 = [pos (fst a)] | |
| otherwise = [] | |
differ :: Minterm -> Minterm -> Int | |
differ x y = length (filter (== True) (zipWith (\a b -> (fst a == fst b && snd a /= snd b)) x y)) | |
onSame :: Minterm -> Minterm -> Bool | |
onSame x y = (length (filter (== True) (zipWith (\a b -> xor (fst a == -1) (fst b == -1) ) x y))) == 0 | |
rm :: Var -> Var -> Var | |
rm x y | |
| (snd x /= snd y) = (-1,False) | |
| otherwise = x | |
primtermtable :: Tabelle -> (Table Zelle Int) | |
primtermtable x = [[ (j,i) | i <- [0..((length input)-1)]] | j <- x] | |
toDots :: Table Zelle Int -> [[Bool]] | |
toDots = map toDots' | |
toDots' :: [(Zelle,Int)] -> [Bool] | |
toDots' = map (\x -> elem (snd x) (snd (fst x))) | |
dominanz :: Table Zelle Int -> Table Zelle Int | |
dominanz x | |
| (dom == x) = dom | |
| ((nub dom) == [[]]) = x | |
| otherwise = dominanz dom | |
where | |
dom = dominanzR ( dominanzC x ) | |
dominanzC x = dominanzC' x (colCount x - 1) x | |
dominanzC' x (-1) all = all | |
dominanzC' x i all | |
| dominated == True = dominanzC' x (i-1) (rmCol all pos) | |
| otherwise = dominanzC' x (i-1) all | |
where | |
c = toDots' (col x pos) | |
dots = toDots x | |
dominated = (domiC c (toDots (rmCol all pos))) | |
pos = i | |
domiC :: [Bool] -> [[Bool]] -> Bool | |
domiC i a = foldl (||) False (domiC' i a) | |
domiC' :: [Bool] -> [[Bool]] -> [Bool] | |
domiC' i a = map c con | |
where | |
con = map (zip i) (cols a) | |
c x = foldl (&&) True (map (\a -> not (fst a == False && snd a == True)) x) | |
dominanzR x = dominanzR' x (length x - 1) x | |
dominanzR' x (-1) all = all | |
dominanzR' x i all | |
| dominated == True = dominanzR' x (i-1) (rmRow all pos) | |
| otherwise = dominanzR' x (i-1) all | |
where | |
c = toDots' (row x pos) | |
dots = toDots x | |
dominated = (domiR c (toDots (rmRow all pos))) | |
pos = i | |
domiR :: [Bool] -> [[Bool]] -> Bool | |
domiR i a = foldl (||) False (domiR' i a) | |
domiR' :: [Bool] -> [[Bool]] -> [Bool] | |
domiR' i a = map c con | |
where | |
con = map (zip i) a | |
c x = (foldl (&&) True (map (\a -> not (fst a == True && snd a == False)) x)) | |
-- stuff | |
create' x = zip [0..((length x) -1)] (map toBool x) | |
toBool W = True | |
toBool F = False | |
create = map create' | |
toIn True = W | |
toIn False = F | |
varToIn (-1) False = N | |
varToIn _ False = F | |
varToIn _ True = W | |
uncreate' x = map (toIn.snd) x | |
uncreate = map uncreate' | |
row :: Table a b -> Int -> [(a,b)] | |
row x i = x !! i | |
col :: Table a b -> Int -> [(a,b)] | |
col x i = map (!! i) x | |
cols x = reverse (cols' x []) | |
cols' x y | |
| ((nub x) == [[]]) = y | |
| otherwise = cols' (map (drop 1) x) ((map (\a -> (take 1 a)!!0) x):y) | |
testTable = [[1,2,3],[4,5,6],[7,8,9],[10,11,12]] | |
colCount x = length (x !! 0) | |
rmRow x i = delete (row x i) x | |
rmCol x i = map (\a -> delete (a !! i) a) x | |
cleanTable x = uncreate (fst (unzip (map (\a -> fst a) (col x 0)))) | |
cleanTabelle x = map (reverse .(map (\a -> varToIn (fst a) (snd a)))) (map fst x) | |
pos x = fromMaybe (-1) (elemIndex x input) | |
pos2 x dat = fromMaybe (0) (elemIndex x dat) | |
tabelle :: [Minterm] -> Tabelle | |
tabelle x = map (\a -> (a,[])) x | |
xor :: Bool -> Bool -> Bool | |
xor True a = not a | |
xor False a = a | |
boolListToInt :: [Bool] -> Int | |
boolListToInt x = foldl (+) 0 (map (\a -> (fst a)*(snd a)) (zip (map boolToInt (reverse x)) (iterate (*2) 1))) | |
minTermToBoolList x = map (\a -> snd a) x | |
boolToInt :: Bool -> Int | |
boolToInt True = 1 | |
boolToInt False = 0 | |
showDots' x = foldl (++) "" (map (\a -> "| " ++ (d a) ++ " ") x) | |
showDots'' x = map showDots' x | |
d True = "*" | |
d False = " " | |
test2 = tabelle input | |
test3 = primes test2 | |
test4 = primtermtable test3 | |
test5 = dominanz test4 | |
umformen' x = fst (umformen x x [] []) | |
test6 = umformen' (umformen' test2) | |
test7 = umformen' test2 | |
{-input = create ([ | |
[F,F,F,F], | |
[W,F,F,F], | |
[F,F,W,F], | |
[W,F,W,F], | |
[F,W,W,F], | |
[W,W,W,F], | |
[F,F,F,W], | |
[W,F,F,W], | |
[W,W,F,W], | |
[W,W,W,W] | |
])-} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment