malloc82 / quine-mccluskey-method Goto Github PK

(require :quine-mccluskey)

(defun create-n-bit-multiplier-problem (&optional (nbits 2))
  (let ((max-val (- (expt 2 nbits) 1)))
    (values
     (loop
       for a upto max-val
       appending
       (loop
	 for b upto max-val
	 collecting
	 (list a b (* a b))))
     (list :nbit-in nbits :nbit-out (ash nbits 1)))))

(defun create-minterms-for-bit (bit-position
				problem
				problem-spec)
  (when (<= 0
	    bit-position
	    (- (getf problem-spec :nbit-out) 1))
    (let ((mask (ash 1 bit-position))
	  (nbit-in (getf problem-spec :nbit-in)))
      (let ((one-terms
	      (remove-if #'(lambda (term)
			     (destructuring-bind (a b o) term
			       (declare (ignorable a b))
			       (= 0 (logand o mask))))
			 problem)))
	(format
	 t "1-terms (~D): ~A~%"
	 (length one-terms) one-terms)
	(values
	 (loop
	   for term in one-terms
	   collecting
	   (logior (ash (first term) nbit-in)
		   (second term))))))))

(defun make-sample-string (nbit-in)
  (let ((input-width (ash nbit-in 1)))
    (with-output-to-string (stream)
      (loop
	for i below input-width
	do (princ (code-char (+ (char-code #\a) i))
		  stream)))))
	  

(defun solve-n-bit-multiplier-problem (&optional (nbits 2))
  (multiple-value-bind (terms spec)
      (create-n-bit-multiplier-problem nbits)
    (let ((nbit-out (getf spec :nbit-out))
	  (sample-str (make-sample-string
		       (getf spec :nbit-in))))
      (loop
	for bit below nbit-out
	collecting
	(list
	 :bit bit
	 :result (quine-mccluskey:quine-mccluskey
		  sample-str
		  (create-minterms-for-bit
		   bit
		   terms
		   spec)))))))

(defun expected-time-complexity (nbits)
  (/ (expt 3 nbits)
     (log nbits)))