blob: 9a4b1bd6805705cf10da013105c4d406178b5020 (
plain) (
blame)
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
# some ideas by u/DaVinci103
# MIT License, Copyright (c) 2024 Marvin Borner
:import std/Logic .
:import std/Combinator .
:import std/Pair .
:import std/Math/Rational Q
:import std/Math N
# a Real is just a Unary → Rational!
# converts a balanced ternary number to a real number
number→real [[Q.number→rational 1]] ⧗ Number → Real
:test (number→real (+5)) ((+5.0r))
# returns true if two real numbers are equal approximately
approx-eq? [[[Q.eq? (1 2) (0 2)]]] ⧗ Number → Real → Real → Boolean
# TODO: bigger value??
…≈?… approx-eq? (+100u)
# adds two real numbers
add φ Q.add ⧗ Real → Real → Real
…+… add
:test ((+1.0r) + (+0.0r) ≈? (+1.0r)) (true)
:test ((+0.0r) + (-1.0r) ≈? (-1.0r)) (true)
# subtracts two real numbers
sub φ Q.sub ⧗ Real → Real → Real
…-… sub
:test ((+1.0r) - (+0.5r) ≈? (+0.5r)) (true)
:test ((+0.0r) - (-1.0r) ≈? (+1.0r)) (true)
# multiplies two real numbers
mul φ Q.mul ⧗ Real → Real → Real
…⋅… mul
:test ((+5.0r) ⋅ (+5.0r) ≈? (+25.0r)) (true)
:test ((+1.8r) ⋅ (+1.2r) ≈? (+2.16r)) (true)
# divides two real numbers
div φ Q.div ⧗ Real → Real → Real
…/… div
:test ((+8.0r) / (+4.0r) ≈? (+2.0r)) (true)
:test ((+18.0r) / (+12.0r) ≈? (+1.5r)) (true)
# negates a real number
negate b Q.negate ⧗ Real → Real
-‣ negate
:test (-(+0.0r) ≈? (+0.0r)) (true)
:test (-(+4.2r) ≈? (-4.2r)) (true)
:test (-(-4.2r) ≈? (+4.2r)) (true)
# inverts a real number
invert b Q.invert ⧗ Real → Real
~‣ invert
:test (~(+0.5r) ≈? (+2.0r)) (true)
:test (~(-0.5r) ≈? (-2.0r)) (true)
# finds smallest equivalent representation of a real number
compress b Q.compress ⧗ Real → Real
%‣ compress
:test (%[(+4) : (+1)] ≈? (+2.0r)) (true)
:test (%[(+4) : (+7)] ≈? (+0.5r)) (true)
# increments a real number
inc add (+1.0r) ⧗ Real → Real
++‣ inc
# decrements a real number
dec \sub (+1.0r) ⧗ Real → Real
--‣ dec
# ---
:import std/List L
# e^x using Taylor expansion
# tex: \sum_{n=0}^\infty \frac{x^n}{n!}
unary-exp [[0 &[[[[[[[2 1 0 (Q.add 4 (1 : N.--0)) N.++3]] pow fac]]]]] start [[[[1]]]]]] ⧗ Number → Real
pow N.mul 6 4
fac N.mul 1 3
start [0 (+1) (+1) (+1.0q) (+1)]
# equivalent to unary-exp but with ternary index using infinite list iteration
exp [[L.nth-iterate &[[[[op]]]] start 0 [[[[1]]]] 0]] ⧗ Real → Real
start [0 (+1.0r) (+1.0r) (+1.0r) (+1)]
op [[[2 1 0 (4 + (1 / 0)) N.++3]] pow fac]
pow 6 ⋅ 4
fac (number→real 1) ⋅ 3
# power function: real^number
pow-n [L.nth-iterate (mul 0) (+1.0r)] ⧗ Real → Number → Real
# e^x using infinite limit
# tex: \lim_{n\to\infty}(1+x/n)^n
lim-exp [[pow-n [(N.add 2 1) : N.--1] 0]] ⧗ Number → Real
# natural logarithm using Taylor expansion
# tex: \sum_{n=0}^\infty\frac{2}{2n+1}(\frac{x-1}{x+1})^{2n+1}
# error: O((x-1)/2)^{2n+1}
ln [[[L.nth-iterate &[[[op]]] start 1] (--1 / ++1 0) [[[1]]]]] ⧗ Real → Real
start [0 1 (+0.0q) (+0)]
op [0 pow (Q.add 2 go) N.++1]
pow Q.mul 3 (Q.mul 4 4)
go Q.mul ((+2) : (N.mul (+2) 1)) 3
:test (Q.eq? (ln (+2.0r) (+2)) ((+168) : (+242))) (true)
derive [[[[((3 (0 + 1)) - (3 0)) / 1]] ((+1.0r) / 0) 0]] ⧗ (Real → Real) → (Real → Real)
# power function: real^real
pow [[exp (0 ⋅ (ln 1))]] ⧗ Real → Real → Real
…**… pow
# square root by x^{0.5}
sqrt* \pow (+0.5r) ⧗ Real → Real
# Newton's/Heron's method, quadratic convergence
# tex: x_{n+1}=\frac{x_n+a/x_n}{2}
sqrt [[y [[[N.=?0 guess go]]] (1 0) 0]] ⧗ Real → Real
guess (+1.0q)
go [Q.div (Q.add 0 (Q.div 2 0)) (+2.0q)] (2 1 N.--0)
# Newton's/Heron's method, quadratic convergence
# tex: x_{n+1}=\frac{3x_n+a/(x_n^2)}{4}
cbrt [[y [[[N.=?0 guess go]]] (1 0) 0]] ⧗ Real → Real
guess (+1.0q)
go [Q.div (Q.add (Q.mul (+3.0q) 0) (Q.div 2 (Q.mul 0 0))) (+4.0q)] (2 1 N.--0)
# hypotenuse
hypot [[sqrt ((0 ⋅ 0) + (1 ⋅ 1))]] ⧗ Real → Real → Real
# tex: \sum_{n=0}^\infty\frac{2^n n!^2}{(2n+1)!}
π/2 [L.nth-iterate &[[[[[op]]]]] start 0 [[[[[3]]]]]] ⧗ Real
start [0 (+1) (+0.0q) (+1) (+1) (+1)]
op [0 N.++5 (Q.add 4 ((N.mul 3 2) : N.--1)) enum-pow enum-fac denom]
enum-pow N.mul 3 (+2)
enum-fac N.mul 2 (N.mul 5 5)
denom [N.mul 2 (N.mul 0 N.++0)] (N.mul (+2) 5)
# ratio of circle's circumference to its diameter
π π/2 ⋅ (+2.0r) ⧗ Real
# Gauss-Legendre, quadratic convergence
# Chudnovsky would be even faster but is ugly (i.e. magic numbers)
π-gauss [L.nth-iterate &[[[[op]]]] start 0 final]
start [0 (+1.0q) Q.~(sqrt (+2.0r) 1) (+0.25q) (+1.0q)]
op [[1 0 b t p] a]
a Q.div (Q.add 4 3) (+2.0q)
b sqrt [Q.mul 6 5] 6
t Q.sub 3 (Q.mul 2 (Q.pow-n (Q.sub 5 0) (+2)))
p Q.mul (+2.0q) 2
final [[[[Q.div (Q.pow-n (Q.add 3 2) (+2)) (Q.mul (+4.0q) 1)]]]]
# golden ratio from direct formula
φ ++(sqrt (+5.0r)) / (+2.0r)
# conjugate golden ratio
ψ -(~φ)
# golden ratio from fibonacci convergence
φ* [(L.index (L.iterate &[[0 : (N.add 1 0)]] ((+0) : (+1))) 0) [[1 : N.--0]]]
# real fibonacci
fib [((pow φ 0) - (pow ψ 0)) / (sqrt (+5.0r))]
# arctan by Taylor expansion, only for |x|<=1
# tex: \sum_{n=0}^\infty(-1)^n \frac{x^{2n+1}}{2n+1}
arctan* [[[L.nth-iterate &[[[[op]]]] start 1] (1 0) [[[[3]]]]]] ⧗ Real → Real
start [0 1 [[0]] (Q.pow-n 1 (+3)) (+3.0q)]
op [0 ((3 Q.add Q.sub) 4 (Q.div 2 1)) \3 enum denom]
enum Q.mul 2 (Q.mul 5 5)
denom Q.add 1 (+2.0q)
# actual arctan for arbitrary x
arctan [[Q.sub (π/2 0) (arctan* [Q.div (+1.0q) (2 1)] 0)]] ⧗ Real → Real
# TODO: atan2
atan2 [0] ⧗ Real → Real
|
