[ELPA] New package: hap.el

[Tino Calancha <tino.calancha@gmail.com>]

hap.el provides following items:

*) Convert between alist, plist and hash table.
   E.g.:
   (hap-alist-to-hash-table '((1 . 2) (a . b)))
   => #s(hash-table size 65 test eql rehash-size 1.5 rehash-threshold 0.8125 data (1 2 a b))

*) Define constructors for alist, plist and hash table
   accepting two sequences: KEYS and VALUES.
   E.g.:
   (hap-alist '(1 2) [a b])
   => ((1 . a) (2 . b))

*) Add functions to compare two hash tables.
   E.g.:
   (hap-hash-table= #s(hash-table data (1 a 2 b)) #s(hash-table data (1 a 2 b)))
   => t
   (or
     (hap-hash-table= #s(hash-table test equal data (1 a 2 b)) #s(hash-table data (1 a 2 b)))
     (hap-hash-table= #s(hash-table data (1 c 2 b)) #s(hash-table data (1 a 2 b))))
   => nil

It might be convenient to group together under same file all these
related operations.  Thus, I'd like to add this file to Elpa (or Emacs
core, whatever is appropiate), in case people think it's useful.

Regards,
Tino

--8<-----------------------------cut here---------------start------------->8---
;;; hap.el --- Convert between hash table, alist and plist  -*- lexical-binding: t; -*-

;; Copyright (C) 2017  Tino Calancha

;; Author: Tino Calancha <tino.calancha@gmail.com>
;; Created: Sun Feb 26 22:36:24 2017
;; Maintainer: Tino Calancha <tino.calancha@gmail.com>
;; Keywords: lisp, extensions
;; Compatibility: GNU Emacs 24
;; Version: 1.0
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))

;; This file is NOT part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
\f
;;; Commentary:

;; Obtain from a hash table, association list or a property list,
;; an equivalent representation using one of the other two structures.
;;
;; Equivalent doesn't necessarily mean equal data if one of the
;; structures is a hash table.
;; For instance, the ALIST '((foo . 1) (foo . 2) (bar . 3))
;; might produce the following two hash tables:
;;
;; HASH-1 = #s(hash-table data (foo 2 bar 3))
;; HASH-2 = #s(hash-table data (foo 1 bar 3))
;;
;; Both have different data than ALIST because hash tables have
;; unique keys.
;; Note that only the second one satisfies:
;; (equal (cdr (assq foo ALIST))
;;        (gethash foo HASH-TABLE))
;;
;; Functions `hap-alist-to-hash-table', `hap-plist-to-hash-table' and
;; `hap-hash-table' accept an optional argument UNIQ-KEY; when non-nil,
;; only the first occurrency of KEY is stored.  Otherwise, each
;; occurrency of KEY updates the value.
;;
;; In the previous example you'd get HASH-1 with:
;; (hap-alist-to-hash-table ALIST)
;;
;; and you'd get HASH-2 with:
;; (hap-alist-to-hash-table nil 'uniq-key)
;;
;; This library define constructors for alist, plist or hash table
;; that accept two sequences as arguments: the keys and values.
;; E.g.
;; (hap-alist '(1 2) [a b])
;; => ((1 . a) (2 . b))
;;
;; In addition, this file adds functions to compare hash tables:
;; *) `hap-hash-table-data=' returns non-nil if two hash tables store
;;    equal data.
;; *) `hap-hash-table-prop='  returns non-nil if two hash tables have
;;    equal parameters.
;; *) `hap-hash-table=' returns non-nil if two hash tables store
;;    equal data and have equal parameters.

;;; Code:

