Jump to content

Monads/List monad

From Rosetta Code
Task
Monads/List monad
You are encouraged to solve this task according to the task description, using any language you may know.

A Monad is a combination of a data-type with two helper functions written for that type.

The data-type can be of any kind which can contain values of some other type – common examples are lists, records, sum-types, even functions or IO streams. The two special functions, mathematically known as eta and mu, but usually given more expressive names like 'pure', 'return', or 'yield' and 'bind', abstract away some boilerplate needed for pipe-lining or enchaining sequences of computations on values held in the containing data-type.

The bind operator in the List monad enchains computations which return their values wrapped in lists. One application of this is the representation of indeterminacy, with returned lists representing a set of possible values. An empty list can be returned to express incomputability, or computational failure.

A sequence of two list monad computations (enchained with the use of bind) can be understood as the computation of a cartesian product.

The natural implementation of bind for the List monad is a composition of concat and map, which, used with a function which returns its value as a (possibly empty) list, provides for filtering in addition to transformation or mapping.


Demonstrate in your programming language the following:

  1. Construct a List Monad by writing the 'bind' function and the 'pure' (sometimes known as 'return') function for that Monad (or just use what the language already has implemented)
  2. Make two functions, each which take a number and return a monadic number, e.g. Int -> List Int and Int -> List String
  3. Compose the two functions with bind

AppleScript

Translation of: JavaScript

We can use a list monad in AppleScript to express set comprehension for the Pythagorean triples, but the lack of nestable first class (and anonymous) functions means that the closure can only be achieved using script objects, which makes the idiom rather less direct and transparent. AppleScript is creaking at the seams here.

-- MONADIC FUNCTIONS (for list monad) ------------------------------------------

-- Monadic bind for lists is simply ConcatMap
-- which applies a function f directly to each value in the list,
-- and returns the set of results as a concat-flattened list

-- bind :: (a -> [b]) -> [a] -> [b]
on bind(f, xs)
    -- concat :: a -> a -> [a]
    script concat
        on |λ|(a, b)
            a & b
        end |λ|
    end script
    
    foldl(concat, {}, map(f, xs))
end bind

-- Monadic return/unit/inject for lists: just wraps a value in a list
-- a -> [a]
on unit(a)
    [a]
end unit

-- TEST ------------------------------------------------------------------------
on run
    -- Pythagorean triples drawn from integers in the range [1..n]
    -- {(x, y, z) | x <- [1..n], y <- [x+1..n], z <- [y+1..n], (x^2 + y^2 = z^2)}
    
    pythagoreanTriples(25)
    
    --> {{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17}, 
    --   {9, 12, 15}, {12, 16, 20}, {15, 20, 25}}
    
end run

-- pythagoreanTriples :: Int -> [(Int, Int, Int)]
on pythagoreanTriples(maxInteger)
    script X
        on |λ|(X)
            script Y
                on |λ|(Y)
                    script Z
                        on |λ|(Z)
                            if X * X + Y * Y = Z * Z then
                                unit([X, Y, Z])
                            else
                                []
                            end if
                        end |λ|
                    end script
                    
                    bind(Z, enumFromTo(1 + Y, maxInteger))
                end |λ|
            end script
            
            bind(Y, enumFromTo(1 + X, maxInteger))
        end |λ|
    end script
    
    bind(X, enumFromTo(1, maxInteger))
    
end pythagoreanTriples


-- GENERIC  FUNCTIONS ---------------------------------------------------------

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if n < m then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn
Output:
{{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17}, {9, 12, 15}, {12, 16, 20}, {15, 20, 25}}

ATS

#include "share/atspre_staload.hats"

(* I will use the list type of prelude/SATS/list.sats *)

#define NIL list_nil ()
#define ::  list_cons

fn {a : t@ype}
unit_List (x : a) : list (a, 1) =
  x :: NIL

fn {a, b : t@ype}
bind_List (m : List a,
           f : a -<cloref1> List b) : List0 b =
  let
    fun
    reversed_segments (m     : List a,
                       accum : List0 (List b))
        : List0 (List b) =
      case+ m of
      | NIL => accum
      | hd :: tl => reversed_segments (tl, f hd :: accum)

    fun
    assemble_segments (segments : List (List b),
                       accum    : List0 b)
        : List0 b =
      case+ segments of
      | NIL => accum
      | hd :: tl =>
        let
          prval () = lemma_list_param hd
          val accum = list_append (hd, accum)
        in
          assemble_segments (tl, accum)
        end
  in
    assemble_segments (reversed_segments (m, NIL), NIL)
  end

infixl 0 >>=
overload >>= with bind_List

fn
intseq_List {n  : nat}
            (i0 : int,
             n  : int n) :<cloref1> list (int, n) =
  let
    implement
    list_tabulate$fopr<int> j = i0 + j
  in
    list_vt2t (list_tabulate<int> n)
  end

implement
main0 () =
  let
    val n = 25
    val pythagorean_triples =
      intseq_List (1, n) >>=
        (lam i =>
          (intseq_List (succ (i : int), n) >>=
            (lam j =>
              (intseq_List (succ (j : int), n) >>=
                (lam k =>
                  let
                    val i = i : int
                    and j = j : int
                    and k = k : int
                  in
                    if (i * i) + (j * j) = (k * k) then
                      @(i, j, k) :: NIL
                    else
                      NIL
                  end)))))

    fun
    loop {n : nat}
         .<n>.
         (m : list (@(int, int, int), n)) : void =
      case+ m of
      | NIL => ()
      | (@(a, b, c) :: tl) =>
        begin
          println! ("(", a, ",", b, ",", c, ")");
          loop tl
        end
  in
    loop pythagorean_triples
  end
