Monads/Writer monad: Difference between revisions
Added FreeBASIC
(Added FreeBASIC) |
|||
| (6 intermediate revisions by 4 users not shown) | |||
Line 450:
half → 1
</syntaxhighlight>
=={{header|FreeBASIC}}==
{{trans|Go}}
<syntaxhighlight lang="vbnet">Type mwriter
value As Double
log_ As String
End Type
Function Unit(v As Double, s As String) As mwriter
Dim As mwriter mw
mw.value = v
mw.log_ = " " & s & ": " & Str(v) & Chr(10)
Return mw
End Function
Function Root(mw As mwriter) As mwriter
mw.value = Sqr(mw.value)
mw.log_ = mw.log_ & " Took square Root: " & Str(mw.value) & Chr(10)
Return mw
End Function
Function addOne(mw As mwriter) As mwriter
mw.value = mw.value + 1
mw.log_ = mw.log_ & " Added one : " & Str(mw.value) & Chr(10)
Return mw
End Function
Function Half(mw As mwriter) As mwriter
mw.value = mw.value / 2
mw.log_ = mw.log_ & " Divided by two : " & Str(mw.value) & Chr(10)
Return mw
End Function
Dim As mwriter mw1
mw1 = Unit(5, "Initial value ")
mw1 = Root(mw1)
mw1 = addOne(mw1)
mw1 = Half(mw1)
Print "The Golden Ratio is "; mw1.value
Print !"\nThis was derived as follows:-"
Print mw1.log_
Sleep</syntaxhighlight>
{{out}}
<pre>The Golden Ratio is 1.618033988749895
This was derived as follows:-
Initial value : 5
Took square Root: 2.23606797749979
Added one : 3.23606797749979
Divided by two : 1.618033988749895</pre>
=={{header|F_Sharp|F#}}==
Line 617 ⟶ 668:
added 1 -> 3.23607
divided by 2 -> 1.61803</syntaxhighlight>
=={{header|Java}}==
<syntaxhighlight lang="java">
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;
}
</syntaxhighlight>
{{ out }}
<pre>
The Golden Ratio is 1.618033988749895
This was derived as follows:
Initial value : 5.0
Took square root : 2.23606797749979
Added one : 3.23606797749979
Divided by two : 1.618033988749895
</pre>
=={{header|JavaScript}}==
Line 1,060 ⟶ 1,179:
=={{header|Python}}==
<syntaxhighlight lang="python">
"""A Writer Monad. Requires Python >= 3.7 for type hints."""
from __future__ import annotations
Line 1,067 ⟶ 1,187:
import os
from typing import Callable
from typing import Generic
Line 1,076 ⟶ 1,195:
T = TypeVar("T")
U = TypeVar("U")
Line 1,087 ⟶ 1,207:
self.msgs = list(f"{msg}: {self.value}" for msg in msgs)
def bind(self, func: Callable[[T], Writer[
writer = func(self.value)
return Writer(writer, *self.msgs)
def __rshift__(self, func: Callable[[T], Writer[
return self.bind(func)
Line 1,101 ⟶ 1,221:
def lift(func: Callable[[T], U], msg: str) -> Callable[[
"""Return a writer monad version of the simple function `func`."""
@functools.wraps(func)
def wrapped(value: T) -> Writer[U]:
return Writer(func(value), msg)
Line 1,113 ⟶ 1,233:
if __name__ == "__main__":
square_root = lift(math.sqrt, "square root")
add_one: Callable[[Union[int, float]], Writer[Union[int, float]]] = lift(
lambda x: x + 1, "add one"
)
half: Callable[[Union[int, float]], Writer[float]] = lift(
lambda x: x / 2, "div two"
)
print(Writer(5, "initial") >> square_root >> add_one >> half)
Line 1,207 ⟶ 1,333:
Added one: 3.23606797749979
Divided by 2: 1.618033988749895
</pre>
=={{header|Scheme}}==
{{works with|Gauche Scheme|0.9.12}}
{{works with|CHICKEN Scheme|5.3.0}}
The program is written in R7RS-small Scheme. For CHICKEN you will need the <code>r7rs</code> egg.
<syntaxhighlight lang="scheme">
(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)
</syntaxhighlight>
{{out}}
Compile and run with <pre>gosh -r7 writer_monad_r7rs.scm</pre> or <pre>csc -O5 -X r7rs -R r7rs writer_monad_r7rs.scm && ./writer_monad_r7rs</pre>
(I use the high optimization level <code>-O5</code> to check I have done nothing to impede such optimization.)
The result is computed in three different notations. The <code>perform</code> syntax is something that looks like Haskell's <code>do</code> syntax. (The name <code>do</code> is already used as the Scheme and Common Lisp name for a kind of for-loop.)
Notice that the <code>>>=</code> and <code>>-></code> are ordinary "prefix" procedures, rather than infix operators. One might think this would make them very difficult to write with, but a Scheme procedure can be made to recursively perform a chain of operations, so that you will need to write the procedure name only once. I have made <code>>>=</code> and <code>>-></code> work that way.
<pre>
---------------
Using just >>=
---------------
(1 + sqrt(5))/2 = 1.61803398874989
messages:
(new writer-monad 5)
(5 root 2.23606797749979)
(2.23606797749979 addOne 3.23606797749979)
(3.23606797749979 half 1.61803398874989)
------------------
Using >>= and >=>
------------------
(1 + sqrt(5))/2 = 1.61803398874989
messages:
(new writer-monad 5)
(5 root 2.23606797749979)
(2.23606797749979 addOne 3.23606797749979)
(3.23606797749979 half 1.61803398874989)
-----------------------
Using 'perform' syntax
-----------------------
(1 + sqrt(5))/2 = 1.61803398874989
messages:
(new writer-monad 5)
(5 root 2.23606797749979)
(2.23606797749979 addOne 3.23606797749979)
(3.23606797749979 half 1.61803398874989)
</pre>
Line 1,212 ⟶ 1,542:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
class Mwriter {
| |||