diff options
Diffstat (limited to 'src')
| -rwxr-xr-x | src/pr.bqn | 2 | ||||
| -rw-r--r-- | src/r.bqn | 136 |
2 files changed, 74 insertions, 64 deletions
@@ -34,7 +34,7 @@ names ↩ (⥊¨kt⊏chr)⌾(ki⊸⊏)names E_isdef ← (3≤≠)◶⟨0,∧´⟨chr," ","←↩"⟩∊˜¨3⊸↑⟩ E_proc ← ({𝕨∘𝕩}´ {𝕨•_R_𝕩}⟜⥊¨⟜(≠↑chr˜) def)∘{ l←≠chr - q←≠`𝕩∊"""'" ⋄ f←¬∨`q¬⊸∧𝕩='#' + q←≠`𝕩='"' ⋄ q∨↩≠`q<𝕩=''' ⋄ f←¬∨`q<𝕩='#' ∾ (((l×f/q)+chr⊸⊐) (≥⟜l)◶⟨⊑⟜names,⥊∘⊢⟩¨ ⊢) f/𝕩 } E_redef ← { # handles [fmd] [←↩] @@ -22,7 +22,7 @@ Nat←IsArray◶⟨0⊸≤×⌊⊸=,0⟩ ≠ ← (0<=)◶⟨1⋄0⊑≢⟩ # LIMITED to monadic case _fold←{ - ! 1==𝕩 + "Argument to fold must be a list" ! 1==𝕩 l←≠v←𝕩 ⋄ F←𝔽 r←𝕨 (0<l)◶{𝕩⋄Identity f}‿{l↩l-1⋄l⊑𝕩}⊘⊣ 𝕩 {r↩(𝕩⊑v)F r}⌜(l-1)⊸-⌜↕l @@ -38,12 +38,12 @@ Cell←{(𝕨⊸+⊑𝕩˜)⌜↕(≠𝕩)-𝕨}⟜≢ _eachd←{ _d←{ # Equal ranks p←≢𝕨 - ! 1(⊑⟜p=⊑⟜(≢𝕩))⊸×´↕=𝕨 + "Equal-rank argument shapes don't agree" ! 1(⊑⟜p=⊑⟜(≢𝕩))⊸×´↕=𝕨 p⥊ (⊑⟜(⥊𝕨)𝔽⊑⟜(⥊𝕩))⌜↕1×´p } _e←{ # 𝕨 has smaller or equal rank p←≢𝕨 ⋄ k←=𝕨 ⋄ q←≢𝕩 - ! 1(⊑⟜p=⊑⟜q)⊸×´↕k + "Argument shape prefixes don't agree" ! 1(⊑⟜p=⊑⟜q)⊸×´↕k l←1(q⊑˜k⊸+)⊸×´↕(=𝕩)-k a←⥊𝕨 ⋄ b←⥊𝕩 q⥊⥊(≠a) (⊑⟜a𝔽l⊸×⊸+⊑b˜)⌜○↕ l @@ -68,7 +68,7 @@ Cmp ← +○IsArray◶⟨ } ⟩ _grade_←{ - ! 1≤=𝕩 + "Grade argument must have rank at least 1" ! 1≤=𝕩 l←≠𝕩 m←1×´1 Cell 𝕩 d←⥊𝕩 @@ -90,10 +90,10 @@ _grade_←{ } Indices←{ - ! 1==𝕩 + "Replication argument in Indices or Replicate must have rank 1" ! 1==𝕩 l←≠𝕩 { - ! 1×´Nat⌜𝕩 + "Amounts to replicate must be natural numbers" ! 1×´Nat⌜𝕩 k←l-1 N ← ((⊢+-×0=𝕩⊑˜⊢)`k⊸-⌜↕l)⊑˜k-⊢ # Next nonzero E ← ⊑⟜(+`𝕩) @@ -108,10 +108,10 @@ Transpose←{ }⍟(0<=) SelSub←{ - ! IsArray 𝕨 - ! 1×´⥊Int⌜ 𝕨 + "Right argument to Select must be an array" ! IsArray 𝕨 + "Indices in Select must be integers" ! 1×´⥊Int⌜ 𝕨 l←≠𝕩 - ! 1×´⥊ ((-l)⊸≤×l⊸>)⌜ 𝕨 + "Select indices out of range" ! 1×´⥊ ((-l)⊸≤×l⊸>)⌜ 𝕨 ((⊢+l×0>⊢)⌜𝕨)(1==𝕩)◶{ c←1×´s←1 Cell 𝕩 𝕨((⥊𝕩)⊑˜c⊸×⊸+)⌜s⥊↕c @@ -120,8 +120,15 @@ SelSub←{ }𝕩 } -Reverse ← {!1≤=𝕩 ⋄ l←≠𝕩 ⋄ ((l-1)⊸-⌜↕l) Select 𝕩} -Rot ← {!Int𝕨 ⋄ l←≠𝕩 ⋄ 𝕨-↩l×⌊𝕨÷l ⋄ ((𝕨+⊢-l×(l-𝕨)≤⊢)⌜↕l) Select 𝕩} +Reverse ← { + "Reverse argument must have rank at least 1" ! 1≤=𝕩 + l←≠𝕩 + ((l-1)⊸-⌜↕l) Select 𝕩 +} +Rot ← { + "Amount to rotate must be an integer" ! Int𝕨 + l←≠𝕩 ⋄ 𝕨-↩l×⌊𝕨÷l ⋄ ((𝕨+⊢-l×(l-𝕨)≤⊢)⌜↕l) Select 𝕩 +} _under_←{ i←↕l←1×´s←≢𝕩 @@ -149,7 +156,7 @@ Depth←IsArray◶0‿{1+0(⊣-≤×-)´Depth⌜⥊𝕩} Merge←{ c←≢0⊑⥊𝕩 - ! 1×´(c≡≢)⌜⥊𝕩 + "Elements in Merge argument must have matching shapes" ! 1×´(c≡≢)⌜⥊𝕩 𝕩⊑⟜Deshape˜⌜c⥊↕1×´c }⍟(0<≠∘⥊)⍟IsArray @@ -166,18 +173,18 @@ Merge←{ > ↩ Merge ⊘ ((1-≤) _perv) ≠ ↩ ≠ ⊘ ((1-=) _perv) = ↩ = ⊘ (= _perv) -≥ ← !∘0 ⊘ (≤˜_perv) -≤ ↩ !∘0 ⊘ (≤ _perv) +≥ ← ("No monadic form: ≥"!0˜) ⊘ (≤˜_perv) +≤ ↩ ("No monadic form: ≤"!0˜) ⊘ (≤ _perv) + ↩ + _perv - ↩ - _perv ¬ ← 1+- -identity ← (0⊑⟨!∘0⟩) {(0⊑𝕨){𝕗=𝕩}◶𝕩‿(1⊑𝕨)}´ ⟨+‿0,-‿0,×‿1,÷‿1,⋆‿1,√‿1,∧‿1,∨‿0,|‿0,⌊‿∞,⌈‿¯∞,<‿0,≤‿1,=‿1,≥‿1,>‿0,≠‿0⟩ +identity ← (0⊑⟨"Identity not found"!0˜⟩) {(0⊑𝕨){𝕗=𝕩}◶𝕩‿(1⊑𝕨)}´ ⟨+‿0,-‿0,×‿1,÷‿1,⋆‿1,√‿1,∧‿1,∨‿0,|‿0,⌊‿∞,⌈‿¯∞,<‿0,≤‿1,=‿1,≥‿1,>‿0,≠‿0⟩ Deshape←IsArray◶{⟨𝕩⟩}‿⥊ Reshape←{ - ! 1≥=𝕨 + "Shape argument to Reshape must have rank at most 1" ! 1≥=𝕨 𝕨↩Deshape 𝕨 - ! ∧´Nat⌜𝕨 + "Shape in Reshape must consist of natural numbers" ! ∧´Nat⌜𝕨 l←×´𝕨 n←×´≢𝕩 𝕨⥊{ @@ -187,8 +194,8 @@ Reshape←{ ⥊ ↩ Deshape ⊘ ⥊ Range←{ - I←{!Nat𝕩⋄↕𝕩} - M←{!1==𝕩⋄(<⟨⟩)⥊⊸∾⌜´I⌜𝕩} + I←{"Range argument must consist of natural numbers"!Nat𝕩⋄↕𝕩} + M←{"Range argument must be a number or list"!1==𝕩⋄(<⟨⟩)⥊⊸∾⌜´I⌜𝕩} IsArray◶I‿M 𝕩 } @@ -219,7 +226,7 @@ _rankOp_←{ ⎉ ← _rankOp_ ˘ ← {𝔽⎉¯1} _insert←{ - ! 1≤=𝕩 + "Insert argument must have rank at least 1" ! 1≤=𝕩 𝕨 𝔽´ <˘𝕩 } ˝ ← _insert @@ -228,11 +235,11 @@ _insert←{ _onAxes_←{ F←𝔽 (𝔾<≡)∘⊣◶{ # One axis - ! 1≤=𝕩 + "First-axis function right argument must have rank at least 1" ! 1≤=𝕩 𝕨F𝕩 }‿{ # Multiple axes - ! 1≥=𝕨 - ! 𝕨≤○≠≢𝕩 + "Left argument must have rank at most 1" ! 1≥=𝕨 + "Left argument length must be at most right argument rank" ! 𝕨≤○≠≢𝕩 l←≠𝕨 ⋄ W←⊑⟜(⥊𝕨) 0{(W𝕨)F(1+𝕨)⊸𝕊˘⍟(𝕨<l-1)𝕩}⍟(0<l)𝕩 } @@ -244,43 +251,43 @@ Select←ToArray⊸(SelSub _onAxes_ 1) JoinTo←∨○(1<=)◶(∾○⥊)‿{ s←𝕨Pair○≢𝕩 a←1⌈´k←≠⌜s - ! ∧´1≥a-k + "Rank of joined arguments must differ by at most 1" ! ∧´1≥a-k c←(k¬a)+⟜(↕a-1)⊸⊏¨s - ! ≡´c + "Cell shapes of joined arguments must match" ! ≡´c l←+´(a=k)⊣◶1‿(0⊑⊢)¨s (⟨l⟩∾0⊑c)⥊𝕨∾○⥊𝕩 } Take←{ T←{ - ! Int 𝕨 + "Left argument to Take or Drop must be an integer" ! Int 𝕨 l←≠𝕩 ⋄ n←𝕨<0 ⋄ e←l⌊r←|𝕨 ⋄ s←⟨r⟩ ⋄ m←1 i ← 𝕩{s∾↩c←1 Cell 𝕨⋄𝕩(×+⌜↕∘⊢)m↩×´c}⍟(1≠=𝕩) (l-e)+⍟n ↕e s⥊𝕩{(⥊𝕩)n◶⟨∾,∾˜⟩(0⊑⥊Type𝕗)⌜↕m×r-e}⍟(l<r) ⊑⟜(⥊𝕩)⌜i } 𝕨 T _onAxes_ 0 ((1⌜∘↕0⌈𝕨-○≠⊢)⊸∾∘≢⥊⥊) 𝕩 } -Prefixes ← {!1≤=𝕩 ⋄ Take⟜𝕩⌜↕1+≠𝕩} +Prefixes ← {"Prefixes argument must have rank at least 1"!1≤=𝕩 ⋄ Take⟜𝕩⌜↕1+≠𝕩} ↑ ← Prefixes ⊘ Take Drop←{ s←(≠𝕨)(⊣↑⊢∾˜·1⌜∘↕0⌈-⟜≠)≢𝕩 ((sׯ1⋆𝕨>0)+(-s)⌈s⌊𝕨)↑𝕩 } -Suffixes ← {!1≤=𝕩 ⋄ Drop⟜𝕩⌜↕1+≠𝕩} +Suffixes ← {"Suffixes argument must have rank at least 1"!1≤=𝕩 ⋄ Drop⟜𝕩⌜↕1+≠𝕩} ↓ ← Suffixes ⊘ Drop Windows←{ - ! IsArray 𝕩 - ! 1≥=𝕨 - ! 𝕨≤○≠≢𝕩 - ! ∧´Nat⌜⥊𝕨 + "Windows right argument must be an array" ! IsArray 𝕩 + "Windows left argument must have rank at most 1" ! 1≥=𝕨 + "Windows left argument length must be at most right argument rank" ! 𝕨≤○≠≢𝕩 + "Windows left argument must consist of natural numbers" ! ∧´Nat⌜⥊𝕨 s←(≠𝕨)↑≢𝕩 - ! ∧´𝕨≤1+s + "Window length must be at most axis length plus one" ! ∧´𝕨≤1+s 𝕨{(∾⟜(𝕨≠⊸↓≢𝕩)∘≢⥊>)<⌜⊸⊏⟜𝕩¨s(¬+⌜○Range⊢)⥊𝕨}⍟(0<≠𝕨)𝕩 } Rep ← Indices⊸⊏ -Replicate ← {0<=𝕨}◶{𝕨⌜⊸Rep𝕩}‿{!𝕨=○≠𝕩⋄𝕨Rep𝕩} _onAxes_ (1-0=≠) +Replicate ← {0<=𝕨}◶{𝕨⌜⊸Rep𝕩}‿{"Replicate argument lengths must match"!𝕨=○≠𝕩⋄𝕨Rep𝕩} _onAxes_ (1-0=≠) ↕ ↩ Range ⊘ Windows ⌽ ← Reverse ⊘ (Rot _onAxes_ 0) @@ -293,33 +300,35 @@ Join←(1≠=)◶⟨∨´1≠=⌜,1⟩◶{ }‿{ # Multidimensional C←(<⟨⟩)⥊⊸∾⌜´⊢ # Cartesian array product - ! IsArray 𝕩 + "Join argument must be an array" ! IsArray 𝕩 s←≢⌜𝕩 d←≠0⊑⥊s - ! ∧´⥊d=≠⌜s - ! d≥=𝕩 + "Join argument elements must all have the same rank" ! ∧´⥊d=≠⌜s + "Join argument element rank must be at least argument rank" ! d≥=𝕩 l←(≢𝕩){(𝕩⊑⟜≢a Pick1˜(j=𝕩)⊸×)⌜↕𝕨}¨j←↕r←=a←𝕩 - ! (r⊸↑⌜s)≡C l + "Join argument element shapes must be compatible" ! (r⊸↑⌜s)≡C l i←C{p←+´⌜↑𝕩⋄(↕0⊑⌽p)-𝕩/¯1↓p}⌜l >i<⌜⊸⊏¨l/𝕩 }⍟(0<≠∘⥊) _group←{ - !1==𝕩⋄!∧´Int⌜𝕩⋄!∧´¯1≤𝕩 + "Grouping argument must be a list" ! 1==𝕩 + "Grouping argument must consist of integers" ! ∧´Int⌜𝕩 + "Grouping argument values cannot be less than ¯1" ! ∧´¯1≤𝕩 d←(l←GroupLen𝕩)GroupOrd𝕩 i←0⋄(𝔽{𝕩⋄(i↩i+1)⊢i⊑d}⌜∘↕)⌜l } GroupInds←{ - ! IsArray 𝕩 + "Group Indices argument must be an array" ! IsArray 𝕩 G←⊢_group (1<≡)◶G‿((<<⟨⟩)⥊⊸∾⌜⌜´G⌜)𝕩 } GroupGen←{ - ! IsArray 𝕩 + "Group right argument must be an array" ! IsArray 𝕩 m←1<≡𝕨 - l←m◶≠‿{!1==𝕩⋄≠⌜𝕩}𝕨 - ! l≤○≠≢𝕩 - ! ∧´l=l≠⊸↑≢𝕩 + l←m◶≠‿{"Group left argument must consist of lists"!1==𝕩⋄≠⌜𝕩}𝕨 + "Group left argument length must be at most right argument rank" ! l≤○≠≢𝕩 + "Group argument lengths must be compatible" ! ∧´l=l≠⊸↑≢𝕩 𝕨m◶(⊏⟜𝕩_group⊣)‿{ ⊏⟜(𝕩⥊˜⟨×´l⟩∾(≠l)Cell𝕩)⌜ +⌜⌜´ (⌽×`⟨1⟩∾⌽1↓l) × ⊢_group⌜𝕨 }𝕩 @@ -329,10 +338,10 @@ GroupGen←{ ⊔ ← GroupInds ⊘ GroupGen Pick1←{ - ! 1==𝕨 - ! 𝕨=○≠s←≢𝕩 - ! ∧´Int⌜𝕨 - ! ∧´𝕨(≥⟜-∧<)s + "Indices in compound Pick must be lists" ! 1==𝕨 + "Pick index length must match right argument rank" ! 𝕨=○≠s←≢𝕩 + "Pick indices must consist of integers" ! ∧´Int⌜𝕨 + "Pick index out of range" ! ∧´𝕨(≥⟜-∧<)s 𝕨↩𝕨+s×𝕨<0 (⥊𝕩)⊑˜0(⊑⟜𝕨+⊑⟜s×⊢)´-↕⊸¬≠𝕨 } @@ -373,11 +382,11 @@ _binSearch ← { } _bins←{ c←1-˜=𝕨 - ! 0≤c - ! c≤=𝕩 + "Bins argument must have rank at least 1" ! 0≤c + "Bins right argument rank is too small" ! c≤=𝕩 lw←×´sw←1 Cell 𝕨 cw←lw 𝔽○(⊑⟜(⥊𝕨)) _getCellCmp 0 - ! 0⊸<◶⟨1,∧´0≤˜·cw⟜(lw⊸+)⌜lw×↕∘-⟜1⟩≠𝕨 + "Bins left argument must be sorted" ! 0⊸<◶⟨1,∧´0≤˜·cw⟜(lw⊸+)⌜lw×↕∘-⟜1⟩≠𝕨 cx←c-˜=𝕩 sx←cx Cell 𝕩 ⋄ lc←sw CmpLen sx cc ← (⊑⟜(⥊𝕨))⊸𝔽⟜(⊑⟜(⥊𝕩)) _getCellCmp´ lc @@ -394,7 +403,7 @@ _search←{ # 0 for ∊˜, 1 for ⊐ red ← 𝕗⊑⟨¬∧˝,+˝∧`⟩ { c←1-˜=𝕨 - ! 0≤c + "Search principal argument must have rank at least 1" ! 0≤c 𝕨 ∧○(8<≠∘⥊)◶⟨ (0<≠𝕨)◶⟨0⎉c∘⊢, Red≢⌜○((0<c)◶⟨⊢,<⎉c⟩)⟩ { g←⌽⍒𝕨 ⋄ i←g⊏˜0⌈1-˜(g⊏𝕨)⍋𝕩 ⋄ (≠𝕨)(⊣+i⊸-⊸×)⍟ind(i⊏𝕨)≡⎉c𝕩 } @@ -402,28 +411,28 @@ _search←{ # 0 for ∊˜, 1 for ⊐ } } UniqueMask←{ - ! 1≤=𝕩 + "Unique mask argument must have rank at least 1" ! 1≤=𝕩 g←⍋𝕩 (1¨⊸GroupOrd g)⊏0⊸<◶⟨1,-⟜1≢○(⊑⟜(g⊏<˘⍟(1<=)𝕩))⊢⟩⌜↕≠𝕩 } Find←{ r←=𝕨 - ! r≤=𝕩 + "Find left argument rank cannot exceed right argument rank" ! r≤=𝕩 𝕨 ≡⎉r (≢𝕨) ↕⎉r 𝕩 } -⊐ ← !∘0 ⊘ (1 _search) +⊐ ← ("No monadic form: ⊐"!0˜) ⊘ (1 _search) ∊ ← UniqueMask ⊘ (0 _search˜) ⍷ ← ∊⊸/ ⊘ Find ReorderAxes←{ 𝕩↩<⍟(0=≡)𝕩 - ! 1≥=𝕨 + "Left argument to Reorder Axes must have rank at most 1" ! 1≥=𝕨 𝕨↩⥊𝕨 - ! 𝕨≤○≠≢𝕩 - ! ∧´Nat⌜⥊𝕨 + "Reorder Axes left argument length must not exceed right argument rank" ! 𝕨≤○≠≢𝕩 + "Reorder Axes left argument must consist of natural numbers" ! ∧´Nat⌜⥊𝕨 r←(=𝕩)-+´¬∊𝕨 - ! ∧´𝕨<r + "No such axis in Reorder Axes" ! ∧´𝕨<r 𝕨↩𝕨∾𝕨(¬∘∊˜/⊢)↕r (𝕨⊸⊏Pick𝕩˜)⌜↕⌊´⌜𝕨⊔≢𝕩 } @@ -436,7 +445,8 @@ ProgressiveIndexOf ← {𝕨⊐○(≍˘⟜OccurrenceCount𝕨⊸⊐)𝕩} ⊑ ↩ (0⊑⥊) ⊘ Pick ◶ ↩ {𝕨((𝕨𝔽𝕩)⊑𝕘){𝔽}𝕩} # Same definition, new Pick -inverse ← {(⊑(0⊏𝕩)⊐<) ⊑ ((1⊏𝕩)∾⟨!∘0⟩)˜} ⍉ (2∾˜2÷˜≠)⊸⥊ ⟨ +IA ← "Inverse failed"⊸! +inverse ← {(⊑(0⊏𝕩)⊐<) ⊑ ((1⊏𝕩)∾⟨"Inverse not found"!0˜⟩)˜} ⍉ (2∾˜2÷˜≠)⊸⥊ ⟨ +, +⊘(-˜) -, - ×, ⊢⊘(÷˜) @@ -445,15 +455,15 @@ inverse ← {(⊑(0⊏𝕩)⊐<) ⊑ ((1⊏𝕩)∾⟨!∘0⟩)˜} ⍉ (2∾˜2 √, ⋆⟜2⊘(⋆˜) ∧, ⊢⊘(÷˜) ∨, ⊢⊘(-˜÷1-⊢) - <, {!IsArray𝕩⋄!0==𝕩⋄⊑𝕩}⊘(!∘0) - /, {!1==𝕩⋄!∧´Nat⌜𝕩⋄!(∧´¯1⊸↓≤1⊸↓)𝕩⋄GroupLen𝕩}⊘(!∘0) + <, {IA IsArray𝕩⋄IA 0==𝕩⋄⊑𝕩}⊘(IA∘0) + /, {IA 1==𝕩⋄IA∧´Nat⌜𝕩⋄IA(∧´¯1⊸↓≤1⊸↓)𝕩⋄GroupLen𝕩}⊘(IA∘0) ⟩ ⁼ ← {Inverse 𝕗} _repeat_←{ n←𝕨𝔾𝕩 l←u←0 - {!Int𝕩⋄l↩l⌊𝕩⋄u↩u⌈𝕩}⚇0 n + {"Repetition numbers must be integers"!Int𝕩⋄l↩l⌊𝕩⋄u↩u⌈𝕩}⚇0 n a←𝕩⋄_p←{𝔽∘⊣`⟨a⟩∾↕0+𝕩} pos←(𝕨𝔽 ⊢)_p u neg←(𝕨𝔽⁼⊢)_p-l |