hash-lang-uwu
/
CS3700-project2
2
0
Fork 0
Code Issues Releases Activity

Meme up radix tree

This commit is contained in:
xenia 2020-01-31 21:19:55 -05:00
parent d7d6f2bdfc
commit 0127f57230
1 changed files with 65 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
radix-tree.rkt
View File

@ -1,89 +1,100 @@
#lang racket #lang racket
(require data/bit-vector) (require "iputil.rkt")
(provide make-rt rt-update! rt-lookup rt-dump)
(struct rt-node [edge0 edge1 data] #:transparent #:mutable) (struct rt-node [edge0 edge1 data] #:transparent #:mutable)
(struct rt-edge [label target] #:transparent) (struct rt-edge [label target] #:transparent)
(define empty-node-data (gensym 'WATERDRINKERS))
(define (make-rt) (define (make-rt)
(rt-node #f #f #f)) (rt-node #f #f empty-node-data))
;; Helper functions for rt-node struct access based on whether the edge is 1 or 0 ;; Helper functions for rt-node struct access based on whether the edge is 1 or 0
(define (rt-getter bit) (if bit rt-node-edge1 rt-node-edge0)) (define (rt-getter bit) (if bit rt-node-edge1 rt-node-edge0))
(define (rt-setter bit) (if bit set-rt-node-edge1! set-rt-node-edge0!)) (define (rt-setter bit) (if bit set-rt-node-edge1! set-rt-node-edge0!))
;; Bit vector functions but short (define (bl-common-len bl1 bl2)
(define bv-ref bit-vector-ref) (for/sum ([b1 (in-list bl1)]
(define bv-len bit-vector-length) [b2 (in-list bl2)])
(define bv-copy bit-vector-copy)
(define bv bit-vector)
(define (bv-common-len bv1 bv1-start bv2 bv2-start)
;; How to avoid this bv copy?? Why is there no drop for sequences either
;; Matthias pls
(for/sum ([b1 (in-bit-vector (bv-copy bv1 bv1-start))]
[b2 (in-bit-vector (bv-copy bv2 bv2-start))])
#:break (not (equal? b1 b2)) #:break (not (equal? b1 b2))
1)) 1))
(define (rt-partial-iterate node key [start 0]) (define (rt-partial-iterate node key)
(cond (cond
[(>= start (bv-len key)) (list 'exact node)] [(empty? key) (list 'exact node)]
[else [else
(let* ([bit (bv-ref key start)] (let* ([bit (first key)]
[getter (rt-getter bit)] [getter (rt-getter bit)]
[next-edge (getter node)] [next-edge (getter node)]
[next-label (and next-edge (rt-edge-label next-edge))] [next-label (and next-edge (rt-edge-label next-edge))]
[next-target (and next-edge (rt-edge-target next-edge))] [next-target (and next-edge (rt-edge-target next-edge))]
[next-common-len (and next-label (bv-common-len next-label 0 key start))]) [next-common-len (and next-label (bl-common-len next-label key))])
(cond (cond
[(and next-edge (= next-common-len (bv-len next-label))) [(and next-edge (= next-common-len (length next-label)))
(rt-partial-iterate next-target key (+ start next-common-len))] (rt-partial-iterate next-target (drop key next-common-len))]
[next-edge (list 'partial node start next-edge next-common-len)] [next-edge (list 'partial node next-edge next-common-len key)]
[else (list 'no-match node start)]))])) [else (list 'no-match node key)]))]))
(define (rt-insert! node key data) (define (rt-update! node key updater failure-result)
(define (insert-node! node key start data) (define (insert-node! node key)
(let* ([bit (bv-ref key start)] (let* ([bit (first key)]
[setter! (rt-setter bit)]) [setter! (rt-setter bit)])
(setter! node (rt-edge (bv-copy key start) (rt-node #f #f data))))) (setter! node (rt-edge key (rt-node #f #f (updater (failure-result)))))))
(define (split-node! node key start orig-edge prefix-len data) (define (split-node! node key orig-edge prefix-len)
(let* ([bit (bv-ref key start)] (let* ([bit (first key)]
[setter! (rt-setter bit)] [setter! (rt-setter bit)]
[orig-label (rt-edge-label orig-edge)] [orig-label (rt-edge-label orig-edge)]
[orig-target (rt-edge-target orig-edge)] [orig-target (rt-edge-target orig-edge)]
[new-orig-edge (rt-edge (bv-copy orig-label prefix-len) orig-target)] [new-orig-edge (rt-edge (drop orig-label prefix-len) orig-target)]
[new-insert-edge (rt-edge (bv-copy key (+ start prefix-len)) (rt-node #f #f data))] [new-insert-edge (rt-edge (drop key prefix-len)
[diff-bit (bv-ref key (+ start prefix-len))] (rt-node #f #f (updater (failure-result))))]
[diff-bit (list-ref key prefix-len)]
[common-node (rt-node (if diff-bit new-orig-edge new-insert-edge) [common-node (rt-node (if diff-bit new-orig-edge new-insert-edge)
(if diff-bit new-insert-edge new-orig-edge) (if diff-bit new-insert-edge new-orig-edge)
#f)] empty-node-data)]
[common-edge (rt-edge (bv-copy key start (+ start prefix-len)) common-node)]) [common-edge (rt-edge (take key prefix-len) common-node)])
(setter! node common-edge))) (setter! node common-edge)))
(match (rt-partial-iterate node key) (match (rt-partial-iterate node key)
[(list 'exact node) (set-rt-node-data! data)] [(list 'exact node)
[(list 'partial node start orig-edge prefix-len) (set-rt-node-data!
(split-node! node key start orig-edge prefix-len data)] node
[(list 'no-match node start) (let ([d (rt-node-data node)])
(insert-node! node key start data)])) (updater
(if (eq? d empty-node-data) (failure-result) d))))]
[(list 'partial node orig-edge prefix-len partial-key)
(split-node! node partial-key orig-edge prefix-len)]
[(list 'no-match node partial-key)
(insert-node! node partial-key)]))
(define (rt-lookup node key)
(match (rt-partial-iterate node key)
[(list 'exact node) (rt-node-data node)]
[_ #f]))
; (define test (make-rt)) ; (define test (make-rt))
; (define (test-insert! x) ; (define (test-insert! x)
; (rt-insert! test (string->bit-vector x) x)) ; (rt-update!
; test
; (map (curry equal? #\1) (string->list x))
; (lambda (_) x)
; (lambda () x)))
; (test-insert! "0001") ; (test-insert! "0001")
; (test-insert! "1000") ; ; (test-insert! "1000")
; (test-insert! "1010") ; ; (test-insert! "1010")
; (test-insert! "0011") ; (test-insert! "0011")
; (test-insert! "0000") ; (test-insert! "0000")
;
; (define (rt-dump node [prefix ""]) (define (rt-dump node [prefix ""])
; (displayln (format "~a node ~a" prefix (rt-node-data node))) (displayln (format "~a node ~a" prefix (rt-node-data node)))
; (define edge0 (rt-node-edge0 node)) (define edge0 (rt-node-edge0 node))
; (define edge1 (rt-node-edge1 node)) (define edge1 (rt-node-edge1 node))
; (when edge0 (when edge0
; (displayln (format "~a edge0 ~a" prefix (bit-vector->string (rt-edge-label edge0)))) (displayln (format "~a edge0 ~a" prefix (rt-edge-label edge0)))
; (rt-dump (rt-edge-target edge0) (string-append prefix " "))) (rt-dump (rt-edge-target edge0) (string-append prefix " ")))
; (when edge1 (when edge1
; (displayln (format "~a edge1 ~a" prefix (bit-vector->string (rt-edge-label edge1)))) (displayln (format "~a edge1 ~a" prefix (rt-edge-label edge1)))
; (rt-dump (rt-edge-target edge1) (string-append prefix " ")))) (rt-dump (rt-edge-target edge1) (string-append prefix " "))))
; (rt-dump test) (rt-dump test)