diff options
| -rw-r--r-- | apl9.h | 2 | ||||
| -rw-r--r-- | array.c | 18 | ||||
| -rw-r--r-- | functions.c | 5 | ||||
| -rw-r--r-- | operators.c | 57 |
4 files changed, 75 insertions, 7 deletions
@@ -346,10 +346,12 @@ Array *fnSelfReference2(Array *, Array *); /* Monadic operators from operators.c */ Array *opEach(Datum *, Array *, Array *); Array *opSwitch(Datum *, Array *, Array *); +Array *opOuterProduct(Datum *, Array *, Array *); Array *opSelfReference1(Datum *, Array *, Array *); /* Dyadic operators from operators.c */ Array *opPower(Datum *, Datum *, Array *, Array *); +Array *opInnerProduct(Datum *, Datum *, Array *, Array *); Array *opBind(Datum *, Datum *, Array *, Array *); Array *opAtop(Datum *, Datum *, Array *, Array *); Array *opOver(Datum *, Datum *, Array *, Array *); @@ -335,7 +335,23 @@ fillelement(Array *a) case AtypeInt: return mkscalarint(0); case AtypeFloat: return mkscalarfloat(0); case AtypeRune: return mkscalarrune(' '); - case AtypeArray: + case AtypeMixed:{ + Array *first = arrayitem(a, 0); + Array *fill = fillelement(first); + freearray(first); + return fill; + } + case AtypeArray:{ + Array *b = duparrayshape(a, a->type); + for(int i = 0; i < b->size; i++){ + Array *fill = fillelement(a->arraydata[i]); + Array *shape = fnShape(a->arraydata[i]); + b->arraydata[i] = fnReshape(shape, fill); + freearray(fill); + freearray(shape); + } + return b; + } default: print("Can't make fill element of array type %d\n", a->type); exits(nil); diff --git a/functions.c b/functions.c index c4b5cee..0e302de 100644 --- a/functions.c +++ b/functions.c @@ -426,11 +426,9 @@ fnMix(Array *right) int *index = malloc(sizeof(int) * commonrank); int offset; for(i = 0; i < size/commonsize; i++){ - print("COPY CELL %d\n", i); Array *a = right->arraydata[i]; Array *fill = fillelement(a); if(a->rank == 0){ - print("Copy scalar :-)\n"); memcpy( result->rawdata + i * commonsize * datasizes[a->type], a->rawdata, datasizes[a->type]); @@ -461,7 +459,6 @@ fnMix(Array *right) index[commonrank-2-k]++; } if(offset < commonsize){ - print("Copying from %d to %d\n", j, commonsize*i+offset); memcpy( result->rawdata + (i * commonsize + offset) * datasizes[a->type], a->rawdata + j * datasizes[a->type], datasizes[a->type]); @@ -482,7 +479,7 @@ fnMix(Array *right) Array * fnSplit(Array *right) { - Rune *code = L"0≡≢⍴⍵: ⍵ ⋄ (⊂⍵)⌷⍨¨⍳≢⍵"; + Rune *code = L"0≡≢⍴⍵: ⍵ ⋄ 1≡≢⍴⍵: ⊂⍵ ⋄ (⊂⍵)⌷⍨¨⍳≢⍵"; return rundfn(code, nil, nil, nil, right); } diff --git a/operators.c b/operators.c index 2d26251..2280e13 100644 --- a/operators.c +++ b/operators.c @@ -4,7 +4,7 @@ #include "apl9.h" -Rune primmonopnames[] = L"¨⍨⌸⌶&∆"; +Rune primmonopnames[] = L"¨⍨⌸⌶&⌾∆"; Rune primdyadopnames[] = L"⍣.∘⍤⍥@⍠⌺⍢⍫⍙"; opmonad monadoperatordefs[] = { @@ -13,12 +13,13 @@ opmonad monadoperatordefs[] = { 0, /* ⌸ */ 0, /* ⌶ */ 0, /* & */ + opOuterProduct, /* ⌾ */ opSelfReference1, /* ∆ */ }; opdyad dyadoperatordefs[] = { opPower, /* ⍣ */ - 0, /* . */ + opInnerProduct, /* . */ opBind, /* ∘ */ opAtop, /* ⍤ */ opOver, /* ⍥ */ @@ -79,6 +80,44 @@ opSwitch(Datum *lefto, Array *left, Array *right) } Array * +opOuterProduct(Datum *lefto, Array *left, Array *right) +{ + if(left == nil) + throwerror(L"f⌾ expected a left argument", ESyntax); + if(lefto->tag != FunctionTag) + throwerror(nil, EType); + + int i; + int rank = left->rank + right->rank; + int size = 1; + int *shape = malloc(sizeof(int) * rank); + for(i = 0; i < left->rank; i++){ + shape[i] = left->shape[i]; + size *= left->shape[i]; + } + for(i = 0; i < right->rank; i++){ + shape[i+left->rank] = right->shape[i]; + size *= right->shape[i]; + } + Array *result = allocarray(AtypeArray, rank, size); + for(i = 0; i < rank; i++) + result->shape[i] = shape[i]; + + for(int leftindex = 0; leftindex < left->size; leftindex++){ + for(int rightindex = 0; rightindex < right->size; rightindex++){ + i = leftindex * right->size + rightindex; + Array *leftitem = arrayitem(left, leftindex); + Array *rightitem = arrayitem(right, rightindex); + result->arraydata[i] = runfunc(lefto->func, leftitem, rightitem); + freearray(leftitem); + freearray(rightitem); + } + } + free(shape); + return result; +} + +Array * opSelfReference1(Datum *lefto, Array *left, Array *right) { DfnFrame *dfn = getcurrentdfn(); @@ -126,6 +165,20 @@ opPower(Datum *lefto, Datum *righto, Array *left, Array *right) } Array * +opInnerProduct(Datum *lefto, Datum *righto, Array *left, Array *right) +{ + if(left == nil) + throwerror(L"f.g expected a left argument", ESyntax); + if(lefto->tag != FunctionTag || righto->tag != FunctionTag) + throwerror(nil, EType); + + if(left->rank > 0 && right->rank > 0 && left->shape[left->rank-1] != right->shape[0]) + throwerror(L"Last dimension of A must match first dimension of B in A f.g B", EShape); + + return rundfn(L"⍶/¨(↓⍺)⍹⌾⍉↓⍉⍵", lefto, righto, left, right); +} + +Array * opBind(Datum *lefto, Datum *righto, Array *left, Array *right) { if(lefto->tag == FunctionTag && righto->tag == FunctionTag){ |