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-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 (take number-of-points (points (int (time))))
    result (Counter (gfor [x y] samples (>= 1.0 (+ (** x 2) (** y 2))))))
  (-> 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-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 "!"))))))

(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-return]])

(defn gcd [a b]
  (if (zero? 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)))))

(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 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

(require
  [hymn.macros [do-monad-return]]
  [hymn.types.list [~]])

(setv total 1000
      limit (-> total (** 0.5) int inc))

(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 (-> (+ 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-return]]
  [hymn.types.list [~]]
  [hymn.types.maybe [?]])

(setv ops [+ - * /])

(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))

(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