Skip to content

Commit ac20c2b

Browse files
phantomicsphantomics
committed
work toward composable ↑↓
1 parent cc9c15d commit ac20c2b

File tree

3 files changed

+132
-161
lines changed

3 files changed

+132
-161
lines changed

‎libraries/dfns/numeric/numeric.apl

+7-7
Original file line numberDiff line numberDiff line change
@@ -366,12 +366,12 @@ NormRand ← { ⍝ Random numbers with a normal
366366
⍝ TODO: Loose comparison tolerance is needed here, why?
367367
phinary ← { ⎕IO ⎕CT←0 0.001 ⍝ Phinary representation of numbers ⍵.
368368
⍺←1 ⍝ result formatted by default.
369-
P←(1+5*÷2)÷2 ⍝ Phi.
369+
Ø←(1+5*÷2)÷2 ⍝ Phi.
370370
$[''≡0/∊⍵;{ ⍝ char array: inverse: phinary → decimal.
371371
1<|≡⍵:∇¨⍵ ⍝ nested: decode each.
372372
'¯'=⊃⍵:-∇ 1↓⍵ ⍝ -ive: negation of inverse of +ive.
373-
a←P⊥⎕D⍳⍵~'.' ⍝ phi decode of ⍵.
374-
a÷P*(≢⍵∪'.')-1+(,⍵)⍳'.' ⍝ adjusted by posn of phinary point.
373+
a←Ø⊥⎕D⍳⍵~'.' ⍝ phi decode of ⍵.
374+
a÷Ø*(≢⍵∪'.')-1+(,⍵)⍳'.' ⍝ adjusted by posn of phinary point.
375375
}⍵; ⍝ ⍵ is char vect phinary number.
376376
0≠≡⍵;⍺ ∇¨⍵; ⍝ higher rank, depth: encode each.
377377
⍵<0;'¯',⍺ ∇-⍵; ⍝ negative.
@@ -387,11 +387,11 @@ phinary ← { ⎕IO ⎕CT←0 0.001 ⍝ Phinary representation
387387
(fmt lft),'.',fmt rgt ⍝ both: point-separated digits.
388388
]
389389
}⍬{ ⍝ accumulated powers of phi.
390-
num=P+.*⍺:⍺ ⍝ convergence: done.
390+
num=Ø+.*⍺:⍺ ⍝ convergence: done.
391391
∆←(-⍴⍺)↑1 ⍝ delta (1 in least sig place)
392-
num=P+.*⍺+∆:⍺+∆ ⍝ (⍺+∆) convergence: done.
393-
k←⌊P⍟⍵ ⍝ next power of phi.
394-
(⍺,k)∇ ⍵-P*k ⍝ accumlated powers of phi.
392+
num=Ø+.*⍺+∆:⍺+∆ ⍝ (⍺+∆) convergence: done.
393+
k←⌊Ø⍟⍵ ⍝ next power of phi.
394+
(⍺,k)∇ ⍵-Ø*k ⍝ accumlated powers of phi.
395395
}⍵
396396
]
397397
}

‎varray/setup.lisp

+40-47
Original file line numberDiff line numberDiff line change
@@ -61,9 +61,9 @@
6161

6262
(when (member var-type '(:cindex-width))
6363
(setf (getf sub-params :coordinate-width) width))
64-
;; these variable types impose a width limit on subordinate variables;
65-
;; i.e. the sub-byte values of an integer must be half or less of
66-
;; that integer's width
64+
;; these variable types impose a width limit on subordinate
65+
;; variables; i.e. the sub-byte values of an integer must
66+
;; be half or less of that integer's width
6767
(process-var-range
6868
form (cddr vars) sub-params
6969
(if (not (member var-type '(:lindex-width :eindex-width
@@ -81,24 +81,18 @@
8181
(setf ,@output)
8282
,table))))
8383

84-
(defun indexer-section (inverse dims dimensions output-shorter span padding)
84+
(defun indexer-section (inverse dims output-shorter span padding)
8585
"Return indices of an array sectioned as with the [↑ take] or [↓ drop] functions."
8686
;; (print (list :is inverse dims dimensions output-shorter span padding))
8787
(let* ((scalar (not dims))
8888
(dims (or dims '(1)))
8989
(isize (reduce #'* dims)) (irank (length dims))
90-
(rdiff (- irank (length dimensions)))
9190
(idims (make-array irank :element-type (if (zerop isize) t (list 'integer 0 isize))
9291
:initial-contents dims))
93-
;; (odims (loop :for odim :across dimensions :for idim :across idims
94-
;; :collect (if (not inverse) (abs odim) (- idim (abs odim)))))
95-
(odims (if (and span (not scalar))
96-
(loop :for ix :below irank :for sp :across span
97-
:collect (+ (- sp) (aref span (+ ix irank))
98-
(aref padding ix)
99-
(aref padding (+ ix irank))))
100-
(loop :for odim :across dimensions :for idim :across idims
101-
:collect (if (not inverse) (abs odim) (- idim (abs odim))))))
92+
(odims (loop :for ix :below irank :for sp :across span
93+
:collect (+ (- sp) (aref span (+ ix irank))
94+
(aref padding ix)
95+
(aref padding (+ ix irank)))))
10296
(osize (reduce #'* odims))
10397
(last-dim)
10498
(id-factors (make-array irank :element-type 'fixnum))
@@ -119,51 +113,51 @@
119113
;; choose shorter path depending on whether input or output are larger, and
120114
;; always iterate over output in the case of sub-7-bit arrays as this is necessary
121115
;; to respect the segmentation of the elements
122-
(lambda (i)
116+
(lambda (i) ;; x←4 5⍴⍳20 ⋄ (2 3↓x)←0 ⋄ x
123117
(let ((oindex 0) (remaining i) (valid t))
124118
;; calculate row-major offset for outer array dimensions
125-
(loop :for i :from 0 :to (- irank 1) :while valid
126-
:for dim :across dimensions :for id :across idims :for od :in odims
119+
(loop :for i :below irank :while valid :for id :across idims :for od :in odims
127120
:for ifactor :across id-factors :for ofactor :across od-factors
128121
:do (multiple-value-bind (index remainder) (floor remaining ifactor)
129-
(let ((adj-index (- index (if inverse (if (> 0 dim) 0 dim)
130-
(if (< 0 dim) 0 (+ dim id))))))
122+
(let ((adj-index (+ (if padding (aref padding i) 0) ;; TODO: OPTIMIZE, SLOW
123+
(- index (if span (aref span i) 0)))))
131124
(setf valid (when (< -1 adj-index od)
132125
(incf oindex (* ofactor adj-index))
133126
(setq remaining remainder))))))
134127
(when valid oindex)))
135128
(lambda (i)
136129
(let ((iindex 0) (remaining i) (valid t))
137130
;; calculate row-major offset for outer array dimensions
138-
(loop :for i :from 0 :to (- irank 1) :while valid
139-
:for dim :across dimensions :for id :across idims :for od :in odims
131+
(loop :for i :below irank :while valid :for id :across idims
140132
:for ifactor :across id-factors :for ofactor :across od-factors
141133
:do (multiple-value-bind (index remainder) (floor remaining ofactor)
142-
(let ((adj-index (+ index (if inverse (if (> 0 dim) 0 dim)
143-
(if (< 0 dim) 0 (+ dim id)))))
144-
;; (adj-index (- index (aref padding i)))
145-
)
146-
;; (print (list :sp index span padding id adj-index (+ irank i)))
147-
(setf valid (when ;; (< -1 adj-index (aref span (+ irank i)))
148-
(< -1 adj-index id)
134+
(let ((adj-index (+ (if span (aref span i) 0) ;; TODO: OPTIMIZE, SLOW
135+
(- index (if padding (aref padding i) 0)))))
136+
;; (print (list :sp adj-index (- adj-index (aref padding i)) id (+ irank i)
137+
;; span padding id (+ irank i) idims))
138+
(setf valid (when (< -1 adj-index id)
149139
(incf iindex (* ifactor adj-index))
150140
(setq remaining remainder))))))
151141
(when valid iindex))))))
152142

153143
;; (defun indexer-section (inverse dims dimensions output-shorter span padding)
154144
;; "Return indices of an array sectioned as with the [↑ take] or [↓ drop] functions."
155-
;; ;; (print (list :is inverse dims dimensions output-shorter))
156-
;; (let* ((isize (reduce #'* dims)) (irank (length dims))
145+
;; ;; (print (list :is inverse dims dimensions output-shorter span padding))
146+
;; (let* ((scalar (not dims))
147+
;; (dims (or dims '(1)))
148+
;; (isize (reduce #'* dims)) (irank (length dims))
157149
;; (rdiff (- irank (length dimensions)))
158150
;; (idims (make-array irank :element-type (if (zerop isize) t (list 'integer 0 isize))
159151
;; :initial-contents dims))
160152
;; ;; (odims (loop :for odim :across dimensions :for idim :across idims
161153
;; ;; :collect (if (not inverse) (abs odim) (- idim (abs odim)))))
162-
;; (odims (loop :for ix :below irank
163-
;; :collect (+ (aref span (+ ix irank))
164-
;; (- (aref span ix))
165-
;; (aref padding ix)
166-
;; (aref padding (+ ix irank)))))
154+
;; (odims (if (and span (not scalar))
155+
;; (loop :for ix :below irank :for sp :across span
156+
;; :collect (+ (- sp) (aref span (+ ix irank))
157+
;; (aref padding ix)
158+
;; (aref padding (+ ix irank))))
159+
;; (loop :for odim :across dimensions :for idim :across idims
160+
;; :collect (if (not inverse) (abs odim) (- idim (abs odim))))))
167161
;; (osize (reduce #'* odims))
168162
;; (last-dim)
169163
;; (id-factors (make-array irank :element-type 'fixnum))
@@ -179,40 +173,39 @@
179173
;; :do (setf (aref od-factors (- irank 1 dx))
180174
;; (if (zerop dx) 1 (* last-dim (aref od-factors (- irank dx))))
181175
;; last-dim d))
182-
;; ;; (print (list :pad span padding odims id-factors od-factors dimensions output-shorter))
176+
;; ;; (print (list :pad odims irank dims span padding idims odims id-factors od-factors dimensions))
183177
;; (if output-shorter
184178
;; ;; choose shorter path depending on whether input or output are larger, and
185179
;; ;; always iterate over output in the case of sub-7-bit arrays as this is necessary
186180
;; ;; to respect the segmentation of the elements
187181
;; (lambda (i)
188182
;; (let ((oindex 0) (remaining i) (valid t))
189183
;; ;; calculate row-major offset for outer array dimensions
190-
;; (loop :for i :from 0 :to (1- irank) :while valid
184+
;; (loop :for i :below irank :while valid
191185
;; :for dim :across dimensions :for id :across idims :for od :in odims
192186
;; :for ifactor :across id-factors :for ofactor :across od-factors
193187
;; :do (multiple-value-bind (index remainder) (floor remaining ifactor)
194-
;; (let (;; (adj-index (- index (if inverse (if (> 0 dim) 0 dim)
195-
;; ;; (if (< 0 dim) 0 (+ dim id)))))
196-
;; (adj-index (- index (aref padding i)))
197-
;; )
198-
;; (setf valid (when (< -1 adj-index (aref span (+ irank i)))
188+
;; (let ((adj-index (- index (if inverse (if (> 0 dim) 0 dim)
189+
;; (if (< 0 dim) 0 (+ dim id))))))
190+
;; (setf valid (when (< -1 adj-index od)
199191
;; (incf oindex (* ofactor adj-index))
200192
;; (setq remaining remainder))))))
201193
;; (when valid oindex)))
202194
;; (lambda (i)
203195
;; (let ((iindex 0) (remaining i) (valid t))
204196
;; ;; calculate row-major offset for outer array dimensions
205-
;; (loop :for i :from 0 :to (1- irank) :while valid
197+
;; (loop :for i :below irank :while valid
206198
;; :for dim :across dimensions :for id :across idims :for od :in odims
207199
;; :for ifactor :across id-factors :for ofactor :across od-factors
208200
;; :do (multiple-value-bind (index remainder) (floor remaining ofactor)
209201
;; (let (;; (adj-index (+ index (if inverse (if (> 0 dim) 0 dim)
210202
;; ;; (if (< 0 dim) 0 (+ dim id)))))
211-
;; (adj-index (- index (aref padding i)))
203+
;; (adj-index (+ (if span (aref span i) 0) ;; TODO: OPTIMIZE, SLOW
204+
;; (- index (if padding (aref padding i) 0))))
212205
;; )
213-
;; ;; (print (list :adj adj-index))
214-
;; (setf valid (when (< -1 adj-index (aref span (+ irank i)))
215-
;; ;; (< -1 adj-index id)
206+
;; ;; (print (list :sp index adj-index dim id span padding id (+ irank i) idims))
207+
;; (setf valid (when ;; (< -1 adj-index (aref span (+ irank i)))
208+
;; (< -1 adj-index id)
216209
;; (incf iindex (* ifactor adj-index))
217210
;; (setq remaining remainder))))))
218211
;; (when valid iindex))))))

0 commit comments

Comments
 (0)