;
;  This is a Common Lisp implementation of an inverted index,
;  contributed by Darius Bacon.  http://www.accesscom.com/~darius/
;  Released January 2004 as public domain software.
;

(defun list-to-idx (a-list)
  ; This function is kind of annoying -- functionally it's like
  ; calling idx-invert twice, but if we coded it as such then our
  ; test wouldn't really test that much.
  (loop for key in (reduce #'adjoin (loop for (key2 vals) in a-list
                                          unless (null vals)
                                          collect key2)
                           :from-end t :initial-value '())
        collect (list key (reduce #'union
                                  (loop for (key2 vals) in a-list
                                        if (eql key key2)
                                        collect (remove-duplicates vals))))))

(defun idx-invert (idx)
  (loop for val in (reduce #'union (mapcar #'second idx) :initial-value '())
        collect (list val (loop for (key vals) in idx
                                if (member val vals)
                                collect key))))

(defun idx-lookup (idx key)
  (second (assoc key idx)))

(defun idx-lookup-all (idx keys)
  (and keys (reduce #'intersection (lookup-each idx keys))))

(defun idx-lookup-any (idx keys)
  (and keys (reduce #'union (lookup-each idx keys))))

(defun lookup-each (idx keys)
  (loop for key in keys
        collect (idx-lookup idx key)))


(use-package :click-check)

(defun idx-equal (idx1 idx2)
  (equal (canon idx1) (canon idx2)))

(defun canon (idx)
  (sort (loop for (key vals) in idx
              collect (list key (sort vals #'<)))
        #'<
        :key #'first))

(define (an-idx)
  (list-to-idx (generate (a-list (a-tuple an-integer
                                          (a-list an-integer))))))

(defun test-index ()
  (let ((idx-generator an-idx)
        (keys-generator (a-list an-index)))
    (tests
     (for-all (idx)
       (is idx-equal idx (idx-invert (idx-invert idx))))
     (for-all (idx keys)
       (test (let ((all-val (idx-lookup-all idx keys)))
               (every (lambda (one-val) (subsetp all-val one-val))
                      (lookup-each idx keys)))))
     (for-all (idx keys)
       (test (let ((any-val (idx-lookup-any idx keys)))
               (every (lambda (one-val) (subsetp one-val any-val))
                      (lookup-each idx keys))))))))

(click-check #'test-index)