Monads/Maybe monad
Demonstrate in your programming language the following:
- Construct a Maybe Monad by writing the 'bind' function and the 'unit' (sometimes known as 'return') function for that Monad (or just use what the language already has implemented)
- Make two functions, each which take a number and return a monadic number, e.g. Int -> Maybe Int and Int -> Maybe String
- Compose the two functions with bind
You are encouraged to solve this task according to the task description, using any language you may know.
A Monad is a single type which encapsulates several other types, eliminating boilerplate code. In practice it acts like a dynamically typed computational sequence, though in many cases the type issues can be resolved at compile time.
A Maybe Monad is a monad which specifically encapsulates the type of an undefined value.
ALGOL 68
<lang algol68>BEGIN
# This is a translation of the Javascript sample, main differences are because Algol 68 # # is strongly typed and "on-the-fly" constructon of functions is not really possible - # # we need to define a STRUCT where Javascript would just construct a new function. # # As Algol 68 does not allow procedure overloading, we use custom operators (which do # # allow overloading) so the techniques used here could be extended to procedures with # # signatures other than PROC(REAL)REAL # # The comments are generally the same as in the javascript original, changed as necessary # # to reflect Algol 68... # # START WITH SOME SIMPLE (UNSAFE) PARTIAL FUNCTIONS: # # error in n < 0 # PROC unsafe reciprocal = (REAL n)REAL: 1 / n; # error if n < 0 # PROC unsafe root = (REAL n)REAL: sqrt(n); # error if n <= 0 # PROC unsafe log = (REAL n)REAL: ln(n); # NOW DERIVE SAFE VERSIONS OF THESE SIMPLE FUNCTIONS: # # These versions use a validity test, and return a wrapped value # # with a boolean is valid property as well as a value property #
MODE SAFEFUNCTION = STRUCT( PROC(REAL)REAL fn, PROC(REAL)BOOL fn safety check ); MODE MAYBE = STRUCT( BOOL is valid, REAL value ); SAFEFUNCTION safe reciprocal = ( unsafe reciprocal, ( REAL n )BOOL: n /= 0 ); SAFEFUNCTION safe root = ( unsafe root, ( REAL n )BOOL: n >= 0 ); SAFEFUNCTION safe log = ( unsafe log, ( REAL n )BOOL: n > 0 );
COMMENT
the original Javascript contains this:
// THE DERIVATION OF THE SAFE VERSIONS USED THE 'UNIT' OR 'RETURN'
// FUNCTION OF THE MAYBE MONAD
// Named maybe() here, the unit function of the Maybe monad wraps a raw value
// in a datatype with two elements: .isValid (Bool) and .value (Number)
// a -> Ma
function maybe(n) {
return {
isValid: (typeof n !== 'undefined'),
value: n
};
}
However Algol 68 is strongly typed, so the type (MODE) of the function parameters cannot be anything other than REAL. We therefore use "MAYBE( TRUE, n )" instead.
COMMENT
# THE PROBLEM FOR FUNCTION NESTING (COMPOSITION) OF THE SAFE FUNCTIONS #
# IS THAT THEIR INPUT AND OUTPUT TYPES ARE DIFFERENT #
# Our safe versions of the functions take simple numeric arguments (i.e. REAL), but return #
# wrapped results. If we feed a wrapped result as an input to another safe function, the #
# compiler will object. The solution is to write a higher order #
# function (sometimes called 'bind' or 'chain') which handles composition, taking a #
# a safe function and a wrapped value as arguments, #
# The 'bind' function of the Maybe monad: #
# 1. Applies a 'safe' function directly to the raw unwrapped value, and #
# 2. returns the wrapped result. #
# Ma -> (a -> Mb) -> Mb #
# defined as an operator to allow overloading to other PROC modes #
PRIO BIND = 1;
OP BIND = (MAYBE maybe n, SAFEFUNCTION mf )MAYBE:
IF is valid OF maybe n THEN mf CALL ( value OF maybe n ) ELSE maybe n FI;
# we need an operator to call the wrapped function #
PRIO CALL = 1;
OP CALL = ( SAFEFUNCTION f, REAL value )MAYBE:
BEGIN
BOOL is valid = ( fn safety check OF f )( value );
MAYBE( is valid, IF is valid THEN ( fn OF f )( value ) ELSE value FI )
END; # CALL #
# Using the bind function, we can nest applications of safe functions, # # without the compiler choking on unexpectedly wrapped values returned from # # other functions of the same kind. # REAL root one over four = value OF ( MAYBE( TRUE, 4 ) BIND safe reciprocal BIND safe root );
- print( ( root one over four, newline ) ); #
# -> 0.5 #
# We can compose a chain of safe functions (of any length) with a simple foldr/reduceRight #
# which starts by 'lifting' the numeric argument into a Maybe wrapping, #
# and then nests function applications (working from right to left) #
# again, defined as an operator here to allow extension to other PROC modes #
# also, as Algol 68 doesn't have builtin foldr/reduceRight, we need a loop... #
PRIO SAFECOMPOSE = 1;
OP SAFECOMPOSE = ( []SAFEFUNCTION lst functions, REAL value )MAYBE:
BEGIN
MAYBE result := MAYBE( TRUE, value );
FOR fn pos FROM UPB lst functions BY -1 TO LWB lst functions DO
result := result BIND lst functions[ fn pos ]
OD;
result
END; # SAFECOMPOSE #
# TEST INPUT VALUES WITH A SAFELY COMPOSED VERSION OF LOG(SQRT(1/X)) #
PROC safe log root reciprocal = ( REAL n )MAYBE:
BEGIN
# this declaration is requied for Algol 68G 2.8 #
[]SAFEFUNCTION function list = ( safe log, safe root, safe reciprocal );
function list SAFECOMPOSE n
END; # safe log root reciprocal #
# Algol 68 doesn't have a builtin map operator, we could define one here but we can just # # use a loop for the purposes of this task... # REAL e = exp( 1 ); []REAL test values = ( -2, -1, -0.5, 0, 1 / e, 1, 2, e, 3, 4, 5 );
STRING prefix := "[";
FOR test pos FROM LWB test values TO UPB test values DO
MAYBE result = safe log root reciprocal( test values[ test pos ] );
print( ( prefix, IF is valid OF result THEN fixed( value OF result, -12, 8 ) ELSE "undefined" FI ) );
IF test pos MOD 4 = 0 THEN print( ( newline ) ) FI;
prefix := ", "
OD;
print( ( "]", newline ) )
END</lang>
- Output:
[undefined, undefined, undefined, undefined , 0.50000000, 0.00000000, -0.34657359, -0.50000000 , -0.54930614, -0.69314718, -0.80471896]
AppleScript
Algebraically-reasoned defence against invalid arguments for partial functions buried deep in function nests is probably more than a light-weight scripting language will really need on an average weekday, but we can usually do most things in most languages, and stretching a language a little bit is a way of exploring both its limits, and its relationships with other languages.
What AppleScript mostly lacks here (apart from a rich core library) is a coherent first-class function type which allows for anonymous functions. Nevertheless there is enough there to emulate first-class functions (using script objects), and we can set up a working Maybe monad without too much trouble.
It would, at least, spare us from having to structure things around try … on error … end try etc
<lang AppleScript>property e : 2.71828182846
on run {}
-- Derive safe versions of three simple functions set sfReciprocal to safeVersion(reciprocal, notZero) set sfRoot to safeVersion(root, isPositive) set sfLog to safeVersion(ln, aboveZero) -- Test a composition of these function with a range of invalid and valid arguments -- (The safe composition returns missing value (without error) for invalid arguments) map([-2, -1, -0.5, 0, 1 / e, 1, 2, e, 3, 4, 5], safeLogRootReciprocal)
-- 'missing value' is returned by a safe function (and threaded up through the monad) when the input argument is out of range
--> {missing value, missing value, missing value, missing value, 0.5, 0.0, -0.346573590279, -0.499999999999, -0.549306144333, -0.69314718056, -0.804718956217}
end run
-- START WITH SOME SIMPLE (UNSAFE) PARTIAL FUNCTIONS:
-- Returns ERROR 'Script Error: Can’t divide 1.0 by zero.' if n = 0 on reciprocal(n)
1 / n
end reciprocal
-- Returns ERROR 'error "The result of a numeric operation was too large." number -2702' -- for all values below 0 on root(n)
n ^ (1 / 2)
end root
-- Returns -1.0E+20 for all values of zero and below on ln(n)
(do shell script ("echo 'l(" & (n as string) & ")' | bc -l")) as real
end ln
-- DERIVE A SAFE VERSION OF EACH FUNCTION -- (SEE on Run() handler)
on safeVersion(f, fnSafetyCheck)
script
on call(x)
if sReturn(fnSafetyCheck)'s call(x) then
sReturn(f)'s call(x)
else
missing value
end if
end call
end script
end safeVersion
on notZero(n)
n is not 0
end notZero
on isPositive(n)
n ≥ 0
end isPositive
on aboveZero(n)
n > 0
end aboveZero
-- DEFINE A FUNCTION WHICH CALLS A COMPOSITION OF THE SAFE VERSIONS
on safeLogRootReciprocal(x)
value of mbCompose([my sfLog, my sfRoot, my sfReciprocal], x)
end safeLogRootReciprocal
-- UNIT/RETURN and BIND functions for the Maybe monad
-- Unit / Return for maybe on maybe(n)
{isValid:n is not missing value, value:n}
end maybe
-- BIND maybe on mbBind(recMaybe, mfSafe)
if isValid of recMaybe then
maybe(mfSafe's call(value of recMaybe))
else
recMaybe
end if
end mbBind
-- 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
on mbCompose(lstFunctions, value)
reduceRight(lstFunctions, mbBind, maybe(value))
end mbCompose
-- 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 mf to sReturn(f)
repeat with i from length of xs to 1 by -1
set a to mf's call(a, item i of xs, i, xs)
end repeat
end reduceRight
-- [a] -> (a -> b) -> [b] on map(xs, f)
set mf to sReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set end of lst to mf's call(item i of xs, i, xs)
end repeat
return lst
end map </lang>
- Output:
-- 'missing value' is returned by a safe function (and threaded up through the monad) when the input argument is out of range
{missing value, missing value, missing value, missing value, 0.5, 0.0, -0.346573590279, -0.499999999999, -0.549306144333, -0.69314718056, -0.804718956217}
Clojure
<lang clojure> (defn bind [val f]
(if-let [v (:value val)] (f v) val))
(defn unit [val] {:value val})
(defn opt_add_3 [n] (unit (+ 3 n))) ; takes a number and returns a Maybe number (defn opt_str [n] (unit (str n))) ; takes a number and returns a Maybe string
(bind (unit 4) opt_add_3) ; evaluates to {:value 7} (bind (unit nil) opt_add_3) ; evaluates to {:value nil} (bind (bind (unit 8) opt_add_3) opt_str) ; evaluates to {:value "11"} (bind (bind (unit nil) opt_add_3) opt_str) ; evaluates to {:value nil} </lang>
C#
<lang csharp>using System;
namespace RosettaMaybe {
// courtesy of https://www.dotnetcurry.com/patterns-practices/1510/maybe-monad-csharp public abstract class Maybe<T> { public sealed class Some : Maybe<T> { public Some(T value) => Value = value; public T Value { get; } } public sealed class None : Maybe<T> { } }
class Program
{
static Maybe<double> MonadicSquareRoot(double x)
{
if (x >= 0)
{
return new Maybe<double>.Some(Math.Sqrt(x));
}
else
{
return new Maybe<double>.None();
}
}
static void Main(string[] args)
{
foreach (double x in new double[] { 4.0D, 8.0D, -15.0D, 16.23D, -42 })
{
Maybe<double> maybe = MonadicSquareRoot(x);
if (maybe is Maybe<double>.Some some)
{
Console.WriteLine($"The square root of {x} is " + some.Value);
}
else
{
Console.WriteLine($"Square root of {x} is undefined.");
}
}
}
}
}</lang>
Delphi
<lang Delphi> program Maybe_monad;
{$APPTYPE CONSOLE}
uses
System.SysUtils;
type
TmList = record Value: PInteger; function ToString: string; function Bind(f: TFunc<PInteger, TmList>): TmList; end;
function _Unit(aValue: Integer): TmList; overload; begin
Result.Value := GetMemory(sizeof(Integer)); Result.Value^ := aValue;
end;
function _Unit(aValue: PInteger): TmList; overload; begin
Result.Value := aValue;
end;
{ TmList }
function TmList.Bind(f: TFunc<PInteger, TmList>): TmList; begin
Result := f(self.Value);
end;
function TmList.ToString: string; begin
if Value = nil then Result := 'none' else Result := value^.ToString;
end;
function Decrement(p: PInteger): TmList; begin
if p = nil then exit(_Unit(nil)); Result := _Unit(p^ - 1);
end;
function Triple(p: PInteger): TmList; begin
if p = nil then exit(_Unit(nil)); Result := _Unit(p^ * 3);
end;
var
m1, m2: TmList; i, a, b, c: Integer; p: Tarray<PInteger>;
begin
a := 3; b := 4; c := 5; p := [@a, @b, nil, @c];
for i := 0 to High(p) do begin m1 := _Unit(p[i]); m2 := m1.Bind(Decrement).Bind(Triple);
Writeln(m1.ToString: 4, ' -> ', m2.ToString); end; Readln;
end.</lang>
- Output:
3 -> 6 4 -> 9 none -> none 5 -> 12
EchoLisp
Our monadic Maybe elements will be pairs (boolean . value), where value is in Maybe.domain. Functions which return something not in Maybe.domain are unsafe and return (#f . input-value), If a function is given as input a (#f . value) element, it will return this element.
<lang scheme> (define (Maybe.domain? x) (or (number? x) (string? x))) (define (Maybe.unit elem (bool #t)) (cons bool elem))
- f is a safe or unsafe function
- (Maybe.lift f) returns a safe Maybe function which returns a Maybe element
(define (Maybe.lift f) (lambda(x)
(let [(u (f x))]
(if (Maybe.domain? u)
(Maybe.unit u)
(Maybe.unit x #f))))) ;; return offending x
- elem = Maybe element
- f is safe or unsafe (lisp) function
- return Maybe element
(define (Maybe.bind f elem) (if (first elem) ((Maybe.lift f) (rest elem)) elem))
- pretty-print
(define (Maybe.print elem) (if (first elem) (writeln elem ) (writeln '❌ elem)))
- unsafe functions
(define (u-log x) (if (> x 0) (log x) #f)) (define (u-inv x) (if (zero? x) 'zero-div (/ x)))
- (print (number->string (exp (log 3))))
(->> 3 Maybe.unit (Maybe.bind u-log) (Maybe.bind exp) (Maybe.bind number->string) Maybe.print)
→ (#t . "3.0000000000000004")
- (print (number->string (exp (log -666))))
(->> -666 Maybe.unit (Maybe.bind u-log) (Maybe.bind exp) (Maybe.bind number->string) Maybe.print)
→ ❌ (#f . -666)
- ;; (print (number->string (inverse (log 1))))
(->> 1 Maybe.unit (Maybe.bind u-log) (Maybe.bind u-inv) (Maybe.bind number->string) Maybe.print)
→ ❌ (#f . 0)
</lang>
F#
<lang fsharp> // We can use Some as return, Option.bind and the pipeline operator in order to have a very concise code
let f1 (v:int) = Some v // int -> Option<int>
let f2 (v:int) = Some(string v) // int -> Option<sting>
f1 4 |> Option.bind f2 |> printfn "Value is %A" // bind when option (maybe) has data None |> Option.bind f2 |> printfn "Value is %A" // bind when option (maybe) does not have data </lang>
- Output:
4 null
Factor
Factor comes with an implementation of Haskell-style monads in the monads vocabulary.
<lang factor>USING: monads ;
FROM: monads => do ;
! Prints "T{ just { value 7 } }" 3 maybe-monad return >>= [ 2 * maybe-monad return ] swap call
>>= [ 1 + maybe-monad return ] swap call .
! Prints "nothing" nothing >>= [ 2 * maybe-monad return ] swap call
>>= [ 1 + maybe-monad return ] swap call .</lang>
Or:
<lang factor>3 <just> [ 2 * <just> ] bind [ 1 + <just> ] bind .
nothing [ 2 * <just> ] bind [ 1 + <just> ] bind .</lang>
Or with do notation:
<lang factor>{
[ 3 <just> ] [ 2 * <just> ] [ 1 + <just> ]
} do . {
[ nothing ] [ 2 * <just> ] [ 1 + <just> ]
} do .</lang>
Go
<lang go>package main
import (
"fmt" "strconv"
)
type maybe struct{ value *int }
func (m maybe) bind(f func(p *int) maybe) maybe {
return f(m.value)
}
func unit(p *int) maybe {
return maybe{p}
}
func decrement(p *int) maybe {
if p == nil {
return unit(nil)
} else {
q := *p - 1
return unit(&q)
}
}
func triple(p *int) maybe {
if p == nil {
return unit(nil)
} else {
q := (*p) * 3
return unit(&q)
}
}
func main() {
i, j, k := 3, 4, 5
for _, p := range []*int{&i, &j, nil, &k} {
m1 := unit(p)
m2 := m1.bind(decrement).bind(triple)
var s1, s2 string = "none", "none"
if m1.value != nil {
s1 = strconv.Itoa(*m1.value)
}
if m2.value != nil {
s2 = strconv.Itoa(*m2.value)
}
fmt.Printf("%4s -> %s\n", s1, s2)
}
}</lang>
- Output:
3 -> 6 4 -> 9 none -> none 5 -> 12
Haskell
Haskell has the built-in Monad type class, and the built-in Maybe type already conforms to the Monad type class.
<lang haskell>main = do print $ Just 3 >>= (return . (*2)) >>= (return . (+1)) -- prints "Just 7"
print $ Nothing >>= (return . (*2)) >>= (return . (+1)) -- prints "Nothing"</lang>
Or, written using do notation:
<lang haskell>main = do print (do x <- Just 3
y <- return (x*2)
z <- return (y+1)
return z)
print (do x <- Nothing
y <- return (x*2)
z <- return (y+1)
return z)</lang>
Or alternately: <lang haskell>main = do print (do x <- Just 3
let y = x*2
let z = y+1
return z)
print (do x <- Nothing
let y = x*2
let z = y+1
return z)</lang>
Deriving and composing safe versions of reciprocal, square root and log functions. : <lang haskell>import Control.Monad ((>=>))
safeVersion :: (a -> b) -> (a -> Bool) -> a -> Maybe b safeVersion f fnSafetyCheck x | fnSafetyCheck x = Just (f x)
| otherwise = Nothing
safeReciprocal = safeVersion (1/) (/=0) safeRoot = safeVersion sqrt (>=0) safeLog = safeVersion log (>0)
safeLogRootReciprocal = safeReciprocal >=> safeRoot >=> safeLog
main = print $ map safeLogRootReciprocal [-2, -1, -0.5, 0, exp (-1), 1, 2, exp 1, 3, 4, 5]</lang>
- Output:
[Nothing,Nothing,Nothing,Nothing,Just 0.5,Just 0.0,Just (-0.3465735902799726),Just (-0.5),Just (-0.5493061443340549),Just (-0.6931471805599453),Just (-0.8047189562170503)]
Hoon
<lang hoon>
- - %say
|= [^ [[txt=(unit ,@tas) ~] ~]]
- - %noun
|^
%+ biff txt
;~ biff
m-parse
m-double
==
++ m-parse
|= a=@tas
^- (unit ,@ud)
(rust (trip a) dem)
::
++ m-double
|= a=@ud
^- (unit ,@ud)
(some (mul a 2))
--
</lang>
Hoon has a built-in rune, %smsg (;~) that binds gates under a monad.
++unit is Hoon's Maybe: it is either ~ (None) or [~ u=val] (Some)
++biff is the monadic bind, which %smsg uses to wire the gates together. It's defined in the standard library here. m-parse is @tas -> (unit ,@ud), so I use biff a second time in order for the program to be called with (unit ,@tas).
++rust is one of the parser combinator runners: it parses the string `a` with the rule `dem`, returning a unit with the returned value if it success or ~ if it fails. Note that Hoon's type system is complex enough to get a strongly typed result of the parsing rule, in this case an unsigned decimal (@ud)
> +monad (some '2') [~ 4] > +monad (some 'a') ~ > +monad ~ ~
J
It's difficult to find a useful and illustrative (but simple) example of this task in J. So we shall not try to be useful.
<lang J> NB. monad implementation: unit=: < bind=: (@>)( :: ])
NB. monad utility safeVersion=: (<@) ( ::((<_.)"_)) safeCompose=:dyad define
dyad def 'x`:6 bind y'/x,unit y
)
NB. unsafe functions (fail with infinite arguments) subtractFromSelf=: -~ divideBySelf=: %~
NB. wrapped functions: safeSubtractFromSelf=: subtractFromSelf safeVersion safeDivideBySelf=: divideBySelf safeVersion
NB. task example:
safeSubtractFromSelf bind safeDivideBySelf 1
┌─┐ │0│ └─┘
safeSubtractFromSelf bind safeDivideBySelf _
┌──┐ │_.│ └──┘</lang>
JavaScript
ES5
Example: deriving and composing safe versions of reciprocal, square root and log functions.
<lang JavaScript>(function () {
'use strict';
// START WITH SOME SIMPLE (UNSAFE) PARTIAL FUNCTIONS:
// Returns Infinity if n === 0
function reciprocal(n) {
return 1 / n;
}
// Returns NaN if n < 0
function root(n) {
return Math.sqrt(n);
}
// Returns -Infinity if n === 0
// Returns NaN if n < 0
function log(n) {
return Math.log(n);
}
// NOW DERIVE SAFE VERSIONS OF THESE SIMPLE FUNCTIONS: // These versions use a validity test, and return a wrapped value // with a boolean .isValid property as well as a .value property
function safeVersion(f, fnSafetyCheck) {
return function (v) {
return maybe(fnSafetyCheck(v) ? f(v) : undefined);
}
}
var safe_reciprocal = safeVersion(reciprocal, function (n) {
return n !== 0;
});
var safe_root = safeVersion(root, function (n) {
return n >= 0;
});
var safe_log = safeVersion(log, function (n) {
return n > 0;
});
// THE DERIVATION OF THE SAFE VERSIONS USED THE 'UNIT' OR 'RETURN' // FUNCTION OF THE MAYBE MONAD
// Named maybe() here, the unit function of the Maybe monad wraps a raw value // in a datatype with two elements: .isValid (Bool) and .value (Number)
// a -> Ma
function maybe(n) {
return {
isValid: (typeof n !== 'undefined'),
value: n
};
}
// THE PROBLEM FOR FUNCTION NESTING (COMPOSITION) OF THE SAFE FUNCTIONS // IS THAT THEIR INPUT AND OUTPUT TYPES ARE DIFFERENT
// Our safe versions of the functions take simple numeric arguments, but return // wrapped results. If we feed a wrapped result as an input to another safe function, // it will choke on the unexpected type. The solution is to write a higher order // function (sometimes called 'bind' or 'chain') which handles composition, taking a // a safe function and a wrapped value as arguments,
// The 'bind' function of the Maybe monad: // 1. Applies a 'safe' function directly to the raw unwrapped value, and // 2. returns the wrapped result.
// Ma -> (a -> Mb) -> Mb
function bind(maybeN, mf) {
return (maybeN.isValid ? mf(maybeN.value) : maybeN);
}
// Using the bind function, we can nest applications of safe_ functions,
// without their choking on unexpectedly wrapped values returned from
// other functions of the same kind.
var rootOneOverFour = bind(
bind(maybe(4), safe_reciprocal), safe_root
).value;
// -> 0.5
// We can compose a chain of safe functions (of any length) with a simple foldr/reduceRight
// which starts by 'lifting' the numeric argument into a Maybe wrapping,
// and then nests function applications (working from right to left)
function safeCompose(lstFunctions, value) {
return lstFunctions
.reduceRight(function (a, f) {
return bind(a, f);
}, maybe(value));
}
// TEST INPUT VALUES WITH A SAFELY COMPOSED VERSION OF LOG(SQRT(1/X))
var safe_log_root_reciprocal = function (n) {
return safeCompose([safe_log, safe_root, safe_reciprocal], n).value;
}
return [-2, -1, -0.5, 0, 1 / Math.E, 1, 2, Math.E, 3, 4, 5].map(
safe_log_root_reciprocal
);
})();</lang>
- Output:
[undefined, undefined, undefined, undefined, 0.5, 0, -0.3465735902799726, -0.5, -0.5493061443340549, -0.6931471805599453, -0.8047189562170503]
Julia
<lang julia>struct maybe x::Union{Real, Missing}; end
Base.show(io::IO, m::maybe) = print(io, m.x)
unit(x) = maybe(x) bind(f, x) = unit(f(x.x))
f1(x) = 5x f2(x) = x + 4
a = unit(3) b = unit(missing)
println(a, " -> ", bind(f2, bind(f1, a)))
println(b, " -> ", bind(f2, bind(f1, b)))
</lang>
- Output:
3 -> 19 missing -> missing
Kotlin
The JVM already contains a 'Maybe' monad in the form of the java.util.Optional<T> generic class.
Its static methods, 'of' and 'ofNullable', serve as its 'unit' function for wrapping nullable and non-nullable values respectively and its instance method, 'flatMap', serves as its 'bind' function.
Rather than write something from scratch, we use this class to complete this task. <lang scala>// version 1.2.10
import java.util.Optional
/* doubles 'i' before wrapping it */ fun getOptionalInt(i: Int) = Optional.of(2 * i)
/* returns an 'A' repeated 'i' times wrapped in an Optional<String> */ fun getOptionalString(i: Int) = Optional.of("A".repeat(i))
/* does same as above if i > 0, otherwise returns an empty Optional<String> */ fun getOptionalString2(i: Int) =
Optional.ofNullable(if (i > 0) "A".repeat(i) else null)
fun main(args: Array<String>) {
/* prints 10 'A's */ println(getOptionalInt(5).flatMap(::getOptionalString).get())
/* prints 4 'A's */ println(getOptionalInt(2).flatMap(::getOptionalString2).get())
/* prints 'false' as there is no value present in the Optional<String> instance */ println(getOptionalInt(0).flatMap(::getOptionalString2).isPresent)
}</lang>
- Output:
AAAAAAAAAA AAAA false
Lua
<lang lua> -- None is represented by an empty table. Some is represented by any -- array with one element. You SHOULD NOT compare maybe values with the -- Lua operator == because it will give incorrect results. Use the -- functions isMaybe(), isNone(), and isSome().
-- define once for efficiency, to avoid many different empty tables local NONE = {}
local function unit(x) return { x } end local Some = unit local function isNone(mb) return #mb == 0 end local function isSome(mb) return #mb == 1 end local function isMaybe(mb) return isNone(mb) or isSome(mb) end
-- inverse of Some(), extract the value from the maybe; get(Some(x)) === x local function get(mb) return mb[1] end
function maybeToStr(mb) return isNone(mb) and "None" or ("Some " .. tostring(get(mb))) end
local function bind(mb, ...) -- monadic bind for multiple functions local acc = mb for _, fun in ipairs({...}) do -- fun should be a monadic function assert(type(fun) == "function") if isNone(acc) then return NONE else acc = fun(get(acc)) end end return acc end
local function fmap(mb, ...) -- monadic fmap for multiple functions local acc = mb for _, fun in ipairs({...}) do -- fun should be a regular function assert(type(fun) == "function") if isNone(acc) then return NONE else acc = Some(fun(get(acc))) end end return acc end -- ^^^ End of generic maybe monad functionality ^^^
--- vvv Start of example code vvv
local function time2(x) return x * 2 end local function plus1(x) return x + 1 end
local answer answer = fmap(Some(3), time2, plus1, time2) assert(get(answer)==14)
answer = fmap(NONE, time2, plus1, time2) assert(isNone(answer))
local function safeReciprocal(x) if x ~= 0 then return Some(1/x) else return NONE end end local function safeRoot(x) if x >= 0 then return Some(math.sqrt(x)) else return NONE end end local function safeLog(x) if x > 0 then return Some(math.log(x)) else return NONE end end local function safeComputation(x) return bind(safeReciprocal(x), safeRoot, safeLog) end
local function map(func, table) local result = {} for key, val in pairs(table) do result[key] = func(val) end return result end
local inList = {-2, -1, -0.5, 0, math.exp (-1), 1, 2, math.exp (1), 3, 4, 5} print("input:", table.concat(map(tostring, inList), ", "), "\n")
local outList = map(safeComputation, inList) print("output:", table.concat(map(maybeToStr, outList), ", "), "\n") </lang>
Nim
<lang nim>import options,math,sugar,strformat template checkAndWrap(x:float,body:typed): untyped =
if x.classify in {fcNormal,fcZero,fcNegZero}:
some(body)
else:
none(typeof(body))
func reciprocal(x:float):Option[float] =
let res = 1 / x res.checkAndWrap(res)
func log(x:float):Option[float] =
let res = ln(x) res.checkAndWrap(res)
func format(x:float):Option[string] =
x.checkAndWrap(&"{x:.2f}")
- our bind function:
func `-->`[T,U](input:Option[T], f: T->Option[U]):Option[U] =
if input.isSome: f(input.get) else: none(U)
when isMainModule:
for i in [0.9,0.0,-0.9,3.0]: echo some(i) --> reciprocal --> log --> format</lang>
- Output:
some("0.11")
none(string)
none(string)
some("-1.10")
Perl
<lang Perl># 20201101 added Perl programming solution
use strict; use warnings;
use Data::Monad::Maybe;
sub safeReciprocal { ( $_[0] == 0 ) ? nothing : just( 1 / $_[0] ) }
sub safeRoot { ( $_[0] < 0 ) ? nothing : just( sqrt( $_[0] ) ) }
sub safeLog { ( $_[0] <= 0 ) ? nothing : just( log ( $_[0] ) ) }
print join(' ', map {
my $safeLogRootReciprocal = just($_)->flat_map( \&safeReciprocal )
->flat_map( \&safeRoot )
->flat_map( \&safeLog );
$safeLogRootReciprocal->is_nothing ? "NaN" : $safeLogRootReciprocal->value;
} (-2, -1, -0.5, 0, exp (-1), 1, 2, exp(1), 3, 4, 5) ), "\n";</lang>
- Output:
NaN NaN NaN NaN 0.5 0 -0.346573590279973 -0.5 -0.549306144334055 -0.693147180559945 -0.80471895621705
Phix
Phix has an "object" type which can be an integer or a string, so not entirely un-like Perl.
Here we simply treat all strings or rather non-integers as the "unknown" type.
<lang Phix>function bind(object m, integer f)
return f(m)
end function
function unit(object m)
return m
end function
function times_five(object l)
return iff(integer(l)?l*5:l)
end function
function plus_four(object l)
return iff(integer(l)?l+4:l)
end function
procedure test(object l)
printf(1,"%v -> %v\n", {l, bind(bind(l,times_five),plus_four)})
end procedure test(3) test("none")</lang>
- Output:
3 -> 19 "none" -> "none"
Racket
It is idiomatic in Racket to use #f for Nothing, and every other value is considered implicitly tagged with Just.
<lang racket>#lang racket
(require syntax/parse/define)
(define (bind x f) (and x (f x))) (define return identity)
- error when arg = 0
(define reciprocal (curry / 1))
- error when arg < 0
(define (root x) (if (< x 0) (error 'bad) (sqrt x)))
- error whe arg <= 0
(define (ln x) (if (<= x 0) (error 'bad) (log x)))
(define (lift f check) (λ (x) (and (check x) (f x))))
(define safe-reciprocal (lift reciprocal (negate (curry equal? 0)))) (define safe-root (lift root (curry <= 0))) (define safe-ln (lift ln (curry < 0)))
(define (safe-log-root-reciprocal x)
(bind (bind (bind x safe-reciprocal) safe-root) safe-ln))
(define tests `(-2 -1 -0.5 0 1 ,(exp -1) 1 2 ,(exp 1) 3 4 5))
(map safe-log-root-reciprocal tests)
(define-syntax-parser do-macro
[(_ [x {~datum <-} y] . the-rest) #'(bind y (λ (x) (do-macro . the-rest)))]
[(_ e) #'e])
(define (safe-log-root-reciprocal* x)
(do-macro [x <- (safe-reciprocal x)]
[x <- (safe-root x)]
[x <- (safe-ln x)]
(return x)))
(map safe-log-root-reciprocal* tests)</lang>
- Output:
'(#f #f #f #f 0 0.5 0 -0.3465735902799726 -0.5 -0.5493061443340549 -0.6931471805599453 -0.8047189562170503) '(#f #f #f #f 0 0.5 0 -0.3465735902799726 -0.5 -0.5493061443340549 -0.6931471805599453 -0.8047189562170503)
Raku
(formerly Perl 6)
It is exceptionally difficult to come up with a compelling valuable use for a Maybe monad in Raku. Monads are most useful in languages that don't have exceptions and/or only allow a single point of entry/exit from a subroutine.
There are very good reasons to have those restrictions. It makes it much less complex to reason about a programs correctness and actually prove that a program is correct, but those restrictions also lead to oddities like Monads, just as a way to work around those restrictions.
The task description asks for two functions that take an Int and return a Maybe Int or Maybe Str, but those distinctions are nearly meaningless in Raku. See below.
<lang perl6>my $monad = <42>; say 'Is $monad an Int?: ', $monad ~~ Int; say 'Is $monad a Str?: ', $monad ~~ Str; say 'Wait, what? What exactly is $monad?: ', $monad.^name;</lang>
- Output:
Is $monad an Int?: True Is $monad a Str?: True Wait, what? What exactly is $monad?: IntStr
$monad is both an Int and a Str. It exists in a sort-of quantum state where what-it-is depends on how-it-is-used. Bolting on some 'Monad' type to do this will only remove functionality that Raku already has.
Ok, say you have a situation where you absolutely do not want an incalculable value to halt processing. (In a web process perhaps.) In that case, it might be useful to subvert the normal exception handler and just return a "Nothing" type. Any routine that needs to be able to handle a Nothing type will need to be informed of it, but for the most part, that just means adding a multi-dispatch candidate.
<lang perl6># Build a Nothing type. When treated as a string it returns the string 'Nothing'.
- When treated as a Numeric, returns the value 'Nil'.
class NOTHING {
method Str { 'Nothing' }
method Numeric { Nil }
}
- A generic instance of a Nothing type.
my \Nothing = NOTHING.new;
- A reimplementation of the square-root function. Could just use the CORE one
- but this more fully shows how multi-dispatch candidates are added.
- Handle positive numbers & 0
multi root (Numeric $n where * >= 0) { $n.sqrt }
- Handle Negative numbers (Complex number handling is built in.)
multi root (Numeric $n where * < 0) { $n.Complex.sqrt }
- Else return Nothing
multi root ($n) { Nothing }
- Handle numbers > 0
multi ln (Real $n where * > 0) { log $n, e }
- Else return Nothing
multi ln ($n) { Nothing }
- Handle fraction where the denominator != 0
multi recip (Numeric $n where * != 0) { 1/$n }
- Else return Nothing
multi recip ($n) { Nothing }
- Helper formatting routine
sub center ($s) {
my $pad = 21 - $s.Str.chars; ' ' x ($pad / 2).floor ~ $s ~ ' ' x ($pad / 2).ceiling;
}
- Display the "number" the reciprocal, the root, natural log and the 3 functions
- composed together.
put ('"Number"', 'Reciprocal', 'Square root', 'Natural log', 'Composed')».¢er;
- Note how it handles the last two "values". The string 'WAT' is not numeric at
- all; but Ethiopic number 30, times vulgar fraction 1/7, is.
put ($_, .&recip, .&root, .&ln, .&(&ln o &root o &recip) )».¢er
for -2, -1, -0.5, 0, exp(-1), 1, 2, exp(1), 3, 4, 5, 'WAT', ፴ × ⅐;</lang>
- Output:
"Number" Reciprocal Square root Natural log Composed
-2 -0.5 0+1.4142135623730951i Nothing Nothing
-1 -1 0+1i Nothing Nothing
-0.5 -2 0+0.7071067811865476i Nothing Nothing
0 Nothing 0 Nothing Nothing
0.36787944117144233 2.718281828459045 0.6065306597126334 -1 0.5
1 1 1 0 0
2 0.5 1.4142135623730951 0.6931471805599453 -0.3465735902799726
2.718281828459045 0.36787944117144233 1.6487212707001282 1 -0.5
3 0.333333 1.7320508075688772 1.0986122886681098 -0.5493061443340549
4 0.25 2 1.3862943611198906 -0.6931471805599453
5 0.2 2.23606797749979 1.6094379124341003 -0.8047189562170503
WAT Nothing Nothing Nothing Nothing
4.285714 0.233333 2.0701966780270626 1.455287232606842 -0.727643616303421
REXX
This REXX version is modeled after the Zkl version. <lang rexx>/*REXX program mimics a bind operation when trying to perform addition upon arguments. */ call add 1, 2 call add 1, 2.0 call add 1, 2.0, -6 call add self, 2 exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ add: void= 'VOID'; f= /*define in terms of a function&binding*/
do j=1 for arg() /*process, classify, bind each argument*/
call bind( arg(j) ); f= f arg(j)
end /*j*/
say
say 'adding' f; call sum f /*telegraph what's being performed next*/
return /*Note: REXX treats INT & FLOAT as num.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/ bind: arg a; type.a= datatype(a); return /*bind argument's kind with its "type".*/ /*──────────────────────────────────────────────────────────────────────────────────────*/ sum: parse arg a; $= 0 /*sum all arguments that were specified*/
do k=1 for words(a); ?= word(a, k)
if type.?==num & $\==void then $= ($ + word(a, k)) / 1
else $= void
end /*k*/
say 'sum=' $
return $</lang>
- output when using the default inputs:
adding 1 2 sum= 3 adding 1 2.0 sum= 3 adding 1 2.0 -6 sum= -3 adding SELF 2 sum= VOID
Ruby
OOP version using Ruby's block syntax
<lang ruby>class Maybe
def initialize(value) @value = value end
def map
if @value.nil?
self
else
Maybe.new(yield @value)
end
end
end
Maybe.new(3).map { |n| 2*n }.map { |n| n+1 }
- => #<Maybe @value=7>
Maybe.new(nil).map { |n| 2*n }.map { |n| n+1 }
- => #<Maybe @value=nil>
Maybe.new(3).map { |n| nil }.map { |n| n+1 }
- => #<Maybe @value=nil>
- alias Maybe#new and write bind to be in line with task
class Maybe
class << self alias :unit :new end def initialize(value) @value = value end
def bind
if @value.nil?
self
else
yield @value
end
end
end
Maybe.unit(3).bind { |n| Maybe.unit(2*n) }.bind { |n| Maybe.unit(n+1) }
- => #<Maybe @value=7>
Maybe.unit(nil).bind { |n| Maybe.unit(2*n) }.bind { |n| Maybe.unit(n+1) }
- => #<Maybe @value=nil>
</lang>
Wren
<lang ecmascript>import "/fmt" for Fmt
class Maybe {
construct new(value) {
_value = value
}
value { _value }
bind(f) { f.call(_value) }
static unit(i) { Maybe.new(i) }
}
var decrement = Fn.new { |i|
if (!i) return Maybe.unit(null) return Maybe.unit(i - 1)
}
var triple = Fn.new { |i|
if (!i) return Maybe.unit(null) return Maybe.unit(3 * i)
}
for (i in [3, 4, null, 5]) {
var m1 = Maybe.unit(i)
var m2 = m1.bind(decrement).bind(triple)
var s1 = (m1.value) ? "%(m1.value)" : "none"
var s2 = (m2.value) ? "%(m2.value)" : "none"
System.print("%(Fmt.s(4, s1)) -> %(s2)")
}</lang>
- Output:
3 -> 6 4 -> 9 none -> none 5 -> 12
zkl
While I'm unsure of the utility of Monads in a dynamic type-less language, it can be done.
From the Wikipedia
Here we use the Void object as Nothing and define some functions. Since zkl is type-less, we can consider Maybe as a native type and don't need to define it. <lang zkl>fcn bind(a,type,b){ if(type.isType(a)) b else Void } fcn just(x){ if(Deferred.isType(x)) x() else x } // force lazy evaluation fcn rtn(x) { just(x) }</lang> Since zkl is eager, add needs to gyrate a bit by creating a lazy result and evaluating that after the binds have done their bizness. <lang zkl>fcn add(mx,my){
bind(mx,Int,
bind(my,Int,
'+.fp(mx,my))) : rtn(_) // create a lazy mx+my to avoid eager eval
} add(1,2).println(); // two ints add(1,2.0).println(); // int and float add(self,2).println(); // class and int</lang>
- Output:
3 Void Void