From 7f66d444451dab0e831cc0f14cc77ad691936f42 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Wed, 26 Jan 2022 13:00:39 +0000
Subject: =?UTF-8?q?Implement=20inner=20product=20.=20and=20outer=20product?=
 =?UTF-8?q?=20=E2=8C=BE?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 apl9.h      |  2 ++
 array.c     | 18 +++++++++++++++++-
 functions.c |  5 +----
 operators.c | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 4 files changed, 75 insertions(+), 7 deletions(-)

diff --git a/apl9.h b/apl9.h
index 4da1606..1348d23 100644
--- a/apl9.h
+++ b/apl9.h
@@ -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 *);
diff --git a/array.c b/array.c
index 7efc1b0..a4bde78 100644
--- a/array.c
+++ b/array.c
@@ -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, /* ⍥ */
@@ -78,6 +79,44 @@ opSwitch(Datum *lefto, Array *left, Array *right)
 		return nil;
 }
 
+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)
 {
@@ -125,6 +164,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)
 {
-- 
cgit v1.2.3