share/logic/Ksimplifier.lisp

   1 (defun is-adjacent (form1 form2)
   2   "Checks if the two forms can be combined(are adjacent in the K-Map).
   3    Example : (is-adjacent '(0 0 1 0) '(0 0 1 1)) -> t
   4              (is-adjacent '(0 0 1 1) '(0 0 1 1)) -> nil"
   5   (loop
   6      for x on form1
   7      for y on form2
   8      do
   9        (if (equal (car x) (car y))
  10            nil
  11            (if (equal (cdr x) (cdr y))
  12                (if (or (equal (car x) 2) (equal (car y) 2))
  13                    (return-from is-adjacent nil)
  14                    (return-from is-adjacent t))
  15                (return-from is-adjacent nil))))
  16   (return-from is-adjacent nil))
  17
  18 (defun common-expression (minterm1 minterm2)
  19   "Returns the common-expression obtained by combining 2 minterms.
  20    Example : (common-expression '(1 1 0 1) '(1 1 1 1)) -> (1 1 2 1)"
  21   (loop
  22      for x in minterm1
  23      for y in minterm2
  24      collect
  25        (if (equal x y)
  26            x
  27            2)))
  28
  29 (defun combine-neighbours (minterm minterms)
  30   "Checks a minterm against a list of minterms to find adjacent pairs.
  31    Returns a list l such that,
  32      (car l) is a list of implicants formed by combining minterm with all possible neighbours in minterms.
  33      (cadr l) is a list of all minterms covered in the implicants in the first list.
  34    Example :  (combine-neighbours '(0 0) '((0 1) (1 1))) -> (((0 2)) ((0 0) (0 1)))"
  35   (let* ((pair_found nil)
  36          (result (loop for minterm2 in minterms
  37                     if (is-adjacent minterm minterm2)
  38                     collect (progn
  39                               (setf pair_found t)
  40                               (common-expression minterm minterm2))
  41                     into comm_expr_ls and
  42                     collect minterm2 into to_remove
  43                     finally (return (list comm_expr_ls (cons minterm to_remove))))))
  44     (if pair_found
  45         result
  46         (list (cons minterm nil) ()))))
  47
  48
  49 (defun reduce-to-prime-implicants (numvar minterms)
  50   "Reduces a list of minterms, corresponding to numvar number of boolean variables, to it's prime-implicants, collectively covering all minterms.
  51    Returns a list of prime-impicants covering all minterms.
  52    Example : (reduce-to-prime-implicants 2 '((0 0) (0 1) (1 0))) -> ((0 2) (2 0))"
  53   (dotimes (counter numvar)
  54     (setf minterms (loop for minterms-left on minterms as result = (combine-neighbours (car minterms-left) (cdr minterms-left))
  55                       append (car result) into implicants ; Add the returned list of combined minterms to "implicants" list
  56                       append (cadr result) into covered   ; Add all the minterms covered in prime-implicants to list "covered"
  57                       finally (return
  58                                 (remove-duplicates
  59                                  (remove-if (lambda (implicant) (member implicant covered)) implicants) :test 'equal)))))
  60   minterms)
  61
  62 (defun is-covered-by-implicant (minterm prime-implicant)
  63   "Returns prime-implicant if minterm is covered in given prime-implicant, else return nil.
  64    Example : (is-covered-by-implicant '(0 0 1 0) '(2 2 2 2)) -> (2 2 2 2)"
  65   (if (every
  66        (lambda (term) (not (null term)))
  67        (mapcar (lambda (bit_minterm bit_prime_implicant)
  68                  (or
  69                   (equal bit_minterm bit_prime_implicant) ; Check if bit is same as in prime-implicant
  70                   (equal bit_prime_implicant 2)))         ; OR check if bit is covered in prime-implicant
  71                minterm prime-implicant))
  72       prime-implicant
  73       nil))
  74
  75 (defun is-covered-by-set-of-implicants (minterm prime-implicants)
  76   "Returns list of prime-implicants covering the minterm.
  77    Example : (is-covered-by-set-of-implicants '(0 0 1 0) '((0 0 2 0) (2 0 2 2) (2 2 0 2))) -> ((0 0 2 0) (2 0 2 2))"
  78   (remove-if 'null (mapcar (lambda (prime_implicant) (is-covered-by-implicant minterm prime_implicant)) prime-implicants)))
  79
  80 (defun select-maximum-reduced-prime-implicants (implicant-by-minterms)
  81   "Given a list of prime-implicants by minterms, returns a list of implicants by minterms having maximum level of reduction.
  82    Example : (select-maximum-reduced-prime-implicants '(((1 0 2 2) (1 2 2 2) (2 0 2 2)) ((0 0 0 2) (0 0 2 2) (2 2 0 0))))
  83           -> (((1 2 2 2) (2 0 2 2)) ((0 0 2 2) (2 2 0 0)))"
  84   (mapcar
  85    (lambda (minterms max-reduction) (remove-if (lambda (minterm) (/= (count 2 minterm) max-reduction)) minterms))
  86    implicant-by-minterms
  87    (mapcar (lambda (minterms) (apply #'max (cons 0 (mapcar (lambda (minterm) (count 2 minterm)) minterms)))) implicant-by-minterms)))
  88
  89 (defun reduce-to-minimum-cover (numvar minterms)
  90   "numvar : number of boolean variables
  91    minterms : list of minterms of the form (X X X X) where Xs are 0s or 1s.
  92    Returns a list of prime-implicants which is the minimum cover of the given minterms
  93    Example : (reduce-to-minimum-cover 2 '((0 0) (0 1) (1 0))) -> ((0 2) (2 0))"
  94   (let* ((prime-implicants (reduce-to-prime-implicants numvar minterms))
  95          (implicant-by-minterms (mapcar
  96                                  (lambda (minterm)
  97                                    (is-covered-by-set-of-implicants minterm prime-implicants))
  98                                  minterms)))
  99     (remove-duplicates (mapcar (lambda (minterms) (car minterms)) (select-maximum-reduced-prime-implicants implicant-by-minterms)))))
 100
 101 (defun decimal-to-binary (numvar number)
 102   "numvar : number of bits
 103    number : decimal number to be converted
 104    Returns the binary representation of number in binary.
 105    Example : (decimal-to-binary 2 3) -> (1 1)"
 106   (loop
 107      for x from (1- numvar) downto 0
 108      if (>= number (expt 2 x))
 109      collect (progn (setf number (- number (expt 2 x))) 1)
 110      else
 111      collect 0))
 112
 113 (defun maxima-expression (minimum-cover list-of-variables)
 114   "minimum-cover : list of prime-implicants forming a minimum cover
 115    list-of-variables : a sorted list of variable symbols in the input
 116    Returns the maxima-expression corresponding to the given minimum-cover
 117    Example : (maxima-expression '((0 2) (2 0)) '($x $y)) -> ((MOR SIMP) ((MNOT SIMP) $X) ((MNOT SIMP) $Y))"
 118   (cons '(mor simp)
 119                 (mapcar
 120                  (lambda (prime-implicant)
 121                    (let* ((implicant-maxima-expr
 122                                    (remove-if
 123                                         'null (mapcar
 124                                                    (lambda (bit variable)
 125                                                          (cond ((equal bit 0) `((mnot simp) ,variable))
 126                                                                    ((equal bit 1) variable)
 127                                                                    ((equal bit 2) nil)))
 128                                                    prime-implicant
 129                                                    list-of-variables))))
 130                          (if (equal (list-length implicant-maxima-expr) 1)
 131                                  (car implicant-maxima-expr)
 132                            (cons '(mand simp) implicant-maxima-expr))))
 133                  minimum-cover)))
 134
 135 (defun transform-to-intermediate (expr substitution-table)
 136   (cond ((and (consp expr)
 137                           (consp (car expr))
 138                           (member (caar expr) '(mand mor mnot)))
 139                  `(,(car expr) ,@(mapcar (lambda (x) (transform-to-intermediate x substitution-table)) (cdr expr))))
 140                 ((and (consp expr)
 141                           (consp (car expr)))
 142                  (let ((sym (gensym)))
 143                    (setf (gethash sym substitution-table) expr)
 144                    sym))
 145                 (t expr)))
 146
 147 (defun substitute-intermediate (expr substitution-table)
 148   (cond ((and (consp expr)
 149                           (consp (car expr)))
 150                  `(,(car expr) ,@(mapcar (lambda (x) (substitute-intermediate x substitution-table)) (cdr expr))))
 151                 ((atom expr) (if (nth-value 1 (gethash expr substitution-table))
 152                                            (gethash expr substitution-table)
 153                                            expr))))
 154
 155 (defun $logic_simplify (expr)
 156   "Requisite : needs logic.lisp for charactristic_vector function and running maxima for listofvars function.
 157    Given a logic expression, reduce it to it's simplest form using the method of K-Map reduction.
 158    Example : logic_simplify(((not a) and (not b) and c) or ((not a) and b and c) or (a and (not b) and c) or (a and b and c) or ((not a) and b and (not c))); -> ((not a) and b) or c
 159              logic_simplify(((not a) and b) or (a and b)) -> b"
 160   (let* ((substitutions (make-hash-table))
 161                  (intermediate (transform-to-intermediate expr substitutions))
 162                  (characteristic-vector (cdr ($characteristic_vector intermediate)))
 163                  (list-of-variables (list-of-variables intermediate))
 164                  (numvar (list-length list-of-variables))
 165                  (list-of-minterms (loop
 166                                                         for bit in characteristic-vector
 167                                                         for counter from 0 to (1- (expt 2 numvar))
 168                                                         if bit collect (decimal-to-binary numvar counter)))
 169                  (minimum-cover (reduce-to-minimum-cover numvar list-of-minterms)))
 170     (cond ((null minimum-cover) nil)
 171                   ((equal (car minimum-cover) (make-list numvar :initial-element 2)) t)
 172                   (t (let ((converted-expression (substitute-intermediate (maxima-expression minimum-cover list-of-variables) substitutions)))
 173                            (if (equal (list-length converted-expression) 2)
 174                                    (cadr converted-expression)
 175                                  converted-expression))))))