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