In today’s post from Programming Praxis, the goal is to check if two cyclic lists are equal. So if you have the cycles ↻(1 2 3 4 5)
and ↻(3 4 5 1 2)
, they’re equal. Likewise, ↻(1 2 2 1)
and ↻(2 1 1 2)
are equal. But ↻(1 2 3 4)
and ↻(1 2 3 5)
are not since they have different elements while ↻(1 1 1)
and ↻(1 1 1 1)
aren’t since they have different elements.
Basically, there are two ways that you can solve this problem. First, you actually use the cyclic structure and recursively check each start in one list for a matching cycle in the other. Alternatively, so long as the lengths are equal you can just double one list and search for the other as a subset. We’ll go ahead and code up both.
First, we want to write a semistraight forward comparison. The function will take two lists. It will recur across each in both for a start and loop in the second until either a match is confirmed or not. One thing that I want to do is make a cycle structure. We could use mutation to set the last cdr
/tail
of the list to the head, but instead I’ll make the following structure:
; Store a cycle as the current head and original (reset) head
(definestruct cycle (current original))
; Convert a list to a cycle
(define (list>cycle ls)
(makecycle ls ls))
; Convert a cycle to a list
(define (cycle>list c)
(cycletake (cyclelength c) c))
; Return the first item of a cycle
(define (cyclehead c)
(if (null? (cyclecurrent c))
(car (cycleoriginal c))
(car (cyclecurrent c))))
; Return all but the first item of a cycle
(define (cycletail c)
(if (null? (cyclecurrent c))
(makecycle (cdr (cycleoriginal c)) (cycleoriginal c))
(makecycle (cdr (cyclecurrent c)) (cycleoriginal c))))
; Get the length of a cycle
(define (cyclelength c)
(length (cycleoriginal c)))
; Take the first n items from a cycle
(define (cycletake n c)
(let loop ([i 0] [c c])
(if (= i n)
'()
(cons (cyclehead c) (loop (+ i 1) (cycletail c))))))
; Test if a cycle is about to reset
(define (cyclereset? c)
(null? (cyclecurrent c)))
Essentially, we’ll keep a pointer to the original list and reset when the current pointer runs out. All of this is of course transparent to anyone using the API, so we could switch it out for another (using a vector and a current pointer for example) if we wanted. The most useful function yet potentially nonstandard function is cyclereset?
. Essentially, it fills what would have been cyclenull?
, except a cycle will never be null. This tests when we’re about to reset to the beginning of the cycle.
There are a bunch of unit tests in the source on GitHub, but reset assured it works.
Now that we have that, the function it relatively straight forward:
; Test if two cycles are equal
(define (cycleequal? c1 c2)
; Check the lengths first
(define len (cyclelength c1))
(and (= len (cyclelength c2))
(let loop ([ci1 c1] [ci2 c2])
(cond
; No matches found
[(cyclereset? ci1)
#f]
; No match found for this start in c1
; Advance c1, reset c2
[(cyclereset? ci2)
(loop (cycletail ci1) c2)]
; Match found at the current element!
[(equal? (cycletake len ci1)
(cycletake len ci2))
#t]
; Otherwise, no match, advance c2
[else
(loop ci1 (cycletail ci2))]))))
Theoretically, the comments should be pretty straight forward. For each starting pair, test if we have matching cycles using cycletake
. That could bail out early to make the code more efficient, but at the cost of being rather less clean. Really, if you wanted to make this code efficient you’d most likely use a vector and a head pointer anyways.
And here we have a few tests:
> (cycleequal? (list>cycle '(1 2 3 4 5)) (list>cycle '(1 2 3 4 5)))
#t
> (cycleequal? (list>cycle '(1 2 3 4 5)) (list>cycle '(3 4 5 1 2)))
#t
> (cycleequal? (list>cycle '(1 2 2 1)) (list>cycle '(2 1 1 2)))
#t
> (cycleequal? (list>cycle '(1 1)) (list>cycle '(1 1 1 1)))
#f
> (cycleequal? (list>cycle '(1 2 3 4)) (list>cycle '(1 2 3 5)))
#f
The next solution is a bit more straight forward if not quite as efficient. Essentially, double one of the lists and then check if the other is in it. For equal cycles, this will be equal but not others. You do have to check the length first though.
First, we need to write code to check if one given list is a subset anywhere in another. Here’s one way to do that:
; Check if p is a prefix of ls
(define (prefix? ls p)
(or (null? p)
(and (equal? (car ls) (car p))
(prefix? (cdr ls) (cdr p)))))
; Check if a list needle is in the list haystack
(define (contains? haystack needle)
(and (not (null? haystack))
(or (prefix? haystack needle)
(contains? (cdr haystack) needle))))
And with that, checking for equal is a rather minimal function (we’re taking the cycles as lists this time):
; Check if two cycles (as lists) are equal by doubling one
(define (listcycleequal? lsc1 lsc2)
(and (= (length lsc1) (length lsc2))
(contains? (append lsc1 lsc1) lsc2)))
And to check that we can use the same tests. We just don’t convert to cycles first:
> (listcycleequal? '(1 2 3 4 5) '(1 2 3 4 5))
#t
> (listcycleequal? '(1 2 3 4 5) '(3 4 5 1 2))
#t
> (listcycleequal? '(1 2 2 1) '(2 1 1 2))
#t
> (listcycleequal? '(1 1) '(1 1 1 1))
#f
> (listcycleequal? '(1 2 3 4) '(1 2 3 5))
#f
And that’s it. If you’d like, you can see the entire code on GitHub (cycle equality source). All of the functions are already in this post, but there are a bunch of unit tests that might be of interest.
Edit 9 April 2013: A comment from Maurits on the Programming Praxis post got me wondering if it could be done in O(m + n)^{1}. Basically, their idea was to lexically order both cycles and then check if they are equal as lists.
To lexically order them, we want to advance the cycle so that the smallest element in the cycle is first. If there is a tie, break it with the element right after each smallest and so on. Something like this:
; Advance a cycle to the lexically minimum position
(define (cyclelexicalmin c [< <] [= =])
; Check if one cycle is less than another
(define (cycle< c1 c2)
(let loop ([c1 c1] [c1cnt (cyclelength c1)]
[c2 c2] [c2cnt (cyclelength c2)])
(and (> c1cnt 0)
(> c2cnt 0)
(or (< (cyclehead c1) (cyclehead c2))
(and (= (cyclehead c1) (cyclehead c2))
(loop (cycletail c1) ( c1cnt 1)
(cycletail c2) ( c2cnt 1)))))))
; Lexically sort by storing minimum
(let loop ([min c] [c (cycletail c)])
(cond
[(cyclereset? c) min]
[(cycle< c min) (loop c (cycletail c))]
[else (loop min (cycletail c))])))
Note: This code uses an updated version of cyclelength
that is amortized O(1) (it caches the length). You can see the code for that on GitHub.
One you have the sort, the actual comparison is easy:
; Compare cycles by lexical comparison
(define (lexicalcycleequal? c1 c2 [< <] [= =])
(equal? (cycletake (cyclelength c1) (cyclelexicalmin c1 < =))
(cycletake (cyclelength c2) (cyclelexicalmin c2 < =))))
I’m not completely sure about the runtime of finding the lexical minimum. In the general case (with few duplicates), it’ll be O(n) though. Then there’s another O(n + n) for the cyclelength and cycletake, plus a final additional O(max(m, n)) for the equal?. So overall it would be O(3m + 3n + max(m, n)) which is O(m + n). The constant could be improved with a better abstraction, but not the bigO time.
And of course all of the previous tests still work:
> (lexicalcycleequal? (list>cycle '(1 2 3 4 5)) (list>cycle '(1 2 3 4 5)) < =)
#t
> (lexicalcycleequal? (list>cycle '(1 2 3 4 5)) (list>cycle '(3 4 5 1 2)) < =)
#t
> (lexicalcycleequal? (list>cycle '(1 2 2 1)) (list>cycle '(2 1 1 2)) < =)
#t
> (lexicalcycleequal? (list>cycle '(1 1)) (list>cycle '(1 1 1 1)) < =)
#f
> (lexicalcycleequal? (list>cycle '(1 2 3 4)) (list>cycle '(1 2 3 5)) < =)
#f

The previous two solutions are O(mn) because they have to compare each starting point pairwise ↩︎