(in-package :com.sandersn.util)
(defun make-hash (alist &key (test #'equal))
  (let ((h (make-hash-table :test test)))
    (loop for (k . v) in alist
      do (setf (gethash k h) v))
    h))
(defun hash->alist (h)
  (let ((acc ()))
    (maphash (lambda (k v) (push (cons k v) acc)) h)
    acc))
(defmethod gmap (f (h hash-table) &rest ls)
  (declare (ignore ls)) ; haven't got a cool way to handle ls yet
  (map-values f h))
(defun map-keys (f h &key (test #'equal))
  (let ((d (make-hash-table :test test)))
    (maphash #'(lambda (k v) (setf (gethash (funcall f k) d) v)) h)
    d))
(defun map-values (f h &key (test #'equal))
  (let ((d (make-hash-table :test test)))
    (maphash #'(lambda (k v) (setf (gethash k d) (funcall f v))) h)
    d))
(defun map-items (key val h &key (test #'equal))
  (let ((d (make-hash '() :test test)))
    (maphash #'(lambda (k v)
                 (setf (gethash (funcall key k v) d) (funcall val k v)))
             h)
    d))
(defun filter-keys (f h &key (test #'equal)) ; filter isn't yet generic. oops.
  (let ((d (make-hash-table :test test)))
    (maphash #'(lambda (k v) (when (funcall f k)
                               (setf (gethash k d) v))) h)
    d))
(defun filter-values (f h &key (test #'equal))
  (let ((d (make-hash-table :test test)))
    (maphash #'(lambda (k v) (when (funcall f v)
                               (setf (gethash k d) v))) h)
    d))
(defun filter-items (f h &key (test #'equal))
  (let ((d (make-hash-table :test test)))
    (maphash #'(lambda (k v) (when (funcall f k v)
                               (setf (gethash k d) v))) h)
    d))
(defun zip~ (&rest hs)
  (let ((d (make-hash '())))
    (maphash #'(lambda (k _)
                 (declare (ignore _))
                 (when (every #'(lambda (h) (has-key? h k)) hs)
                   (setf (gethash k d) (gmap (lambda (h) (gethash k h)) hs))))
             (car hs))
    d))
(defun extract~ (h &rest xs)
  (let ((d (make-hash '())))
    (dolist (k xs d)
      (setf (gethash k d) (gethash k h)))))
(defun except~ (h &rest xs)
  (filter-keys #'(lambda (k) (not (member k xs))) h))
;;; hash folders ... sort of ;;;
(defun fold/hash (key val/key-present val/key-absent h &key (test #'equal))
  (let ((d (make-hash '() :test test)))
    (maphash #'(lambda (k v)
                 (let ((new-k (funcall key k)))
                   (setf (gethash new-k d)
                         (if (has-key? d k)
                             (funcall val/key-present k v (gethash new-k d))
                             (funcall val/key-absent k v)))))
             h)
    d))
(defun fold/list (val/key-present val/key-absent l
                  &key (key #'identity) (test #'equal))
  (let ((h (make-hash '() :test test)))
    (dolist (k l h)
      (let ((j (funcall key k)))
        (setf (gethash j h) (if (has-key? h j)
                                (funcall val/key-present k (gethash j h))
                                (funcall val/key-absent k)))))))
(defun hash-collapse (l &optional (keymap #'identity) (valuemap #'identity))
  (fold/list #'(lambda (k v) (append v (list (funcall valuemap k))))
             #'(lambda (k) (list (funcall valuemap k)))
             l
             :key keymap))
(defun pair-collapse (pairs)
  (hash-collapse pairs #'car #'cdr))
(defun has-key? (h k)
  (multiple-value-bind (_ has-key?) (gethash k h)
    (declare (ignore _))
    has-key?))
(defun hash-values (h) ; the loop macro still sucks after all these years
  (loop for v being the hash-value of h collect v))
(defun hash-keys (h)
  (loop for k being the hash-key of h collect k))
(defun cat (f h i)
  "(a*b->c)*hash*hash->hash--using f, combine values of all keys in h and i.
pairs in only one hash are copied."
  (let ((d (make-hash-table :test #'equal)))
    (maphash #'(lambda (k v)
                 (multiple-value-bind (v2 present?) (gethash k i)
                   (setf (gethash k d)
                         (if present? (funcall f v v2) v))))
             h)
    (maphash #'(lambda (k v)
                 (when (not (second (multiple-value-list (gethash k h))))
                   (setf (gethash k d) v)))
             i)
    d))
(defun count/hash (l)
  "(list a)->(hash a int)"
  (let ((h (make-hash-table :test #'equal)))
    (dolist (x l)
      (if (gethash x h)
          (incf (gethash x h))
          (setf (gethash x h) 1)))
    h))