work to lazify /⌿ operator

Author: phantomics

libraries/dfns/graph/demo.lisp

@@ -53,22 +53,22 @@
          (provision "scg1 ← ,¨1(2 4 5)(3 6)(2 7)(0 5)6 5(3 6)")
          (provision "scg2 ← ,¨4 0(1 3)2 1(1 4 6)(2 5)(3 6 7)")
          (provision "scg3 ← (3)(4)(3 4)(0 2 4)(1 2 3)")
-         (is "↓show scg1" #("1 → 1    " "2 → 2 4 5" "3 → 3 6  " "4 → 2 7  "
-                            "5 → 0 5  " "6 → 6    " "7 → 5    " "8 → 3 6  "))
-         (is "{⎕io←0 ⋄ scc ⍵} scg1" #(0 0 1 1 0 2 2 1))
-         (is "↓show scg2" #("1 → 4    " "2 → 0    " "3 → 1 3  " "4 → 2    "
-                            "5 → 1    " "6 → 1 4 6" "7 → 2 5  " "8 → 3 6 7"))
-         (is "{⎕io←0 ⋄ scc ⍵} scg2" #(0 0 1 1 0 2 2 3))
-         (is "{⎕io←0 ⋄ scc ⍵} scg3" #(0 0 0 0 0))
-         (is "{⎕io←0 ⋄ ↑∪scc¨{⍵∘gperm¨↓pmat ≢⍵} ⍵} scg3" #2A((0 0 0 0 0)))
-         (is "scc scg1+1" #(1 1 2 2 1 3 3 2))
-         (is "scc scg2+1" #(1 1 2 2 1 3 3 4))
-         (is "scc 1⌽⍳10" #(1 1 1 1 1 1 1 1 1 1))
-         (is "scc ⍳10" #(1 2 3 4 5 6 7 8 9 10))
-         (is "scc 2⌽⍳10" #(1 2 1 2 1 2 1 2 1 2))
-         (is "cond scg1+1" #(#(#(2 3) #(3) #()) #(#(1 2 5) #(3 4 8) #(6 7))))
-         (is "(scc≡⍳∘≢) scg1+1" 0)
-         (is "(scc≡⍳∘≢) (⍳10),⊂⍬" 1)
+         ;; (is "↓show scg1" #("1 → 1    " "2 → 2 4 5" "3 → 3 6  " "4 → 2 7  "
+         ;;                    "5 → 0 5  " "6 → 6    " "7 → 5    " "8 → 3 6  "))
+         ;; (is "{⎕io←0 ⋄ scc ⍵} scg1" #(0 0 1 1 0 2 2 1))
+         ;; (is "↓show scg2" #("1 → 4    " "2 → 0    " "3 → 1 3  " "4 → 2    "
+         ;;                    "5 → 1    " "6 → 1 4 6" "7 → 2 5  " "8 → 3 6 7"))
+         ;; (is "{⎕io←0 ⋄ scc ⍵} scg2" #(0 0 1 1 0 2 2 3))
+         ;; (is "{⎕io←0 ⋄ scc ⍵} scg3" #(0 0 0 0 0))
+         ;; (is "{⎕io←0 ⋄ ↑∪scc¨{⍵∘gperm¨↓pmat ≢⍵} ⍵} scg3" #2A((0 0 0 0 0)))
+         ;; (is "scc scg1+1" #(1 1 2 2 1 3 3 2))
+         ;; (is "scc scg2+1" #(1 1 2 2 1 3 3 4))
+         ;; (is "scc 1⌽⍳10" #(1 1 1 1 1 1 1 1 1 1))
+         ;; (is "scc ⍳10" #(1 2 3 4 5 6 7 8 9 10))
+         ;; (is "scc 2⌽⍳10" #(1 2 1 2 1 2 1 2 1 2))
+         ;; (is "cond scg1+1" #(#(#(2 3) #(3) #()) #(#(1 2 5) #(3 4 8) #(6 7))))
+         ;; (is "(scc≡⍳∘≢) scg1+1" 0)
+         ;; (is "(scc≡⍳∘≢) (⍳10),⊂⍬" 1)
          (is "stdists¨g∘span¨⍳⍴g" #(#(0 1 1 2 3) #(3 0 1 2 3) #(2 1 0 1 2) #(1 2 2 0 1) #(3 2 1 2 0)))
          (is "(g span 3)∘stpath¨⍳5" #(#(3 4 1) #(3 2) #(3) #(3 4) #(3 4 5)))
          (is "(g∘span¨⍳⍴g)∘.stpath⍳⍴g"

libraries/dfns/numeric/april-lib.dfns.numeric.asd

@@ -5,7 +5,7 @@
   :author "Andrew Sengul"
   :license "Apache-2.0"
   :serial t
-  :depends-on ("april")
+  :depends-on ("april" "april-lib.dfns.graph")
   :components ((:file "package")
                (:file "setup")
                (:file "demo")))

libraries/dfns/numeric/numeric.apl

@@ -1,6 +1,11 @@
 ⍝⍝ Ported from http://dfns.dyalog.com/n_contents.htm into April APL
 
 
+⍝⍝ External dependencies
+
+path ← 'GRAPH-LIB-SPACE' ⎕XWF 'path'
+
+
 ⍝⍝ Whole number processing
 
 ⍝ From http://dfns.dyalog.com/c_adic.htm
@@ -192,23 +197,6 @@ roman ← {                                    ⍝ Roman numeral arithmetic.
   fmts(⌊nums ⍺)⍺⍺ ⌊nums ⍵                    ⍝ dyadic operand function.
 }
 
-⍝ From http://dfns.dyalog.com/n_path.htm
-
-path ← {                                     ⍝ Shortest path from/to ⍵ in graph ⍺.
-  graph(fm tto)←⍺ ⍵                          ⍝ graph and entry/exit vertex vectors
-  fm{                                        ⍝ fm is the starting-from vertex
-    ⍺≡⍬:⍬                                    ⍝ no vertices left: no path
-    ∨/tto∊⍺:⍬(⊃∘⍵){                          ⍝ found target: path from tree:
-      ⍵<0:⍺                                  ⍝ root: finished
-      (⍵,⍺)∇ ⍺⍺ ⍵                            ⍝ accumulated path to next vertex
-    }1↑⍺∩tto                                 ⍝ found vertex ⍺
-    next←graph[⍺]∩¨⊂⍸⍵=¯2                    ⍝ next vertices to visit
-    back←⊃,/⍺+0×next                         ⍝ back links
-    wave←⊃,/next                             ⍝ vertex wave front
-    (∪wave)∇ back@wave⊢⍵                     ⍝ advanced wave front
-  }¯2+(⍳⍴⍺)∊fm                               ⍝ null spanning tree
-}
-
 ⍝ From http://dfns.dyalog.com/c_stamps.htm
 
 stamps ← {                                   ⍝ Postage stamps to the value of ⍵.

libraries/dfns/numeric/package.lisp

@@ -2,4 +2,4 @@
 ;;;; package.lisp
 
 (defpackage #:april-lib.dfns.numeric
-  (:use #:cl #:april #:april.demo-definition-tools))
+  (:use #:cl #:april #:april.demo-definition-tools #:april-lib.dfns.graph))

spec.lisp

@@ -618,7 +618,7 @@
                                         :index-origin index-origin
                                         :axis (or (first axes) :last))))
       (meta (primary :axes axes :implicit-args (index-origin) :virtual-support t)
-            (dyadic :on-axis :last))
+            (dyadic :on-axis :last :id #()))
       (tests (is ",5" #(5))
              (is ",3 4⍴⍳9" #(1 2 3 4 5 6 7 8 9 1 2 3))
              (is ",↓⍬,9" #(#(9)))
@@ -1338,7 +1338,8 @@
                 ;;          '(:axis))
                 (values `(op-compose 'vacomp-reduce :left (sub-lex ,operand)
                                                     :index-origin index-origin)
-                        '(:axis))))
+                        '(:axis))
+                ))
      (tests (is "+/1 2 3 4 5" 15)
             (is "⊢/⍳5" 5)
             (is "×/5" 5)

utilities.lisp

@@ -40,7 +40,7 @@
   '(april-lib.dfns.array april-lib.dfns.string april-lib.dfns.power
     ;; tree library is disabled for ABCL, Lispworks because its large functions cannot be
     ;; compiled using the JVM, while the functions cause LispWorks to freeze
-    #+(not (or abcl lispworks)) april-lib.dfns.tree
+    ;; #+(not (or abcl lispworks)) april-lib.dfns.tree
     april-lib.dfns.graph april-lib.dfns.numeric))
 
 (defvar ∇ nil)
@@ -115,7 +115,8 @@
                                                                   (getf ,this-meta :lexical-reference))
                                                          (list nil))
                                                  (when (not (getf ,this-meta :lexical-reference))
-                                                   (list (list :index-origin index-origin)))))))))))
+                                                   (list (list :fn-params
+                                                               :index-origin index-origin)))))))))))
 
 (let ((this-package (package-name *package*)))
   (defmacro in-april-workspace (name &body body)
@@ -253,7 +254,7 @@
                                 (loop :for (key val) :on *system-variables* :by #'cddr
                                       :collect (list (first (push (find-symbol (string val) space)
                                                                   vals-list))
-                                                     `(or (getf ,env ,(intern (string key) "KEYWORD"))
+                                                     `(or (getf (rest ,env) ,(intern (string key) "KEYWORD"))
                                                           ,(find-symbol (string val) space)))))
                         (declare (ignorable ,@vals-list))
                         ,@body))))
@@ -647,7 +648,10 @@
           ;; handle assignment of ⍺ or ⍵; ⍺-assignment sets its default value if no right argument is
           ;; present; ⍵-assignment is an error. This is handled below for strand assignments.
           (cond (axes (enclose-axes symbol axes :set value :set-by by))
-                ((eql '⍺ symbol) `(or ⍺ (setf ⍺ ,set-to)))
+                ((eql '⍺ symbol) `(or (and (or (not (listp ⍺))
+                                               (not (eql :fn-params (first ⍺))))
+                                           ⍺)
+                                      (setf ⍺ ,set-to)))
                 ((eql '⍵ symbol) `(error "The [⍵ right argument] cannot have a default assignment."))
                 ((string= "*RNGS*" (string symbol))
                  (let ((valsym (gensym)) (seed (gensym))