sourcedemos/manifold-tour/manifold-tour.xtl
1⍝!/usr/bin/env xetal
2⍝│ Manifold tour: five spaces this repository's experiments live on,
3⍝│ the circle, the sphere, the torus, the Swiss roll and the Poincare
4⍝│ disk, each drawn from its map (its own coordinates) into the space
5⍝│ around it, and on each one measurement of what a manifold is: two
6⍝│ points near each other are nearly as far apart along the space as
7⍝│ through it (locally flat), two points far apart are not; on the
8⍝│ roll, near through the air can be far along the sheet; on the disk,
9⍝│ near the rim a small step on paper is a long way. Nothing is trained.
10"mf:" u̲se< "Manifold"
11"tr:" u̲se< "Trig"
12"ch:" u̲se< "Check"
13
14⍝ -- the tour
15Pi ← p̲i @
16deg ← Pi ÷ 180.0
17
18⍝│ a ᵘp̲airs b: a and b side by side, one (a, b) row per item (the
19⍝│ rows of a map). A general pairing belongs in X_eTaL-libraries: a
20⍝│ workaround here until it is asked for (docs/plan.md, G3b).
21ᵘp̲airs ← { a b → o̲\ (2 c̲at t̲ally a) r̲eshape (f̲loat a) c̲at f̲loat b }
22⍝│ ᵘr̲ound m: m + 1 angles evenly round a full turn, 0 to 2 pi, the
23⍝│ first repeated last: a closed wire line.
24ᵘr̲ound ← { m → (2.0 × Pi ÷ f̲loat m) × (f̲loat r̲ange m + 1) − 1.0 }
25⍝│ n ᵘe̲ach v: every item of v repeated n times, in v's order.
26ᵘe̲ach ← { n v → r̲avel o̲\ (n c̲at t̲ally v) r̲eshape v }
27⍝│ n ᵘt̲imes v: v whole, n times over.
28ᵘt̲imes ← { n v → r̲avel (n c̲at t̲ally v) r̲eshape v }
29⍝│ ᵘl̲ength M: the length of the wire line through the rows of M,
30⍝│ segment by segment (measured along the wire, not the curve).
31ᵘl̲ength ← { M → '+ r̲/ s̲qrt '+ r̲/₂ ((1 d̲rop M) − -1 d̲rop M) ^ 2.0 }
32⍝│ p ᵘs̲traight q: the straight-line distance, through whatever
33⍝│ surrounds the space.
34ᵘs̲traight ← { p q → s̲qrt '+ r̲/ ((f̲loat p) − f̲loat q) ^ 2.0 }
35⍝│ ᵘt̲wo M: for the two points (rows) of M on the sphere or the
36⍝│ circle, the straight line through it and the distance along it.
37ᵘt̲wo ← { M → ((1 s̲elect M) ᵘs̲traight 2 s̲elect M) c̲at (1 s̲elect M) ᵐᶠs̲phereDistance 2 s̲elect M }
38⍝│ ᵘl̲onLat P: points of the sphere back onto its map, (longitude,
39⍝│ latitude) in degrees: where a drawn arc runs on the flat view.
40ᵘl̲onLat ← { P → (((2 s̲elect₂ P) ᵗʳa̲tan2 1 s̲elect₂ P) ᵘp̲airs ᵗʳa̲sin 3 s̲elect₂ P) ÷ deg }
41
42⍝━━ The circle: one dimension, drawn in two
43
44circleAngles ← ᵘr̲ound 72
45circle ← ᵐᶠc̲irclePoints circleAngles
46⍝│ Two points a tenth of a radian apart, and two 2.5 radians apart:
47⍝│ the chord through the disk and the arc along the circle, for each.
48circleNearA ← 0.0 0.1
49circleFarA ← 0.0 2.5
50circleNear ← ᵐᶠc̲irclePoints circleNearA
51circleFar ← ᵐᶠc̲irclePoints circleFarA
52circleNearD ← ᵘt̲wo circleNear
53circleFarD ← ᵘt̲wo circleFar
54
55⍝━━ The sphere: two dimensions, drawn in three
56
57⍝│ The map's wire lines: five parallels (latitudes -60 to 60 degrees,
58⍝│ 48 segments round) and twelve half meridians (every 30 degrees of
59⍝│ longitude, pole to pole in 24 segments), as (longitude, latitude).
60parallelLL ← (5 ᵘt̲imes ᵘr̲ound 48) ᵘp̲airs 49 ᵘe̲ach (30.0 × deg) × -2.0 -1.0 0.0 1.0 2.0
61meridianLL ← (25 ᵘe̲ach (30.0 × deg) × (f̲loat r̲ange 12) − 1.0) ᵘp̲airs 12 ᵘt̲imes (7.5 × deg) × (f̲loat r̲ange 25) − 13.0
62parallels ← ᵐᶠs̲pherePoints parallelLL
63meridians ← ᵐᶠs̲pherePoints meridianLL
64⍝│ Three points by longitude and latitude in degrees: p, q near it
65⍝│ (6 degrees east, 3 north), r far from it; the chord through the
66⍝│ sphere and the great circle along it, p to q and p to r; the arcs.
67sphereDeg ← 3 2 r̲eshape 20.0 30.0 26.0 33.0 110.0 -35.0
68sphereLL ← deg × sphereDeg
69spherePts ← ᵐᶠs̲pherePoints sphereLL
70sphereNearD ← ᵘt̲wo 2 t̲ake spherePts
71sphereFarD ← ᵘt̲wo (1 s̲elect spherePts) c̲at 3 s̲elect spherePts
72sphereNearArc ← (1 s̲elect spherePts, 2 s̲elect spherePts) ᵐᶠs̲phereArc 12
73sphereFarArc ← (1 s̲elect spherePts, 3 s̲elect spherePts) ᵐᶠs̲phereArc 48
74sphereNearArcLL ← ᵘl̲onLat sphereNearArc
75sphereFarArcLL ← ᵘl̲onLat sphereFarArc
76⍝│ The chord from p to q worked in full: the differences coordinate
77⍝│ by coordinate, their squares, the sum (the chord is its square
78⍝│ root); and the length of p + q, from which the great circle is
79⍝│ 2 atan2(|p - q|, |p + q|).
80workedDiff ← (1 s̲elect spherePts) − 2 s̲elect spherePts
81workedSq ← workedDiff ^ 2.0
82workedSum ← '+ r̲/ workedSq
83workedPlus ← s̲qrt '+ r̲/ ((1 s̲elect spherePts) + 2 s̲elect spherePts) ^ 2.0
84
85⍝━━ The torus: two dimensions, drawn in three, with a hole
86
87radii ← 3.0 1.0
88⍝│ Six rings round the hole (v every 60 degrees, 48 segments) and
89⍝│ twelve round the tube (u every 30 degrees, 24 segments), as (u, v).
90torusRingsUV ← (6 ᵘt̲imes ᵘr̲ound 48) ᵘp̲airs 49 ᵘe̲ach (60.0 × deg) × (f̲loat r̲ange 6) − 1.0
91torusTubesUV ← (25 ᵘe̲ach (30.0 × deg) × (f̲loat r̲ange 12) − 1.0) ᵘp̲airs 12 ᵘt̲imes ᵘr̲ound 24
92torusRings ← radii ᵐᶠt̲orusPoints torusRingsUV
93torusTubes ← radii ᵐᶠt̲orusPoints torusTubesUV
94⍝│ The outer ring (v = 0) and the inner ring (v = 180 degrees): the
95⍝│ same line of the map, measured along the wire.
96torusRimLengths ← (ᵘl̲ength 49 t̲ake torusRings) c̲at ᵘl̲ength 49 t̲ake 147 d̲rop torusRings
97
98⍝━━ The Swiss roll: a flat sheet rolled up, in three dimensions
99
100⍝│ The sheet: t from 1.5 pi to 4.5 pi (a turn and a half), h from -6
101⍝│ to 6. Five lines along the roll (60 segments) and thirteen across
102⍝│ it (straight, 2 points), as (t, h); and the map they unroll to,
103⍝│ (the length along the sheet, h).
104rollT ← (1.5 × Pi) + (Pi ÷ 20.0) × (f̲loat r̲ange 61) − 1.0
105rollAlongTH ← (5 ᵘt̲imes rollT) ᵘp̲airs 61 ᵘe̲ach -6.0 -3.0 0.0 3.0 6.0
106rollAcrossTH ← (2 ᵘe̲ach (1.5 × Pi) + (Pi ÷ 4.0) × (f̲loat r̲ange 13) − 1.0) ᵘp̲airs 13 ᵘt̲imes -6.0 6.0
107rollAlong ← ᵐᶠr̲ollPoints rollAlongTH
108rollAcross ← ᵐᶠr̲ollPoints rollAcrossTH
109rollAlongMap ← (ᵐᶠr̲ollAlong 1 s̲elect₂ rollAlongTH) ᵘp̲airs 2 s̲elect₂ rollAlongTH
110rollAcrossMap ← (ᵐᶠr̲ollAlong 1 s̲elect₂ rollAcrossTH) ᵘp̲airs 2 s̲elect₂ rollAcrossTH
111⍝│ Three points of the sheet: a, b a little farther round, c one full
112⍝│ turn farther round at the same height, so that it sits right above
113⍝│ a's turn: through the air and along the sheet, a to b and a to c.
114rollTH ← 3 2 r̲eshape (5.2 0.0 5.5 0.0) c̲at (5.2 + 2.0 × Pi) c̲at 0.0
115rollPts ← ᵐᶠr̲ollPoints rollTH
116rollMap ← (ᵐᶠr̲ollAlong 1 s̲elect₂ rollTH) ᵘp̲airs 2 s̲elect₂ rollTH
117rollNearD ← ((1 s̲elect rollPts) ᵘs̲traight 2 s̲elect rollPts) c̲at (1 s̲elect rollTH) ᵐᶠr̲ollDistance 2 s̲elect rollTH
118rollFarD ← ((1 s̲elect rollPts) ᵘs̲traight 3 s̲elect rollPts) c̲at (1 s̲elect rollTH) ᵐᶠr̲ollDistance 3 s̲elect rollTH
119
120⍝━━ The Poincare disk: two dimensions, flat on the page, with its own ruler
121
122⍝│ The rim (not part of the disk: points of the disk never reach it),
123⍝│ and the disk's ruler laid along a diameter: the points 0, 1, 2, 3,
124⍝│ 4 and 5 apart from the middle by the disk's distance.
125rim ← ᵐᶠc̲irclePoints ᵘr̲ound 90
126ruler ← (t̲anh (0.0 1.0 2.0 3.0 4.0 5.0) ÷ 2.0) ᵘp̲airs 6 r̲eshape 0.0
127rulerD ← '{ k → 0.0 0.0 ᵐᶠb̲allDistance k s̲elect ruler } e̲ach r̲ange 6
128⍝│ Two points near the rim, 20 degrees apart round it (at the top,
129⍝│ off the ruler), and the same two drawn in toward the middle: on paper and by the disk's
130⍝│ distance, for each; and the geodesics between them.
131diskFar ← 0.95 × ᵐᶠc̲irclePoints deg × 80.0 100.0
132diskNear ← 0.1 × ᵐᶠc̲irclePoints deg × 80.0 100.0
133diskFarD ← ((1 s̲elect diskFar) ᵘs̲traight 2 s̲elect diskFar) c̲at (1 s̲elect diskFar) ᵐᶠb̲allDistance 2 s̲elect diskFar
134diskNearD ← ((1 s̲elect diskNear) ᵘs̲traight 2 s̲elect diskNear) c̲at (1 s̲elect diskNear) ᵐᶠb̲allDistance 2 s̲elect diskNear
135diskFarGeo ← (1 s̲elect diskFar, 2 s̲elect diskFar) ᵐᶠb̲allGeodesic 24
136diskNearGeo ← (1 s̲elect diskNear, 2 s̲elect diskNear) ᵐᶠb̲allGeodesic 24
137⍝│ Three more geodesics, to see their shape: a diameter, and two arcs.
138geo1 ← (-0.9 0.0, 0.9 0.0) ᵐᶠb̲allGeodesic 24
139geo2 ← (-0.5 0.6, 0.7 0.2) ᵐᶠb̲allGeodesic 24
140geo3 ← (0.0 -0.9, 0.6 -0.6) ᵐᶠb̲allGeodesic 24
141
142⍝━━ The dimensions
143
144⍝│ Each space's intrinsic dimension (how many coordinates its map
145⍝│ has: the circle's map is a list of angles, the others' are pairs)
146⍝│ and its ambient dimension (how many coordinates the space it is
147⍝│ drawn in has), read off the arrays' shapes: one row per space, the
148⍝│ circle, the sphere, the torus, the roll, the disk.
149dims ← ((t̲ally s̲hape circleAngles) c̲at (2 s̲elect s̲hape parallelLL) c̲at (2 s̲elect s̲hape torusRingsUV) c̲at (2 s̲elect s̲hape rollAlongMap) c̲at 2 s̲elect s̲hape rim) ᵘp̲airs (2 s̲elect s̲hape circle) c̲at (2 s̲elect s̲hape parallels) c̲at (2 s̲elect s̲hape torusRings) c̲at (2 s̲elect s̲hape rollAlong) c̲at 2 s̲elect s̲hape rim
150⍝ -- end of the core
151
152⍝━━ The dimensions
153
154dims
155
156⍝━━ The circle
157
158"intrinsic and ambient dimension" ᶜʰt̲est 1.0 2.0 ᶜʰn̲ear 1 s̲elect dims
159"the circle's points have length 1" ᶜʰt̲est (73 r̲eshape 0.0) ᶜʰn̲ear ᵐᶠs̲phereOff circle
160circleNear
161"near: the chord and the arc agree to a part in a thousand" ᶜʰt̲est 1 ᶜʰi̲s 0.001 > a̲bs 1.0 − (1 s̲elect circleNearD) ÷ 2 s̲elect circleNearD
162circleNearD
163circleFar
164"far: they do not" ᶜʰt̲est 1 ᶜʰi̲s 0.1 < a̲bs 1.0 − (1 s̲elect circleFarD) ÷ 2 s̲elect circleFarD
165circleFarD
166
167⍝━━ The sphere
168
169"intrinsic and ambient dimension" ᶜʰt̲est 2.0 3.0 ᶜʰn̲ear 2 s̲elect dims
170"the wire lines are on the sphere" ᶜʰt̲est 0.0 ᶜʰn̲ear 'm̲ax r̲/ (ᵐᶠs̲phereOff parallels) c̲at ᵐᶠs̲phereOff meridians
171s̲hape parallels
172s̲hape meridians
173sphereDeg
174spherePts
175"near: the chord and the great circle, p to q" ᶜʰt̲est 1 ᶜʰi̲s 0.01 > a̲bs 1.0 − (1 s̲elect sphereNearD) ÷ 2 s̲elect sphereNearD
176sphereNearD
177workedDiff
178workedSq
179workedSum
180s̲qrt workedSum
181workedPlus
182"far: the chord and the great circle, p to r" ᶜʰt̲est 1 ᶜʰi̲s 0.1 < a̲bs 1.0 − (1 s̲elect sphereFarD) ÷ 2 s̲elect sphereFarD
183sphereFarD
184"the arc from p to r is on the sphere, p first and r last" ᶜʰt̲est ((1 s̲elect spherePts) c̲at 3 s̲elect spherePts) ᶜʰn̲ear (1 s̲elect sphereFarArc) c̲at 49 s̲elect sphereFarArc
185ᵘl̲ength sphereFarArc
186
187⍝━━ The torus
188
189"intrinsic and ambient dimension" ᶜʰt̲est 2.0 3.0 ᶜʰn̲ear 3 s̲elect dims
190"the wire lines are on the torus" ᶜʰt̲est 0.0 ᶜʰn̲ear 'm̲ax r̲/ (radii ᵐᶠt̲orusOff torusRings) c̲at radii ᵐᶠt̲orusOff torusTubes
191s̲hape torusRings
192s̲hape torusTubes
193"the outer rim is longer than the inner" ᶜʰt̲est 1 ᶜʰi̲s (1 s̲elect torusRimLengths) > 2 s̲elect torusRimLengths
194torusRimLengths
195(2.0 × Pi) × 4.0 2.0
196
197⍝━━ The Swiss roll
198
199"intrinsic and ambient dimension" ᶜʰt̲est 2.0 3.0 ᶜʰn̲ear 4 s̲elect dims
200"the roll's points are t from the axis" ᶜʰt̲est (1 s̲elect₂ rollAlongTH) ᶜʰn̲ear s̲qrt ((1 s̲elect₂ rollAlong) ^ 2.0) + (3 s̲elect₂ rollAlong) ^ 2.0
201s̲hape rollAlong
202s̲hape rollAcross
203rollTH
204rollPts
205rollMap
206"near: through the air and along the sheet, a to b" ᶜʰt̲est 1 ᶜʰi̲s 0.01 > a̲bs 1.0 − (1 s̲elect rollNearD) ÷ 2 s̲elect rollNearD
207rollNearD
208"a turn apart: near through the air, far along the sheet, a to c" ᶜʰt̲est 1 ᶜʰi̲s 5.0 < (2 s̲elect rollFarD) ÷ 1 s̲elect rollFarD
209rollFarD
210
211⍝━━ The Poincare disk
212
213"intrinsic and ambient dimension" ᶜʰt̲est 2.0 2.0 ᶜʰn̲ear 5 s̲elect dims
214ruler
215"the ruler's marks are 0 to 5 from the middle" ᶜʰt̲est 0.0 1.0 2.0 3.0 4.0 5.0 ᶜʰn̲ear rulerD
216diskFar
217"near the rim: on paper and by the disk" ᶜʰt̲est 1 ᶜʰi̲s 5.0 < (2 s̲elect diskFarD) ÷ 1 s̲elect diskFarD
218diskFarD
219diskNear
220"near the middle: on paper and by the disk, about twice" ᶜʰt̲est 1 ᶜʰi̲s 0.02 > a̲bs 2.0 − (2 s̲elect diskNearD) ÷ 1 s̲elect diskNearD
221diskNearD
222"the geodesics stay inside the disk" ᶜʰt̲est 1 ᶜʰi̲s 1.0 > 'm̲ax r̲/ s̲qrt '+ r̲/₂ (diskFarGeo c̲at diskNearGeo c̲at geo1 c̲at geo2 c̲at geo3) ^ 2.0
223"the diameter is straight" ᶜʰt̲est (25 r̲eshape 0.0) ᶜʰn̲ear 2 s̲elect₂ geo1
224"the geodesic near the rim bows toward the middle" ᶜʰt̲est 1 ᶜʰi̲s (s̲qrt '+ r̲/ (13 s̲elect diskFarGeo) ^ 2.0) < s̲qrt '+ r̲/ ((1 s̲elect diskFar) + 2 s̲elect diskFar) ^ 2.0 ÷ 4.0
22513 s̲elect diskFarGeo