Data commit

Task/Monads-Writer-monad/00-META.yaml

@@ -0,0 +1,4 @@
+---
+category:
+- Monads
+from: http://rosettacode.org/wiki/Monads/Writer_monad

Task/Monads-Writer-monad/00-TASK.txt

@@ -0,0 +1,9 @@
+The Writer monad is a programming design pattern which makes it possible to compose functions which return their result values paired with a log string. The final result of a composed function yields both a value, and a concatenation of the logs from each component function application.
+
+Demonstrate in your programming language the following:
+
+# Construct a Writer monad by writing the 'bind' function and the 'unit' (sometimes known as 'return') function for that monad (or just use what the language already provides)
+# Write three simple functions: root, addOne, and half
+# Derive Writer monad versions of each of these functions
+# Apply a composition of the Writer versions of root, addOne, and half to the integer 5, deriving both a value for the Golden Ratio φ, and a concatenated log of the function applications (starting with the initial value, and followed by the application of root, etc.)
+

Task/Monads-Writer-monad/ALGOL-68/monads-writer-monad.alg

@@ -0,0 +1,26 @@
+BEGIN
+    MODE MWRITER = STRUCT( LONG REAL value
+                         , STRING    log
+                         );
+    PRIO BIND = 9;
+    OP   BIND = ( MWRITER m, PROC( LONG REAL )MWRITER f )MWRITER:
+    (    MWRITER n := f( value OF m );
+         log OF n  := log OF m + log OF n;
+         n
+    );
+
+    OP   LEN     = ( STRING s )INT: ( UPB s + 1 ) - LWB s;
+    PRIO PAD     = 9;
+    OP   PAD     = ( STRING s, INT width )STRING: IF LEN s >= width THEN s ELSE s + ( width - LEN s ) * " " FI;
+
+    PROC unit    = ( LONG REAL v, STRING s )MWRITER: ( v, "  " + s PAD 17 + ":" + fixed( v, -19, 15 ) + REPR 10 );
+
+    PROC root    = ( LONG REAL v )MWRITER: unit( long sqrt( v ), "Took square root" );
+    PROC add one = ( LONG REAL v )MWRITER: unit( v+1, "Added one" );
+    PROC half    = ( LONG REAL v )MWRITER: unit( v/2, "Divided by two" );
+
+    MWRITER mw2 := unit( 5, "Initial value" ) BIND root BIND add one BIND half;
+    print( ( "The Golden Ratio is", fixed( value OF mw2, -19, 15 ), newline ) );
+    print( ( newline, "This was derived as follows:-", newline ) );
+    print( ( log OF mw2 ) )
+END

Task/Monads-Writer-monad/ATS/monads-writer-monad.ats

@@ -0,0 +1,144 @@
+#include "share/atspre_staload.hats"
+
+%{^
+#include <math.h>
+%}
+
+#define NIL list_nil ()
+#define ::  list_cons
+
+(* The log is a list of strings. For efficiency, it is ordered
+   most-recent-first. The static value "n" represents the number of
+   entries in the log. (It exists and is used only during the
+   typechecking phase.) *)
+datatype Writer (a : t@ype+, n : int) =
+| Writer of (a, list (string, n))
+typedef Writer (a : t@ype+) = [n : int] Writer (a, n)
+
+prfn
+lemma_Writer_param {a : t@ype}
+                   {n : int}
+                   (m : Writer (a, n))
+    :<prf> [0 <= n] void =
+  let
+    val+ Writer (_, log) = m
+  in
+    lemma_list_param log
+  end
+
+fn {a : t@ype}
+unit_Writer (x : a) : Writer (a, 1) =
+  let
+    val msg = string_append ("unit_Writer (",
+                             tostring_val<a> x, ")")
+    val msg = strptr2string msg
+  in
+    Writer (x, msg :: NIL)
+  end
+
+overload return with unit_Writer
+
+fn {a, b : t@ype}
+bind_Writer {n : int}
+            (m : Writer (a, n),
+             f : a -<cloref1> Writer b)
+    : [n1 : int | n <= n1] Writer (b, n1) =
+  let
+    val+ Writer (x, log) = m
+    val y = f (x)
+    prval () = lemma_Writer_param y
+    val+ Writer (y, entries) = y
+  in
+    Writer (y, list_append (entries, log))
+  end
+
+infixl 0 >>=
+overload >>= with bind_Writer
+
+fn {a, b, c : t@ype}
+compose_Writer (f : a -<cloref1> Writer b,
+                g : b -<cloref1> Writer c)
+    : a -<cloref1> Writer c =
+  lam m => f m >>= g
+
+infixl 0 >=>
+overload >=> with compose_Writer
+
+(* "make_Writer_closure_from_fun" wraps an ordinary function from a to
+   b, resulting in a closure that will produce exactly one log
+   entry. *)
+fn {a, b : t@ype}
+make_Writer_closure_from_fun (func     : a -> b,
+                              make_msg : (a, b) -<cloref1> string)
+    : a -<cloref1> Writer (b, 1) =
+  lam x =>
+    let
+      val y = func x
+    in
+      Writer (y, make_msg (x, y) :: NIL)
+    end
+
+overload make_Writer_closure with make_Writer_closure_from_fun
+
+(* A note regarding "root": interfaces to the C math library are
+   available, even within the Postiats distribution, but I shall
+   simply make a foreign function call to sqrt(3). The Postiats
+   prelude itself provides no (or very little) interface to libm. *)
+fn root (x : double) : double = $extfcall (double, "sqrt", x)
+fn addOne (x : double) : double = succ x
+fn half (x : double) : double = 0.5 * x
+
+fn {a, b : t@ype}
+make_logging (func     : a -> b,
+              notation : string)
+    : a -<cloref1> Writer (b, 1) =
+  let
+    fn
+    make_msg (x : a, y : b) :<cloref1> string =
+      let
+        val msg = string_append ("(", tostring_val<a> x,
+                                 " |> ", notation, ") --> ",
+                                 tostring_val<b> y)
+      in
+        strptr2string msg
+      end
+  in
+    make_Writer_closure<a,b> (func, make_msg)
+  end
+
+val logging_root = make_logging<double,double> (root, "sqrt")
+val logging_addOne = make_logging<double,double> (addOne, "(+ 1.0)")
+val logging_half = make_logging<double,double> (half, "(0.5 *)")
+
+val the_big_whatchamacallit =
+  logging_root >=> logging_addOne >=> logging_half
+
+fn
+print_log (log : List string) : void =
+  let
+    fun
+    loop (lst : List0 string) : void =
+      case+ lst of
+      | NIL => ()
+      | hd :: tl =>
+        begin
+          println! ("  ", hd);
+          loop tl
+        end
+
+    prval () = lemma_list_param log
+  in
+    loop (list_vt2t (list_reverse log))
+  end
+
+implement
+main0 () =
+  let
+    val x = 5.0
+    val m = return<double> x
+    val+ Writer (y, log) = m >>= the_big_whatchamacallit
+  in
+    println! ("(1 + sqrt(", x : double, "))/2 = ", y : double);
+    println! ("log:");
+    print_log log
+  end

