Haniyya · August 2, 2019 20:37
diff --git a/rle-combinators.clj b/rle-combinators.clj
 (ns run-length-encoding)

 ;; Combinators
 (defn matches [predicate]
  (fn [input]
    (if (not (empty? input))
      (let [[head & tail] input]
        (if (predicate head) [head (apply str tail)])))))

 (defn mmap [func parser]
  (fn [input]
    (if-let [[result parse-rest] (parser input)] [(func result) parse-rest])))

 (defn alts [& parsers]
  (fn [input]
    (some #(% input) parsers)))

 (defn combine [p q]
  (fn [input]
    (if-let [[result newi] (p input)]
      (let [[res2 newi2] (q newi)]
        [[result res2] newi2]))))

 (defn all [& parsers]
  (reduce combine parsers))

 (defn many [parser]
  (fn [input]
    (loop [results []
           current-input input]
      (if-let [[res newi] (parser current-input)]
        (recur (conj results res) newi)
        [results current-input]))))

 (defn many1 [parser]
  (mmap flatten (all parser (many parser))))

 (defn mchar [ch]
  (matches (partial = ch)))

 (defn runp [parser]
  "Returns a function that runs a given parser
  over some input and return the joined result."
  (fn [input]
    (->> input (parser) (first) (apply str))))

 ;; Predicates
 (defn digit? [ch]
  (Character/isDigit ^Character ch))

 (defn letter? [ch]
  (Character/isLetter ^Character ch))

 (defn whitespace? [ch]
  (Character/isWhitespace ^Character ch))

 ;; Tokens
 (def whitespace (matches whitespace?))
 (def letter (matches letter?))
 (def digit (matches digit?))
 (def any (matches (fn [& _args] (identity true))))

 ;; Run-length tokens
 (def consecutives
  (fn [[headi & resti]]
    ((mmap (partial cons headi) (many1 (mchar headi))) resti)))
 (def conscount
  (mmap #(str (count %) (first %)) consecutives))
 (def expandable (all (many1 digit) any))
 (def expansion
  (fn [c ch]
    (apply str (repeat (Integer/parseInt (apply str c)) ch))))

 ;; Decoding and Encoding functions
 (def run-length-encode
  (runp (many1 (alts conscount letter whitespace))))

 (def run-length-decode
  (runp (many1 (alts (mmap (partial apply expansion) expandable)
                     letter
                     whitespace))))

 (run-length-encode "jjAaames") ; -> "2jA2ames"
 (run-length-decode "2j3ames") ; -> "jjaaames"
 (->> "jeff"
     (run-length-encode)
     (run-length-decode)) ; -> "jeff"
	(ns run-length-encoding)

	;; Combinators
	(defn matches [predicate]
	(fn [input]
	(if (not (empty? input))
	(let [[head & tail] input]
	(if (predicate head) [head (apply str tail)])))))

	(defn mmap [func parser]
	(fn [input]
	(if-let [[result parse-rest] (parser input)] [(func result) parse-rest])))

	(defn alts [& parsers]
	(fn [input]
	(some #(% input) parsers)))

	(defn combine [p q]
	(fn [input]
	(if-let [[result newi] (p input)]
	(let [[res2 newi2] (q newi)]
	[[result res2] newi2]))))

	(defn all [& parsers]
	(reduce combine parsers))

	(defn many [parser]
	(fn [input]
	(loop [results []
	current-input input]
	(if-let [[res newi] (parser current-input)]
	(recur (conj results res) newi)
	[results current-input]))))

	(defn many1 [parser]
	(mmap flatten (all parser (many parser))))

	(defn mchar [ch]
	(matches (partial = ch)))

	(defn runp [parser]
	"Returns a function that runs a given parser
	over some input and return the joined result."
	(fn [input]
	(->> input (parser) (first) (apply str))))

	;; Predicates
	(defn digit? [ch]
	(Character/isDigit ^Character ch))

	(defn letter? [ch]
	(Character/isLetter ^Character ch))

	(defn whitespace? [ch]
	(Character/isWhitespace ^Character ch))

	;; Tokens
	(def whitespace (matches whitespace?))
	(def letter (matches letter?))
	(def digit (matches digit?))
	(def any (matches (fn [& _args] (identity true))))

	;; Run-length tokens
	(def consecutives
	(fn [[headi & resti]]
	((mmap (partial cons headi) (many1 (mchar headi))) resti)))
	(def conscount
	(mmap #(str (count %) (first %)) consecutives))
	(def expandable (all (many1 digit) any))
	(def expansion
	(fn [c ch]
	(apply str (repeat (Integer/parseInt (apply str c)) ch))))

	;; Decoding and Encoding functions
	(def run-length-encode
	(runp (many1 (alts conscount letter whitespace))))

	(def run-length-decode
	(runp (many1 (alts (mmap (partial apply expansion) expandable)
	letter
	whitespace))))

	(run-length-encode "jjAaames") ; -> "2jA2ames"
	(run-length-decode "2j3ames") ; -> "jjaaames"
	(->> "jeff"
	(run-length-encode)
	(run-length-decode)) ; -> "jeff"