From 071bef0ccfca9137eb3c814cbc9552f02e6f1b4d Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Sat, 22 Jan 2022 16:44:27 +0000
Subject: =?UTF-8?q?Implement=20monadic=20+=20-=20=C3=B7=20=C3=97=20*=20?=
 =?UTF-8?q?=E2=8D=9F=20|=20=E2=8C=88=20=E2=8C=8A?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 functions.c | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 115 insertions(+), 12 deletions(-)

(limited to 'functions.c')

diff --git a/functions.c b/functions.c
index d9b2eb4..870ee17 100644
--- a/functions.c
+++ b/functions.c
@@ -7,19 +7,19 @@
 Rune primfuncnames[] = L"+-×÷*⍟⌹○!?|⌈⌊⊥⊤⊣⊢=≠≤<>≥≡≢∨∧⍲⍱↑↓⊂⊃⊆⌷⍋⍒⍳⍸∊⍷∪∩~,⍪⍴⌽⊖⍉⍎⍕";
 
 fnmonad monadfunctiondefs[] = {
-	0, /* + */
-	0, /* - */
-	0, /* × */
-	0, /* ÷ */
-	0, /* * */
-	0, /* ⍟ */
+	fnSame, /* + */
+	fnNegate, /* - */
+	fnSign, /* × */
+	fnRecip, /* ÷ */
+	fnExponent, /* * */
+	fnNaturalLog, /* ⍟ */
 	0, /* ⌹ */
-	0, /* ○ */
+	fnPiTimes, /* ○ */
 	0, /* ! */
 	0, /* ? */
-	0, /* | */
-	0, /* ⌈ */
-	0, /* ⌊ */
+	fnMagnitude, /* | */
+	fnCeiling, /* ⌈ */
+	fnFloor, /* ⌊ */
 	0, /* ⊥ */
 	0, /* ⊤ */
 	fnSame, /* ⊣ */
@@ -50,7 +50,7 @@ fnmonad monadfunctiondefs[] = {
 	0, /* ⍷ */
 	0, /* ∪ */
 	0, /* ∩ */
-	0, /* ~ */
+	fnNot, /* ~ */
 	fnRavel, /* , */
 	fnTable, /* ⍪ */
 	fnShape, /* ⍴ */
@@ -221,6 +221,87 @@ rundfn(Rune *code, Array *left, Array *right)
 
 /* Monadic functions */
 
+Array *
+fnNegate(Array *right)
+{
+	return rundfn(L"0-⍵", nil, right);
+}
+
+Array *
+fnSign(Array *right)
+{
+	return rundfn(L"(¯1×⍵<0)+⍵>0", nil, right);
+}
+
+Array *
+fnRecip(Array *right)
+{
+	return rundfn(L"1÷⍵", nil, right);
+}
+
+Array *
+fnExponent(Array *right)
+{
+	Array *e = mkscalarfloat(2.7182818284590452353602);
+	Array *res = fnPower(e, right);
+	freearray(e);
+	return res;
+}
+
+Array *
+fnNaturalLog(Array *right)
+{
+	Array *e = mkscalarfloat(2.7182818284590452353602);
+	Array *res = fnLogarithm(e, right);
+	freearray(e);
+	return res;
+}
+
+Array *
+fnPiTimes(Array *right)
+{
+	Array *pi = mkscalarfloat(PI);
+	Array *res = fnTimes(pi, right);
+	freearray(pi);
+	return res;
+}
+
+Array *
+fnMagnitude(Array *right)
+{
+	return rundfn(L"⍵××⍵", nil, right);
+}
+
+Array *
+fnCeiling(Array *right)
+{
+	return rundfn(L"-⌊-⍵", nil, right);
+}
+
+Array *
+fnFloor(Array *right)
+{
+	Array *res = nil;
+	switch(right->type){
+	case AtypeInt:
+		res = fnSame(right);
+		break;
+	case AtypeFloat:
+		res = duparrayshape(right, AtypeInt);
+		for(int i = 0; i < right->size; i++)
+			res->intdata[i] = floor(right->floatdata[i]);
+		break;
+	case AtypeArray:
+		res = duparrayshape(right, AtypeArray);
+		for(int i = 0; i < right->size; i++)
+			res->arraydata[i] = fnFloor(right->arraydata[i]);
+		break;
+	default:
+		throwerror(nil, EType);
+	}
+	return res;
+}
+
 Array *
 fnSame(Array *right)
 {
@@ -420,6 +501,25 @@ fnNest(Array *right)
 		return fnSame(right);
 }
 
+Array *
+fnNot(Array *right)
+{
+	if(right->type != AtypeInt)
+		throwerror(nil, EType);
+	Array *res = duparray(right);
+	for(int i = 0; i < res->size; i++){
+		if(res->intdata[i] == 0)
+			res->intdata[i] = 1;
+		else if(res->intdata[i] == 1)
+			res->intdata[i] = 0;
+		else{
+			freearray(res);
+			throwerror(nil, EType);
+		}
+	}
+	return res;
+}
+
 Array *
 fnRavel(Array *right)
 {
@@ -580,7 +680,10 @@ SCALAR_FUNCTION_2(fnTimes, 0, left->type,
 
 SCALAR_FUNCTION_2(fnDivide, 1, left->type,
 	case AtypeFloat:
-		res->floatdata[i] /= right->floatdata[i];
+		if(right->floatdata[i] == 0)
+			throwerror(nil, EDomain);
+		else
+			res->floatdata[i] /= right->floatdata[i];
 		break;
 )
 
-- 
cgit v1.2.3