Task/Monads-Writer-monad/AppleScript/monads-writer-monad.applescript

@@ -0,0 +1,119 @@
+-- WRITER MONAD FOR APPLESCRIPT
+
+-- How can we compose functions which take simple values as arguments
+-- but return an output value which is paired with a log string ?
+
+-- We can prevent functions which expect simple values from choking
+-- on log-wrapped output (from nested functions)
+-- by writing Unit/Return() and Bind() for the Writer monad in AppleScript
+
+on run {}
+
+    -- Derive logging versions of three simple functions, pairing
+    -- each function with a particular comment string
+
+    -- (a -> b) -> (a -> (b, String))
+    set wRoot to writerVersion(root, "obtained square root")
+    set wSucc to writerVersion(succ, "added one")
+    set wHalf to writerVersion(half, "divided by two")
+
+    loggingHalfOfRootPlusOne(5)
+
+    --> value + log string
+end run
+
+
+-- THREE SIMPLE FUNCTIONS
+on root(x)
+    x ^ (1 / 2)
+end root
+
+on succ(x)
+    x + 1
+end succ
+
+on half(x)
+    x / 2
+end half
+
+-- DERIVE A LOGGING VERSION OF A FUNCTION  BY COMBINING IT WITH A
+-- LOG STRING FOR THAT FUNCTION
+-- (SEE 'on run()' handler at top of script)
+-- (a -> b) -> String -> (a -> (b, String))
+on writerVersion(f, strComment)
+    script
+        on call(x)
+            {value:sReturn(f)'s call(x), comment:strComment}
+        end call
+    end script
+end writerVersion
+
+
+-- DEFINE A COMPOSITION OF THE SAFE VERSIONS
+on loggingHalfOfRootPlusOne(x)
+    logCompose([my wHalf, my wSucc, my wRoot], x)
+end loggingHalfOfRootPlusOne
+
+
+-- Monadic UNIT/RETURN and BIND functions for the writer monad
+on writerUnit(a)
+    try
+        set strValue to ": " & a as string
+    on error
+        set strValue to ""
+    end try
+    {value:a, comment:"Initial value" & strValue}
+end writerUnit
+
+on writerBind(recWriter, wf)
+    set recB to wf's call(value of recWriter)
+    set v to value of recB
+
+    try
+        set strV to " -> " & (v as string)
+    on error
+        set strV to ""
+    end try
+
+    {value:v, comment:(comment of recWriter) & linefeed & (comment of recB) & strV}
+end writerBind
+
+-- THE TWO HIGHER ORDER FUNCTIONS ABOVE ENABLE COMPOSITION OF
+-- THE LOGGING VERSIONS OF EACH FUNCTION
+on logCompose(lstFunctions, varValue)
+    reduceRight(lstFunctions, writerBind, writerUnit(varValue))
+end logCompose
+
+-- xs: list, f: function, a: initial accumulator value
+-- the arguments available to the function f(a, x, i, l) are
+-- v: current accumulator value
+-- x: current item in list
+-- i: [ 1-based index in list ] optional
+-- l: [ a reference to the list itself ] optional
+on reduceRight(xs, f, a)
+    set sf to sReturn(f)
+
+    repeat with i from length of xs to 1 by -1
+        set a to sf's call(a, item i of xs, i, xs)
+    end repeat
+end reduceRight
+
+-- Unit/Return and bind for composing handlers in script wrappers
+-- lift 2nd class function into 1st class wrapper
+-- handler function --> first class script object
+on sReturn(f)
+    script
+        property call : f
+    end script
+end sReturn
+
+-- return a new script in which function g is composed
+-- with the f (call()) of the Mf script
+-- Mf -> (f -> Mg) -> Mg
+on sBind(mf, g)
+    script
+        on call(x)
+            sReturn(g)'s call(mf's call(x))
+        end call
+    end script
+end sBind

