Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang racket
- (provide empty-dlink dlink? view-dlink -> <- dl-cons )
- (struct node (l k r) #:transparent)
- (struct head (n))
- (struct tail (n))
- ;; An empty dlink, initialized to point at the tail
- (define empty-dlink
- (tail (head #f)))
- (define (dlink? p)
- ;; This helper traverses in the direction dir and ensures that the tree is left/right linear, and null terminated correctly.
- (define (linear? n [dir node-l])
- (let {;; empty-dir is the direction opposite to dir. It should be empty, if this is a correct dlinked list.
- [empty-dir (cadr (member dir `(,node-l ,node-r ,node-l)))]
- ;; This is the corresponding null terminator for the dir.
- [null-ptr? (cadr (member dir (list node-l (conjoin head? (negate head-n))
- node-r (conjoin tail? (negate tail-n)))))]}
- ;; Either this node is a null terminator, or there's more to traverse
- (or (null-ptr? n)
- (and (node? n)
- (empty? (empty-dir n))
- (linear? (dir n) dir)))))
- ;; The cases
- (or (and (node? p)
- (linear? (node-l p) node-l)
- (linear? (node-r p) node-r))
- (and (head? p)
- (linear? (head-n p) node-r))
- (and (tail? p)
- (linear? (tail-n p) node-l))))
- (define (view-dlink p)
- ;; This helper traverses in the direction dir and ensures that the tree is left/right linear, and null terminated correctly.
- (define (linear n [dir node-l])
- (let {;; empty-dir is the direction opposite to dir. It should be empty, if this is a correct dlinked list.
- [empty-dir (cadr (member dir `(,node-l ,node-r ,node-l)))]
- ;; This is the corresponding null terminator for the dir.
- [null-ptr? (cadr (member dir (list node-l (conjoin head? (negate head-n))
- node-r (conjoin tail? (negate tail-n)))))]}
- ;; Either this node is a null terminator, or there's more to traverse
- (cond
- [(null-ptr? n) `(,n)]
- [(and (node? n) (empty? (empty-dir n))) (cons (node-k n) (linear (dir n) dir))]
- [else (printf "got ~a, ~a\n" n dir)])))
- (match p
- [(head n) `(head ,(linear n node-r))]
- [(tail n) `(,(reverse (linear n node-l)) tail)]
- [(node l k r) `(,(reverse (linear l node-l)) (root ,k) ,(linear r node-r))]))
- (define (-> n)
- (match n
- ;; rotate the head
- [(head (tail #f)) (tail (head #f))]
- [(head (node '() k r)) (node (head #f) k r)]
- ;; if the right is a tail, return the tail
- [(node l k (tail #f)) (tail (node l k '()))]
- ;; else, do some rotating
- [(node l b (node '() c r)) (node (node l b '()) c r)]))
- (define (<- n)
- (match n
- ;; rotate the tail
- [(tail (head #f)) (head (tail #f))]
- [(tail (node l k '())) (node l k (tail #f))]
- ;; if the left is a head, return the head
- [(node (head #f) k r) (head (node '() k r))]
- ;; else, do some rotating
- [(node (node l a '()) b r) (node l a (node '() b r))]))
- ;; Adds a node in front of the current node, also moves the pointer (so it feels a lot like the built-in cons)
- (define (dl-cons e dl)
- (match dl
- [(tail n) (node n e (tail #f))]
- [(node l k r) (node l e (node '() k r))]))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement