From 960ac4694db2060429ec54c9ff2878cad34d8661 Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Thu, 20 Jan 2022 17:55:27 +0000 Subject: =?UTF-8?q?Implement=20dyadic=20=E2=8C=B7,=20monadic=20=E2=8D=8B?= =?UTF-8?q?=20and=20monadic=20=E2=8D=92?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- functions.c | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 163 insertions(+), 4 deletions(-) (limited to 'functions.c') 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, /* ⍳ */ @@ -184,6 +184,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) { @@ -511,10 +560,120 @@ 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) { -- cgit v1.2.3