Task/Monads-Writer-monad/C++/monads-writer-monad.cpp

@@ -0,0 +1,43 @@
+#include <cmath>
+#include <iostream>
+#include <string>
+
+using namespace std;
+
+// Use a struct as the monad
+struct LoggingMonad
+{
+    double Value;
+    string Log;
+};
+
+// Use the >> operator as the bind function
+auto operator>>(const LoggingMonad& monad, auto f)
+{
+    auto result = f(monad.Value);
+    return LoggingMonad{result.Value, monad.Log + "\n" + result.Log};
+}
+
+// Define the three simple functions
+auto Root = [](double x){ return sqrt(x); };
+auto AddOne = [](double x){ return x + 1; };
+auto Half = [](double x){ return x / 2.0; };
+
+// Define a function to create writer monads from the simple functions
+auto MakeWriter = [](auto f, string message)
+{
+    return [=](double x){return LoggingMonad(f(x), message);};
+};
+
+// Derive writer versions of the simple functions
+auto writerRoot = MakeWriter(Root, "Taking square root");
+auto writerAddOne = MakeWriter(AddOne, "Adding 1");
+auto writerHalf = MakeWriter(Half, "Dividing by 2");
+
+
+int main()
+{
+    // Compose the writers to compute the golden ratio
+    auto result = LoggingMonad{5, "Starting with 5"} >> writerRoot >> writerAddOne >> writerHalf;
+    cout << result.Log << "\nResult: " << result.Value;
+}

Task/Monads-Writer-monad/EchoLisp/monads-writer-monad.l

