diff options
| -rw-r--r-- | apl9.h | 5 | ||||
| -rw-r--r-- | array.c | 71 | ||||
| -rw-r--r-- | functions.c | 167 |
3 files changed, 211 insertions, 32 deletions
@@ -169,7 +169,7 @@ int scalarextend(Array *, Array *, Array **, Array **); int commontype(Array *, Array *, Array **, Array **, int); Array *arrayitem(Array *, int); Array *simplifyarray(Array *); -int comparearray(Array *, Array *); +int comparearray(Array *, Array *, int); /* eval.c */ Datum *eval(Statement *); @@ -198,6 +198,8 @@ Array *fnSame(Array *); Array *fnTally(Array *); Array *fnEnclose(Array *); Array *fnNest(Array *); +Array *fnGradeUp(Array *); +Array *fnGradeDown(Array *); Array *fnIndexGenerator(Array *); Array *fnRavel(Array *); Array *fnTable(Array *); @@ -216,6 +218,7 @@ Array *fnLogarithm(Array *, Array *); Array *fnLeft(Array *, Array *); Array *fnRight(Array *, Array *); Array *fnMatch(Array *, Array *); +Array *fnIndex(Array *, Array *); Array *fnCatenateFirst(Array *, Array *); Array *fnReshape(Array *, Array *); @@ -212,39 +212,56 @@ simplifyarray(Array *a) } int -comparearray(Array *a, Array *b) +comparearray(Array *a, Array *b, int checkshapes) { - /* returns -1 if a < b, 0 if a == b and 1 if a > b. - Only correctly handles test for equality right now, - and returns 1 for unequal data. */ + /* returns -1 if a < b, 0 if a == b and 1 if a > b. */ + int i; - if(a->type != b->type) - return 1; - if(a->rank != b->rank) - return 1; - if(a->size != b->size) + if(a->type < b->type) + return -1; + else if(a->type > b->type) return 1; - for(int i = 0; i < a->rank; i++) - if(a->shape[i] != b->shape[i]) + + if(checkshapes){ + if(a->rank < b->rank) + return -1; + else if(a->rank > b->rank) return 1; - for(int i = 0; i < a->size; i++){ - if(a->type == AtypeArray){ - /* do something recursive here */ - int sub = comparearray(a->arraydata[i], b->arraydata[i]); - if(sub != 0) - return sub; - }else{ - int sub = memcmp( - a->rawdata + i * datasizes[a->type], - b->rawdata + i * datasizes[a->type], - datasizes[a->type]); - if(sub < 0) + for(i = 0; i < a->rank; i++){ + if(a->shape[i] < b->shape[i]) return -1; - else if(sub > 0) - return 1; + else if(a->shape[i] > b->shape[i]) + return 1; } } - /* if we get here, the arrays are equal */ - return 0; + for(i = 0; i < a->size && i < b->size; i++){ + int sub = 0; + switch(a->type){ + case AtypeInt: + sub = a->intdata[i] > b->intdata[i] ? 1 : a->intdata[i] == b->intdata[i] ? 0 : -1; + break; + case AtypeFloat: + sub = a->floatdata[i] > b->floatdata[i] ? 1 : a->floatdata[i] == b->floatdata[i] ? 0 : -1; + break; + case AtypeRune: + sub = a->runedata[i] > b->runedata[i] ? 1 : a->runedata[i] == b->runedata[i] ? 0 : -1; + break; + case AtypeArray: + sub = comparearray(a->arraydata[i], b->arraydata[i], checkshapes); + break; + default: + print("Missing comparison code for type %d\n", a->type); + exits(nil); + } + if(sub != 0) + return sub; + } + + if(i < a->size) + return 1; + else if(i < b->size) + return -1; + else + return 0; }
\ No newline at end of file diff --git a/functions.c b/functions.c index 90bb3fb..5fafa2a 100644 --- a/functions.c +++ b/functions.c @@ -42,8 +42,8 @@ fnmonad monadfunctiondefs[] = { 0, /* ⊃ */ fnNest, /* ⊆ */ 0, /* ⌷ */ - 0, /* ⍋ */ - 0, /* ⍒ */ + fnGradeUp, /* ⍋ */ + fnGradeDown, /* ⍒ */ fnIndexGenerator, /* ⍳ */ 0, /* ⍸ */ 0, /* ∊ */ @@ -96,7 +96,7 @@ fndyad dyadfunctiondefs[] = { 0, /* ⊂ */ 0, /* ⊃ */ 0, /* ⊆ */ - 0, /* ⌷ */ + fnIndex, /* ⌷ */ 0, /* ⍋ */ 0, /* ⍒ */ 0, /* ⍳ */ @@ -185,6 +185,55 @@ fnEnclose(Array *right) } Array * +fnGradeUp(Array *right) +{ + if(right->rank == 0){ + print("Rank 0 not allowed in ⍋\n"); + exits("rank"); + } + + int i,j; + int len = right->shape[0]; + Array **elems = malloc(sizeof(Array *) * len); + Array *index = mkscalarint(currentsymtab->io); + Array *order = allocarray(AtypeInt, 1, len); + order->shape[0] = len; + + for(i = 0; i < len; i++, index->intdata[0]++){ + order->intdata[i] = currentsymtab->io + i; + elems[i] = fnIndex(index, right); + } + + /* Do a insertion sort on elems, while also updating order */ + for(i = 1; i < len; i++){ + for(j = i; j > 0 && comparearray(elems[j], elems[j-1], 0) == -1; j--){ + Array *tmpA = elems[j]; + elems[j] = elems[j-1]; + elems[j-1] = tmpA; + + int tmpI = order->intdata[j]; + order->intdata[j] = order->intdata[j-1]; + order->intdata[j-1] = tmpI; + } + } + + freearray(index); + for(i = 0; i < len; i++) + freearray(elems[i]); + free(elems); + return order; +} + +Array * +fnGradeDown(Array *right) +{ + Array *tmp = fnGradeUp(right); + Array *res = fnReverseFirst(tmp); + freearray(tmp); + return res; +} + +Array * fnIndexGenerator(Array *right) { /* TODO only works for creating vectors */ @@ -511,11 +560,121 @@ fnRight(Array *left, Array *right) Array * fnMatch(Array *left, Array *right) { - int cmp = comparearray(left, right); + int cmp = comparearray(left, right, 1); return mkscalarint(cmp == 0); } Array * +fnIndex(Array *left, Array *right) +{ + /* + 1) depth must be ≤ 2 + 2) type of data must be integer + 3) all integers must be ≥ ⎕IO + 4) left must be a scalar or vector + 5) if ≢left < ≢right, left is extended: + leftModified←left⍪⍳¨(≢left)↓⍴right + 6) Result shape ≡ ↑,/⍴¨leftModified + */ + + int io = currentsymtab->io; + int i; + + if(left->rank > 1){ + print("Index vector rank too large\n"); + exits(nil); + } + if(left->type != AtypeArray && left->type != AtypeInt){ + print("Index vector wrong type\n"); + exits(nil); + } + if(left->size > right->rank){ + print("Index vector too long\n"); + exits(nil); + } + + /* extend left index vector to full format */ + Array *oldleft = left; + left = allocarray(AtypeArray, 1, right->rank); + left->shape[0] = right->rank; + for(i = 0; i < left->size; i++){ + if(i >= oldleft->size){ + Array *n = mkscalarint(right->shape[i]); + left->arraydata[i] = fnIndexGenerator(n); + freearray(n); + }else if(oldleft->type == AtypeInt){ + if(oldleft->intdata[i] < io || oldleft->intdata[i] >= io + right->shape[i]){ + print("Index error\n"); + exits(nil); + } + left->arraydata[i] = mkscalarint(oldleft->intdata[i]); + }else if(oldleft->type == AtypeArray){ + Array *sub = oldleft->arraydata[i]; + if(sub->type != AtypeInt){ + print("Type error\n"); + exits(nil); + } + for(int j = 0; j < sub->size; j++){ + if(sub->intdata[j] < io || sub->intdata[j] >= io + right->shape[i]){ + print("Index error\n"); + exits(nil); + } + } + left->arraydata[i] = oldleft->arraydata[i]; + incref(left->arraydata[i]); + } + } + + Array *shape = allocarray(AtypeInt, 1, 0); + shape->shape[0] = 0; + + int rank = 0; + int size = 1; + for(i = 0; i < left->size; i++){ + if(left->type == AtypeArray){ + Array *tmp = shape; + Array *newShape = fnShape(left->arraydata[i]); + shape = fnCatenateFirst(tmp, newShape); + freearray(tmp); + freearray(newShape); + } + } + + for(i = 0; i < shape->size; i++){ + size *= shape->intdata[i]; + rank++; + } + + Array *result = allocarray(right->type, rank, size); + for(i = 0; i < rank; i++) + result->shape[i] = shape->intdata[i]; + freearray(shape); + int *leftindex = mallocz(sizeof(int) * right->rank, 1); + for(i = 0; i < result->size; i++){ + for(int j = left->size-1; leftindex[j] == left->arraydata[j]->size; j--){ + leftindex[j] = 0; + leftindex[j-1]++; + } + int from = 0; + int cellsize = right->size; + for(int j = 0; j < left->size; j++){ + cellsize = cellsize / right->shape[j]; + from += cellsize * (left->arraydata[j]->intdata[leftindex[j]] - io); + } + memcpy( + result->rawdata + i * datasizes[result->type], + right->rawdata + from * datasizes[result->type], + datasizes[result->type]); + if(result->type == AtypeArray) + incref(result->arraydata[i]); + leftindex[left->size-1]++; + } + free(leftindex); + freearray(left); + return result; +} + +Array * fnCatenateFirst(Array *left, Array *right) { Array *leftarr; |