Output:

We should get a list of some Pythagorean triples that start with some integer between 1 and 25, inclusive.

$ patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_GCBDW list_monad_ats.dats -lgc && ./a.out
(3,4,5)
(5,12,13)
(6,8,10)
(7,24,25)
(8,15,17)
(9,12,15)
(10,24,26)
(12,16,20)
(12,35,37)
(15,20,25)
(15,36,39)
(16,30,34)
(18,24,30)
(20,21,29)
(21,28,35)
(24,32,40)
(24,45,51)

C

The C type which best fits the concept used here for monad would be void*.

There's some limitations -- the list type characteristics in this context, if they had been used, would have required special attention to issues like traversing the list. And, C does not provide syntactic sugar which a user would likely expect from experience in some other languages.

Still, the task example is constrained enough that we can provide an implementation like:

#include <stdio.h>
#include <stdlib.h>

#define MONAD void*
#define INTBIND(f, g, x) (f((int*)g(x)))
#define RETURN(type,x) &((type)*)(x)

MONAD boundInt(int *x) {
    return (MONAD)(x);
}

MONAD boundInt2str(int *x) {
    char buf[100];
    char*str= malloc(1+sprintf(buf, "%d", *x));
    sprintf(str, "%d", *x);
    return (MONAD)(str);
}

void task(int y) {
    char *z= INTBIND(boundInt2str, boundInt, &y);
    printf("%s\n", z);
    free(z);
}

int main() {
    task(13);
}

Which, from the command line, might look like:

$ ./monad
13

C++

#include <iostream>
#include <vector>

using namespace std;

// std::vector can be a list monad.  Use the >> operator as the bind function
template <typename T>
auto operator>>(const vector<T>& monad, auto f)
{
    // Declare a vector of the same type that the function f returns
    vector<remove_reference_t<decltype(f(monad.front()).front())>> result;
    for(auto& item : monad)
    {
        // Apply the function f to each item in the monad. f will return a
        // new list monad containing 0 or more items. 
        const auto r = f(item);
        // Concatenate the results of f with previous results
        result.insert(result.end(), begin(r), end(r));
    }
    
    return result;
}

// The Pure function returns a vector containing one item, t
auto Pure(auto t)
{
    return vector{t};
}

// A function to double items in the list monad
auto Double(int i)
{
    return Pure(2 * i);
}

// A function to increment items
auto Increment(int i)
{
    return Pure(i + 1);
}

// A function to convert items to a string
auto NiceNumber(int i)
{
    return Pure(to_string(i) + " is a nice number\n");
}

// A function to map an item to a sequence ending at max value
// for example: 497 -> {497, 498, 499, 500}
auto UpperSequence = [](auto startingVal)
{
    const int MaxValue = 500;
    vector<decltype(startingVal)> sequence;
    while(startingVal <= MaxValue) 
        sequence.push_back(startingVal++);
    return sequence;
};

// Print contents of a vector
void PrintVector(const auto& vec)
{
    cout << " ";
    for(auto value : vec)
    {
        cout << value << " ";
    }
    cout << "\n";
}

// Print the Pythagorean triples
void PrintTriples(const auto& vec)
{
    cout << "Pythagorean triples:\n";
    for(auto it = vec.begin(); it != vec.end();)
    {
        auto x = *it++;
        auto y = *it++;
        auto z = *it++;
        
        cout << x << ", " << y << ", " << z << "\n";
    }
    cout << "\n";
}

int main()
{
    // Apply Increment, Double, and NiceNumber to {2, 3, 4} using the monadic bind 
    auto listMonad = 
        vector<int> {2, 3, 4} >> 
        Increment >> 
        Double >>
        NiceNumber;
        
    PrintVector(listMonad);
    
    // Find Pythagorean triples using the list monad.  The 'x' monad list goes
    // from 1 to the max; the 'y' goes from the current 'x' to the max; and 'z'
    // goes from the current 'y' to the max.  The last bind returns the triplet
    // if it is Pythagorean, otherwise it returns an empty list monad.
    auto pythagoreanTriples = UpperSequence(1) >> 
        [](int x){return UpperSequence(x) >>
        [x](int y){return UpperSequence(y) >>
        [x, y](int z){return (x*x + y*y == z*z) ? vector{x, y, z} : vector<int>{};};};};
    
    PrintTriples(pythagoreanTriples);
}
Output:
 6 is a nice number
 8 is a nice number
 10 is a nice number
 
Pythagorean triples:
3, 4, 5
5, 12, 13
6, 8, 10
7, 24, 25
8, 15, 17
9, 12, 15
9, 40, 41
10, 24, 26
11, 60, 61
 . . .
 . . . 
320, 336, 464
325, 360, 485
340, 357, 493

Clojure

(defn bind [coll f] (apply vector (mapcat f coll)))
(defn unit [val] (vector val))

(defn doubler [n] [(* 2 n)])   ; takes a number and returns a List number
(def vecstr (comp vector str)) ; takes a number and returns a List string

