Examples¶
Calculating Pi with Monte Carlo Method¶
Pseudo-random number generator with State
monad:
(import
[collections [Counter]]
[time [time]]
[hymn.dsl [get-state replicate set-state]])
(require [hymn.macros [do-monad]])
;;; Knuth!
(setv a 6364136223846793005)
(setv c 1442695040888963407)
(setv m (** 2 64))
;;; linear congruential generator
(setv random
(do-monad
[seed get-state
_ (set-state (-> seed (* a) (+ c) (% m)))
new-seed get-state]
(/ new-seed m)))
(setv random-point (do-monad [x random y random] (, x y)))
(defn points [seed]
"stream of random points"
(while True
;; NOTE:
;; limited by the maximum recursion depth, we take 150 points each time
(setv [random-points seed] (.run (replicate 150 random-point) seed))
(for [point random-points]
(yield point))))
(defn monte-carlo [number-of-points]
"use monte carlo method to calculate value of pi"
(setv samples (take number-of-points (points (int (time)))))
(setv result
(Counter (genexpr (>= 1.0 (+ (** x 2) (** y 2))) [[x y] samples])))
(-> result (get True) (/ number-of-points) (* 4)))
(defmain [&rest args]
(if (-> args len (!= 2))
(print "usage:" (first args) "number-of-points")
(print "the estimate for pi =" (-> args second int monte-carlo))))
Example output:
$ ./monte_carlo.hy 50000
the estimate for pi = 3.14232
Calculating Sum¶
Wicked sum function with Writer
monad:
(import [hymn.dsl [sequence tell]])
(defn wicked-sum [numbers]
(.execute (sequence (map tell numbers))))
(defmain [&rest args]
(if (-> args len (= 1))
(print "usage:" (first args) "number1 number2 .. numberN")
(print "sum:" (->> args rest (map int) wicked-sum))))
Example output:
$ ./sum.hy 123 456 789
sum: 1368
Dependency Handling with Lazy Monad¶
Actions with the Lazy
monad can be used to handle
dependencies:
(import [hymn.dsl [force lift]])
(require [hymn.types.lazy [lazy]])
(setv depends (lift (constantly None)))
(defmacro deftask [n &rest actions]
`(setv ~n
(depends (lazy (print "(started" '~n))
~@actions
(lazy (print " finished " '~n ")" :sep "")))))
(deftask a)
(deftask b)
(deftask c)
(deftask d)
(deftask e)
(deftask f (depends c a))
(deftask g (depends b d))
(deftask h (depends g e f))
(defmain [&rest args]
(force h))
Example output:
$ ./deps.hy
(started h
(started g
(started b
finished b)
(started d
finished d)
finished g)
(started e
finished e)
(started f
(started c
finished c)
(started a
finished a)
finished f)
finished h)
The FizzBuzz Test¶
The possibly over-engineered FizzBuzz solution:
;;; The fizzbuzz test, in the style inspired by c_wraith on Freenode #haskell
(import [hymn.dsl [<> from-maybe maybe-m]])
(require [hymn.macros [do-monad-with]])
(defn fizzbuzz [i]
(from-maybe
(<>
(do-monad-with maybe-m [:when (zero? (% i 3))] "fizz")
(do-monad-with maybe-m [:when (zero? (% i 5))] "buzz"))
(str i)))
;;; using monoid operation, it is easy to add new case, just add one more line
;;; in the append (<>) call. e.g
(defn fizzbuzzbazz [i]
(from-maybe
(<>
(do-monad-with maybe-m [:when (zero? (% i 3))] "fizz")
(do-monad-with maybe-m [:when (zero? (% i 5))] "buzz")
(do-monad-with maybe-m [:when (zero? (% i 7))] "bazz"))
(str i)))
(defn format [seq]
(.join "" (interleave seq (cycle "\t\t\t\t\n"))))
(defmain [&rest args]
(if (-> args len (= 1))
(print "usage:" (first args) "up-to-number")
(print (->> args second int inc (range 1) (map fizzbuzz) format))))
Example output:
$ ./fizzbuzz.hy 100
1 2 fizz 4 buzz
fizz 7 8 fizz buzz
11 fizz 13 14 fizzbuzz
16 17 fizz 19 buzz
fizz 22 23 fizz buzz
26 fizz 28 29 fizzbuzz
31 32 fizz 34 buzz
fizz 37 38 fizz buzz
41 fizz 43 44 fizzbuzz
46 47 fizz 49 buzz
fizz 52 53 fizz buzz
56 fizz 58 59 fizzbuzz
61 62 fizz 64 buzz
fizz 67 68 fizz buzz
71 fizz 73 74 fizzbuzz
76 77 fizz 79 buzz
fizz 82 83 fizz buzz
86 fizz 88 89 fizzbuzz
91 92 fizz 94 buzz
fizz 97 98 fizz buzz
Interactive Greeting¶
Greeting from Continuation
monad:
(import [hymn.dsl [cont-m call-cc]])
(require [hymn.macros [do-monad m-when with-monad]])
(defn validate [name exit]
(with-monad cont-m
(m-when (not name) (exit "Please tell me your name!"))))
(defn greeting [name]
(.run (call-cc
(fn [exit]
(do-monad
[_ (validate name exit)]
(+ "Welcome, " name "!"))))))
(defmain [&rest args]
(print (greeting (input "Hi, what is your name? "))))
Example output:
$ ./greeting.hy
Hi, what is your name?
Please tell me your name!
$ ./greeting.hy
Hi, what is your name? Marvin
Welcome, Marvin!
Greatest Common Divisor¶
Logging with Writer
monad:
(import [hymn.dsl [tell]])
(require [hymn.macros [do-monad do-monad-m]])
(defn gcd [a b]
(if (zero? b)
(do-monad
[_ (tell (.format "the result is: {}\n" (abs a)))]
(abs a))
(do-monad-m
[_ (tell (.format "{} mod {} = {}\n" a b (% a b)))]
(gcd b (% a b)))))
(defmain [&rest args]
(if (-> args len (!= 3))
(print "usage:" (first args) "number1 number2")
(do
(setv a (int (get args 1)) b (int (get args 2)))
(print "calculating the greatest common divisor of" a "and" b)
(print (.execute (gcd a b))))))
Example output:
$ ./gcd.hy 24680 1352
calculating the greatest common divisor of 24680 and 1352
24680 mod 1352 = 344
1352 mod 344 = 320
344 mod 320 = 24
320 mod 24 = 8
24 mod 8 = 0
the result is: 8
Project Euler Problem 9¶
Solving problem 9 with List
monad
(require
[hymn.macros [do-monad]]
[hymn.types.list [~]])
(setv total 1000)
(setv limit (-> total (** 0.5) int inc))
(setv triplet
(do-monad
[m #~ (range 2 limit)
n #~ (range 1 m)
:let [a (- (** m 2) (** n 2))
b (* 2 m n)
c (+ (** m 2) (** n 2))]
:when (-> (+ a b c) (= total))]
[a b c]))
(defmain [&rest args]
(print "Project Euler Problem 9 - list monad example"
"https://projecteuler.net/problem=9"
"There exists exactly one Pythagorean triplet"
"for which a + b + c = 1000. Find the product abc."
(->> triplet first (reduce *))
:sep "\n"))
Example output:
$ ./euler9.hy
Project Euler Problem 9 - list monad example
https://projecteuler.net/problem=9
There exists exactly one Pythagorean triplet
for which a + b + c = 1000. Find the product abc.
31875000
Project Euler Problem 29¶
Solving problem 29 with lift()
and
List
monad
(require
[hymn.macros [^]]
[hymn.types.list [~]])
(defmain [&rest args]
(print "Project Euler Problem 29 - lift and list monad example"
"https://projecteuler.net/problem=29"
"How many distinct terms are in the sequence generated by"
"a to the power of b for 2 <= a <= 100 and 2 <= b <= 100?"
(-> (#^ pow #~ (range 2 101) #~ (range 2 101)) distinct list len)
:sep "\n"))
Example output:
$ ./euler29.hy
Project Euler Problem 29 - lift and list monad example
https://projecteuler.net/problem=29
How many distinct terms are in the sequence generated by
a to the power of b for 2 <= a <= 100 and 2 <= b <= 100?
9183
Solving 24 Game¶
Nondeterministic computation with List
monad and
error handling with Maybe
monad:
(import
[functools [partial]]
[itertools [permutations]])
(require
[hymn.macros [do-monad do-monad-m]]
[hymn.types.list [~]]
[hymn.types.maybe [?]])
(setv ops [+ - * /])
(defmacro infix-repr [fmt]
`(.format ~fmt :a a :b b :c c :d d :op1 (. op1 --name--)
:op2 (. op2 --name--) :op3 (. op3 --name--)))
;;; use maybe monad to handle division by zero
(defmacro safe [expr] `(#? (fn [] ~expr)))
(defn template [[a b c d]]
(do-monad-m
[op1 #~ ops
op2 #~ ops
op3 #~ ops]
;; (, result infix-representation)
[(, (safe (op1 (op2 a b) (op3 c d)))
(infix-repr "({a} {op2} {b}) {op1} ({c} {op3} {d})"))
(, (safe (op1 a (op2 b (op3 c d))))
(infix-repr "{a} {op1} ({b} {op2} ({c} {op3} {d}))"))
(, (safe (op1 (op2 (op3 a b) c) d))
(infix-repr "(({a} {op3} {b}) {op2} {c}) {op1} {d}"))]))
(defn combinations [numbers]
(do-monad
[:let [seemed (set)]
[a b c d] #~ (permutations numbers 4)
:when (not-in (, a b c d) seemed)]
(do
(.add seemed (, a b c d))
[a b c d])))
;;; In python, 8 / (3 - (8 / 3)) = 23.99999999999999, it should be 24 in fact,
;;; so we have to use custom comparison function like this
(defn close-enough [a b] (< (abs (- a b)) 0.0001))
(defn solve [numbers]
(do-monad
[[result infix-repr] (<< template (combinations numbers))
:when (>> result (partial close-enough 24))]
infix-repr))
(defmain [&rest args]
(if (-> args len (!= 5))
(print "usage:" (first args) "number1 number2 number3 number4")
(->> args rest (map int) solve (.join "\n") print)))
Example output:
$ ./solve24.hy 2 3 8 8
((2 * 8) - 8) * 3
(3 / 2) * (8 + 8)
3 / (2 / (8 + 8))
((8 - 2) - 3) * 8
((8 * 2) - 8) * 3
((8 - 3) - 2) * 8
8 * (8 - (2 + 3))
((8 + 8) / 2) * 3
(8 + 8) / (2 / 3)
(8 + 8) * (3 / 2)
8 * (8 - (3 + 2))
((8 + 8) * 3) / 2