#! /usr/local/bin/apl --script ⍝ ******************************************************************** ⍝ $Id: $ ⍝ $desc: Library of useful apl functions $ ⍝ ******************************************************************** ⍝ Util ⍝ Copyright (C) 2016 Bill Daly ⍝ This program is free software: you can redistribute it and/or modify ⍝ it under the terms of the GNU General Public License as published by ⍝ the Free Software Foundation, either version 3 of the License, or ⍝ (at your option) any later version. ⍝ This program is distributed in the hope that it will be useful, ⍝ but WITHOUT ANY WARRANTY; without even the implied warranty of ⍝ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ⍝ GNU General Public License for more details. ⍝ You should have received a copy of the GNU General Public License ⍝ along with this program. If not, see . ∇msg←utl∆helpFns fn;src;t ⍝⍝ Display help about a function src←⎕cr fn t←(+/∧\src=' ')⌽src msg←(1,∧\'⍝'=1↓t[;1])⌿src ∇ ∇msg←utl∆functionList prefix;list ⍝⍝ Display help for a list of functions whose name begins with ⍝⍝ prefix. list←utl∆clean¨⊂[2](list[;⍳⍴prefix]∧.=prefix)⌿list←⎕nl 3 msg←{⎕tc,⎕tc,'∇',⎕tc[3] utl∆join ⊂[2]utl∆helpFns ⍵}¨list ∇ ∇t←utl∆numberp v ⍝⍝ Is arg a number? →(0=⍴t←''⍴0=⍴v)/0 ⍎(1<≡v)/'t←0◊→0' t←''⍴0=1↑0⍴v ∇ ∇ t←utl∆stringp s ⍝⍝ Is arg a string? ⍝⍝ test for nested array →(~t←1=≡s)/0 t←''⍴' '=1↑0⍴s←,s ∇ ∇b←utl∆numberis tst ⍝⍝ Test whether a number can be obtained by executing a string ⍎(0=⍴tst←,tst)/'b←0 ◊ →0' ⍝⍝ Rotate spaces to right side tst←(+/∧\tst=' ')⌽tst ⍝⍝ Test for spaces imbedded in numbers →(~b←(+/∧\b)=+/b←tst≠' ')/0 b←(∧/tst∊' 1234567890-¯.')∧∨/0 1=+/tst='.' b←b∧∧/~(1↓tst)∊'-¯' ∇ ∇New←utl∆stripArraySpaces old;b ⍝⍝ Strips off leading and trailing spaces. Function operates on both ⍝⍝ vectors and arrays of rank 2. See also utl∆clean. New←(+/∧\old=' ')⌽old b←⌊/+/∧\⌽New=' ' →(V,M,E)[3⌊⍴⍴old] ⍝ Vector V: New←New[⍳-b-⍴New] →0 ⍝ Matrix M: New←New[;⍳-b-1↓⍴New] →0 ⍝ Error -- rank of old is too high E: ⎕es 'Rank of array is too high' ∇ ∇cl←utl∆clean txt;b;ix ⍝⍝ Converts all whites space to spaces and then removes duplicate ⍝⍝ spaces. See also utl∆stringArraySpaces. txt←,txt ix←(txt∊⎕tc,⎕av[10])/⍳⍴txt txt[ix]←' ' →(0=⍴cl←(~(1⌽b)∧b←txt=' ')/txt)/0 cl←(cl[1]=' ')↓(-cl[⍴cl]=' ')↓cl ∇ ∇o←k utl∆sub d ⍝⍝ Calculates subtotals for each break point in larg o←+\[1]d ⍝ Test for rank of data ⎕es (~(⍴⍴d) ∊ 1 2)/'RANK ERROR' →(V,A)[⍴⍴d] ⍝ Vectors V:o←o[k]-¯1↓0,o[k] →0 ⍝ Arrays (of rank 2) A: o←o[k;]-0,[1] o[¯1↓k;] →0 ∇ ∇string←delim utl∆join vector ⍝⍝ Returns a character string with delim delimiting the items ⍝⍝ in vector. string←1↓∊,delim,(⌽1,⍴vector)⍴vector ∇ ∇v←delim utl∆split string;b;c ⍝⍝ Splits a character string into a nested vector of strings using ⍝⍝ delim as the delimiter. →(1≠⍴delim←,delim)/many →(∧/b←string ≠ delim)/last →exit many: →(∧/~b←string∊delim)/last string←(c←~b∧1⌽b)/string b←c/~b →exit exit: v←(⊂b/string),delim utl∆split 1↓(~b←∧\b)/string →0 last: v←1⍴⊂string ∇ ∇v←delim utl∆split2 string;b ⍝⍝ Split a string at delim. No recursive algorithm b←(delim=string)/⍳⍴string←,string b←b,[1.1]-b-¯1+1↓b,1+⍴string v←utl∆sph ¨ ⊂[2]b ∇ ∇item←utl∆sph ix ⍝⍝ Helper function for utl∆split returns an item from a character ⍝⍝ vector where ix index of the delimeter in the stringstring and the ⍝⍝ length of the item. ix←ix[1]+⍳ix[2] item←string[ix] ∇ ∇ix← list utl∆listSearch item;rl;ri;l ⍝⍝ Search a character list for an item. →(1=≡list)/arr list←⊃list arr: ⎕es(2≠⍴rl←⍴list)/'RANK ERROR' ri←⍴item←,item l←rl[2]⌈ri →(0=⍴ix←(((rl[1],l)↑list)∧.=l↑,item)⌿⍳rl[1])/naught ix←''⍴ix →0 naught: ix←1+''⍴⍴list ∇ ∇ix←txt utl∆search word;⎕io;old∆io;ixx;bv ⍝⍝ Search for larg in rarg. old∆io←⎕io ⎕io←0 ixx←⍳⍴txt←,txt bv←(txt=1↑word←,word)∧ixx≤(⍴txt)-⍴word ix←bv/ixx ix←old∆io+(txt[ix∘.+⍳⍴word]∧.=word)/ix ∇ ∇new←txt utl∆replace args;ix ⍝⍝ Search for and replace an item in rarg. Larg is a two element ⍝⍝ vector where Larg[1] is the text to search for, Larg[2] is the ⍝⍝ replacement text. ix← txt utl∆search ⊃args[1] new←((¯1+ix)↑txt),(,⊃args[2]),(¯1+(ix←''⍴ix)+⍴,⊃args[1])↓txt ∇ ∇t←n utl∆execTime c;ts;lb;i ⍝⍝ Returns the number of milliseconds a command took. larg is the ⍝⍝ number of times to execute command. If larg is missing we execute ⍝⍝ once. →(2=⎕nc 'n')/many ts←⎕ts ⍎c →ed many: lb←(n⍴st),ed i←0 ts←⎕ts st: ⍎c →lb[i←i+1] ed: t←⎕ts t←(60 1000⊥t[6 7])-60 1000⊥ts[6 7] →0 ∇ ∇today←utl∆today ⍝⍝ Today's date as a string today←'06/06/0000'⍕⎕ts[2 3 1] ∇ ∇txt←utl∆lower m;ix ⍝⍝ Convert text to all lower case. m←⎕ucs m←,m ix←((m≥65)∧m≤90)/⍳⍴m m[ix]←m[ix]+32 txt←⎕ucs m ∇ ∇txt←utl∆upper m;ix ⍝⍝ Convert text to all upper case. m←⎕ucs m←,m ix←((m≥97)∧m≤122)/⍳⍴m m[ix]←m[ix]-32 txt←⎕ucs m ∇ ∇v←delim utl∆split_with_quotes string;b;c ⍝⍝ Split a string on a delimiter where some delimiter(s) may be ⍝⍝ inside quotes and therefore ignored. delim←,delim b←~(string∊delim)∧~≠\string='"' v←(⊂c/string), ((~c)/b) utl∆swq_helper (~c←∧\b)/string v←utl∆strip_quotes ¨ v ∇ ∇v←b utl∆swq_helper string;c;d ⍝⍝ Helper function for utl∆split_with_quotes →(0=+/~b)/end d←~c←∧\1↓b v←(⊂c/1↓string), (d/1↓b) utl∆swq_helper d/1↓string →0 end: v←0⍴0 ∇ ∇b←str1 utl∆stringEquals str2;l ⍝⍝ Compare two strings. l←(⍴str1)⌈⍴str2 b←∧/(l↑str1)=l↑str2 ∇ ∇txt←utl∆crWithLineNo name;l ⍝⍝ Add line numbers to a character representation of a function. l←¯1+1↑⍴txt←⎕cr name txt←(' ∇',[1]'[000] '⍕⍪⍳l),txt ∇ ∇clean←utl∆strip_quotes txt;bv ⍝⍝ Strip quotes from the start and end of character string. clean←txt →(~1↑bv←≠\clean∊'''"')/0 clean←(bv∧¯1⌽bv)/clean ∇ ∇new←om utl∆round old ⍝⍝ Round numbers based on the Order of Magnitude. Left ⍝⍝ arg is thus a power of ten where positive numbers round to the ⍝⍝ left of the decimal point and negative to the right. ⍎(2≠⎕nc'om')/'om←0' om←10*om new←om×⌊.5+old÷om ∇ ∇ar←utl∆concatColumns na ⍝⍝ Function returns a 2 dimensional text array from a nested array of text. →(1=¯1↑⍴na)/lastCol ar←(⊃na[;1]),' ', utl∆concatColumns 0 1↓na →0 lastCol: ar←⊃,na →0 ∇ ∇n←utl∆convertStringToNumber s;bv;a ⍝⍝ Converts a vector of characters to a number. Function ⍝⍝ returns the original string when it fails in this attempt. For ⍝⍝ strings multiple numbers see utl∆import∆numbers. →(~∧/s∊'0123456789.,+-¯ ()')/fail →(1<+/s='.')/fail →(0=⍴(s≠' ')/s)/fail a←((~∧\bv)∧⌽~∧\⌽bv←s=' ')/s →(0≠+/a=' ')/fail →((∨/a='+')∧a[1]≠'+')/fail →(∧/'-'=(' '≠a)/a)/zero a[(a∊'(-')/⍳⍴a←,' ',a]←'¯' n←⍎(~a∊'),')/a →0 zero: ⍝ Excel sometimes uses dash for 0 n←0 →0 fail: n←s ∇ ∇n←utl∆import∆numbers s;bv ⍝⍝ Function to turn a column of figures (ie characters) into ⍝⍝ numbers. For a single number see util∆convertStringToNumber ⍎(2=≡s)/'s←⊃s' bv←~∧/s=' ' s[(s∊'(-')/⍳⍴s←,' ',s]←'¯' n←bv\⍎(~s∊'),')/s ∇ ∇utl∆es msg ⍝⍝ Simulate an error. Similar to ⎕es with better control of the error ⍝⍝ message. Thanks JAS →(0=⍴msg)/0 msg ⎕es 0 1 ∇ ∇b←list utl∆member item ⍝⍝ Tests whether a character vector is in list, a character array, ⍝⍝ or a nested list of strings. b←(1+1↑⍴list)>list utl∆stringSearch item ∇ ∇parsed←utl∆fileName∆parse fname;suffix ⍝⍝ Function breaks a fname down into three strings: ⍝⍝ 1) Path to directory ⍝⍝ 2) root name ⍝⍝ 3) suffix, that is whatever trails the final '.'. parsed←'/' utl∆split fname suffix←'.' utl∆split (⍴parsed)⊃parsed →(one,many)[2⌊⍴suffix] one: parsed←(⊂'/' utl∆join ¯1↓ parsed),⊃suffix,⊂'' →0 many: parsed←(⊂'/' utl∆join ¯1↓ parsed),(⊂'.'utl∆join ¯1↓suffix),¯1↑suffix →0 ∇ ∇dir←utl∆fileName∆dirname parsed ⍝⍝ Function returns the directory portion of a parsed file name dir←1⊃parsed ∇ ∇base←utl∆fileName∆basename parsed ⍝⍝ Function returns the base of the file name from a parsed file name base←2⊃parsed ∇ ∇suffix←utl∆fileName∆suffixname parsed ⍝⍝ Function returns the suffix of a parsed file name. suffix ← 3⊃parsed ∇ ∇backup←utl∆fileName∆backupname parsed ⍝⍝ Function returns a name to which a file can be backed up. backup←(1⊃parsed),'/',(2⊃parsed),'.bak' ∇ ∇ar←utl∆concatColumns na ⍝⍝ Function returns a 2 dimensional text array from a nested array of text →(1=¯1↑⍴na)/lastCol ar←(⊃na[;1]),' ', utl∆concatColumns 0 1↓na →0 lastCol: ar←⊃,na →0 ∇ ∇sub←breakFld utl∆breakon amts;ix ⍝⍝ function to calculate subtotals for changes in breakFld ix←(~breakFld utl∆stringEquals ¨ 1⌽breakFld)/⍳⍴breakFld←,breakFld sub←ix utl∆sub amts ∇ ∇b←str utl∆stringMember list ⍝⍝ Function returns true if str is in list b←∨/(⊂str) utl∆stringEquals ¨ list ∇ ∇numbered←utl∆numberedArray array;shape;level ⍝⍝ Function prepends a line number on to an array shape←⍴array utl∆es ((0=level)∨(2≠⍴⍴array)∨2