(bind (bind (vector 3 4 5) doubler) vecstr) ; evaluates to ["6" "8" "10"]
(-> [3 4 5]
  (bind doubler)
  (bind vecstr)) ; also evaluates to ["6" "8" "10"]

Delphi

Translation of: Go
program List_monad;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TmList = record
    Value: TArray<Integer>;
    function ToString: string;
    function Bind(f: TFunc<TArray<Integer>, TmList>): TmList;
  end;

function Create(aValue: TArray<Integer>): TmList;
begin
  Result.Value := copy(aValue, 0, length(aValue));
end;

{ TmList }

function TmList.Bind(f: TFunc<TArray<Integer>, TmList>): TmList;
begin
  Result := f(self.Value);
end;

function TmList.ToString: string;
var
  i: Integer;
begin
  Result := '[ ';
  for i := 0 to length(value) - 1 do
  begin
    if i > 0 then
      Result := Result + ', ';
    Result := Result + value[i].toString;
  end;
  Result := Result + ']';
end;

function Increment(aValue: TArray<Integer>): TmList;
var
  i: integer;
begin
  SetLength(Result.Value, length(aValue));
  for i := 0 to High(aValue) do
    Result.Value[i] := aValue[i] + 1;
end;

function Double(aValue: TArray<Integer>): TmList;
var
  i: integer;
begin
  SetLength(Result.Value, length(aValue));
  for i := 0 to High(aValue) do
    Result.Value[i] := aValue[i] * 2;
end;

var
  ml1, ml2: TmList;

begin
  ml1 := Create([3, 4, 5]);
  ml2 := ml1.Bind(Increment).Bind(double);
  Writeln(ml1.ToString, ' -> ', ml2.ToString);
  readln;
end.
Output:
[ 3, 4, 5] -> [ 8, 10, 12]

EchoLisp

Our monadic lists will take the form (List a b c ...), ie raw lists prefixed by the List symbol.

;; -> and ->> are the pipeline operators
;; (-> x f g h) = (h (g ( f x)))
;; (->> x f (g a) h) = (h (g a ( f x)))