@@ -0,0 +1,42 @@
+(define (Writer.unit x (log #f))
+	(if log (cons log x)
+		(cons (format "init → %d" x) x)))
+
+;; f is a lisp function
+;; (Writer.lift f) returns a  Writer function which returns a Writer element
+
+(define (Writer.lift f name)
+	(lambda(elem)
+             (Writer.unit
+             	(f (rest elem))
+                (format "%a \n %a  → %a" (first elem) name (f (rest elem))))))
+
+;; lifts and applies
+(define (Writer.bind f elem) ((Writer.lift f (string f)) elem))
+
+(define (Writer.print elem) (writeln 'result (rest elem)) (writeln (first elem)))
+		
+;; Writer monad versions
+(define w-root  (Writer.lift sqrt "root"))
+(define w-half  (Writer.lift (lambda(x) (// x 2)) "half"))
+(define w-inc  ( Writer.lift add1 "add-one"))
+
+
+;; no binding required, as we use Writer lifted functions
+(->  5 Writer.unit w-root w-inc w-half Writer.print)
+
+result 1.618033988749895
+init → 5
+root → 2.23606797749979
+add-one → 3.23606797749979
+half → 1.618033988749895
+
+;; binding
+(->>  0 Writer.unit (Writer.bind sin) (Writer.bind cos)  w-inc w-half Writer.print)
+
+result 1
+init → 0
+sin → 0
+cos → 1
+add-one → 2
+half → 1

Task/Monads-Writer-monad/F-Sharp/monads-writer-monad.fs

@@ -0,0 +1,11 @@
+// Monads/Writer monad . Nigel Galloway: July 20th., 2022
+type Riter<'n>=Riter of 'n * List<string>
+let eval=function |Riter(n,g)->(n,g)
+let compose f=function |Riter(n,g)->let n,l=eval(f n) in Riter(n,List.append g l)
+let initV n=Riter(n,[sprintf "Initial Value %f" n])
+let sqrt n=Riter(sqrt n,["Took square root"])
+let div n g=Riter(n/g,[sprintf "Divided by %f" n])
+let add n g=Riter(n+g,[sprintf "Added %f" n])
+let result,log=eval((initV>>compose sqrt>>compose(add 1.0)>>compose(div 2.0))5.0)
+log|>List.iter(printfn "%s")
+printfn "Final value = %f" result

Task/Monads-Writer-monad/Factor/monads-writer-monad.factor

@@ -0,0 +1,9 @@
+USING: kernel math math.functions monads prettyprint ;
+FROM: monads => do ;
+
+{
+    [ 5 "Started with five, " <writer> ]
+    [ sqrt "took square root, " <writer> ]
+    [ 1 + "added one, " <writer> ]
+    [ 2 / "divided by two." <writer> ]
+} do .

Task/Monads-Writer-monad/Go/monads-writer-monad.go

@@ -0,0 +1,41 @@
+package main
+
+import (
+    "fmt"
+    "math"
+)
+
+type mwriter struct {
+    value float64
+    log   string
+}
+
+func (m mwriter) bind(f func(v float64) mwriter) mwriter {
+    n := f(m.value)
+    n.log = m.log + n.log
+    return n
+}
+
+func unit(v float64, s string) mwriter {
+    return mwriter{v, fmt.Sprintf("  %-17s: %g\n", s, v)}
+}
+
+func root(v float64) mwriter {
+    return unit(math.Sqrt(v), "Took square root")
+}
+
+func addOne(v float64) mwriter {
+    return unit(v+1, "Added one")
+}
+
+func half(v float64) mwriter {
+    return unit(v/2, "Divided by two")
+}
+
+func main() {
+    mw1 := unit(5, "Initial value")
+    mw2 := mw1.bind(root).bind(addOne).bind(half)
+    fmt.Println("The Golden Ratio is", mw2.value)
+    fmt.Println("\nThis was derived as follows:-")
+    fmt.Println(mw2.log)
+}

Task/Monads-Writer-monad/Haskell/monads-writer-monad.hs

@@ -0,0 +1,13 @@
+import Control.Monad.Trans.Writer
+import Control.Monad ((>=>))
+
+loggingVersion :: (a -> b) -> c -> a -> Writer c b
+loggingVersion f log x = writer (f x, log)
+
+logRoot = loggingVersion sqrt "obtained square root, "
+logAddOne = loggingVersion (+1) "added 1, "
+logHalf = loggingVersion (/2) "divided by 2, "
+
+halfOfAddOneOfRoot = logRoot >=> logAddOne >=> logHalf
+
+main = print $ runWriter (halfOfAddOneOfRoot 5)

Task/Monads-Writer-monad/J/monads-writer-monad-1.j

@@ -0,0 +1,27 @@
+root=: %:
+incr=: >:
+half=: -:
+
+tostr=: ,@":
+
+loggingVersion=: conjunction define
+  n;~u
+)
+
+Lroot=: root loggingVersion 'obtained square root'
+Lincr=: incr loggingVersion 'added 1'
+Lhalf=: half loggingVersion 'divided by 2'
+
+loggingUnit=: verb define
+  y;'Initial value: ',tostr y
+)
+
+loggingBind=: adverb define
+  r=. u 0{::y
+  v=. 0{:: r
+  v;(1{::y),LF,(1{::r),' -> ',tostr v
+)
+
+loggingCompose=: dyad define
+  ;(dyad def '<x`:6 loggingBind;y')/x,<loggingUnit y
+)

Task/Monads-Writer-monad/J/monads-writer-monad-2.j

@@ -0,0 +1,7 @@
+   0{::Lhalf`Lincr`Lroot loggingCompose 5
+1.61803
+   1{::Lhalf`Lincr`Lroot loggingCompose 5
+Initial value: 5
+obtained square root -> 2.23607
+added 1 -> 3.23607
+divided by 2 -> 1.61803

Task/Monads-Writer-monad/Java/monads-writer-monad.java

@@ -0,0 +1,54 @@
+import java.util.function.Function;
+
+public final class MonadWriter {
+
+	public static void main(String[] aArgs) {
+		Monad<Double> initial = Monad.unit(5.0, "Initial value");
+	    Monad<Double> result = initial.bind(MonadWriter::root).bind(MonadWriter::addOne).bind(MonadWriter::half);
+	    System.out.println("The Golden Ratio is " + result.getValue() + System.lineSeparator());
+	    System.out.println("This was derived as follows:"  + System.lineSeparator() + result.getText());
+	}
+	
+	private static Monad<Double> root(double aD) {
+		return Monad.unit(Math.sqrt(aD), "Took square root");
+	}
+
+	private static Monad<Double> addOne(double aD) {
+		return Monad.unit(aD + 1.0, "Added one");
+	}
+
+	private static Monad<Double> half(double aD) {
+		return Monad.unit(aD / 2.0, "Divided by two");
+	}
+	
+}
+	
+final class Monad<T> {		
+	
+	public static <T> Monad<T> unit(T aValue, String aText) {
+		return new Monad<T>(aValue, aText);
+	}
+	
+	public Monad<T> bind(Function<T, Monad<T>> aFunction) {
+		Monad<T> monad = aFunction.apply(value);
+		monad.text = text + monad.text;
+		return monad;
+	}
+	
+	public T getValue() {
+		return value;
+	}
+	
+	public String getText() {
+		return text;
+	}
+	
+	private Monad(T aValue, String aText) {
+		value = aValue;
+		text = String.format("%-21s%s%n", "    " + aText, ": " + aValue);
+	}
+	
+	private T value;
+	private String text;
+	
+}

Task/Monads-Writer-monad/JavaScript/monads-writer-monad.js

@@ -0,0 +1,87 @@
+(function () {
+    'use strict';
+
+    // START WITH THREE SIMPLE FUNCTIONS
+
+    // Square root of a number more than 0
+    function root(x) {
+        return Math.sqrt(x);
+    }
+
+    // Add 1
+    function addOne(x) {
+        return x + 1;
+    }
+
+    // Divide by 2
+    function half(x) {
+        return x / 2;
+    }
+
+
+    // DERIVE LOGGING VERSIONS OF EACH FUNCTION
+
+    function loggingVersion(f, strLog) {
+        return function (v) {
+            return {
+                value: f(v),
+                log: strLog
+            };
+        }
+    }
+
+    var log_root = loggingVersion(root, "obtained square root"),
+
+        log_addOne = loggingVersion(addOne, "added 1"),
+
+        log_half = loggingVersion(half, "divided by 2");
+
+
+    // UNIT/RETURN and BIND for the the WRITER MONAD
+
+    // The Unit / Return function for the Writer monad:
+    // 'Lifts' a raw value into the wrapped form
+    // a -> Writer a
+    function writerUnit(a) {
+        return {
+            value: a,
+            log: "Initial value: " + JSON.stringify(a)
+        };
+    }
+
+    // The Bind function for the Writer monad:
+    // applies a logging version of a function
+    // to the contents of a wrapped value
+    // and return a wrapped result (with extended log)
+
+    // Writer a -> (a -> Writer b) -> Writer b
+    function writerBind(w, f) {
+        var writerB = f(w.value),
+            v = writerB.value;
+
+        return {
+            value: v,
+            log: w.log + '\n' + writerB.log + ' -> ' + JSON.stringify(v)
+        };
+    }
+
+    // USING UNIT AND BIND TO COMPOSE LOGGING FUNCTIONS
+
+    // We can compose a chain of Writer functions (of any length) with a simple foldr/reduceRight
+    // which starts by 'lifting' the initial value into a Writer wrapping,
+    // and then nests function applications (working from right to left)
+    function logCompose(lstFunctions, value) {
+        return lstFunctions.reduceRight(
+            writerBind,
+            writerUnit(value)
+        );
+    }
+
+    var half_of_addOne_of_root = function (v) {
+        return logCompose(
+            [log_half, log_addOne, log_root], v
+        );
+    };
+
+    return half_of_addOne_of_root(5);
+})();

Task/Monads-Writer-monad/Jsish/monads-writer-monad.jsish

@@ -0,0 +1,103 @@
+'use strict';
+
+/* writer monad, in Jsish */
+function writerMonad() {
+
+    // START WITH THREE SIMPLE FUNCTIONS
+
+    // Square root of a number more than 0
+    function root(x) {
+        return Math.sqrt(x);
+    }
+
+    // Add 1
+    function addOne(x) {
+        return x + 1;
+    }
+
+    // Divide by 2
+    function half(x) {
+        return x / 2;
+    }
+
+
+    // DERIVE LOGGING VERSIONS OF EACH FUNCTION
+
+    function loggingVersion(f, strLog) {
+        return function (v) {
+            return {
+                value: f(v),
+                log: strLog
+            };
+        };
+    }
+
+    var log_root = loggingVersion(root, "obtained square root"),
+
+        log_addOne = loggingVersion(addOne, "added 1"),
+
+        log_half = loggingVersion(half, "divided by 2");
+
+
+    // UNIT/RETURN and BIND for the the WRITER MONAD
+
+    // The Unit / Return function for the Writer monad:
+    // 'Lifts' a raw value into the wrapped form
+    // a -> Writer a
+    function writerUnit(a) {
+        return {
+            value: a,
+            log: "Initial value: " + JSON.stringify(a)
+        };
+    }
+
+    // The Bind function for the Writer monad:
+    // applies a logging version of a function
+    // to the contents of a wrapped value
+    // and return a wrapped result (with extended log)
+
+    // Writer a -> (a -> Writer b) -> Writer b
+    function writerBind(w, f) {
+        var writerB = f(w.value),
+            v = writerB.value;
+
+        return {
+            value: v,
+            log: w.log + '\n' + writerB.log + ' -> ' + JSON.stringify(v)
+        };
+    }
+
+    // USING UNIT AND BIND TO COMPOSE LOGGING FUNCTIONS
+
+    // We can compose a chain of Writer functions (of any length) with a simple foldr/reduceRight
+    // which starts by 'lifting' the initial value into a Writer wrapping,
+    // and then nests function applications (working from right to left)
+    function logCompose(lstFunctions, value) {
+        return lstFunctions.reduceRight(
+            writerBind,
+            writerUnit(value)
+        );
+    }
+
+    var half_of_addOne_of_root = function (v) {
+        return logCompose(
+            [log_half, log_addOne, log_root], v
+        );
+    };
+
+    return half_of_addOne_of_root(5);
+}
+
+var writer = writerMonad();
+;writer.value;
+;writer.log;
+
+/*
+=!EXPECTSTART!=
+writer.value ==> 1.61803398874989
+writer.log ==> Initial value: 5
+obtained square root -> 2.23606797749979
+added 1 -> 3.23606797749979
+divided by 2 -> 1.61803398874989
+=!EXPECTEND!=
+*/

Task/Monads-Writer-monad/Julia/monads-writer-monad.julia

@@ -0,0 +1,17 @@
+struct Writer x::Real; msg::String; end
+
+Base.show(io::IO, w::Writer) = print(io, w.msg, ": ", w.x)
+
+unit(x, logmsg) = Writer(x, logmsg)
+
+bind(f, fmsg, w) = unit(f(w.x), w.msg * ", " * fmsg)
+
+f1(x) = 7x
+f2(x) = x + 8
+
+a = unit(3, "after intialization")
+b = bind(f1, "after times 7 ", a)
+c = bind(f2, "after plus 8", b)
+
+println("$a => $b => $c")
+println(bind(f2, "after plus 8", bind(f1, "after times 7", unit(3, "after intialization"))))

Task/Monads-Writer-monad/Kotlin/monads-writer-monad.kotlin

@@ -0,0 +1,31 @@
+// version 1.2.10
+
+import kotlin.math.sqrt
+
+class Writer<T : Any> private constructor(val value: T, s: String) {
+    var log = "  ${s.padEnd(17)}: $value\n"
+        private set
+
+    fun bind(f: (T) -> Writer<T>): Writer<T> {
+        val new = f(this.value)
+        new.log = this.log + new.log
+        return new
+    }
+
+    companion object {
+        fun <T : Any> unit(t: T, s: String) = Writer<T>(t, s)
+    }
+}
+
+fun root(d: Double) = Writer.unit(sqrt(d), "Took square root")
+
+fun addOne(d: Double) = Writer.unit(d + 1.0, "Added one")
+
+fun half(d: Double) = Writer.unit(d / 2.0, "Divided by two")
+
+fun main(args: Array<String>) {
+    val iv = Writer.unit(5.0, "Initial value")
+    val fv = iv.bind(::root).bind(::addOne).bind(::half)
+    println("The Golden Ratio is ${fv.value}")
+    println("\nThis was derived as follows:-\n${fv.log}")
+}

Task/Monads-Writer-monad/Nim/monads-writer-monad.nim

@@ -0,0 +1,19 @@
+from math import sqrt
+from sugar import `=>`, `->`
+
+type
+  WriterUnit = (float, string)
+  WriterBind = proc(a: WriterUnit): WriterUnit
+
+proc bindWith(f: (x: float) -> float; log: string): WriterBind =
+  result = (a: WriterUnit) => (f(a[0]), a[1] & log)
+
+func doneWith(x: int): WriterUnit =
+  (x.float, "")
+
+var
+  logRoot = sqrt.bindWith "obtained square root, "
+  logAddOne = ((x: float) => x+1'f).bindWith "added 1, "
+  logHalf = ((x: float) => x/2'f).bindWith "divided by 2, "
+
+echo 5.doneWith.logRoot.logAddOne.logHalf

Task/Monads-Writer-monad/PHP/monads-writer-monad.php

@@ -0,0 +1,44 @@
+class WriterMonad {
+
+	/** @var mixed */
+	private $value;
+	/** @var string[] */
+	private $logs;
+
+	private function __construct($value, array $logs = []) {
+		$this->value = $value;
+		$this->logs = $logs;
+	}
+
+	public static function unit($value, string $log): WriterMonad {
+		return new WriterMonad($value, ["{$log}: {$value}"]);
+	}
+
+	public function bind(callable $mapper): WriterMonad  {
+		$mapped = $mapper($this->value);
+		assert($mapped instanceof WriterMonad);
+		return new WriterMonad($mapped->value, [...$this->logs, ...$mapped->logs]);
+	}
+
+	public function value() {
+		return $this->value;
+	}
+
+	public function logs(): array {
+		return $this->logs;
+	}
+}
+
+$root = fn(float $i): float => sqrt($i);
+$addOne = fn(float $i): float => $i + 1;
+$half = fn(float $i): float => $i / 2;
+
+$m = fn (callable $callback, string $log): callable => fn ($value): WriterMonad => WriterMonad::unit($callback($value), $log);
+
+$result = WriterMonad::unit(5, "Initial value")
+	->bind($m($root, "square root"))
+	->bind($m($addOne, "add one"))
+	->bind($m($half, "half"));
+
+print "The Golden Ratio is: {$result->value()}\n";
+print join("\n", $result->logs());

Task/Monads-Writer-monad/Perl/monads-writer-monad.pl

@@ -0,0 +1,28 @@
+# 20200704 added Perl programming solution
+
+package Writer;
+
+use strict;
+use warnings;
+
+sub new {
+   my ($class, $value, $log) = @_;
+   return bless [ $value => $log ], $class;
+}
+
+sub Bind {
+   my ($self, $code) = @_;
+   my ($value, $log) = @$self;
+   my $n = $code->($value);
+   return Writer->new( @$n[0], $log.@$n[1] );
+}
+
+sub Unit { Writer->new($_[0], sprintf("%-17s: %.12f\n",$_[1],$_[0])) }
+
+sub root { Unit sqrt($_[0]), "Took square root" }
+
+sub addOne { Unit $_[0]+1, "Added one" }
+
+sub half { Unit $_[0]/2, "Divided by two" }
+
+print Unit(5, "Initial value")->Bind(\&root)->Bind(\&addOne)->Bind(\&half)->[1];

Task/Monads-Writer-monad/Phix/monads-writer-monad.phix

@@ -0,0 +1,30 @@
+(phixonline)-->
+ <span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
+ <span style="color: #008080;">function</span> <span style="color: #000000;">bind</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">unit</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">m</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">al</span><span style="color: #0000FF;">)</span>
+     <span style="color: #0000FF;">{</span><span style="color: #004080;">atom</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">lg</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">al</span>
+     <span style="color: #004080;">atom</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lg</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"took root: %f -&gt; %f\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">})}</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">addOne</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">al</span><span style="color: #0000FF;">)</span>
+     <span style="color: #0000FF;">{</span><span style="color: #004080;">atom</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">lg</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">al</span>
+     <span style="color: #004080;">atom</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">1</span>
+     <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lg</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"added one: %f -&gt; %f\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">})}</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">half</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">al</span><span style="color: #0000FF;">)</span>
+     <span style="color: #0000FF;">{</span><span style="color: #004080;">atom</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">lg</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">al</span>
+     <span style="color: #004080;">atom</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">/</span> <span style="color: #000000;">2</span>
+     <span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lg</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"halved it: %f -&gt; %f\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">})}</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%f obtained by\n%s"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">bind</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bind</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bind</span><span style="color: #0000FF;">({</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #008000;">""</span><span style="color: #0000FF;">},</span><span style="color: #000000;">root</span><span style="color: #0000FF;">),</span><span style="color: #000000;">addOne</span><span style="color: #0000FF;">),</span><span style="color: #000000;">half</span><span style="color: #0000FF;">))</span>
+<!--

Task/Monads-Writer-monad/Python/monads-writer-monad.py

@@ -0,0 +1,57 @@
+"""A Writer Monad. Requires Python >= 3.7 for type hints."""
+from __future__ import annotations
+
+import functools
+import math
+import os
+
+from typing import Any
+from typing import Callable
+from typing import Generic
+from typing import List
+from typing import TypeVar
+from typing import Union
+
+
+T = TypeVar("T")
+
+
+class Writer(Generic[T]):
+    def __init__(self, value: Union[T, Writer[T]], *msgs: str):
+        if isinstance(value, Writer):
+            self.value: T = value.value
+            self.msgs: List[str] = value.msgs + list(msgs)
+        else:
+            self.value = value
+            self.msgs = list(f"{msg}: {self.value}" for msg in msgs)
+
+    def bind(self, func: Callable[[T], Writer[Any]]) -> Writer[Any]:
+        writer = func(self.value)
+        return Writer(writer, *self.msgs)
+
+    def __rshift__(self, func: Callable[[T], Writer[Any]]) -> Writer[Any]:
+        return self.bind(func)
+
+    def __str__(self):
+        return f"{self.value}\n{os.linesep.join(reversed(self.msgs))}"
+
+    def __repr__(self):
+        return f"Writer({self.value}, \"{', '.join(reversed(self.msgs))}\")"
+
+
+def lift(func: Callable, msg: str) -> Callable[[Any], Writer[Any]]:
+    """Return a writer monad version of the simple function `func`."""
+
+    @functools.wraps(func)
+    def wrapped(value):
+        return Writer(func(value), msg)
+
+    return wrapped
+
+
+if __name__ == "__main__":
+    square_root = lift(math.sqrt, "square root")
+    add_one = lift(lambda x: x + 1, "add one")
+    half = lift(lambda x: x / 2, "div two")
+
+    print(Writer(5, "initial") >> square_root >> add_one >> half)

Task/Monads-Writer-monad/Raku/monads-writer-monad.raku

@@ -0,0 +1,18 @@
+# 20200508 Raku programming solution
+
+class Writer { has Numeric $.value ; has Str $.log }
+
+sub Bind (Writer \v, &code) {
+   my \n = v.value.&code;
+   Writer.new: value => n.value, log => v.log ~ n.log
+};
+
+sub Unit(\v, \s) { Writer.new: value=>v, log=>sprintf "%-17s: %.12f\n",s,v}
+
+sub root(\v) { Unit v.sqrt, "Took square root" }
+
+sub addOne(\v) { Unit v+1, "Added one" }
+
+sub half(\v) { Unit v/2, "Divided by two" }
+
+say Unit(5, "Initial value").&Bind(&root).&Bind(&addOne).&Bind(&half).log;

Task/Monads-Writer-monad/Ruby/monads-writer-monad.rb

@@ -0,0 +1,38 @@
+# 20220720 Ruby programming solution
+class Writer
+  attr_reader :value, :log
+
+  def initialize(value, log = "New")
+    @value = value
+    if value.is_a? Proc
+      @log = log
+    else
+      @log = log + ": " + @value.to_s
+    end
+  end
+
+  def self.unit(value, log)
+    Writer.new(value, log)
+  end
+
+  def bind(mwriter)
+    new_value = mwriter.value.call(@value)
+    new_log = @log + "\n" + mwriter.log
+    self.class.new(new_value, new_log)
+  end
+end
+
+lam_sqrt = ->(number) { Math.sqrt(number) }
+lam_add_one = ->(number) { number + 1 }
+lam_half = ->(number) { number / 2.0 }
+
+sqrt = Writer.unit( lam_sqrt, "Took square root")
+add_one = Writer.unit( lam_add_one, "Added one")
+half = Writer.unit( lam_half, "Divided by 2")
+
+m1 = Writer.unit(5, "Initial value")
+m2 = m1.bind(sqrt).bind(add_one).bind(half)
+
+puts "The final value is #{m2.value}\n\n"
+puts "This value was derived as follows:"
+puts m2.log

Task/Monads-Writer-monad/Scheme/monads-writer-monad.ss

@@ -0,0 +1,154 @@
+(define-library (monad base)
+  (export make-monad monad? monad-identifier
+          monad-object monad-additional
+          >>= >=>)
+  (import (scheme base)
+          (scheme case-lambda))
+  (begin
+
+    (define-record-type <monad>
+      (make-monad identifier bind object additional)
+      monad?
+      (identifier monad-identifier)
+      (bind monad-bind)
+      (object monad-object)
+      (additional monad-additional))
+
+    (define >>=
+      (case-lambda
+        ((m f) ((monad-bind m) m f))
+        ((m f . g*) (apply >>= (cons (>>= m f) g*)))))
+
+    (define >=>
+      (case-lambda
+        ((f g) (lambda (x) (>>= (f x) g)))
+        ((f g . h*) (apply >=> (cons (>=> f g) h*)))))
+
+    )) ;; end library
+
+(define-library (monad perform)
+  (export perform)
+  (import (scheme base)
+          (monad base))
+  (begin
+
+    (define-syntax perform
+      ;; "do" is already one of the loop syntaxes, so I call this
+      ;; syntax "perform" instead.
+      (syntax-rules (<-)
+        ((perform (x <- action) clause clause* ...)
+         (>>= action (lambda (x) (perform clause clause* ...))))
+        ((perform action)
+         action)
+        ((perform action clause clause* ...)
+         (action (perform clause clause* ...)))))
+
+    )) ;; end library
+
+(define-library (monad writer-monad)
+  (export make-writer-monad writer-monad?)
+  (import (scheme base)
+          (monad base))
+  (begin
+
+    ;; The messages are a list, most recent message first, of whatever
+    ;; data f decides to log.
+    (define (make-writer-monad object messages)
+      (define (bind m f)
+        (let ((ym (f (monad-object m))))
+          (let ((old-messages (monad-additional m))
+                (new-messages (monad-additional ym))
+                (y (monad-object ym)))
+            (make-monad 'writer-monad bind y
+                        (append new-messages old-messages)))))
+      (unless (or (null? messages) (pair? messages))
+        ;;
+        ;; I do not actually test whether the list is proper, because
+        ;; to do so would be inefficient.
+        ;;
+        ;; The R7RS-small test for properness of a list is called
+        ;; "list?" (and the report says something tendentious in
+        ;; defense of this name, but really it is simply historical
+        ;; usage). The SRFI-1 procedure, by constrast, is called
+        ;; "proper-list?".
+        ;;
+        (error "should be a proper list" messages))
+      (make-monad 'writer-monad bind object messages))
+
+    (define (writer-monad? object)
+      (and (monad? object)
+           (eq? (monad-identifier object) 'writer-monad)))
+
+    )) ;; end library
+
+(import (scheme base)
+        (scheme inexact)
+        (scheme write)
+        (monad base)
+        (monad perform)
+        (monad writer-monad))
+
+(define root sqrt)
+(define (addOne x) (+ x 1))
+(define (half x) (/ x 2))
+
+(define-syntax make-logging
+  (syntax-rules ()
+    ((_ proc)
+     (lambda (x)
+       (define (make-msg x y) (list x 'proc y))
+       (let ((y (proc x)))
+         (make-writer-monad y (list (make-msg x y))))))))
+
+(define logging-root (make-logging root))
+(define logging-addOne (make-logging addOne))
+(define logging-half (make-logging half))
+
+(define (display-messages messages)
+  (if (writer-monad? messages)
+      (display-messages (monad-additional messages))
+      (begin
+        (display "  messages:")
+        (newline)
+        (let loop ((lst (reverse messages)))
+          (when (pair? lst)
+            (display "    ")
+            (write (car lst))
+            (newline)
+            (loop (cdr lst)))))))
+
+(display "---------------") (newline)
+(display "Using just >>=") (newline)
+(display "---------------") (newline)
+(define result
+  (>>= (make-writer-monad 5 '((new writer-monad 5)))
+       logging-root logging-addOne logging-half))
+(display "  (1 + sqrt(5))/2 = ")
+(write (monad-object result)) (newline)
+(display-messages result)
+
+(newline)
+
+(display "------------------") (newline)
+(display "Using >>= and >=>") (newline)
+(display "------------------") (newline)
+(define result
+  (>>= (make-writer-monad 5 '((new writer-monad 5)))
+       (>=> logging-root logging-addOne logging-half)))
+(display "  (1 + sqrt(5))/2 = ")
+(write (monad-object result)) (newline)
+(display-messages result)
+
+(newline)
+
+(display "-----------------------") (newline)
+(display "Using 'perform' syntax") (newline)
+(display "-----------------------") (newline)
+(define result
+  (perform (x <- (make-writer-monad 5 '((new writer-monad 5))))
+           (x <- (logging-root x))
+           (x <- (logging-addOne x))
+           (logging-half x)))
+(display "  (1 + sqrt(5))/2 = ")
+(write (monad-object result)) (newline)
+(display-messages result)

Task/Monads-Writer-monad/Wren/monads-writer-monad.wren

@@ -0,0 +1,30 @@
+import "/fmt" for Fmt
+
+class Mwriter {
+    construct new(value, log) {
+        _value = value
+        _log = log
+    }
+
+    value { _value }
+    log {_log}
+    log=(value) { _log = value }
+
+    bind(f) {
+        var n = f.call(_value)
+        n.log = _log + n.log
+        return n
+    }
+
+    static unit(v, s) { Mwriter.new(v, "  %(Fmt.s(-17, s)): %(v)\n") }
+}
+
+var root   = Fn.new { |v| Mwriter.unit(v.sqrt, "Took square root") }
+var addOne = Fn.new { |v| Mwriter.unit(v + 1,  "Added one") }
+var half   = Fn.new { |v| Mwriter.unit( v / 2, "Divided by two") }
+
+var mw1 = Mwriter.unit(5, "Initial value")
+var mw2 = mw1.bind(root).bind(addOne).bind(half)
+System.print("The Golden Ratio is %(mw2.value)")
+System.print("\nThis was derived as follows:-")
+System.print(mw2.log)

Task/Monads-Writer-monad/Zkl/monads-writer-monad-1.zkl

@@ -0,0 +1,11 @@
+class Writer{
+   fcn init(x){ var X=x, logText=Data(Void,"  init \U2192; ",x.toString()) }
+   fcn unit(text)  { logText.append(text); self }
+   fcn lift(f,name){ unit("\n  %s \U2192; %s".fmt(name,X=f(X))) }
+   fcn bind(f,name){ lift.fp(f,name) }
+   fcn toString{ "Result = %s\n%s".fmt(X,logText.text) }
+
+   fcn root{ lift(fcn(x){ x.sqrt() },"root") }
+   fcn half{ lift('/(2),"half") }
+   fcn inc { lift('+(1),"inc") }
+}

Task/Monads-Writer-monad/Zkl/monads-writer-monad-2.zkl

@@ -0,0 +1 @@
+Writer(5.0).root().inc().half().println();

Task/Monads-Writer-monad/Zkl/monads-writer-monad-3.zkl

@@ -0,0 +1,2 @@
+w:=Writer(5.0);
+Utils.Helpers.fcomp(w.half,w.inc,w.root)(w).println();  // half(inc(root(w)))

Task/Monads-Writer-monad/Zkl/monads-writer-monad-4.zkl

@@ -0,0 +1,3 @@
+w:=Writer(5.0);
+root,inc,half := w.bind(fcn(x){ x.sqrt() },"root"), w.bind('+(1),"+ 1"), w.bind('/(2),"/ 2");
+root(); inc(); half(); w.println();