;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :wvu-lib.tricks)

(defun as-list (x)
  "Ensures that x is a list."
  (if (listp x)
      x
      (list x)))

(defun transpose (l)
  "transposes a list similar to the matrix operation.
*Only works with 2 dimensional lists"
  (when l
    (apply #'mapcar #'list l)))

(defun insert-delim (list delim)
  (declare (list list))
  "puts delim in between each item list"
  (when list
    (apply #'append
           (list (first list))
           (mapcar #'(lambda (item)
                       (list delim item))
                   (rest list)))))

(defun geta (key alist &optional default)
  "Returns a value from an association list.  If the key is absent, returns a
   default value."
  (let* ((entry (assoc key alist))
         (foundp (when entry
                   t)))
    (values (or (cdr entry)
                default)
            foundp)))

(defmacro puta (key value alist)
  "Adds or replaces a value in an association list."
  (let ((entry (gensym))
        (insertp (gensym))
        (k (gensym))
        (v (gensym)))
    `(let* ((,k ,key)
            (,v ,value)
            (,entry (assoc ,k ,alist))
            (,insertp (unless ,entry
                        t)))
       (if ,insertp
           (push (cons ,k ,v) ,alist)
           (setf (cdr (assoc ,k ,alist)) ,v))
       (values ,alist ,insertp))))

(defmacro pusha (key value alist)
  "pushs the value onto the list of the key in the alist"
  (let ((l (gensym "LIST-")))
    `(let ((,l (geta ,key ,alist)))
       (puta ,key (cons ,value ,l) ,alist))))

(defmacro popa (key alist)
  "pops a value from the list of the key in the alist"
  (let ((l (gensym "LIST-"))
        (fp (gensym "FOUNDP-")))
    `(multiple-value-bind (,l ,fp) (geta ,key ,alist)
       (when ,fp
         (puta ,key (cdr ,l) ,alist)
         (car ,l)))))

(defmacro move-elt (x from to)
  "Moves an item from one list to another."
  (let ((x-name (gensym)))
    `(let ((,x-name ,x))
      (when (find ,x-name ,from :test #'equalp)
	(setf ,from (remove ,x-name ,from :test #'equalp :count 1))
	(setf ,to (append ,to (list ,x-name)))))))

(defmacro move-elts (l from to)
  "Moves a list of items from one list to another."
  `(dolist (x ,l ,to)
    (move-elt x ,from ,to)))

(defmacro switch-elt (x l1 l2)
  "Swaps an item between two lists."
  `(or (move-elt ,x ,l1 ,l2) (move-elt ,x ,l2 ,l1)))

(defmacro switch-elts (l l1 l2)
  "Swaps a list of items between two lists."
  `(dolist (x ,l)
    (switch-elt x ,l1 ,l2)))

(defun subset-compare (l1 l2 &key (test #'eql))
  "compare 2 lists by making sure that each is a subset of the other: 'order of elements don't matter'"
  (when (= (length l1)
           (length l2))
    (and (null (set-difference l1 l2 :test test))
         (null (set-difference l2 l1 :test test)))))

(defun array2matrix (array)
  (declare (array array))
  (labels ((handle-element (subscripts)
             (apply #'aref array subscripts))
           (handle-structure (remaining-dimensions subscripts)
             (let (partial-list)
               (if (= (length remaining-dimensions) 1)
                   (dotimes (i (first remaining-dimensions) (nreverse partial-list))
                     (push (handle-element (append subscripts (as-list i)))
                           partial-list))
                   (dotimes (i (first remaining-dimensions) (nreverse partial-list))
                     (push (handle-structure (rest remaining-dimensions) (append subscripts (as-list i)))
                           partial-list))))))
    (handle-structure (array-dimensions array) '())))

(defun count-items (sequence &key (key #'identity) (test #'eql))
  (let* ((unique-count (length (remove-duplicates (mapcar key sequence) :test test)))
         (key-item-ht (make-hash-table :test test :size (1+ unique-count)))
         (key-counts-ht (make-hash-table :test test :size (1+ unique-count))))
    ;;reverse sequence so key-item-ht will hold first item (per key) in sequence
    (dolist (item (reverse sequence))
      (let ((k (funcall key item)))
        (setf (gethash k key-item-ht) item)
        (incf (gethash k key-counts-ht 0))))
    (let (counts)
      (maphash #'(lambda (keyed-item item-count)
                   (push (cons (gethash keyed-item key-item-ht)
                               item-count)
                         counts))
               key-counts-ht)
      (nreverse counts))))