misc-deps
/
racket-ansi
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

circular-{snoc,last,butlast}

This commit is contained in:
Tony Garnock-Jones 2014-12-28 15:09:10 -05:00
parent dd6298f36b
commit 635c0d6359
1 changed files with 44 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
rmacs/circular-list.rkt
View File

@ -5,8 +5,11 @@
circular-null? circular-null?
circular-pair? circular-pair?
circular-cons circular-cons
circular-snoc
circular-car circular-car
circular-cdr circular-cdr
circular-last
circular-butlast
circular-length circular-length
circular-list-rotate-forward circular-list-rotate-forward
circular-list-rotate-backward circular-list-rotate-backward
@ -34,18 +37,27 @@
(and (circular-list? xs) (and (circular-list? xs)
(not (circular-null? xs)))) (not (circular-null? xs))))
(define (circular-cons->cons xs) (define (circular-uncons xs)
(cons (circular-car xs) (cons (circular-car xs)
(circular-cdr xs))) (circular-cdr xs)))
(define (circular-unsnoc xs)
(cons (circular-butlast xs)
(circular-last xs)))
(define (circular-cons* x xs) (define (circular-cons* x xs)
(circular-list (cons x (circular-list-front xs)) (circular-list-back xs))) (circular-list (cons x (circular-list-front xs)) (circular-list-back xs)))
(define (circular-snoc* xs x)
(circular-list (circular-list-front xs) (cons x (circular-list-back xs))))
(define-match-expander circular-cons (define-match-expander circular-cons
(syntax-rules () (syntax-rules () [(_ a d) (? circular-pair? (app circular-uncons (cons a d)))])
[(_ a d) (? circular-pair? (app circular-cons->cons (cons a d)))]) (syntax-rules () [(_ a d) (circular-cons* a d)]))
(syntax-rules ()
[(_ a d) (circular-cons* a d)])) (define-match-expander circular-snoc
(syntax-rules () [(_ d a) (? circular-pair? (app circular-unsnoc (cons d a)))])
(syntax-rules () [(_ d a) (circular-snoc* d a)]))
(define (prime! xs) (define (prime! xs)
(match xs (match xs
@ -74,6 +86,17 @@
(begin (prime! xs) (begin (prime! xs)
(circular-list (cdr (circular-list-front xs)) (circular-list-back xs))))) (circular-list (cdr (circular-list-front xs)) (circular-list-back xs)))))
(define (circular-last xs)
(if (circular-null? xs)
(error 'circular-last "Empty circular list")
(car (circular-list-back (anti-prime! xs)))))
(define (circular-butlast xs)
(if (circular-null? xs)
(error 'circular-butlast "Empty circular list")
(begin (anti-prime! xs)
(circular-list (circular-list-front xs) (cdr (circular-list-back xs))))))
(define (circular-length xs) (define (circular-length xs)
(+ (length (circular-list-front xs)) (+ (length (circular-list-front xs))
(length (circular-list-back xs)))) (length (circular-list-back xs))))
@ -194,6 +217,22 @@
(circular-cons 1 (circular-cons 2 circular-empty))) (circular-cons 1 (circular-cons 2 circular-empty)))
[(circular-cons a d) (cons a (circular-list->list d))]) [(circular-cons a d) (cons a (circular-list->list d))])
(list 2 1)) (list 2 1))
(check-equal? (match (circular-snoc circular-empty 1)
[(circular-snoc d a) (cons d a)])
(cons circular-empty 1))
(check-equal? (match (circular-list-rotate-forward (circular-snoc circular-empty 1))
[(circular-snoc d a) (cons d a)])
(cons circular-empty 1))
(check-equal? (match (circular-list-rotate-forward
(circular-snoc (circular-snoc circular-empty 2) 1))
[(circular-snoc d a) (cons a (circular-list->list d))])
(list 2 1))
(check-equal? (match (circular-snoc (circular-snoc circular-empty 1) 2)
[(circular-cons x (circular-cons y z)) (cons x (cons y (circular-list->list z)))])
(list 1 2))
(check-equal? (circular-list->list (circular-list-remove 2 (circular-list '(1 2 3) '(6 5 4)))) (check-equal? (circular-list->list (circular-list-remove 2 (circular-list '(1 2 3) '(6 5 4))))
'(1 3 4 5 6)) '(1 3 4 5 6))
(check-equal? (circular-list->list (circular-list-remove 2 (circular-list '(1) '(6 5 4 3 2)))) (check-equal? (circular-list->list (circular-list-remove 2 (circular-list '(1) '(6 5 4 3 2))))