flexible-with-utils.hl.rkt (3866B)
1 #lang aful/unhygienic hyper-literate type-expander/lang 2 3 @(require scribble-math) 4 5 @title[#:tag-prefix "utils" 6 #:style manual-doc-style]{Utility math functions for binary tree 7 manipulation} 8 9 @(chunks-toc-prefix 10 '("(lib phc-graph/scribblings/phc-graph-implementation.scrbl)" 11 "phc-graph/flexible-with" 12 "utils")) 13 14 @defmodule[(lib "phc-graph/flexible-with-utils.hl.rkt")] 15 16 @(unless-preexpanding 17 (require (for-label (submod "..")))) 18 19 @chunk[<*> 20 (require (for-syntax racket/base)) 21 22 (provide (for-syntax to-bits 23 from-bits 24 floor-log2 25 ceiling-log2)) 26 27 <to-bits> 28 <from-bits> 29 <floor-log2> 30 <ceiling-log2> 31 32 (module* test racket/base 33 (require (for-template (submod ".."))) 34 (require rackunit) 35 <test-to-bits> 36 <test-from-bits>)] 37 38 @defproc[(to-bits [n exact-nonnegative-integer?]) (listof boolean?)]{} 39 40 @CHUNK[<to-bits> 41 ;; 1 => 1 42 ;; 2 3 => 10 11 43 ;; 4 5 6 7 => 100 101 110 111 44 ;; 89 ab cd ef => 1000 1001 1010 1011 1100 1101 1110 1111 45 46 ;; 1 => ε 47 ;; 2 3 => 0 1 48 ;; 4 5 6 7 => 00 01 10 11 49 ;; 89 ab cd ef => 000 001 010 011 100 101 110 111 50 51 ;; 0 => 0 52 ;; 1 2 => 1 10 53 ;; 3 4 5 6 => 11 100 101 110 54 ;; 78 9a bc de => 111 1000 1001 1010 1011 1100 1101 1110 55 56 (define-for-syntax (to-bits n) 57 (reverse 58 (let loop ([n n]) 59 (if (= n 0) 60 null 61 (let-values ([(q r) (quotient/remainder n 2)]) 62 (cons (if (= r 1) #t #f) (loop q)))))))] 63 64 @chunk[<test-to-bits> 65 (check-equal? (to-bits 0) '()) 66 (check-equal? (to-bits 1) '(#t)) 67 (check-equal? (to-bits 2) '(#t #f)) 68 (check-equal? (to-bits 3) '(#t #t)) 69 (check-equal? (to-bits 4) '(#t #f #f)) 70 (check-equal? (to-bits 5) '(#t #f #t)) 71 (check-equal? (to-bits 6) '(#t #t #f)) 72 (check-equal? (to-bits 7) '(#t #t #t)) 73 (check-equal? (to-bits 8) '(#t #f #f #f)) 74 (check-equal? (to-bits 12) '(#t #t #f #f)) 75 (check-equal? (to-bits 1024) '(#t #f #f #f #f #f #f #f #f #f #f))] 76 77 @defproc[(from-bits [n (listof boolean?)]) exact-nonnegative-integer?]{} 78 79 @CHUNK[<from-bits> 80 (define-for-syntax (from-bits b) 81 (foldl (λ (bᵢ acc) 82 (+ (* acc 2) (if bᵢ 1 0))) 83 0 84 b))] 85 86 @chunk[<test-from-bits> 87 (check-equal? (from-bits '()) 0) 88 (check-equal? (from-bits '(#t)) 1) 89 (check-equal? (from-bits '(#t #f)) 2) 90 (check-equal? (from-bits '(#t #t)) 3) 91 (check-equal? (from-bits '(#t #f #f)) 4) 92 (check-equal? (from-bits '(#t #f #t)) 5) 93 (check-equal? (from-bits '(#t #t #f)) 6) 94 (check-equal? (from-bits '(#t #t #t)) 7) 95 (check-equal? (from-bits '(#t #f #f #f)) 8) 96 (check-equal? (from-bits '(#t #t #f #f)) 12) 97 (check-equal? (from-bits '(#t #f #f #f #f #f #f #f #f #f #f)) 1024)] 98 99 @defproc[(floor-log2 [n exact-positive-integer?]) 100 exact-nonnegative-integer?]{ 101 Exact computation of @${\lfloor\log_2(n)\rfloor}. 102 } 103 104 @chunk[<floor-log2> 105 (define-for-syntax (floor-log2 n) 106 (if (<= n 1) 107 0 108 (add1 (floor-log2 (quotient n 2)))))] 109 110 @defproc[(ceiling-log2 [n exact-positive-integer?]) 111 exact-nonnegative-integer?]{ 112 Exact computation of @${\lceil\log_2(n)\rceil}. 113 } 114 115 @chunk[<ceiling-log2> 116 (define-for-syntax (ceiling-log2 n) 117 (floor-log2 (sub1 (* n 2))))]