Implement inner product . and outer product ⌾

1 files changed, 55 insertions, 2 deletions

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){