Skip to content

Instantly share code, notes, and snippets.

@jackfirth
Created February 16, 2022 02:57
Show Gist options
  • Save jackfirth/6cf14f82ff0884b4e4c69760296eb28d to your computer and use it in GitHub Desktop.
Save jackfirth/6cf14f82ff0884b4e4c69760296eb28d to your computer and use it in GitHub Desktop.
A debugging tool that draws a pict of a mutable red black tree. Useful for debugging Rebellion's RB trees in mutable sorted collection implementations.
#lang racket/base
(require racket/contract/base)
(provide
(contract-out
[mutable-rb-tree-pict (-> mutable-rb-tree? pict?)]))
(require pict
pict/tree-layout
racket/port
rebellion/collection/private/mutable-red-black-tree-base)
;@----------------------------------------------------------------------------------------------------
(define (mutable-rb-tree-pict tree)
(binary-tidier (mutable-rb-node-layout (mutable-rb-tree-root-node tree))))
(define (nil-pict)
(cc-superimpose (filled-rectangle 25 15 #:color "black") (colorize (text "NIL" '() 10) "white")))
(define (mutable-rb-node-layout node)
(if (nil-leaf? node)
(tree-layout #:pict (nil-pict) #false #false)
(tree-layout
#:pict (proper-mutable-rb-node-pict node)
(mutable-rb-node-layout (mutable-rb-node-child node left))
(mutable-rb-node-layout (mutable-rb-node-child node right)))))
(define (proper-mutable-rb-node-pict node)
(define parent (mutable-rb-node-parent node))
(define root-text (if (mutable-rb-root? parent) (colorize (text "ROOT") "white") (blank)))
(define size-text (colorize (text (format "size: ~a" (mutable-rb-node-size node))) "white"))
(define color (if (red-node? node) "red" "black"))
(define contents (display-to-string (mutable-rb-node-key node)))
(define node-pict
(cc-superimpose (disk 25 #:border-width 2 #:color color) (colorize (text contents) "white")))
(vc-append root-text size-text node-pict))
(define (display-to-string v)
(with-output-to-string (λ () (display v))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment