Implement dyadic ⌷, monadic ⍋ and monadic ⍒

1 files changed, 163 insertions, 4 deletions

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;