Sp, Common Lisp - rextester

Language: Layout:

;;;	$Id: missing.lsp,v 1.4 2000/02/10 11:20:39 pawel Exp $	
;;; package MISSING
;;; most simple utilities for handling missing attribute values
;;; Copyleft 1998 Pawel Cichosz

(provide 'missing)
;;;	$Id: util.lsp,v 1.19 1998/09/26 13:33:10 pawel Exp $
;;; package UTIL
;;; utility functions for the machine learning collection
;;; Copyleft 1998 Pawel Cichosz

(provide 'util)

(defpackage "UTIL"
    (:documentation "Package providing some utility functions used by
the machine learning collection.")
  (:use "COMMON-LISP")
  (:export "ARGMAX"
           "ARGMIN"
           "AVG"
           "BOUND"
           "SUBSETS"
           "SUBSETS-N"
           "PARTITION"
           "NPARTITION"
           "BIPARTITION"
           "NBIPARTITION"
           "PREFIXES"
           "POSTFIXES"
           "NPOSTFIXES"
           "RANDOM-SHUFFLE"
           "RANDOM-SUBSET"
           "RANDOM-PARTITION"
           "RANDOM-BIPARTITION"
           "SELECT"
           "FREQUENCY"
           "FREQUENCY-DISTRIBUTION"))

(in-package "UTIL")

(declaim (inline argmax)
         (ftype (function (sequence &key (function (t) t)) fixnum) argmax))
(defun argmax (s &key
                 (key #'identity))
  "Get the index of the maximum element in sequence s. The maximum value
itself is returned as the second value."
  (let ((m (reduce #'max s :key key)))
    (values (position m s :key key) m)))

(declaim (inline argmin)
         (ftype (function (sequence &key (function (t) t)) fixnum) argmin))
(defun argmin (s &key
                 (key #'identity))
  "Get the index of the minimum element in sequence s. The minimum value
itself is returned as the second value."
  (let ((m (reduce #'min s :key key)))
    (values (position m s :key key) m)))

(declaim (inline avg)
         (ftype (function (sequence &key (function (t) t)) number) avg))
(defun avg (s &key
              (key #'identity))
  "Compute the average of numbers in sequence s."
  (/ (reduce #'+ s :key key) (length s)))

(declaim (inline bound)
         (ftype (function (number number) number) bound))
(defun bound (x l h)
  "Return the value of x bound to the interval l..h."
  (cond ((< x l) l)
        ((> x h) h)
        (t x)))

(declaim (ftype (function (list &optional list) list) subsets))
(defun subsets (s &optional (subsets (list nil)))
  "Generate a list of all subsets of set represented by list s. The empty
subset (nil) is the last element in the result."
  (if (endp s)
      subsets
      (subsets (rest s)
               (dolist (ss subsets subsets)
                 (push (cons (first s) ss) subsets)))))

(declaim (ftype (function (list &optional fixnum list) list) subsets-n))
(defun subsets-n (s &optional (n (length s)) (subsets (list nil)))
  "Generate a list of all subsets of set represented by list s
which contain no more than n elements.  The empty subset (nil) is
the last element in the result. If unspecified, n defaults to (length s),
which gives the same result as subsets, but is slightly less efficient."
  (if (endp s)
      subsets
      (subsets-n (rest s) n
                 (dolist (ss subsets subsets)
                   (when (< (length ss) n)
                     (push (cons (first s) ss) subsets))))))

(declaim (ftype (function (list fixnum) list) partition))
(defun partition (s n)
  "Partition the set represented by list s into n equally sized
consecutive subsets and return a list thereof. The maximum difference
between subset size is 1 (smaller subsets come first in the result list)."
  (do* ((ns (length s) (- ns nss1))     ; the number of elements to partition
        (rs s (nthcdr nss1 rs))         ; the elements still to partition
        (nss0 (floor (/ ns n)))         ; subset base (minimum) size
        (n1 (mod ns n) (1- n1))         ; number of larger (+1) subsets
        (nss1 (if (> n1 0) (1+ nss0) nss0) ; subset actual size
              (if (> n1 0) (1+ nss0) nss0))
        (part (list (butlast rs (max 0 (- ns nss1)))) ; subset list
              (cons (butlast rs (max 0 (- ns nss1))) part)))
       ((<= ns nss1)                    ; until finished partitioning
        (nreverse part))))              ; return the partition

(declaim (ftype (function (list fixnum) list) npartition))
(defun npartition (s n)
  "Partition destructively the set represented by list s into n equally
sized consecutive subsets and return a list thereof. The maximum difference
between subset size is 1 (smaller subsets come first in the result list)."
  (do* ((ns (length s) (- ns nss1))     ; the number of elements to partition
        (rs s rst)                      ; the elements still to partition
        (nss0 (floor (/ ns n)))         ; subset base (minimum) size
        (n1 (mod ns n) (1- n1))         ; number of larger (+1) subsets
        (nss1 (if (> n1 0) (1+ nss0) nss0) ; subset actual size
              (if (> n1 0) (1+ nss0) nss0))
        (rst (nthcdr nss1 rs)           ; keep track of rs's tails
             (nthcdr nss1 rs))          ; before nbutlast cuts them off
        (part (list (nbutlast rs (max 0 (- ns nss1)))) ; subset list
              (cons (nbutlast rs (max 0 (- ns nss1))) part)))
       ((<= ns nss1)                    ; until finished partitioning
        (nreverse part))))              ; return the partition

(declaim (inline bipartition)
         (ftype (function (list (real 0 1)) list) bipartition))
(defun bipartition (s w)
  "Partition the set represented by list s into two subsets,
the first of which contain a fraction of w of all elements, taken from
the beginning of s. Returns the list of the two created subsets."
  (let* ((bw (bound w 0.0 1.0))         ; make sure w is in [0,1]
         (ns (length s))                ; whole set size
         (nss (round (* bw ns)))        ; the first subset size
         (s2 (nthcdr nss s))            ; the second subset
         (s1 (butlast s (- ns nss))))   ; the first subset
    (list s1 s2)))

(declaim (inline nbipartition)
         (ftype (function (list (real 0 1)) list) nbipartition))
(defun nbipartition (s w)
  "Partition destructively the set represented by list s into two subsets,
the first of which contain a fraction of w of all elements. Returns
the list of the two created subsets."
  (let* ((bw (bound w 0.0 1.0))         ; make sure w is in [0,1]
         (ns (length s))                ; whole set size
         (nss (round (* bw ns)))        ; the first subset size
         (s2 (nthcdr nss s))            ; the second subset
         (s1 (nbutlast s (- ns nss))))  ; the first subset
    (list s1 s2)))

(declaim (inline prefixes)
         (ftype (function (list) list) prefixes))
(defun prefixes (s)
  "Create the list of all prefixes of list s, including s as the first
element. The elements of the list are copied to each prefix."
  (mapcar #'nreverse (postfixes (reverse s))))

(declaim (inline postfixes)
         (ftype (function (list) list) postfixes))
(defun postfixes (s)
  "Create the list of all postfixes of list s, including s as the first
element. The elements of the list are copied to each postfix."
  (maplist #'copy-list s))

(declaim (inline npostfixes)
         (ftype (function (list) list) postfixes))
(defun npostfixes (s)
  "Create the list of all postfixes of list s, including s as the first
element. The elements of the list are shared by the postfixes."
  (maplist #'identity s))

(declaim (inline random-shuffle)
         (ftype (function (list) list) random-shuffle))
(defun random-shuffle (s)
  "Generate a random permutation of sequence s."
  (mapcar #'first
	  (sort (mapcar #'(lambda (e)   ; to each element assign
                            (cons e (random 1.0))) ; a random number
                        s)
                #'<
                :key #'rest)))          ; and sort according to it

(declaim (inline random-partition)
         (ftype (function (list fixnum) list) random-partition))
(defun random-partition (s n)
  "Partition at random the set represented by list s into n equally
sized subsets and return a list thereof. The maximum difference between
subset size is 1 (smaller subsets come first in the result list)."
  (npartition (random-shuffle s) n))

(declaim (inline random-bipartition)
         (ftype (function (list (real 0 1)) list) random-bipartition))
(defun random-bipartition (s w)
  "Partition at random the set represented by list s into two subsets,
the first of which contain a fraction of w of all elements. Returns
the list of the two created subsets."
  (nbipartition (random-shuffle s) w))

(declaim (inline random-subset)
         (ftype (function (list (real 0 1)) list) random-subset))
(defun random-subset (s w)
  "Generate a random subset of the set represented by list s,
with size equal w times the size of the original set."
  (first (random-bipartition s w)))

(declaim (inline select)
         (ftype (function (sequence t &key
                                    (function (t) t) (function (t t) t))
                          sequence) select))
(defun select (objects v &key
                       (key #'identity) (test #'eql))
  "Select from objects sequence only those with value v. The value of key for
each object is compared to v using test. All objects are selected
if v is null."
  (if v
      (remove-if #'(lambda (o)
                     (not (funcall test (funcall key o) v)))
                 objects)
      objects))

(declaim (inline frequency)
         (ftype (function (sequence t &key
                                    (function (t) t) (function (t t) t))
                          fixnum) frequency))
(defun frequency (objects v &key
                          (key #'identity) (test #'eql))
  "Count the frequency (number of occurrences) of value v in objects.
The value of key for each object is comparted to v using test."
  (count-if #'(lambda (o)
                (funcall test (funcall key o) v))
            objects))

(declaim (inline frequency-distribution)
         (ftype (function (sequence sequence &key
                                symbol (function (t) t) (function (t t) t))
                          sequence)
                frequency-distribution))
(defun frequency-distribution (objects values &key
                                       (type 'list)
                                       (key #'identity)
                                       (test #'eql))
  "Produce frequency distribution for values (sequence) in objects.
The value of key for each object is comparted to each value using test.
The returned sequence is of specified type, default list."
  (map type
       #'(lambda (v)                 ; for each value
           (frequency objects v :key key :test test))
       values))

(defpackage "MISSING"
    (:documentation "Package providing functions for handling missing
attribute values.")
  (:use "COMMON-LISP" "CONCEPT" "UTIL")
  (:export "MOST-COMMON"
	   "CATEGORY-MOST-COMMON"
           "MISSING-ELIMINATE"
           "MISSING-FILL"))

(in-package "MISSING")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The public interface.                                              ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(declaim (inline missing-eliminate)
	 (ftype (function (list &key) list) missing-eliminate))
(defun missing-eliminate (instances &key)
  "Eliminate non-destructively instances with missing attribute values."
  (select instances nil
          :key #'(lambda (i)
		   (some #'value-unknown-p
			 (instance-values i)))))

(declaim (inline missing-fill)
	 (ftype (function (list &key symbol) list) missing-fill))
(defun missing-fill (instances &key algorithm)
  "Fill missing attribute values for instances using the specified algorithm
\(:most-common, :category-most-common). The instances list is modified and
returned."
  (case algorithm
    (:most-common (most-common-fill instances))
    (:category-most-common (category-most-common-fill instances))
    (otherwise (error "No such algorithm: ~A" algorithm))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The implementation.                                                ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(declaim (ftype (function (list) list) most-common-fill))
(defun most-common-fill (instances)
  "Fill missing attribute values for instances with most common values.
The instances list is modified and returned."
  (let* ((values (mapcar #'(lambda (a)	; values for filling
			     (majority-value instances a))
			 (attributes-sequence))))
    (map-into instances
	      #'(lambda (i)
		  (instance-fill i values))
	      instances)))

(declaim (ftype (function (list) list) most-common-fill))
(defun category-most-common-fill (instances)
  "Fill missing attribute values for instances with most common values
in their categories. The instances list is modified and returned."
  (let* ((values (mapcar #'(lambda (c)	; values for filling
			     (mapcar #'(lambda (a)
					 (majority-value-c instances a c))
				     (attributes-sequence)))
			 (categories-sequence))))
    (map-into instances
	      #'(lambda (i)
		  (instance-fill i (elt values
					(category-position
					 (instance-category i)))))
	      instances)))

(declaim (ftype (function (cons sequence) cons) instance-most-common-fill))
(defun instance-fill (i values)
  "Fill missing attribute values in instance i with values and return
the modified instance."
  (let ((an 0))				; current attribute number
    (map nil
	 #'(lambda (v v1)
	     (when (value-unknown-p v)
	       (setf (instance-value-at i an) v1))
	     (incf an))
	 (instance-values i)
	 values)
    i))

[ + ] Show input
Absolute running time: 0.18 sec, cpu time: 0.03 sec, memory peak: 9 Mb, absolute service time: 0,32 sec