\f
(eval-when-compile (require 'cl-lib))


;;; Compare hash tables.

(defun hap-hash-table-data-equal (t1 t2)
  "Return non-nil if hash tables T1 and T2 store equal data."
  (cl-flet ((fn (x y)
                (catch 'not-equal
                  (prog1 t ; Return t on success.
                    (maphash (lambda (k v)
                               (unless (equal v (gethash k y))
                                 (throw 'not-equal nil)))
                             x)))))
    (and (fn t1 t2)
         (fn t2 t1))))

(defalias 'hap-hash-table-data= 'hap-hash-table-data-equal)

(defun hap-hash-table-prop-equal (t1 t2 &optional ignore-size)
  "Return non-nil if hash tables T1 and T2 have same properties.
Optional arg IGNORE-SIZE non-nil, means ignore parameter size.  Otherwise,
 compare all parameters.
The data stored might be different.  To compare the data as well see
`hap-hash-table='."
  (and (or ignore-size
           (= (hash-table-size t1)
              (hash-table-size t2)))
       (= (hash-table-count t1)
          (hash-table-count t2))
       (eq (hash-table-test t1)
           (hash-table-test t2))
       (eq (hash-table-weakness t1)
           (hash-table-weakness t2))
       (= (hash-table-rehash-size t1)
          (hash-table-rehash-size t2))
       (= (hash-table-rehash-threshold t1)
          (hash-table-rehash-threshold t2))))

(defalias 'hap-hash-table-prop= 'hap-hash-table-prop-equal)

(defun hap-hash-table-equal (t1 t2 &optional ignore-size)
  "Return non-nil if hash tables T1 and T2 have equal data and properties.
Optional arg IGNORE-SIZE non-nil, means ignore parameter size.  Otherwise,
compare all parameters."
  (and (hap-hash-table-prop= t1 t2 ignore-size)
       (hap-hash-table-data= t1 t2)))

(defalias 'hap-hash-table= 'hap-hash-table-equal)


\f
;;; Make alist, plist or hash table from KEYS and VALUES.

(defun hap-make-alist (keys values &optional cadrp)
  "Make an alist from the sequences KEYS and VALUES.
If optional arg CADRP is non-nil, then store the values in
the cadr.  Otherwise, store them in the cdr."
  (cl-loop for k the elements of keys using (index idx) collect
           (let ((v (ignore-errors (elt values idx))))
             (if cadrp
                 (list k v)
               (cons k v)))))

(defalias 'hap-alist 'hap-make-alist)

(defun hap-alist-keys (alist)
  "Return a list with the keys in ALIST."
  (mapcar #'car alist))

(defun hap-alist-values (alist &optional cadrp)
  "Return a list with the values in ALIST.
Optional arg CADRP non-nil, means ALIST store the values in the cadr."
  (mapcar (if cadrp #'cadr #'cdr) alist))

(defun hap-make-plist (keys values)
  "Make a property list from the sequences KEYS and VALUES."
  (cl-loop for k the elements of keys using (index idx) nconc
           (list k (ignore-errors (elt values idx)))))

(defalias 'hap-plist 'hap-make-plist)

(defun hap--plist-keys-or-values (plist &optional keys)
  (unless (= 0 (logand 1 (length plist)))
    (error "PLIST should have an even number of elements"))
  (let ((mod (if keys 0 1)))
    (cl-loop for x the elements of plist using (index idx)
             when (= mod (logand 1 idx))
             collect x)))

(defun hap-plist-keys (plist)
  "Return a list with the keys in PLIST."
  (hap--plist-keys-or-values plist 'keys))

(defun hap-plist-values (plist)
  "Return a list with the values in PLIST."
  (hap--plist-keys-or-values plist))

(defun hap--hash-table-init (kwrds len)
  (if (or (memq :size kwrds) (zerop len))
      kwrds
    (let ((size (floor (max 65 (* 1.5 len)))))
      (append kwrds (list :size size)))))

(defun hap-make-hash-table (keys values &optional uniq-key &rest kwrds)
  "Make a hash table from the sequences KEYS and VALUES.
Optional arg UNIQ-KEY non-nil, means store just the first occurrency of
 each KEY.  Otherwise, update the value associated with KEY each time.
KWRDS are keyword/argument pairs as in `make-hash-table' with same defaults,
 except for size, which is set to (floor (max 65 (* 1.5 (length KEYS))))."
  (let ((ht (apply #'make-hash-table
                   (hap--hash-table-init kwrds
                                         (length keys)))))
    (cl-loop for k the elements of keys using (index idx) do
             (let ((v (ignore-errors (elt values idx))))
               (cond (uniq-key
                      (when (eq '--hap-not-found (gethash k ht '--hap-not-found))
                        (puthash k v ht)))
                     (t (puthash k v ht))))
             ) ht))

(defalias 'hap-hash-table 'hap-make-hash-table)

(defun hap-hash-table-keys (hash-table)
  "Return a list with the keys in HASH-TABLE."
  (cl-loop for k being the hash-keys of hash-table collect k))

(defun hap-hash-table-values (hash-table)
  "Return a list with the values in HASH-TABLE."
  (cl-loop for v being the hash-values of hash-table collect v))


\f
;;; Change keys <--> values, or in alist store values at cdr <--> cadr.

(defun hap-plist-ninvert (plist)
  "Invert the keys and values in PLIST.
This is a destructive function."
  (let ((lst plist))
    (cl-loop while lst do
             (cl-rotatef (car lst) (cadr lst))
             (pop lst) (pop lst))
    plist))

(defun hap-plist-invert (plist)
  "Return a copy of PLIST with inverted keys and values."
  (cl-loop while plist nconc
           (let ((v (pop plist))
                 (k (pop plist)))
             (list k v))))

(defun hap-alist-ninvert (alist &optional cadrp)
  "Invert the keys and values in ALIST.
Optional arg CADRP non-nil, means ALIST store the values in the cadr.
This is a destructive function."
  (let ((lst alist))
    (while lst
      (let ((x (car lst)))
        (if cadrp
            (nreverse x)
          (cl-rotatef (car x) (cdr x)))
        (pop lst))) alist))

(defun hap-alist-invert (alist &optional cadrp)
  "Return a copy of ALIST with inverted keys and values.
Optional arg CADRP non-nil, means ALIST store the values in the cadr."
  (cl-loop for x in alist collect
           (if cadrp
               (list (cadr x) (car x))
             (cons (cdr x) (car x)))))

(defun hap-hash-table-invert (hash-table)
  "Return a copy of HASH-TABLE with inverted keys and values."
  (let ((ht (make-hash-table)))
    (cl-loop for k the hash-keys of hash-table
             using (hash-values v) do
             (puthash v k ht)) ht))

(defun hap-hash-table-ninvert (hash-table)
  "Invert keys and values in HASH-TABLE.
This is a destructive function."
  (let ((ht hash-table))
    (cl-loop for k the hash-keys of ht
             using (hash-values v) do
             (remhash k ht)
             (puthash v k ht)) ht))

(defun hap-alist-set-values-at-cdr (alist &optional cadrp)
  "Return a copy of ALIST with their values stored in the cdr.
Optional arg CADRP non-nil, means ALIST store the values in the cadr."
  (if cadrp
      (cl-loop for x in alist collect
               (cons (car x) (cadr x)))
    (copy-sequence alist)))

(defun hap-alist-set-values-at-cadr (alist &optional cadrp)
  "Return a copy of ALIST with their values stored in the cadr.
Optional arg CADRP non-nil, means ALIST store the values in the cadr."
  (if cadrp
      (copy-sequence alist)
    (cl-loop for x in alist collect
             (list (car x) (cdr x)))))


\f
;;; Convert between alist, plist and hash table.

(defun hap-alist-to-plist (alist &optional cadrp)
  "Make a property list from ALIST.
Optional arg CADRP non-nil, means ALIST store the values in the cadr."
  (cl-loop for x in alist nconc
           (list (car x)
                 (if cadrp (cadr x) (cdr x)))))

(defun hap-plist-to-alist (plist &optional cadrp)
  "Make an alist from the property list PLIST.
Optional arg CADRP non-nil, means store the alist values in the cadr."
  (cl-loop while plist collect
           (let ((k (pop plist))
                 (v (pop plist)))
             (if cadrp
                 (list k v)
               (cons k v)))))

(defun hap-alist-to-hash-table (alist &optional cadrp uniq-key &rest kwrds)
  "Make a hash table from ALIST.
Optional arg CADRP non-nil, means ALIST store the values in the cadr.
Optional arg UNIQ-KEY non-nil, means store just the first occurrency of
 each KEY.  That ensures that (gethash KEY HASH) in the resultant hash table
 equals (cdr (assoc KEY ALIST)).  Otherwise, update the value associated
 with KEY each time.
KWRDS are keyword/argument pairs as in `make-hash-table' with same defaults,
except for size, which is set to (floor (max 65 (* 1.5 (length ALIST))))."
  (let ((ht (apply #'make-hash-table
                   (hap--hash-table-init kwrds
                                         (length alist)))))
    (dolist (x alist)
      (let ((k (car x))
            (v (or (and cadrp (cadr x))
                   (cdr x))))
        (cond (uniq-key
               (and (eq '--hap-not-found (gethash k ht '--hap-not-found))
                    (puthash k v ht)))
              (t (puthash k v ht)))
        )) ht))

(defun hap-plist-to-hash-table (plist &optional uniq-key &rest kwrds)
  "Make a hash table from the property list PLIST.
Optional arg UNIQ-KEY non-nil, means store just the first occurrency of
 each KEY.  Otherwise, update the value associated with KEY each time.
KWRDS are keyword/argument pairs as in `make-hash-table' with same defaults,
except for size, which is set to (floor (max 65 (* 0.75 (length PLIST))))."
  (let ((ht (apply #'make-hash-table
                   (hap--hash-table-init kwrds
                                         (/ (length plist) 2)))))
    (while plist
      (let ((k (pop plist))
            (v (pop plist)))
        (cond (uniq-key
               (and (eq '--hap-not-found (gethash k ht '--hap-not-found))
                    (puthash k v ht)))
              (t (puthash k v ht)))
        )) ht))

(defun hap-hash-table-to-alist (ht &optional cadrp)
  "Make an alist from HASH-TABLE.
Optional arg CADRP non-nil, means store the alist values in the cadr.
\n(fn HASH-TABLE CADRP)"
  (cl-loop for k the hash-keys of ht
           using (hash-values v)
           collect
           (if cadrp
               (list k v)
             (cons k v))))

(defun hap-hash-table-to-plist (ht)
  "Make a property list from HASH-TABLE.
\n(fn HASH-TABLE)"
  (cl-loop for k the hash-keys of ht
           using (hash-values v)
           nconc (list k v)))


(provide 'hap)

;;; hap.el ends here

--8<-----------------------------cut here---------------end--------------->8---