;;;;; ;;;;; ;;;;; Number ;;;;; ;;;;; ;;; ;;; Natural Numbers ;;; (define $nat (matcher {[<o> [] {[0 {[]}] [_ {}]}] [<s $> nat {[$tgt (match (compare tgt 0) ordering {[<greater> {(- tgt 1)}] [_ {}]})]}] [,$n [] {[$tgt (if (eq? tgt n) {[]} {})]}] [$ [something] {[$tgt {tgt}]}] })) (define $nats {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 @(map (+ 100 $) nats)}) (define $nats0 {0 @nats}) (define $odds {1 @(map (+ $ 2) odds)}) (define $evens {2 @(map (+ $ 2) evens)}) (define $fibs {1 1 @(map2 + fibs (cdr fibs))}) (define $prime? (lambda [$n] (eq? n (find-factor n)))) (define $primes {2 @(filter prime? (drop 2 nats))}) (define $divisor? (lambda [$n $d] (eq? 0 (remainder n d)))) (define $find-factor (memoized-lambda [$n] (match (take-while (lte? $ (floor (sqrt (itof n)))) primes) (list integer) {[<join _ <cons (& ?(divisor? n $) $x) _>> x] [_ n]}))) (define $prime-factorization (match-lambda integer {[,1 {}] [(& ?(lt? $ 0) $n) {-1 @(prime-factorization (neg n))}] [$n (let {[$p (find-factor n)]} {p @(prime-factorization (quotient n p))})]})) (define $p-f prime-factorization) (define $even? (lambda [$n] (eq? 0 (modulo n 2)))) (define $odd? (lambda [$n] (eq? 1 (modulo n 2)))) (define $fact (lambda [$n] (foldl * 1 (between 1 n)))) (define $perm (lambda [$n $r] (foldl * 1 (between (- n (- r 1)) n)))) (define $comb (lambda [$n $r] (/ (perm n r) (fact r)))) (define $n-adic (lambda [$n $x] (if (eq? x 0) {} (let {[$q (quotient x n)] [$r (remainder x n)]} {@(n-adic n q) r})))) ;;; ;;; Integers ;;; (define $mod (lambda [$m] (matcher {[,$n [] {[$tgt (if (eq? (modulo tgt m) (modulo n m)) {[]} {})]}] [$ [something] {[$tgt {tgt}]}] }))) ;;; ;;; Floats ;;; (define $exp2 (lambda [$x $y] (exp (* (log x) y)))) ;;; ;;; Decimal Fractions ;;; (define $rtod-helper (lambda [$m $n] (let {[$q (quotient (* m 10) n)] [$r (remainder (* m 10) n)]} {[q r] @(rtod-helper r n)}))) (define $rtod (lambda [$x] (let* {[$m (numerator x)] [$n (denominator x)] [$q (quotient m n)] [$r (remainder m n)]} [q (map fst (rtod-helper r n))]))) (define $rtod' (lambda [$x] (let* {[$m (numerator x)] [$n (denominator x)] [$q (quotient m n)] [$r (remainder m n)] [[$s $c] (find-cycle (rtod-helper r n))]} [q (map fst s) (map fst c)]))) (define $show-decimal (lambda [$c $x] (match (2#[%1 (take c %2)] (rtod x)) [integer (list integer)] {[[$q $sc] (foldl S.append (S.append (show q) ".") (map show sc))]}))) (define $show-decimal' (lambda [$x] (match (rtod' x) [integer (list integer) (list integer)] {[[$q $s $c] (foldl S.append "" {(S.append (show q) ".") @(map show s) " " @(map show c) " ..."})]}))) ;;; ;;; Continued Fraction ;;; (define $regular-continued-fraction (lambda [$n $as] (+ n (foldr (lambda [$a $r] (/ 1 (+ a r))) 0 as)))) (define $continued-fraction (lambda [$n $as $bs] (match [as bs] [(list integer) (list integer)] {[[<cons $a $as> <cons $b $bs>] (+ n (/ b (continued-fraction a as bs)))] [[<nil> <nil>] n]}))) (define $regular-continued-fraction-of-sqrt-helper (lambda [$m $a $b] ; a+b*rt(m) (let* {[$n (floor (f.+ (rtof a) (f.* (rtof b) (sqrt (rtof m)))))] [$x (- m (power n 2))]} (if (eq? x 0) {[a b n]} (let {[$y (- (power (- n a) 2) (* b b m))]} {[a b n] @(regular-continued-fraction-of-sqrt-helper m (/ (- a n) y) (neg (/ b y)))}))))) (define $regular-continued-fraction-of-sqrt (lambda [$m] (let* {[$n (floor (sqrt (rtof m)))] [$x (- m (power n 2))]} ; n+rt(m)-n ; n+(rt(m)-n)*(rt(m)+n)/(rt(m)+n) ; n+x/(rt(m)+n) (if (eq? x 0) [n {} {}] [n (map 3#%3 (regular-continued-fraction-of-sqrt-helper m (/ n x) (/ 1 x)))])))) (define $regular-continued-fraction-of-sqrt' (lambda [$m] (let* {[$n (floor (sqrt (rtof m)))] [$x (- m (power n 2))]} (if (eq? x 0) [n {} {}] (let {[[$s $c] (find-cycle (regular-continued-fraction-of-sqrt-helper m (/ n x) (/ 1 x)))]} [n (map 3#%3 s) (map 3#%3 c)])))))