Skip to content

Instantly share code, notes, and snippets.

@exupero
Last active December 31, 2023 16:29
Show Gist options
  • Save exupero/c6f2cb4a15b1ccd5e9e9ee38a58328ea to your computer and use it in GitHub Desktop.
Save exupero/c6f2cb4a15b1ccd5e9e9ee38a58328ea to your computer and use it in GitHub Desktop.
Stack math evaluator
#!/usr/bin/env bb
(ns stack-math
(:require [clojure.string :as str]
[clojure.core.match :refer [match]]
[clojure.tools.cli :as cli]))
(defn parse-stack [s]
(read-string (format "[%s]" s)))
(def cli-opts
[["-e" "--eval PROGRAM" "evaluate operations"
:id :to-eval
:parse-fn parse-stack]])
(defn pick [stack]
[(pop stack) (peek stack)])
(defn swap-top [stack f & args]
(let [[stack x] (pick stack)]
(conj stack (apply f x args))))
(defn swap-top2 [stack f & args]
(let [[stack y] (pick stack)
[stack x] (pick stack)]
(conj stack (apply f x y args))))
(defmulti op (fn [word _] word))
(defn execute [stack prog]
(reduce
(fn [stack word]
(if (symbol? word)
(op word stack)
(conj stack word)))
stack prog))
;; Stack operations
(defmethod op 'dup [_ stack]
(let [[stack top] (pick stack)]
(conj stack top top)))
(defmethod op 'left [_ stack]
(let [[stack ops] (pick stack)
[stack top] (if (= 1 (count stack))
[stack (peek stack)]
(pick stack))]
(conj (execute stack ops) top)))
(defmethod op 'right [_ stack]
(let [[stack ops] (pick stack)
stack (if (= 1 (count stack))
(conj stack (peek stack))
stack)]
(execute stack ops)))
(defmacro defop [nm f & args]
`(defmethod op '~nm [_ stack#]
(~f stack# ~@args)))
(defop + swap-top2 +)
(defop - swap-top2 -)
(defop * swap-top2 *)
(defop / swap-top2 /)
(defop halve swap-top / 2)
(defop double swap-top * 2)
(defop third swap-top / 3)
(defop triple swap-top * 3)
(defop two-thirds swap-top * 2/3)
(defop quarter swap-top / 4)
(defop quadruple swap-top * 4)
(defop tenth swap-top / 10)
(defop tenfold swap-top * 10)
(defop seven-hundredth swap-top / 700)
(defop seven-hundredfold swap-top * 700)
(defop hundredth swap-top / 100)
(defop hundredfold swap-top * 100)
(defop thousandth swap-top / 1000)
(defop thousandfold swap-top * 1000)
(defop four-thousandth swap-top / 4000)
(defop four-thousandfold swap-top * 4000)
(defop five-thousandth swap-top / 5000)
(defop five-thousandfold swap-top * 5000)
(defop ten-thousandth swap-top / 10000)
(defop ten-thousandfold swap-top * 10000)
(defop +quarter swap-top * 1.25)
(defop -quarter swap-top * 0.75)
(defop +half swap-top * 1.5)
(defop +fifth swap-top * 1.2)
(defop -fifth swap-top * 0.8)
(defop +tenth swap-top * 1.1)
(defop -tenth swap-top * 0.9)
(defop +twentieth swap-top * 1.05)
(defop -twentieth swap-top * 0.95)
(defop sqrt swap-top #(Math/sqrt %))
(defop square swap-top #(* % %))
(defop cube-root swap-top #(Math/cbrt %))
(defop cube swap-top #(* % % %))
;; Error checking
(defn error [expected actual]
(if (zero? expected)
(if (zero? actual)
0
##Inf)
(let [expected (float expected)]
(/ (Math/abs (- expected (float actual))) expected))))
(defn sample-error [exact approx]
(->> [0 1 10 100 1000]
(sequence
(comp
(map #(error
(last (execute [%] exact))
(last (execute [%] approx))))
(remove nil?)))
(apply max)))
(defn find-error [exact approx]
(match exact
[x '*] (error x (last (execute [1] approx)))
[x '/] (error (/ x) (last (execute [1] approx)))
:else (sample-error exact approx)))
(defn format-percent [x]
(let [x (float (* 100 x))
fmt (if (< 10 x) "%.2g%%" "%.1g%%")]
(format fmt x)))
(let [{{:keys [to-eval]} :options [exact & approxs] :arguments}
, (-> (cli/parse-opts *command-line-args* cli-opts)
(update :arguments (partial map parse-stack)))]
(cond
to-eval
, (println (execute [] to-eval))
:else
, (doseq [approx approxs]
(println (str (str/join " " approx) ":")
(format-percent (find-error exact approx))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment