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.dsl)

;;; Knuth!
(def a 6364136223846793005)
(def c 1442695040888963407)
(def m (** 2 64))

;;; linear congruential generator
(def random
  (do-monad
    [seed get-state
     _ (set-state (-> seed (* a) (+ c) (% m)))
     new-seed get-state]
    (/ new-seed m)))

(def 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"
  (def samples (take number-of-points (points (int (time)))))
  (def 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]])
(require hymn.dsl)

(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 [const force lift]])

(require hymn.dsl)

(def depends (lift (const nil)))

(defmacro deftask [n &rest actions]
  `(def ~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.dsl)

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

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

(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")
    (let [[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.dsl)

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

(def 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.dsl)

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

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