/*
Here are some (mostly array) functions that might go to the farnsworth
standard
library, and examples in comments. This is still just a draft, don't
add them yet,
just sending to record them.
You already have in the library: length @$ map reverse sort reduce min
max +.
*/
take{n isa 1, a isa []} := { var r = []; var k = 0; var m = n <
length[a] ? n : length[a]; while (k < m) { r@k$ = a@k$; k++; }; r };
//take[5, [3,1,4,1,5,9,2]];
drop{n isa 1, a isa []} := { var r = []; var m = length[a] - n; var k
= 0; while (k < m) { r@k$ = a@n + k$; k++; }; r };
//drop[2, [3,1,4,1,5,9,2]];
for{p isa {``}, a isa []} := { var k = 0; while (k < length[a]) {
(p)[a@k$]; k++ } };
//var s = 0; for[{`x` s += x }, [3, 4, 5]]; s
concat{a isa []} := { var r = []; var m = 0; for[{`b` for[{`x` r@m++$
= x }, b]}, a]; r };
/*concat[[[3, 1], [], [4], [1, 5, 9, 2]]];
var a = []; var k = 0; while (k < 1000) { a@k$ = [k]; k++ };
concat[a]; */
concatMap{p isa {``}, a isa []} := { var r = []; var m = 0; for[{`b`
for[{`x` r@m++$ = x }, (p)[b]]}, a]; r };
//concatMap[{`x` 0==x%2?[-1,x,-2]:[x]}, [3,1,4,1,5,9,2]]
reduce{p isa {``}, s, a isa []} := { var r = s; for[{`x` r = (p)[r, x]},
a]; r }; /* NOTE: differs from the current reduce function */
//reduce[{`x,y` 10*x+y }, 0, [2,3,4]]
fold{p isa {``}, a isa []} := { var r = a@0$; var k = 1; var m =
length[a]; while (k < m) { r = (p)[r, a@k$]; k++; }; r }; /* this is
like the current reduce function, but does not ignore number of
arguments */
// fold[{`x,y` 10*x+y }, [2,3,4]]
scan{p isa {``}, s, a isa []} := { var t = s; var r = []; var k = 0;
var m = length[a]; while (k < m) { r@k$ = t = (p)[t, a@k$]; k++; }; r };
//scan[{`x,y` 10*x+y }, 0, [2,3,4]]
foldScan{p isa {``}, a isa []} := { var t = a@0$; var r = [t]; var k =
1; var m = length[a]; while (k < m) { r@k$ = t = (p)[t, a@k$]; k++; }; r
};
//foldScan[{`x,y` x*y}, [1,2,3,4]]
iota{n} := { var k = 0; var r = []; while (k < n) { r@k$ = k; k++; }; r };
//iota[5]
times{p isa {``}, n} := { var k = 0; while (k < n) { p[k]; k++; }; };
//var a = []; times[{`k` a = a+[k]+a }, 5]; a
forRange{p isa {``}, a, b = undef, c = undef} := { if (c conforms undef) {
if (b conforms undef) { var k = 0; while (k < a) { (p)[k]; k++; }; } else {
var k = a; while (k < b) { (p)[k]; k++ } } } else { var k = a; while
(0 < c ? k < b : b < k) { (p)[k]; k += c; } } };
/*var s = []; forRange[{`x` s@x$ = 1; }, 3, 6]; s*/
range{a, b = undef, c = undef} := { var r = []; var k = 0;
forRange[{`x` r@k++$ = x }, a, b, c]; r };
/*[range[5], range[2, 6], range[10,5,-1], range[2,10,2]]*/
sliceRange{a isa [], b, c = undef, d = undef} := { var r = []; var k =
0; forRange[{`x` r@k++$ = a@x$; }, b, c, d]; r };
//sliceRange[[3,1,4,1,5,9,2], 0, 10, 2]
slice{a isa [], b isa []} := { map[{`x` a@x$ }, b] };
//slice[[3,1,4,1,5,9,2], [2,2,0]]
mapRange{p isa {``}, a, b = undef, c = undef} := { var r = []; var k =
0; forRange[{`x` r@k++$ = (p)[x]; }, a, b, c]; r };
//mapRange[{`x`, (x^2+x)/2}, 1, 10]
replicate{n isa 1, x} := { mapRange[{`_k` x}, n] };
//replicate[5, "hello "]
transpose{a isa []} := { var m = a ? length[a@0$] : 0;
forRange[{`k` if (length[a@k$] < m) { m = length[a@k$] } }, 1, length[a]];
mapRange[{`k` map[{`b` b@k$ }, a] }, m] };
//transpose[[["a","b","c"],["d","e","f"],["g","h","i"]]]
forTranspose{p isa {``}, a isa []} := { var m = a ? length[a@0$] : 0;
forRange[{`k` if (length[a@k$] < m) { m = length[a@k$] } }, 1, length[a]];
forRange[{`k` (p)[map[{`b` b@k$ }, a]] }, m] };
/* forTranspose might be a private function, but it's needed for the
implementation below */
zip{a isa ...} := { if (2 == length[a]) { var a0 = a@0$; var a1 = a@1$;
var m = length[a0]<=length[a1]?length[a0]:length[a1]; var r = []; var k = 0;
while (k < m) { r@k$ = [a0@k$, a1@k$]; k++; }; r } else { transpose[a]; } };
/*[zip[["a","b","c","k"],["d","e","f"],["g","h","i"]], zip[[1, 2, 3],
[4, 5, 6]]];*/
forZip{p isa {``}, a isa ...} := { if (2 == length[a]) { var a0 = a@0$;
var a1 = a@1$; var m = length[a0]<=length[a1]?length[a0]:length[a1]; var
k = 0;
while (k < m) { (p)[a0@k$, a1@k$]; k++; }; } else { forTranspose[{`x`
(p)x }, a];
} };
/*
var a0 = []; forZip[{`x,y`a@x$=10*x+y}, [3,1,4], [1,5,9]];
var a1 = []; forZip[{`x,y,z`a@x$=10*y+z}, range[0,20,2], [3,1,4],
[1,5,9]]; [a0, a1];
*/
mapZip{p isa {``}, a isa ...} := { var r = []; var k = 0; if (2 ==
length[a]) { var a0 = a@0$; var a1 = a@1$; var m =
length[a0]<=length[a1]?length[a0]:length[a1]; while (k < m) { r@k$ =
(p)[a0@k$,
a1@k$]; k++; }; } else { forTranspose[{`x` r@k++$ = (p)x }, a]; }; r };
/*[mapZip[{`x, y, z` a = (10 x + y) z }, [3, 1, 4], [9, 2, 6], [meter,
kilogram, second]],
mapZip[{`x,y`10*x+y},[3,1,4],[1,5,9,2]],
mapZip[{`x,y,z`100*x+10*y+z},[3,1,4],[1,5,9],[2,6,5]]]*/
find{p isa {``}, a isa []} := { var k = 0; var m = length[a];
while (k < m && !((p)[a@k$])) { k++ }; a@k$ };
//find[{`x`5<x}, [3,1,4,1,5,9,2,6]];
findIndex{p isa {``}, a isa []} := { var k = 0; var m = length[a];
while (k < m && !((p)[a@k$])) { k++ }; k };
//findIndex[{`x`4<x}, [3,1,4,1,5,9,2,6]]
anyMap{p isa {``}, a isa []} := { var k = 0; var m = length[a]; var r;
while (k < m && !(r = (p)[a@k$])) { k++ }; r };
//anyMap[{`x` 8<x }, [3,1,4,1,5,9,2,6]]
any{a isa []} := { var k = 0; var m = length[a]; while (k < m &&
!(a@k$)) { k++ }; a@k$ };
//any[[0,0,3,0,2]]
anyP{a isa []} := { var k = 0; var m = length[a]; while (k < m &&
!(a@k$)) { k++ }; k < m };
//anyP[[0,0,3,0,2]]
anyMapP{p isa {``}, a isa []} := { var k = 0; var m = length[a];
while (k < m && !((p)[a@k$])) { k++ }; k < m };
//anyMapP[{`x` floor[x/6] }, [3,1,4,1,5,20,2,6]]
filter{p isa {``}, a isa []} := { var r = []; var k = 0; var l = 0; var m
= length[a]; while (k < m) { if ((p)[a@k$]) { r@l++$ = a@k$; }; k++; }; r };
//filter[{`x`x<5}, [3,1,4,1,5,9,2,6,3]]
compress{c isa [], a isa []} := { var r = []; var k = 0; var l = 0; var m
= length[a]; if (m != length[c]) { error["error: compress incompatible
arrays"]
}; while (k < m) { if (c@k$) { r@l++$ = a@k$; }; k++; }; r };
//var a = [3,1,4,1,5,9,2,6,3]; compress[map[{`x`x<5},a], a];
copy{c isa [], a isa []} := { var r = []; var k = 0; var l = 0; var m =
length[a]; if (m != length[c]) { error["error: compress incompatible
arrays"] };
while (k < m) { var v = c@k$; while (0 < v--) { r@l++$ = a@k$; }; k++;
}; r };
//var a = [3,1,4,1,5,9,2,6,3]; copy[map[{`x`floor[x/4]},a], a];
indicesMap{p isa {``}, a isa []} := { compress[map[p, a],
iota[length[a]]] };
//indicesMap[{`x`x<4}, [3,1,4,1,5,9,2,6,3]];
sum{a isa []} := { reduce[{`t,x` t+x }, 0, a] };
//sum[[3,4,10]]
count{a isa []} := { reduce[{`t,x` x?t+1:t }, 0, a] };
//count[[True,False,False,False]]
sumMap{p isa {``}, a isa []} := { reduce[{`t,x` t+(p)[x] }, 0, a] };
//sumMap[{`x`abs[x]}, [3,-4,10*unit[i]]
countMap{p isa {``}, a isa []} := { reduce[{`t,x` (p)[x]?t+1:t }, 0, a] };
//countMap[{`x`x<4},[3,1,4,1,5,9,2,6,3]]
complex{x,y} := { x + y * unit[i] };
//complex[3 second, -2 second]
explode{s isa ""} := { mapRange[{`x` substrLen[s,x,1]}, length[s]] };
//explode["hello"]
implode{a isa []} := { if(a) { var p = {`i,j` j<=1 ? a@i$ :
(p)[i,floor[j/2]] + (p)[i+floor[j/2],ceil[j/2]] }; (p)[0, length[a]] }
else { ""
} };
//implode[explode["hello, world"]]
infix{n isa 1, a isa []} := { mapRange[{`k` sliceRange[a, k, k+n] },
length[a]-n+1] };
//map[{`x`implode[x]}, infix[2, explode["hello"]]]
chunk{n isa 1, a isa []} := { var m = length[a]; mapRange[{`x`
sliceRange[a, x, x+n<m?x+n:m] }, 0, m, n] };
//map[{`x`implode[x]}, chunk[5, explode["hello, world"]]]
sortBy{a isa [], b isa []} := { if (length[a]!=length[b]) { error["error:
sortBy incompatible length arrays"] }; slice[b, sort[{`x,y` a@x$<=>a@y$ },
range[length[b]]]] }; sortMap{p isa {``}, b isa []} := { sortBy[map[p,
b], b] };
//var a = map[{`x`100*randmax[100]+x}, [3,1,4,1,5,9,2,6]];
sortMap[{`x` x%100 }, a]
/*
Some ideas to write later:
reverse folds and scans,
head, tail, last, init,
findRange, anyRange, reduceRange, findZip, anyZip, reduceZip, *infix,
*chunk,
or a general lazy iterator/foldable object
(doesn't seem possible without language expansions),
forL, forR, mapL, mapR,
all, allP.
These should rather be implemented as a builtin:
floor ceil rint trunc variants that give float (not bigint).
div, mod, quo, rem,
Ambrus
*/
