Examples¶
Calculating Pi with Monte Carlo Method¶
Pseudo-random number generator with State
monad:
(import
collections [Counter]
itertools [islice]
time [time]
hymn.dsl [get-state replicate set-state])
(require hymn.dsl [do-monad-return])
;; Knuth!
(setv a 6364136223846793005
c 1442695040888963407
m (** 2 64))
;; linear congruential generator
(setv random
(do-monad-return
[seed get-state
_ (set-state (% (+ (* seed a) c) m))
new-seed get-state]
(/ new-seed m)))
(setv random-point (do-monad-return [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 (islice (points (int (time))) number-of-points)
result (Counter (gfor [x y] samples (>= 1.0 (+ (** x 2) (** y 2))))))
(* 4 (/ (get result True) number-of-points)))
(when (= __name__ "__main__")
(import sys)
(setv args sys.argv)
(if (!= 2 (len args))
(print "usage:" (get args 0) "number-of-points")
(print "the estimate for pi =" (monte-carlo (int (get args 1))))))
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))))
(when (= __name__ "__main__")
(import sys)
(setv [prog_name #* args] sys.argv)
(if (= 0 (len args))
(print "usage:" prog_name "number1 number2 .. numberN")
(print "sum:" (wicked-sum (map int args)))))
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]
hymn.utils [constantly])
(require hymn.types.lazy [lazy])
(setv depends (lift (constantly None)))
(defmacro deftask [n #* 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))
(when (= __name__ "__main__")
(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
itertools [chain cycle]
hymn.dsl [<> from-maybe maybe-m])
(require hymn.dsl [do-monad-with])
(defn fizzbuzz [i]
(from-maybe
(<>
(do-monad-with maybe-m [:when (= 0 (% i 3))] "fizz")
(do-monad-with maybe-m [:when (= 0 (% 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 (= 0 (% i 3))] "fizz")
(do-monad-with maybe-m [:when (= 0 (% i 5))] "buzz")
(do-monad-with maybe-m [:when (= 0 (% i 7))] "bazz"))
(str i)))
(defn interleave [#* ss]
(chain.from-iterable (zip #* ss)))
(defn format [seq]
(.join "" (interleave seq (cycle "\t\t\t\t\n"))))
(when (= __name__ "__main__")
(import sys)
(setv [prog_name #* args] sys.argv)
(if (!= 1 (len args))
(print "usage:" prog_name "up-to-number")
(print (format (map fizzbuzz (range 1 (+ (int (get args 0)) 1)))))))
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.dsl [do-monad-return 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-return
[_ (validate name exit)]
(+ "Welcome, " name "!"))))))
(when (= __name__ "__main__")
(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.dsl [do-monad do-monad-return])
(defn gcd [a b]
(if (= 0 b)
(do-monad-return
[_ (tell (.format "the result is: {}\n" (abs a)))]
(abs a))
(do-monad
[_ (tell (.format "{} mod {} = {}\n" a b (% a b)))]
(gcd b (% a b)))))
(when (= __name__ "__main__")
(import sys)
(setv [prog_name #* args] sys.argv)
(if (!= 2 (len args))
(print "usage:" prog_name "number1 number2")
(do
(setv [a b] args)
(print "calculating the greatest common divisor of" a "and" b)
(print (.execute (gcd (int a) (int b)))))))
Example output:
$ ./gcd.hy 1151130 1151330
calculating the greatest common divisor of 1151130 and 1151330
1151130 mod 1151330 = 1151130
1151330 mod 1151130 = 200
1151130 mod 200 = 130
200 mod 130 = 70
130 mod 70 = 60
70 mod 60 = 10
60 mod 10 = 0
the result is: 10
Project Euler Problem 9¶
Solving problem 9 with List
monad
(import functools [reduce]
hy.pyops [*])
(require hymn.dsl [do-monad-return] :readers [@])
(setv total 1000
limit (+ (int (** total 0.5)) 1))
(setv triplet
(do-monad-return
[m #@ (range 2 limit)
n #@ (range 1 m)
:let [a (- (** m 2) (** n 2))
b (* 2 m n)
c (+ (** m 2) (** n 2))]
:when (= total (+ a b c))]
[a b c]))
(when (= __name__ "__main__")
(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."
(reduce * (next (iter triplet)))
: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.dsl :readers [^ @])
(when (= __name__ "__main__")
(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?"
(len (list (set (#^ pow #@ (range 2 101) #@ (range 2 101)))))
: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]
hy.pyops [+ - * /])
(require hymn.dsl [do-monad do-monad-return] :readers [@ ?])
(setv ops [+ - * /])
(defn name [op]
(get (setx mapping {+ "+" - "-" * "*" / "/"}) op))
(defmacro infix-repr [fmt]
`(.format ~fmt :a a :b b :c c :d d :op1 (name op1)
:op2 (name op2) :op3 (name op3)))
;; use maybe monad to handle division by zero
(defmacro safe [expr] `(#? (fn [] ~expr)))
(defn template [numbers]
(setv [a b c d] numbers)
(do-monad
[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-return
[: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-return
[[result infix-repr] (<< template (combinations numbers))
:when (>> result (partial close-enough 24))]
infix-repr))
(when (= __name__ "__main__")
(import sys)
(setv [prog_name #* args] sys.argv)
(if (!= 4 (len args))
(print "usage:" prog_name "number1 number2 number3 number4")
(print (.join "\n" (solve (map int args))))))
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