;;; This file contains functions for encoding multi-value feature vectors into
;;; binary using either log(n) bits or n bits for an n valued feature.

(defvar *print-encoding* nil "Prints the binary encoding of values if non-NIL")

(defun convert-to-bits (examples &optional short-encode-flag)
  ;;; Encode examples with n-valued features as bit strings using n bits/feature
  ;;; unless short-encode-flag is set in which case log(n) bits are used
  ;;; Return the encoded examples.

  (let ((encoding-alists (mapcar #'(lambda (domain) (if short-encode-flag
							(short-encode-domain domain)
							(long-encode-domain domain)))
			  *domains*)))  ; Determine mapping of values to bit strings
    (trace-print *print-encoding* "~%Encoding: ~A" encoding-alists)
    ;; Replace values with their coresponding bit strings in each example
    (mapcar #'(lambda (example)
		(list (first example)
		      (encode-instance (second example)  encoding-alists)))
	    examples)))


(defun short-encode-domain (domain)
  ;; Assign log(n) bit string encodings to each value in the domain
  ;; using Common Lisps ability to print numbers in binary format

  (let* ((num-bits (ceiling (log (length domain) 2)))(i -1)
	 (control-string (concatenate 'string
				      "~" (format nil "~A" num-bits)
				      ",'0B")))
    (mapcar #'(lambda (value)
		(incf i)
		(cons value (mapcar #'(lambda (char) (digit-char-p char))
				    (coerce (format nil control-string i)
					    'list))))
	    domain)))


(defun long-encode-domain (domain)
  ;; Assign an n bit string for each value in domain with the one bit for that
  ;; value set to 1
  
    (mapcar #'(lambda (value)
		(cons value (mapcar #'(lambda (v) (if (eq v value) 1 0))
				    domain)))
	    domain))


(defun encode-instance (instance encoding-alists)
  ;;; Given the encoding for each feature value, encode an instance into binary
  
  (mapcan #'(lambda (feature-value encoding-alist)
	      (copy-list (rest (assoc feature-value
				      encoding-alist))))
	  instance  encoding-alists))


(defun encode-category-instances (categories &optional short-encode-flag)
  ;;; Encodes instances of all categories into binary representations
  ;;; for use by *-CATEGORIES.

  (let ((encoding-alists (mapcar #'(lambda (domain) (if short-encode-flag
							(short-encode-domain domain)
							(long-encode-domain domain)))
			  *domains*)))
    (trace-print *print-encoding* "~%Encoding: ~A" encoding-alists)	;
    (dolist (category categories)
      (set category  (mapcar #'(lambda (instance)
				 (encode-instance instance encoding-alists))
			     (eval category))))))


(defun make-domains (levels-list)
  ;;; If features values are simply integers 0 to n then the number of values of a
  ;;; feature is sufficient for determining its domain.  This function creates a
  ;;; list suitable for *domains* given a list of the number of values for each feature.
  ;;; See the file SOYBEAN-RDOMAINS for a sample use.

  (mapcar #'(lambda (levels) (let ((domain nil)) 
			       (dotimes (i levels domain)
				 (setf domain (nconc domain (list i))))))
	  levels-list))