Naive calculator - that also includes optimization of FreeMonad

diff --git a/example/ApplicatorLiftTest.php b/example/ApplicatorLiftTest.php
index 1198e45..23f2a42 100644 (file)
--- a/example/ApplicatorLiftTest.php
+++ b/example/ApplicatorLiftTest.php
@@ -7,7 +7,7 @@ namespace example;
 use Widmogrod\Functional as f;
 use Widmogrod\Primitive\Listt;
 
-function sum($a, $b)
+function sum_($a, $b)
 {
     return $a + $b;
 }
@@ -20,7 +20,7 @@ class ApplicatorLiftTest extends \PHPUnit\Framework\TestCase
         $listB = f\fromIterable([4, 5]);
 
         // sum <*> [1, 2] <*> [4, 5]
-        $result = f\liftA2('example\sum', $listA, $listB);
+        $result = f\liftA2('example\sum_', $listA, $listB);
         $this->assertInstanceOf(Listt::class, $result);
         $this->assertEquals([5, 6, 6, 7], f\valueOf($result));
     }
@@ -28,7 +28,7 @@ class ApplicatorLiftTest extends \PHPUnit\Framework\TestCase
     public function test_it_should_sum_all_from_one_list_with_single_element()
     {
         // sum <$> [1, 2] <*> [4, 5]
-        $sum = f\curryN(2, 'example\sum');
+        $sum = f\curryN(2, 'example\sum_');
         $a = f\fromIterable([1, 2]);
         $b = f\fromIterable([4, 5]);
 

diff --git a/example/FreeCalculatorTest.php b/example/FreeCalculatorTest.php
new file mode 100644 (file)
index 0000000..dd91161
--- /dev/null
+++ b/example/FreeCalculatorTest.php
@@ -0,0 +1,363 @@
+<?php
+
+declare(strict_types=1);
+
+namespace example;
+
+use Widmogrod\FantasyLand\Functor;
+use Widmogrod\Monad\Free\MonadFree;
+use Widmogrod\Monad\Free\Pure;
+use Widmogrod\Monad\Identity;
+use Widmogrod\Primitive\Stringg;
+use Widmogrod\Useful\PatternMatcher;
+use function Widmogrod\Functional\compose;
+use function Widmogrod\Functional\liftM2;
+use function Widmogrod\Monad\Free\foldFree;
+use function Widmogrod\Monad\Free\liftF;
+use function Widmogrod\Useful\match;
+
+/**
+ *  Exp a next
+ *      = IntVal a (a -> next)
+ *      | Sum a a (a -> next)
+ *      | Multiply a a (a -> next)
+ *      | Square a (a -> next)
+ */
+interface ExpF extends Functor, PatternMatcher
+{
+}
+
+class IntVal implements ExpF
+{
+    private $int;
+    private $next;
+
+    public function __construct(int $int, callable $next)
+    {
+        $this->int = $int;
+        $this->next = $next;
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function map(callable $function): Functor
+    {
+        return new self(
+            $this->int,
+            compose($function, $this->next)
+        );
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function patternMatched(callable $fn)
+    {
+        return $fn($this->int, $this->next);
+    }
+}
+
+class Sum implements ExpF
+{
+    private $a;
+    private $b;
+    private $next;
+
+    public function __construct($a, $b, callable $next)
+    {
+        $this->a = $a;
+        $this->b = $b;
+        $this->next = $next;
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function map(callable $function): Functor
+    {
+        return new self(
+            $this->a,
+            $this->b,
+            compose($function, $this->next)
+        );
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function patternMatched(callable $fn)
+    {
+        return $fn($this->a, $this->b, $this->next);
+    }
+}
+
+class Multiply implements ExpF
+{
+    private $a;
+    private $b;
+    private $next;
+
+    public function __construct($a, $b, callable $next)
+    {
+        $this->a = $a;
+        $this->b = $b;
+        $this->next = $next;
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function map(callable $function): Functor
+    {
+        return new self(
+            $this->a,
+            $this->b,
+            compose($function, $this->next)
+        );
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function patternMatched(callable $fn)
+    {
+        return $fn($this->a, $this->b, $this->next);
+    }
+}
+
+
+class Square implements ExpF
+{
+    private $a;
+    private $next;
+
+    public function __construct($a, callable $next)
+    {
+        $this->a = $a;
+        $this->next = $next;
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function map(callable $function): Functor
+    {
+        return new self(
+            $this->a,
+            compose($function, $this->next)
+        );
+    }
+
+    /**
+     * @inheritdoc
+     */
+    public function patternMatched(callable $fn)
+    {
+        return $fn($this->a, $this->next);
+    }
+}
+
+
+function sum(MonadFree $a, MonadFree $b): MonadFree
+{
+    return liftM2(function ($a, $b) {
+        return liftF(new Sum($a, $b, Pure::of));
+    }, $a, $b);
+}
+
+function int(int $int): MonadFree
+{
+    return liftF(new IntVal($int, Pure::of));
+}
+
+function mul(MonadFree $a, MonadFree $b): MonadFree
+{
+    return liftM2(function ($a, $b) {
+        return liftF(new Multiply($a, $b, Pure::of));
+    }, $a, $b);
+}
+
+function square(MonadFree $a): MonadFree
+{
+    return $a->bind(function ($a) {
+        return liftF(new Square($a, Pure::of));
+    });
+}
+
+const interpretInt = 'example\interpretInt';
+
+/**
+ * interpretInt :: ExpF -> Identity Free Int
+ *
+ * @return Identity
+ * @throws \Widmogrod\Useful\PatternNotMatchedError
+ */
+function interpretInt(ExpF $f)
+{
+    return match([
+        IntVal::class => function (int $x, callable $next): Identity {
+            return Identity::of($x)->map($next);
+        },
+        Sum::class => function (int $a, int $b, callable $next): Identity {
+            return Identity::of($a + $b)->map($next);
+        },
+        Multiply::class => function (int $a, int $b, callable $next): Identity {
+            return Identity::of($a * $b)->map($next);
+        },
+        Square::class => function (int $a, callable $next): Identity {
+            return Identity::of(pow($a, 2))->map($next);
+        },
+    ], $f);
+}
+
+const interpretPrint = 'example\interpretPrint';
+
+/**
+ * interpretInt :: ExpF -> Identity Free Stringg
+ *
+ * @return Identity
+ * @throws \Widmogrod\Useful\PatternNotMatchedError
+ */
+function interpretPrint(ExpF $f)
+{
+    return match([
+        IntVal::class => function (int $x, callable $next): Identity {
+            return Identity::of(Stringg::of("$x"))->map($next);
+        },
+        Sum::class => function (Stringg $a, Stringg $b, callable $next): Identity {
+            return Identity::of(
+                Stringg::of('(')->concat($a->concat(Stringg::of('+'))->concat($b))->concat(Stringg::of(')'))
+            )->map($next);
+        },
+        Multiply::class => function (Stringg $a, Stringg $b, callable $next): Identity {
+            return Identity::of(
+                Stringg::of('(')->concat($a->concat(Stringg::of('*'))->concat($b))->concat(Stringg::of(')'))
+            )->map($next);
+        },
+        Square::class => function (Stringg $a, callable $next): Identity {
+            return Identity::of(
+                Stringg::of('(')->concat($a->concat(Stringg::of('^2')))->concat(Stringg::of(')'))
+            )->map($next);
+        },
+    ], $f);
+}
+
+const optimizeCalc = 'example\optimizeCalc';
+
+/**
+ * optimizeCalc :: ExpF ->  ExpF
+ *
+ * @return Identity
+ * @throws \Widmogrod\Useful\PatternNotMatchedError
+ */
+function optimizeCalc(ExpF $f)
+{
+    return match([
+        IntVal::class => function ($x, callable $next) {
+            return new IntVal($x, $next);
+        },
+        Sum::class => function ($a, $b, callable $next) {
+            return new Sum($a, $b, $next);
+        },
+        Multiply::class => function ($a, $b, callable $next) {
+            return $a == $b
+                ? new Square($a, $next)
+                : new Multiply($a, $b, $next);
+        },
+        Square::class => function ($a, callable $next) {
+            return new Square($a, $next);
+        },
+    ], $f);
+}
+
+class FreeCalculatorTest extends \PHPUnit\Framework\TestCase
+{
+    /**
+     * @dataProvider provideCalculations
+     */
+    public function test_example_with_do_notation($calc, $expected)
+    {
+        $result = foldFree(interpretInt, $calc, Identity::of);
+        $this->assertEquals(Identity::of($expected), $result);
+    }
+
+    public function provideCalculations()
+    {
+        return [
+            '1' => [
+                '$calc' => int(1),
+                '$expected' => 1,
+            ],
+            '1 + 1' => [
+                '$calc' => sum(
+                    int(1),
+                    int(1)
+                ),
+                '$expected' => 2,
+            ],
+            '2 * 3' => [
+                '$calc' => mul(
+                    int(2),
+                    int(3)
+                ),
+                '$expected' => 6,
+            ],
+            '(1 + 1) * (2 * 3)' => [
+                '$calc' => mul(
+                    sum(int(1), int(1)),
+                    mul(
+                        int(2),
+                        int(3)
+                    )
+                ),
+                '$expected' => 12,
+            ],
+            '(2 * 3) ^ 2' => [
+                '$calc' =>
+                    square(
+                        mul(
+                            int(2),
+                            int(3)
+                        )
+                    ),
+                '$expected' => 36,
+            ],
+        ];
+    }
+
+    public function test_it_should_pretty_print()
+    {
+        $calc = mul(
+            sum(int(1), int(1)),
+            mul(
+                int(2),
+                square(int(3))
+            )
+        );
+
+        $expected = '((1+1)*(2*(3^2)))';
+
+        $result = foldFree(interpretPrint, $calc, Identity::of);
+        $this->assertEquals(
+            Identity::of(Stringg::of($expected)),
+            $result
+        );
+    }
+
+    public function test_it_should_optimize()
+    {
+        $calc = mul(
+            sum(int(2), int(1)),
+            sum(int(2), int(1))
+        );
+
+        $expected = '((2+1)^2)';
+
+        $result = foldFree(compose(interpretPrint, optimizeCalc), $calc, Identity::of);
+        $this->assertEquals(
+            Identity::of(Stringg::of($expected)),
+            $result
+        );
+    }
+}