Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Maybe add TAILP* #118

Open
phoe opened this issue Feb 6, 2022 · 2 comments
Open

Maybe add TAILP* #118

phoe opened this issue Feb 6, 2022 · 2 comments

Comments

@phoe
Copy link
Contributor

phoe commented Feb 6, 2022

I can't find a utility that can tell me if any two lists share structure anywhere.

TAILP only works correctly if you provide it the concrete tail of the list. Running TAILP for every element of the other list mostly achieves the goal but has quadratic time complexity, which is painful, plus one needs to remember to handle dotted lists.

I propose adding a TAILP* operator which uses a hash table for detection of shared structure and therefore can do this in linear time and linear memory. Oh, and it also handles circularities.

A quick and hasty implementation:

(defun tailp* (object-1 object-2)
  (let ((hash-table (make-hash-table :test #'eq)))
    ;; Populate the hash table with objects from the first list.
    (typecase object-1
      (atom (setf (gethash object-1 hash-table) :first))
      (cons (loop for cons on object-1
                  when (gethash cons hash-table)
                    ;; For cyclic lists, return gracefully.
                    return nil
                  else
                    ;; Mark cons cell as visited.
                    do (setf (gethash cons hash-table) :first)
                  when (atom (cdr cons))
                    ;; For proper and dotted lists, remember the last CDR.
                    do (setf (gethash (cdr cons) hash-table) :first))))
    ;; Check if any list structure of the second list is in the hashtable.
    (typecase object-2
      (atom (when (eq (gethash object-2 hash-table) :first) object-2))
      (cons (loop for cons on object-2
                  for result = (gethash cons hash-table)
                  when (eq result :first)
                    ;; We found the tail, return it.
                    return cons
                  when (eq result :second)
                    ;; If we hit a cycle in this list, there is no match.
                    return nil
                  else
                    ;; Mark cell as visited.
                    do (setf (gethash cons hash-table) :second)
                  when (atom (cdr cons))
                    ;; For proper and dotted lists, check the last CDR.
                    when (gethash (cdr cons) hash-table)
                      return (cdr cons))))))

Some quick and hasty REPL tests:

SERAPEUM> (tailp* (list 1 2 3) (list 1 2 3))
NIL

SERAPEUM> (tailp* (list* 1 2 3) (list* 1 2 3))
3

SERAPEUM> (let ((shared (list 3 4 5))) 
            (tailp* (list* 1 2 shared) (list* 1 2 shared)))
(3 4 5)

SERAPEUM> (tailp* (list* 1 2 3) (list* 3))
3

SERAPEUM> (tailp* (list* 3) (list* 1 2 3))
3

SERAPEUM> (setf *print-circle* t)
T

SERAPEUM> (let ((cycle (make-circular-list 3 :initial-element 0)))
            (tailp* (list* 1 2 cycle) (list* 1 2 cycle)))
#1=(0 0 0 . #1#)

SERAPEUM> (let ((cycle-1 (make-circular-list 3 :initial-element 0))
                (cycle-2 (make-circular-list 3 :initial-element 0)))
            (tailp* (list* 1 2 cycle-1) (list* 1 2 cycle-2)))
NIL

How does this sound? I can clean this up, add more tests, and make a PR if this sounds like a good addition.

@ruricolist
Copy link
Owner

In the flurry of activity I overlooked this issue. If you're still interested this seems like a good idea, although it could use a more descriptive name (common-tail-p?).

@phoe
Copy link
Contributor Author

phoe commented Mar 5, 2022

Sure, that works. I suggested tailp* because of the sorta-obvious similarity with the standard tailp, but naming is the hard part.

I'll submit this as a PR eventually.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants