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:" (get args 0) "number-of-points")
    (print "the estimate for pi =" (-> args (get 1) 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:" (get args 0) "number1 number2 .. numberN")
    (print "sum:" (wicked-sum (map int (slice args 1))))))

Example output:

$ ./sum.hy 123 456 789
sum: 1368

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:" (get args 0) "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]
  (def seemed (set))
  (do-monad
    [[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:" (get args 0) "number1 number2 number3 number4")
    (print (->> (slice args 1) (map int) solve (.join "\n")))))

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