Skip to content

Instantly share code, notes, and snippets.

@danielsz

danielsz/pr.clj

Last active August 31, 2024 00:18
Show Gist options
  • Save danielsz/c977ec15c4bb2804052d2493e04a8ed8 to your computer and use it in GitHub Desktop.
Save danielsz/c977ec15c4bb2804052d2493e04a8ed8 to your computer and use it in GitHub Desktop.
Download ZIP
Primitive Recursion
Raw
pr.clj
(ns pr.core)
;;; basic functions on numbers: zero, successor and projection
(def Z #(fn [& _] 0))
(def S inc)
(defn P [i]
(fn [& args] (nth args (dec i))))
;;; basic operations on functions: composition and recursion
(defn C [f & gs]
(fn [& xs] (apply f (map #(apply % xs) gs))))
(defn R [n & xs]
(fn [f g]
(loop [i 1
j 0
acc (apply f xs)]
(if (<= i n)
(recur (inc i) (inc j) (apply (partial g j acc) xs))
acc))))
;; constant function
(defn k [n]
(fn [& _]
(let [f (Z)
g (C S (P 1))]
((R n) f g))))
;;; Derivations (defining operations with the above framework)
;; identity
(defn id [n] ((P 1) n))
(defn add [x y]
(let [f (P 1)
g (C S (P 2))]
((R x y) f g)))
(defn double [n]
((C add (P 1) (P 1)) n))
(defn not [x]
(let [f (k 1)
g (Z)]
((R x) f g)))
(defn mul [x y]
(let [f (k 0)
g (C add (P 2) (P 3))]
((R x y) f g)))
(defn pow [x y]
(let [f (k 1)
g (C mul (P 2) (P 3))]
((R y x) f g)))
(defn predecessor [n]
(let [f (k 0)
g (P 1)]
((R n) f g)))
;; zero predicate
(defn z [n]
(let [f (k 1)
g (k 0)]
((R n) f g)))
;; subtraction
(defn sub [x y]
(let [f (P 1)
g (C predecessor (P 2))]
((R y x) f g)))
;; alt
(defn alt [x]
(let [f (k 1)
g (C sub (k 1) (P 2))]
((R x) f g)))
;; even
(def even alt)
;; odd
(def odd (C not even))
;; less or equal
(defn le [x y]
((C z sub) x y))
;; greater or equal
(defn ge [x y]
((C le (P 2) (P 1)) x y))
(defn ite [x y z]
(let [f (P 2)
g (P 3)]
((R x y z) f g)))
(defn bool [x]
(let [f (Z)
g (k 1)]
((R x) f g)))
(def and (C bool mul))
(def or (C bool add))
(defn case [n]
(fn [f h r]
(add (mul (f n) (bool (r n))) (mul (h n) (not (r n))))))
(defn xor [x y]
(let [f (P 1)
g (C not (P 2))]
((R x y) f g)))
(defn eq [x y]
(and (le x y) (ge x y)))
;; less-than
(defn lt [x y]
((C not ge) x y))
(defn min [x y]
(sub y (sub y x)))
(defn max [x y]
(sub (add x y) (min x y)))
;; greater-than
(defn gt [x y]
((C not le) x y))
;; distance
(defn dist [x y ]
((C add sub (C sub (P 2) (P 1))) x y))
(defn mod* [x y]
(let [f (Z)
g (C ite (C lt (C S (P 2)) (P 3)) (C S (P 2)) (Z))]
((R x y) f g)))
(defn mod [x y]
((C ite (C z (P 2)) (P 1) (C mod* (P 1) (P 2))) x y))
(defn divisible [x y]
((C z mod) x y))
(defn prime [n]
(let [f (Z)
g (C add (C divisible (P 3) (P 1)) (P 2))]
((C eq (k 1) #((R n n) f g)))))
(defn ceil [x y]
(let [f (k 0)
g (C ite (C mod (P 1) (P 3)) (P 2) (C S (P 2)))]
((R x y) f g)))
(defn floor [x y]
(let [f (k 0)
g (C ite (C mod (C S (P 1)) (P 3)) (P 2) (C S (P 2)) )]
((R x y) f g)))
;;; Your turn now. Please leave in the comments below the solution to the following exercises
;;; 1. Collapse the modulo functions, currently split in mod* and mod, into one.
;;; 2. Write a function that takes n and returns the nth prime.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment