Skip to content

Commit 5cfb505

Browse files
phantomicsphantomics
committed
work to lazify /\
1 parent 2c75a59 commit 5cfb505

File tree

10 files changed

+189
-17
lines changed

10 files changed

+189
-17
lines changed

‎aplesque/aplesque.lisp

+2-1
Original file line numberDiff line numberDiff line change
@@ -806,7 +806,7 @@
806806
(loop :for degree :across degrees :for dx :from 0
807807
:summing (max (abs degree) (if compress-mode 0 1))
808808
:into this-dim :do (setf (aref c-degrees dx) this-dim)
809-
:finally (setq ex-dim this-dim))
809+
:finally (setq ex-dim this-dim))
810810
(let ((output (make-array (loop :for dim :in (or (dims input) '(1)) :for index :from 0
811811
:collect (if (= index axis) ex-dim dim))
812812
:element-type (if (arrayp input)
@@ -834,6 +834,7 @@
834834
(if (sub-7-bit-integer-elements-p input)
835835
(xdotimes output (i (size output))
836836
(let ((input-index (funcall indexer i)))
837+
;; (print (list :iin input-index))
837838
(if input-index (setf (row-major-aref output i)
838839
(row-major-aref input input-index)))))
839840
(ydotimes output (i (size input))

‎aplesque/forms.lisp

+13-4
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@
6363

6464
(defun indexer-expand (degrees dims axis compress-mode)
6565
"Return indices of an array expanded as with the [/ compress] or [\ expand] functions."
66+
;; (print (list :iex degrees dims axis compress-mode))
6667
(let* ((c-degrees (make-array (length degrees) :element-type 'fixnum :initial-element 0))
6768
(positive-index-list (if (not compress-mode)
6869
(loop :for degree :below (length degrees)
@@ -77,19 +78,27 @@
7778
:into this-dim :do (setf (aref c-degrees dx) this-dim))
7879
(let ((idiv-size (reduce #'* (loop :for d :in dims :for dx :from 0
7980
:when (>= dx axis) :collect d)))
80-
(odiv-size (reduce #'* (loop :for d :in dims :for dx :from 0
81-
:when (> dx axis) :collect d :when (= dx axis)
82-
:collect (aref c-degrees (1- (length degrees)))))))
81+
(odiv-size (reduce #'* (if dims (loop :for d :in dims :for dx :from 0
82+
:when (> dx axis) :collect d :when (= dx axis)
83+
:collect (aref c-degrees (1- (length degrees))))
84+
;; (loop :for d :across c-degrees :for dx :from 0
85+
;; :collect (abs d))
86+
))))
87+
;; (print (list :eee dims idiv-size odiv-size c-degrees))
8388
(lambda (i)
8489
;; in compress-mode: degrees must = length of axis,
8590
;; zeroes are omitted from output, negatives add zeroes
8691
;; otherwise: zeroes pass through, negatives add zeroes, degrees>0 must = length of axis
87-
(if dims
92+
;; (print (list :ll i))
93+
;; (setq dims (list 3))
94+
;; (setq odiv-size 6)
95+
(if t ; dims
8896
(multiple-value-bind (oseg remainder) (floor i odiv-size)
8997
(multiple-value-bind (oseg-index element-index) (floor remainder section-size)
9098
;; dimension index
9199
(let ((dx (loop :for d :across c-degrees :for di :from 0
92100
:when (> d oseg-index) :return di)))
101+
;; (print (list :dd dx oseg oseg-index section-size odiv-size))
93102
(if (< 0 (aref degrees dx))
94103
(+ element-index (* oseg idiv-size)
95104
(* section-size (if (not positive-indices)

‎demos/cnn/#package.lisp#

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Coding:utf-8; Package:AprilDemo.Cnn -*-
2+
;;;; package.lispx
3+
4+
(defpackage #:april-demo.cnn
5+
(:use #:cl #:april #:lisp-binary))

‎demos/cnn/.#package.lisp

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
[email protected]:1649572098

‎libraries/dfns/array/array.apl

+1-1
Original file line numberDiff line numberDiff line change
@@ -154,7 +154,7 @@ display ← { ⎕IO←0 ⍝ Boxed display of array.
154154
deco←{⍺←type open ⍵ ⋄ ⍺,axes ⍵} ⍝ type and axes vector
155155
axes←{(-2⌈⍴⍴⍵)↑1+×⍴⍵} ⍝ array axis types
156156
open←{(1⌈⍴⍵)⍴⍵} ⍝ exposure of null axes
157-
trim←{(~1 1⍷∧⌿⍵=' ')/⍵} ⍝ removal of extra blank cols
157+
trim←{(~1 1⍷∧⌿⍵=' ')/⎕←⍵} ⍝ removal of extra blank cols
158158
char←{⍬≡⍴⍵:'─' ⋄ (⊃⍵∊'¯',⎕D)⊃'#~'}∘⍕ ⍝ simple scalar type
159159
type←{{(1=⍴⍵)⊃'+'⍵}∪,char¨⍵} ⍝ simple array type
160160
line←{(49=⎕DT 1⍴⍵)⊃' -'} ⍝ underline for atom

‎spec.lisp

+14-2
Original file line numberDiff line numberDiff line change
@@ -991,7 +991,13 @@
991991
(is "2 1 1 2 3 3 2⍉3 2 3 4 2 4 3⍴⍳1728"
992992
#3A(((1 16) (602 617) (1203 1218)) ((385 400) (986 1001) (1587 1602))))))
993993
(/ (has :title "Replicate")
994-
(dyadic (expand-array nil t index-origin axes))
994+
(dyadic (expand-array nil t index-origin axes)
995+
;; (funcall (lambda (n io &optional axes)
996+
;; (lambda (omega alpha)
997+
;; (make-instance 'vader-expand :base omega :argument alpha :index-origin io
998+
;; :inverse t :axis (or (first axes) :last))))
999+
;; nil index-origin axes)
1000+
)
9951001
(meta (primary :axes axes :implicit-args (index-origin))
9961002
(dyadic :on-axis :last
9971003
:inverse (λωαχ (if (is-unitary omega)
@@ -1053,7 +1059,13 @@
10531059
(1 0 0 3 3 3 0 0 0 0 5 5 5 5 5)
10541060
(1 0 0 3 3 3 0 0 0 0 5 5 5 5 5)))))
10551061
(\\ (has :title "Expand")
1056-
(dyadic (expand-array nil nil index-origin axes))
1062+
(dyadic (expand-array nil nil index-origin axes)
1063+
;; (funcall (lambda (n io &optional axes)
1064+
;; (lambda (omega alpha)
1065+
;; (make-instance 'vader-expand :base omega :argument alpha :index-origin io
1066+
;; :axis (or (first axes) :last))))
1067+
;; nil index-origin axes)
1068+
)
10571069
(meta (primary :axes axes :implicit-args (index-origin))
10581070
(dyadic :on-axis :last))
10591071
(tests (is "4\\2" #(2 2 2 2))

‎varray/#package.lisp#

+10
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
;;;; package.lisp
2+
3+
(defpackage #:varray
4+
(:use #:cl)
5+
(:export #:varray #:varrayp #:etype-of #:shape-of #:rank-of #:indexer-of #:render
6+
#:vvector-integer-progression
7+
#:vader-shape #:vader-reshape #:vader-section #:vader-expand #:vader-turn)
8+
(:shadowing-import-from #:aplesque #:enclose #:disclose #:disclose-unitary
9+
#:assign-element-type #:type-in-common #:apl-array-prototype)
10+
(:shadowing-import-from #:aplesque.forms #:indexer-sectxion #:indexer-expand #:indexer-turn #:indexer-permute))

‎varray/.#package.lisp

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
[email protected]:1649572098

‎varray/package.lisp

+3-3
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
(:use #:cl)
55
(:export #:varray #:varrayp #:etype-of #:shape-of #:rank-of #:indexer-of #:render
66
#:vvector-integer-progression
7-
#:vader-shape #:vader-reshape #:vader-section #:vader-turn)
8-
(:shadowing-import-from #:aplesque #:enclose #:disclose #:assign-element-type #:type-in-common
9-
#:apl-array-prototype)
7+
#:vader-shape #:vader-reshape #:vader-section #:vader-expand #:vader-turn)
8+
(:shadowing-import-from #:aplesque #:enclose #:disclose #:disclose-unitary
9+
#:assign-element-type #:type-in-common #:apl-array-prototype)
1010
(:shadowing-import-from #:aplesque.forms #:indexer-section #:indexer-expand #:indexer-turn #:indexer-permute))

‎varray/varray.lisp

+139-6
Original file line numberDiff line numberDiff line change
@@ -43,14 +43,18 @@
4343
"The default prototype for a virtual array is 0."
4444
0)
4545

46-
(defmethod etype-of ((varray varray))
47-
"The default element type for a virtual array is T."
48-
't)
46+
(defmethod etype-of ((item t))
47+
"A literal array's element type is returned by the (array-element-type) function."
48+
(assign-element-type item))
4949

5050
(defmethod etype-of ((array array))
5151
"A literal array's element type is returned by the (array-element-type) function."
5252
(array-element-type array))
5353

54+
(defmethod etype-of ((varray varray))
55+
"The default element type for a virtual array is T."
56+
't)
57+
5458
(defmethod shape-of ((_ t))
5559
"Non-arrays have a nil shape."
5660
(declare (ignore _))
@@ -106,8 +110,8 @@
106110
output))
107111
(let ((output (make-array (shape-of varray) :element-type (etype-of varray))))
108112
(dotimes (i (array-total-size output))
109-
(setf (row-major-aref output i)
110-
(funcall indexer i)))
113+
(let ((indexed (funcall indexer i)))
114+
(if indexed (setf (row-major-aref output i) indexed))))
111115
output))
112116
(funcall indexer 1))))
113117

@@ -354,8 +358,137 @@
354358
(funcall base-indexer indexed))
355359
(prototype-of (vader-base varray))))))))
356360

361+
(defclass vader-expand (varray-derived vad-on-axis vad-with-io vad-with-argument vad-invertable)
362+
nil (:documentation "An expanded (as from [\ expand]) or compressed (as from [/ compress]) array."))
357363

358-
(defclass vader-meta-scalar-pass (varray-derived) nil)
364+
(defmethod prototype-of ((varray vader-expand))
365+
(let ((indexer (indexer-of (vader-base varray))))
366+
;; TODO: remove-disclose when [⍴ shape] is virtually implemented
367+
(aplesque::make-empty-array (disclose (if (not (functionp indexer))
368+
indexer ;; ←← remove
369+
(funcall (indexer-of (vader-base varray)) 0))))))
370+
371+
(defmethod shape-of ((varray vader-expand))
372+
"The shape of an expanded or compressed array."
373+
;; (print (list :vv (shape-of (vads-argument varray))))
374+
(get-or-assign-shape
375+
varray
376+
(let* ((degrees-count (first (shape-of (vads-argument varray))))
377+
(degrees (setf (vads-argument varray)
378+
(funcall (lambda (i)
379+
(if (arrayp i)
380+
i (vector i)))
381+
(render (vads-argument varray)))))
382+
(base-shape (copy-list (shape-of (vader-base varray))))
383+
(base-rank (length base-shape))
384+
(is-inverse (vads-inverse varray))
385+
(axis (setf (vads-axis varray)
386+
(max 0 (- (if (eq :last (vads-axis varray))
387+
base-rank (vads-axis varray))
388+
(vads-io varray))))))
389+
390+
;; (print (list :br degrees-count is-inverse base-shape base-rank axis (vads-axis varray)
391+
;; (vader-base varray)))
392+
393+
(cond ((and base-shape (zerop (reduce #'* base-shape)))
394+
;; (print :ee)
395+
(if is-inverse
396+
(if (> axis (1- base-rank))
397+
(error "This array does not have an axis ~a." axis)
398+
(if (or (not (arrayp degrees))
399+
(or (not degrees-count)
400+
(= 1 degrees-count)))
401+
(loop :for d :in base-shape :for dx :from 0
402+
:collect (if (= dx axis) (* d (disclose-unitary degrees)) d))
403+
(if (not degrees-count)
404+
(loop :for d :below base-rank :for dx :from 0
405+
:collect (if (= dx axis) 0 d))
406+
(if (and degrees-count (/= degrees-count (nth axis base-shape)))
407+
(error "Compression degrees must equal size of array in dimension to compress.")
408+
(let ((output-size (loop :for d :below degrees-count
409+
:summing (if (not (arrayp degrees))
410+
degrees (aref degrees d)))))
411+
(loop :for d :in base-shape :for dx :from 0
412+
:collect (if (= dx axis) output-size d)))))))
413+
(if (or (not degrees-count)
414+
(= 1 degrees-count)
415+
(not (arrayp degrees)))
416+
(list (if (and (= 1 base-rank)
417+
(zerop (if (not (arrayp degrees))
418+
degrees (aref degrees 0))))
419+
1 (abs (if (not (arrayp degrees))
420+
degrees (aref degrees 0)))))
421+
(if (and (loop :for d :across degrees :always (zerop d))
422+
(zerop (nth axis base-shape)))
423+
(if (= 1 base-rank) (list degrees-count)
424+
(loop :for d :in base-shape :for dx :from 0
425+
:collect (if (= dx axis) degrees-count d)))
426+
(error "An empty array can only be expanded to a single negative degree ~a"
427+
"or to any number of empty dimensions.")))))
428+
((and (not is-inverse)
429+
(or (and (not (arrayp degrees))
430+
(zerop degrees))
431+
(and degrees-count (= 1 degrees-count)
432+
(zerop (aref degrees 0)))))
433+
;; (print :ff)
434+
(append (butlast base-shape) (list 0)))
435+
((and (not base-shape)
436+
(not (arrayp degrees)))
437+
;; (print :gg)
438+
(setf (vads-argument varray) (list (abs degrees))))
439+
((and is-inverse base-shape degrees-count (< 1 degrees-count)
440+
(nth axis base-shape)
441+
(/= degrees-count (nth axis base-shape)))
442+
(error "Attempting to replicate elements across array but ~a"
443+
"degrees are not equal to length of selected input axis."))
444+
((and (not is-inverse)
445+
base-shape (< 1 (reduce #'* base-shape))
446+
(nth axis base-shape)
447+
(/= (or (and (arrayp degrees)
448+
(loop :for degree :across degrees :when (< 0 degree)
449+
:counting degree :into dcount :finally (return dcount)))
450+
degrees)
451+
(nth axis base-shape)))
452+
(error "Attempting to expand elements across array but ~a"
453+
"positive degrees are not equal to length of selected input axis."))
454+
(t (let* ((degrees (if (and (arrayp degrees)
455+
(not (= 1 (length degrees))))
456+
degrees (setf (vads-argument varray)
457+
(make-array (or (nth axis base-shape) 1)
458+
:element-type 'fixnum
459+
:initial-element (disclose-unitary degrees)))))
460+
(c-degrees (make-array (length degrees)
461+
:element-type 'fixnum :initial-element 0))
462+
(ex-dim))
463+
;; (print (list :gg degrees c-degrees))
464+
(if t ;; (or (not (arrayp degrees))
465+
;; (= 1 degrees-count))
466+
;; (setq ex-dim (* (nth axis base-shape)
467+
;; (abs (disclose-unitary degrees))))
468+
(loop :for degree :across degrees :for dx :from 0
469+
:summing (max (abs degree) (if is-inverse 0 1)) :into this-dim
470+
:do (setf (aref c-degrees dx) this-dim)
471+
:finally (setq ex-dim this-dim)))
472+
;; (print (list :ee ex-dim))
473+
(loop :for dim :in (or base-shape '(1)) :for index :from 0
474+
:collect (if (/= index axis) dim (* 1 ex-dim)))))))))
475+
476+
(defmethod indexer-of ((varray vader-expand))
477+
(let ((base-indexer (indexer-of (vader-base varray)))
478+
(indexer (indexer-expand (coerce (vads-argument varray) 'vector)
479+
(shape-of (vader-base varray))
480+
(vads-axis varray)
481+
(vads-inverse varray))))
482+
;; (PRINT (LIST :ss (shape-of varray)))
483+
(lambda (index)
484+
;; (print (list :iin base-indexer (funcall indexer index) indexer))
485+
(if (not (functionp base-indexer))
486+
(if (funcall indexer index)
487+
(disclose base-indexer))
488+
(let ((indexed (funcall indexer index)))
489+
(if indexed (funcall base-indexer indexed)))))))
490+
491+
;; (defclass vader-meta-scalar-pass (varray-derived) nil)
359492

360493
(defclass vader-turn (varray-derived vad-on-axis vad-with-io vad-with-argument)
361494
nil (:documentation "A rotated array as from the [⌽ rotate] function."))

0 commit comments

Comments
 (0)