(define (List.unit elem)  (append '(List) elem))
(define (List.bind xs f)  (List.unit (->> xs rest (map f)  (map rest) (apply append))))
(define (List.lift f)     (lambda(elem) (List.unit (f elem))))

(define List.square  (List.lift (lambda(x) (*  x x))))
(define List.cube    (List.lift (lambda(x) (* x x x))))
(define List.tostr   (List.lift number->string))

;; composition

(-> '(List 1 -2 3 -5) (List.bind List.cube) (List.bind List.tostr))
     (List "1" "-8" "27" "-125")
;; or
(-> '(1 -2 3 -5) List.unit (List.bind List.cube) (List.bind List.tostr))
      (List "1" "-8" "27" "-125")

F#

type ListMonad() =
   member o.Bind(  (m:'a list), (f: 'a -> 'b list) ) = List.concat( List.map f m )
   member o.Return(x) = [x]
   member o.Zero()    = []
 
let list = ListMonad()
 
let pyth_triples n = list { let! x = [1..n]
                            let! y = [x..n]
                            let! z = [y..n]
                            if x*x + y*y = z*z then return (x,y,z) }
 
printf "%A" (pyth_triples 100)

The list monad is equivalent to List comprehensions which are built into F#:

// Monads/List monad . Nigel Galloway: March 8th., 2021
List.iter ((+) 1>>(*) 2>>printf "%d ") [3;4;5]; printfn "";;
let pT n=[for i in 1..n do for g in i+1..n do for n in g+1..n do if i*i+g*g=n*n then yield(i,g,n)]
Seq.iter(printf "%A ")(pT 25)
let fN g=match g<10 with false->Error "is greater than 9"|_->Ok g
let fG n=match n>5 with false->Error "is less than 6" |_->Ok n
let valid n=n|>Result.bind fN|>Result.bind fG
let test n=match valid(Ok n) with Ok g->printfn "%d is valid" g|Error e->printfn "Error: %d %s" n e
[5..10]|>List.iter test
Output:
8 10 12
(3, 4, 5) (5, 12, 13) (6, 8, 10) (7, 24, 25) (8, 15, 17) (9, 12, 15) (12, 16, 20) (15, 20, 25)
Error: 5 is less than 6
6 is valid
7 is valid
8 is valid
9 is valid
Error: 10 is greater than 9

Factor

Factor comes with an implementation of Haskell-style monads in the monads vocabulary.

USING: kernel math monads prettyprint ;
FROM: monads => do ;

{ 3 4 5 }
>>= [ 1 + array-monad return ] swap call
>>= [ 2 * array-monad return ] swap call .

Or:

{ 3 4 5 }
[ 1 + array-monad return ] bind
[ 2 * array-monad return ] bind .

Or:

{
    [ { 3 4 5 } ]
    [ 1 + array-monad return ]
    [ 2 * array-monad return ]
} do .
Output:
{ 8 10 12 }


FreeBASIC

Translation of: Ring
Dim As Integer m1(1 To 3) = {3,4,5}
Dim As String m2 = "["
Dim As Integer x, y ,z
For x = 1 To Ubound(m1)
    y = m1(x) + 1
    z = y * 2
    m2 &= Str(z) & ", " 
Next x
m2 = Left(m2, Len(m2) -2)
m2 &= "]"
Print m2
Sleep
Output:
[8, 10, 12]


Go

package main

import "fmt"

type mlist struct{ value []int }

func (m mlist) bind(f func(lst []int) mlist) mlist {
    return f(m.value)
}

func unit(lst []int) mlist {
    return mlist{lst}
}

func increment(lst []int) mlist {
    lst2 := make([]int, len(lst))
    for i, v := range lst {
        lst2[i] = v + 1
    }
    return unit(lst2)
}

func double(lst []int) mlist {
    lst2 := make([]int, len(lst))
    for i, v := range lst {
        lst2[i] = 2 * v
    }
    return unit(lst2)
}

func main() {
    ml1 := unit([]int{3, 4, 5})
    ml2 := ml1.bind(increment).bind(double)
    fmt.Printf("%v -> %v\n", ml1.value, ml2.value)
}
Output:
[3 4 5] -> [8 10 12]

Haskell

Haskell has the built-in Monad type class, and the built-in list type already conforms to the Monad type class.

main = print $ [3,4,5] >>= (return . (+1)) >>= (return . (*2)) -- prints [8,10,12]

Or, written using do notation:

main = print $ do x <- [3,4,5]
                  y <- return (x+1)
                  z <- return (y*2)
                  return z

Or alternately:

main = print $ do x <- [3,4,5]
                  let y = x+1
                  let z = y*2
                  return z

Using the list monad to express set comprehension for Pythagorean triples:

pythagoreanTriples :: Integer -> [(Integer, Integer, Integer)]
pythagoreanTriples n =
  [1 .. n] >>= (\x ->
  [x+1 .. n] >>= (\y ->
  [y+1 .. n] >>= (\z ->
  if x^2 + y^2 == z^2 then return (x,y,z) else [])))

main = print $ pythagoreanTriples 25
Output:
[(3,4,5),(5,12,13),(6,8,10),(7,24,25),(8,15,17),(9,12,15),(12,16,20),(15,20,25)]

Which can be written using do notation:

pythagoreanTriples :: Integer -> [(Integer, Integer, Integer)]
pythagoreanTriples n = do x <- [1 .. n]
                          y <- [x+1 .. n]
                          z <- [y+1 .. n]
                          if x^2 + y^2 == z^2 then return (x,y,z) else []

Or directly as a list comprehension:

pythagoreanTriples :: Integer -> [(Integer, Integer, Integer)]
pythagoreanTriples n = [(x,y,z) | x <- [1 .. n], y <- [x+1 .. n], z <- [y+1 .. n], x^2 + y^2 == z^2]

J

Note that J documentation mentions "monad" but that is an older (much older) use of the term from what is intended here. J documentation uses "box" <to describe the operation mentioned here.

That said, here is an implementation which might be adequate for the current task description:

bind=: S:0
unit=: boxopen

m_num=: unit
m_str=: unit@":

Task example:

   m_str bind m_num 5
┌─┐
5
└─┘

Java

import java.util.ArrayList;
import java.util.List;
import java.util.function.Function;

public final class MonadList {

	public static void main(String[] aArgs) {
		Monad<Integer> integers = Monad.unit(List.of( 2, 3, 4 ));
	    Monad<String> strings = integers.bind(MonadList::doubler).bind(MonadList::letters);
	    System.out.println(strings.getValue());
	}
	
	private static Monad<Integer> doubler(List<Integer> aList) {
		return Monad.unit(aList.stream().map( i -> 2 * i ).toList());
	}
	
	private static Monad<String> letters(List<Integer> aList) {
		return Monad.unit(aList.stream().map( i -> Character.toString((char) (64 + i)).repeat(i) ).toList());		
	}
	
}

final class Monad<T> {		
	
	public static <T> Monad<T> unit(List<T> aList) {
		return new Monad<T>(aList);
	}
	
	public <U> Monad<U> bind(Function<List<T>, Monad<U>> aFunction) {
		return aFunction.apply(list);
	}
	
	public List<T> getValue() {
		return list;
	}
	
	private Monad(List<T> aList) {
		list = new ArrayList<T>(aList);
	}
	
	private List<T> list;
	
}
Output:
[DDDD, FFFFFF, HHHHHHHH]

JavaScript

Array.prototype.bind = function (func) {
  return this.map(func).reduce(function (acc, a) { return acc.concat(a); });
}

Array.unit = function (elem) {
  return [elem];
}

Array.lift = function (func) {
  return function (elem) { return Array.unit(func(elem)); };
}

inc = function (n) { return n + 1; }
doub = function (n) { return 2 * n; }
listy_inc = Array.lift(inc);
listy_doub = Array.lift(doub);

[3,4,5].bind(listy_inc).bind(listy_doub); // [8, 10, 12]


ES5 Example: Using the list monad to express set comprehension

(function (n) {

    // ENCODING A SET COMPREHENSION IN TERMS OF A LIST MONAD

    // Pythagorean triples drawn from integers in the range [1..25]


    // Each range of integers here represents the set of possible values for the variable.
    // Where the test returns true for a particular [x, y, z] triple, we return that triple
    // to the expected data type, wrapping it using the unit or return function;

    // Where the test returns false, we return the empty list, which vanishes from the 
    // results set under concatenation, giving us a convenient encoding of filtering.

    // {(x, y, z) | x <- [1..n], y <- [x+1..n], z <- [y+1..n], (x^2 + y^2 = z^2)} 

    return bind(rng(1,     n), function (x) {
    return bind(rng(1 + x, n), function (y) {
    return bind(rng(1 + y, n), function (z) {

        return (x * x + y * y === z * z) ? unit([x, y, z]) : [];

    })})});


    // Monadic return/unit/inject for lists just wraps a value in a list
    // a -> [a]
    function unit(a) {
        return [a];
    }

    // Bind for lists is simply ConcatMap
    // which applies a function f directly to each value in the list,
    // and returns the set of results as a concat-flattened list
    // [a] -> (a -> [b]) -> [b]
    function bind(xs, f) {
        return [].concat.apply([], xs.map(f));
    }



    // we will need some ranges of integers, each expressing a range of possible values
    // [m..n]
    function rng(m, n) {
        return Array.apply(null, Array(n - m + 1))
            .map(function (x, i) {
                return m + i;
            });
    }

})(25);
Output:
[[3, 4, 5], [5, 12, 13], [6, 8, 10], [7, 24, 25], [8, 15, 17], [9, 12, 15], [12, 16, 20], [15, 20, 25]]

jq

Works with: jq

Also works with gojq and fq modulo the proviso about "::"

In this entry, we adopt the approach described in the Wikipedia article on monads at [1], specifically:

"A monad can be created by defining a type constructor M and two operations:

return :: a -> M a (often also called unit), which receives a value of type a and wraps it into a monadic value of type M a,
and
bind :: (M a) -> (a -> M b) -> (M b) 
which receives a function f over type a and can transform monadic values m a applying f to the unwrapped value a,
returning a monadic value M b"

In the following, the monadic type `a` can be specified as any JSON value, but for the List monad, it is just "List". Choosing a string has the advantage that we can use jq's support for function names of the form `Namespace::identifier` to give convenient names to the "return" and "bind" functions for the List monad, namely `List::return` and `List::bind`.

Since gojq does not currently support the definition of functions with a Namespace prefix, the following would have to be adapted; one possibility wold be to replace occurrences of `::` in function names by `__`.

Notice that the "return" and "bind" wrappers for List (i.e., `List::return` and `List::bind`) can be tailored to the List monad independently of the wrapper definitions for other monads.

# Constructor:
def Monad($type; $value):
  {class: "Monad", $type, $value};

# Is the input a monad of type $Type?
def is_monad($Type):
  (type == "object") 
  and (.class == "Monad")
  and (.type == $Type) ;

# input: a value consistent with the "List" monadic type (in practice, a JSON array)
# No checking is done here as the monadic type system is outside the scope of this entry.
def List::return:
  Monad("List"; .);
  
def List::bind(f): 
  if is_monad("List")
  then .value |= f
  else error("List::bind error: monadic type of input is \(.type)")
  end;

# Two illustrative operations on JSON arrays
def increment: map(. + 1);
def double: map(. * 2);
 
def ml1:
  [3, 4, 5] | List::return;
def ml2:
  ml1 | List::bind(increment) | List::bind(double);

"\(ml1.value) -> \(ml2.value)"
Output:
[3,4,5] -> [8,10,12]


Julia

Julia uses the function bind for binding a channel to a task, but this can be imported and overloaded. The |> syntax in Julia can also be used to chain functions taking one argument.

julia> unit(v) = [v...]
unit (generic function with 1 method)

julia> import Base.bind

julia> bind(v, f) = f.(v)
bind (generic function with 5 methods)

julia> f1(x) = x + 1
f1 (generic function with 1 method)

julia> f2(x) = 2x
f2 (generic function with 1 method)

julia> bind(bind(unit([2, 3, 4]), f1), f2)
3-element Array{Int64,1}:
  6
  8
 10

julia> unit([2, 3, 4]) .|> f1 .|> f2
3-element Array{Int64,1}:
  6
  8
 10

Kotlin

// version 1.2.10

class MList<T : Any> private constructor(val value: List<T>) {
    fun <U : Any> bind(f: (List<T>) -> MList<U>) = f(this.value)

    companion object {
        fun <T : Any> unit(lt: List<T>) = MList<T>(lt)
    }
}

fun doubler(li: List<Int>) = MList.unit(li.map { 2 * it } )

fun letters(li: List<Int>) = MList.unit(li.map { "${('@' + it)}".repeat(it) } )

fun main(args: Array<String>) {
    val iv = MList.unit(listOf(2, 3, 4))
    val fv = iv.bind(::doubler).bind(::letters)
    println(fv.value)
}
Output:
[DDDD, FFFFFF, HHHHHHHH]

Nim

a natural use of a list-wrapped return value is when there can be more than one result from a function, for example square roots have a positive and negative solution, and the inverse sine function has multiple solutions we might be interested in.

import math,sequtils,sugar,strformat
func root(x:float):seq[float] = @[sqrt(x),-sqrt(x)]
func asin(x:float):seq[float] = @[arcsin(x),arcsin(x)+TAU,arcsin(x)-TAU]
func format(x:float):seq[string] = @[&"{x:.2f}"]

#'bind' is a nim keyword, how about an infix operator instead
#our bind is the standard map+cat
func `-->`[T,U](input: openArray[T],f: T->seq[U]):seq[U] =
  input.map(f).concat

echo [0.5] --> root --> asin --> format
Output:
@["0.79", "7.07", "-5.50", "-0.79", "5.50", "-7.07"]

OCaml

Defining the list monad is fairly straightforward:

let bind : 'a list -> ('a -> 'b list) -> 'b list =
  fun l f -> List.flatten (List.map f l)

let return x = [x]

For convenience, the example will also use the following definitions:

let (>>) = bind (* operator for inline binding *)
let (let*) = bind (* let pruning for easy bind *)

let print_str_list l =
    Format.printf "[%a]" (fun fmt -> Format.pp_print_list Format.pp_print_string fmt) l

First example: increment and print

let incr x = return (x+1)
let hex x = return (Format.sprintf "%#x" x)

(* Version 1 : With explicit calls *)
let () =
  let l = bind (bind (List.init 5 (fun x -> x)) incr) hex in
  print_str_list l

(* Version 2 : With >> operator *)
let () =
  let l = List.init 5 (fun x -> x) >> incr >> hex in
  print_str_list l

(* Version 3 : With let pruning *)
let () =
  let l =
    let* x = List.init 5 (fun x -> x) in
    let* y = incr x in hex y
  in print_str_list l

Second example: pythegorean triplets

(* Version 1 : with explicit calls *)
let pythegorean_triple n =
  let x = List.init n (fun x -> x) in
  let y = List.init n (fun x -> x) in
  let z = List.init n (fun x -> x) in
  bind x (fun x ->
    bind y (fun y ->
      bind z (fun z ->
        if x*x + y*y = z*z then return (x,y,z) else []
  )))

(* Version 2 : with >> operator *)
let pythegorean_triple n =
  List.init n (fun x -> x) >> fun x ->
    List.init n (fun x -> x) >> fun y ->
      List.init n (fun x -> x) >> fun z ->
        if x*x + y*y = z*z then return (x,y,z) else []

(* Version 3 : with let pruning *)
let pythegorean_triple n =
  let* x = List.init n (fun x -> x) in
  let* y = List.init n (fun x -> x) in
  let* z = List.init n (fun x -> x) in
  if x*x + y*y = z*z then return (x,y,z) else []

Perl

With the help of the CPAN module Data::Monad, we can work with list monads.

use strict;
use feature 'say';
use Data::Monad::List;

# Cartesian product to 'count' in binary
my @cartesian = [(
    list_flat_map_multi { scalar_list(join '', @_) }
        scalar_list(0..1),
        scalar_list(0..1),
        scalar_list(0..1)
)->scalars];
say join "\n", @{shift @cartesian};

say '';

# Pythagorean triples
my @triples = [(
    list_flat_map_multi { scalar_list(
            { $_[0] < $_[1] && $_[0]**2+$_[1]**2 == $_[2]**2 ? join(',',@_) : () }
        ) }
        scalar_list(1..10),
        scalar_list(1..10),
        scalar_list(1..10)
)->scalars];

for (@{shift @triples}) {
    say keys %$_ if keys %$_;
}
Output:
000
001
010
011
100
101
110
111

3,4,5
6,8,10

Phix

Translation of: Go
function bindf(sequence m, integer f)
    return f(m)
end function
 
function unit(sequence m)
    return m
end function
 
function increment(sequence l)
    return unit(sq_add(l,1))
end function
 
function double(sequence l)
    return unit(sq_mul(l,2))
end function
 
sequence m1 = unit({3, 4, 5}),
         m2 = bindf(bindf(m1,increment),double)
printf(1,"%v -> %v\n", {m1, m2})
Output:
{3,4,5} -> {8,10,12}

Python

"""A List Monad. Requires Python >= 3.7 for type hints."""
from __future__ import annotations
from itertools import chain

from typing import Callable
from typing import Iterable
from typing import List
from typing import TypeVar


T = TypeVar("T")
U = TypeVar("U")


class MList(List[T]):
    @classmethod
    def unit(cls, value: Iterable[T]) -> MList[T]:
        return cls(value)

    def bind(self, func: Callable[[T], MList[U]]) -> MList[U]:
        return MList(chain.from_iterable(map(func, self)))

    def __rshift__(self, func: Callable[[T], MList[U]]) -> MList[U]:
        return self.bind(func)


if __name__ == "__main__":
    # Chained int and string functions.
    print(
        MList([1, 99, 4])
        .bind(lambda val: MList([val + 1]))
        .bind(lambda val: MList([f"${val}.00"]))
    )

    # Same, but using `>>` as the bind operator.
    print(
        MList([1, 99, 4])
        >> (lambda val: MList([val + 1]))
        >> (lambda val: MList([f"${val}.00"]))
    )

    # Cartesian product of [1..5] and [6..10].
    print(
        MList(range(1, 6)).bind(
            lambda x: MList(range(6, 11)).bind(lambda y: MList([(x, y)]))
        )
    )

    # Pythagorean triples with elements between 1 and 25.
    print(
        MList(range(1, 26)).bind(
            lambda x: MList(range(x + 1, 26)).bind(
                lambda y: MList(range(y + 1, 26)).bind(
                    lambda z: MList([(x, y, z)])
                    if x * x + y * y == z * z
                    else MList([])
                )
            )
        )
    )
Output:
['$2.00', '$100.00', '$5.00']
['$2.00', '$100.00', '$5.00']
[(1, 6), (1, 7), (1, 8), (1, 9), (1, 10), (2, 6), (2, 7), (2, 8), (2, 9), (2, 10), (3, 6), (3, 7), (3, 8), (3, 9), (3, 10), (4, 6), (4, 7), (4, 8), (4, 9), (4, 10), (5, 6), (5, 7), (5, 8), (5, 9), (5, 10)]
[(3, 4, 5), (5, 12, 13), (6, 8, 10), (7, 24, 25), (8, 15, 17), (9, 12, 15), (12, 16, 20), (15, 20, 25)]

Racket

Translation of: JavaScript

Vanilla Racket

Note that this also demonstrates how to use Racket's macro system to implement the do syntax.

#lang racket

(define (bind x f) (append-map f x))
(define return list)
(define ((lift f) x) (list (f x)))

(define listy-inc (lift add1))
(define listy-double (lift (λ (x) (* 2 x))))

(bind (bind '(3 4 5) listy-inc) listy-double)
;; => '(8 10 12)

(define (pythagorean-triples n)
  (bind (range 1 n)
        (λ (x)
          (bind (range (add1 x) n)
                (λ (y)
                  (bind (range (add1 y) n)
                        (λ (z)
                          (if (= (+ (* x x) (* y y)) (* z z))
                              (return (list x y z))
                              '()))))))))

(pythagorean-triples 25)
;; => '((3 4 5) (5 12 13) (6 8 10) (8 15 17) (9 12 15) (12 16 20))

(require syntax/parse/define)

(define-syntax-parser do-macro
  [(_ [x {~datum <-} y] . the-rest) #'(bind y (λ (x) (do-macro . the-rest)))]
  [(_ e) #'e])

(define (pythagorean-triples* n)
  (do-macro
   [x <- (range 1 n)]
   [y <- (range (add1 x) n)]
   [z <- (range (add1 y) n)]
   (if (= (+ (* x x) (* y y)) (* z z))
       (return (list x y z))
       '())))

(pythagorean-triples* 25)
;; => '((3 4 5) (5 12 13) (6 8 10) (8 15 17) (9 12 15) (12 16 20))

With functional package

The functional package has already implemented the list monad.

#lang racket

(require data/monad 
         data/applicative)

(define (pythagorean-triples n)
  (sequence->list
   (do [x <- (range 1 n)]
       [y <- (range (add1 x) n)]
       [z <- (range (add1 y) n)]
       (if (= (+ (* x x) (* y y)) (* z z))
           (pure (list x y z))
           '()))))

(pythagorean-triples 25)
;; => '((3 4 5) (5 12 13) (6 8 10) (8 15 17) (9 12 15) (12 16 20))

Raku

(formerly Perl 6) Raku does not have Monad types built in but they can be emulated/implemented without a great deal of difficulty. List Monads especially are of questionable utility in Raku. Most item types and Listy types have a Cool role in Raku. (Cool being a play on the slang term "cool" as in: "That's cool with me." (That's ok with me). So Ints are pretty much treated like one item lists for operators that work with lists. ("I work on a list." "Here's an Int." "Ok, that's cool.") Explicitly wrapping an Int into a List is worse than useless. It won't do anything Raku can't do natively, and will likely remove some functionality that it would normally have. That being said, just because it is a bad idea (in Raku) doesn't mean it can't be done.

In Raku, bind is essentially map. I'll shadow map here but again, it removes capability, not adds it. Raku also provided "hyper" operators which will descend into data structures and apply an operator / function to each member of that data structure.

Here's a simple, if contrived example. take the numbers from 0 to 9, add 3 to each, find the divisors of those sums and print the list of divisors for each sum... in base 2. Again, a bind function was implemented but it is more limited than if we just used map directly. The built in map method will work with either items or lists, here we need to implement a multi sub to handle either.

The * in the bind blocks are typically referred to as "whatever"; whatever + 3 etc. The guillemot (») is the hyper operator; descend into the data structure and apply the following operator/function to each member.

multi bind (@list, &code) { @list.map: &code };

multi bind ($item, &code) { $item.&code };

sub divisors (Int $int) { gather for 1 .. $int { .take if $int %% $_ } }

put (^10).&bind(* + 3).&bind(&divisors)».&bind(*.base: 2).join: "\n";
Output:
1 11
1 10 100
1 101
1 10 11 110
1 111
1 10 100 1000
1 11 1001
1 10 101 1010
1 1011
1 10 11 100 110 1100

Ring

# Project : Monads/List monad

 func main()
        str = "["
        for x in [3,4,5]
             y = x+1
             z = y*2
             str = str + z + ", " 
        next
        str = left(str, len(str) -2)
        str = str + "]"
        see str + nl

Output:

[8, 10, 12]

Ruby

class Array
  def bind(f)
    flat_map(&f)
  end
  def self.unit(*args)
    args
  end
  # implementing lift is optional, but is a great helper method for turning
  # ordinary funcitons into monadic versions of them.
  def self.lift(f)
    -> e { self.unit(f[e]) }
  end
end

inc = -> n { n + 1 }
str = -> n { n.to_s }
listy_inc = Array.lift(inc)
listy_str = Array.lift(str)

Array.unit(3,4,5).bind(listy_inc).bind(listy_str) #=> ["4", "5", "6"]

# Note that listy_inc and listy_str cannot be composed directly,
# as they don't have compatible type signature.
# Due to duck typing (Ruby will happily turn arrays into strings),
#   in order to show this, a new function will have to be used:

doub = -> n { 2*n }
listy_doub = Array.lift(doub)
[3,4,5].bind(listy_inc).bind(listy_doub) #=> [8, 10, 12]

# Direct composition will cause a TypeError, as Ruby cannot evaluate 2*[4, 5, 6]
# Using bind with the composition is *supposed* to fail, no matter the programming language.
comp = -> f, g {-> x {f[g[x]]}}
[3,4,5].bind(comp[listy_doub, listy_inc]) #=> TypeError: Array can't be coerced into Fixnum

# Composition needs to be defined in terms of bind
class Array
  def bind_comp(f, g)
    bind(g).bind(f)
  end
end

[3,4,5].bind_comp(listy_doub, listy_inc) #=> [8, 10, 12]

Swift

The unit/return function is provided by the constructor for a Swift array. I define a unit function simply to keep the terminology straight. Similarly, the flatmap function provides what we need for bind, but I define a bind function explicitly.

I also define an operator that is the same as bind but which makes chaining easier.

My two functions to use are one that retiurns the two number adjacent to the supplied Int and another that returns the square roots (as Double) of an Int if it is positive or an empty list, if it is negative.

precedencegroup MonadPrecedence {
	higherThan: BitwiseShiftPrecedence
	associativity: left
}

infix operator >>-: MonadPrecedence	// Monadic bind

extension Array
{
	static func unit(_ x: Element) -> [Element]
	{
		return [x]
	}

	func bind<T>(_ f: (Element) -> [T]) -> [T]
	{
		return flatMap(f)
	}

	static func >>- <U>(_ m: [Element], _ f: (Element) -> [U]) -> [U]
	{
		return m.flatMap(f)
	}
}

func adjacent(_ x: Int) -> [Int]
{
	[x - 1, x + 1]
}

func squareRoots(_ x: Int) -> [Double]
{
	guard x >= 0 else { return [] }
	return [Double(x).squareRoot(), -(Double(x).squareRoot())]
}

print("\([Int].unit(8).bind(adjacent).bind(squareRoots))")
print("\([Int].unit(8) >>- adjacent >>- squareRoots)")
print("\([Int].unit(0) >>- adjacent >>- squareRoots)")
Output:
[2.6457513110645907, -2.6457513110645907, 3.0, -3.0]
[2.6457513110645907, -2.6457513110645907, 3.0, -3.0]
[1.0, -1.0]

uBasic/4tH

Translation of: Ring
s := "[" : Push 5, 4, 3

Do While Used ()
  y = Set (x, Pop ()) + 1
  s = Join (s, Str (Set (z, y * 2)), ", " )
Loop

Print Show (Set (s, Join (Clip (s, 2), "]")))
Output:
[8, 10, 12]

0 OK, 0:138 

V (Vlang)

Translation of: Go
struct Mlist {value []int}

fn (m Mlist) bind(f fn (lst []int) Mlist) Mlist {return f(m.value)}

fn unit(lst []int) Mlist {return Mlist{lst}}

fn increment(lst []int) Mlist {
	mut lst2 := lst.clone()
	for i, v in lst {
		lst2[i] = v + 1
	}
	return unit(lst2)
}

fn double(lst []int) Mlist {
	mut lst2 := lst.clone()
	for i, v in lst {
		lst2[i] = 2 * v
	}
	return unit(lst2)
}

fn main() {
	ml1 := unit([3, 4, 5])
	ml2 := ml1.bind(increment).bind(double)
	println("${ml1.value} -> ${ml2.value}")
}
Output:

[3, 4, 5] -> [8, 10, 12]

Wren

Translation of: Go
class Mlist {
    construct new(value) { _value = value }

    value { _value }

    bind(f) { f.call(_value) }

    static unit(lst) { Mlist.new(lst) }
}

var increment = Fn.new { |lst|
    var lst2 = lst.map { |v| v + 1 }.toList
    return Mlist.unit(lst2)
}

var double = Fn.new { |lst|
    var lst2 = lst.map { |v| v * 2 }.toList
    return Mlist.unit(lst2)
}

var ml1 = Mlist.unit([3, 4, 5])
var ml2 = ml1.bind(increment).bind(double)
System.print("%(ml1.value) -> %(ml2.value)")
Output:
[3, 4, 5] -> [8, 10, 12]

zkl

While I'm unsure of the utility of Monads in a dynamic type-less language, it can be done.

Translation of: Ruby

Here we create a class to do Monad like things. Unlike Ruby, we can't augment the baked in List/Array object so this more verbose. Also unlike Ruby, we can directly compose as we are applying the composition to each element (vs the list-as-object).

class MList{
   fcn init(xs){ var list=vm.arglist }
   fcn bind(f) { list=list.apply(f); self }
   fcn toString{ list.toString() }
}
inc:=Op("+",1);  // '+(1)
str:="toString";
MList(3,4,5).bind(inc).bind(str).println(" == (4,5,6)");

doub:=Op("*",2);
MList(3,4,5).bind(inc).bind(doub).println(" == (8,10,12)");

comp:=Utils.Helpers.fcomp;  // comp(f,g) == f.g == f(g(x))
MList(3,4,5).bind(comp(doub,inc)).println(" == (8,10,12)");
Output:
L("4","5","6") == (4,5,6)
L(8,10,12) == (8,10,12)
L(8,10,12) == (8,10,12)