8000 Expand literal function descriptor language [in progress] by sritchie · Pull Request #262 · sicmutils/sicmutils · GitHub
[go: up one dir, main page]
More Web Proxy on the site http://driver.im/
Skip to content

Expand literal function descriptor language [in progress] #262

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed

Expand literal function descriptor language [in progress] #262

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
123bf04
tidy
sritchie May 3, 2021
71687e8
Merge branch 'master' into sritchie/litfun
sritchie May 27, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
222 changes: 185 additions & 37 deletions src/sicmutils/abstract/function.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,14 @@
applied to structures and numeric inputs, and differentiated.

The namespace also contains an implementation of a small language for
declaring the input and output types of [[literal-function]] instances."
(:refer-clojure :exclude [name])
declaring the input and output types of [[literal-function]] instances.

NOTE:

- a typed function is a function with typed metadata.
- This MIGHT be a thing we want now, given all of the stuff from the calc
work..."
(:refer-clojure :exclude [name ->])
(:require [sicmutils.abstract.number :as an]
[sicmutils.differential :as d]
[sicmutils.expression :as x]
Expand All @@ -50,32 +56,180 @@

(derive ::function ::v/function)

(defn ^:private sicm-set->exemplar
;; The descriptors for literal functions look like prefix versions of the
;; standard function types. Thus, we want to be able to say:
;;
;; (literal-function 'V (-> (X Real Real) Real))
;;
;; The base types are the real numbers, designated by "Real". We will later
;; extend the system to include complex numbers, designated by "Complex".
;;
;; Types can be combined in several ways. The cartesian product of types is
;; designated by:

;; (X <type1> <type2> ...)
;;
;; We use this to specify an argument tuple of objects of the given types
;; arranged in the given order.
;;
;; Similarly, we can specify an up tuple or a down tuple with:
;;
;; (UP <type1> <type2> ...)
;; (DOWN <type1> <type2> ...)
;;
;; We can also specify a uniform tuple of a number of elements of the
;; same type using:
;;
;; (UP* <type> [n])
;; (DOWN* <type> [n])
;;
;; To get started... Type expressions are self-evaluating.

(def Real 'Real)

(defn X
([] (u/illegal "Null type argument -- X"))
([t] t)
([t & ts] (apply list 'X t ts)))

(defn UP
([] (u/illegal "Null type argument -- UP"))
([t] t)
([t & ts] (apply list 'UP t ts)))

(defn DOWN
([] (u/illegal "Null type argument -- DOWN"))
([t] t)
([t & ts] (apply list 'DOWN t ts)))

(defn EXPT [t n]
(apply X (repeat n t)))

;; Examples:
;; (UP* Real 2 (UP Real Real) 2)
;; => (UP Real Real (UP Real Real) (UP Real Real))
;;
;; (UP* Real 2 (UP Real Real) 2 Real)
;; => (UP* Real Real (UP Real Real) (UP Real Real) Real)

(defn- starify [xs starred-sym unstarred-fn]
(if (empty? xs)
(u/illegal (str "Null type argument -- " starred-sym))
(loop [xs xs
current nil
explicit? false
types []]
(if (empty? xs)
(if explicit?
(apply unstarred-fn types)
(cons starred-sym types))
(let [[x & more] xs]
(if (integer? x)
(if current
(recur more
false
true
(into types (repeat (dec x) current)))
(u/illegal "Bad type arguments" starred-sym xs))
(recur more x false (conj types x))))))))

(defn X* [& rest]
(starify rest 'X* X))

(defn UP* [& rest]
(starify rest 'UP* UP))

(defn DOWN* [& rest]
(starify rest 'DOWN* DOWN))

(defn -> [domain range]
(list '-> domain range))

(def Any 'Any)

(defn default-type [n]
(if (= n 1)
(-> Real Real)
(-> (X* Real n) Real)))

(defn permissive-type [n]
(-> (X* Any n) Real))

;; Some useful types

(defn Lagrangian
"n = #degrees-of-freedom"
([] (-> (UP* Real (UP* Real) (UP* Real)) Real))
([n] (-> (UP Real (UP* Real n) (UP* Real n)) Real)))

(defn Hamiltonian
"n = #degrees-of-freedom"
([] (-> (UP Real (UP* Real) (DOWN* Real)) Real))
([n] (-> (UP Real (UP* Real n) (DOWN* Real n)) Real)))

(defn process-type
"combo of all type-> functions."
[t]
{:pre [(sequential? t)]}
(let [[arrow domain range] t]
(if-not (and (= '-> arrow) domain range)
(u/illegal
(str "A SICM signature is of the form '(-> domain range), got: "
arrow domain range))
(let [[dtypes arity]
(cond (and (sequential? domain)
(= (first domain) 'X))
(let [types (into [] (rest domain))]
[types [:exactly (count types)]])

(and (sequential? domain)
(= (first domain) 'X*))
[[domain] [:at-least 0]]

:else [domain [:exactly 1]])]
{:domain domain
:range-type range
:domain-types dtypes
:arity arity}))))

;; Existing Stuff. There is a BIT more in `litfun.scm` that we should read to
;; figure out what is going on.

(defn- sicm-set->exemplar
"Convert a SICM-style set (e.g., Real or (UP Real Real)) to
an exemplar (an instance of the relevant type)."
[s]
(cond
(= s 'Real) 0

(sequential? s)
(let [[constructor & args] s]
(case constructor
X (mapv sicm-set->exemplar args)
UP (apply s/up (map sicm-set->exemplar args))
DOWN (apply s/down (map sicm-set->exemplar args))
UP* (apply s/up (repeat (second args) (sicm-set->exemplar (first args))))
DOWN* (apply s/down (repeat (second args) (sicm-set->exemplar (first args))))
X* (into [] (repeat (second args) (sicm-set->exemplar (first args))))))))

(defn ^:no-doc sicm-signature->domain-range
"Convert a SICM-style literal function signature (e.g.,
'(-> Real (X Real Real)) ) to our 'exemplar' format."
(cond (= s 'Real) 0
(sequential? s)
(let [[ctor & [type arity :as args]] s]
(case ctor
X (mapv sicm-set->exemplar args)
UP (s/up* (map sicm-set->exemplar args))
DOWN (s/down* (map sicm-set->exemplar args))
X* (into [] (repeat arity (sicm-set->exemplar type)))
UP* (s/up* (repeat arity (sicm-set->exemplar type)))
DOWN* (s/down* (repeat arity (sicm-set->exemplar type)))))
:else
(u/illegal "error!")))

;; TODO SHOULD NOT handle an "X" type in the range.

(defn sicm-signature->domain-range
"Convert a SICM-style literal function signature,
e.g., '(-> Real (X Real Real))
to our 'exemplar' format."
[[arrow domain range]]
(when-not (and (= '-> arrow) domain range)
(u/illegal (str "A SICM signature is of the form '(-> domain range), got: " arrow domain range)))
[(let [d (sicm-set->exemplar domain)]
(if (vector? d) d [d]))
(sicm-set->exemplar range)])
(u/illegal
(str "A SICM signature is of the form '(-> domain range), got: "
arrow domain range)))
(let [d (sicm-set->exemplar domain)
d (if (vector? d) d [d])
r (sicm-set->exemplar range)]
[d r]))

;; TODO add metadata!! How did we get away with not having this yet?
;; TODO trawl for other uses of the star constructors, replace those around the library.

(deftype Function [name arity domain range]
v/Value
Expand All @@ -85,7 +239,7 @@
(zero-like [_] (fn [& _] (v/zero-like range)))
(one-like [_] (fn [& _] (v/one-like range)))
(identity-like [_]
(let [meta {:arity arity :from :identity-like}]
(let [meta {:arity arity :from ::v/identity-like}]
(with-meta identity meta)))
(exact? [f] (f/compose v/exact? f))
(freeze [_] (v/freeze name))
Expand Down Expand Up @@ -197,6 +351,11 @@
(= (domain-types a) (domain-types b))
(= (range-type a) (range-type b))))

;; TODO allow for functions in range!
;;
;; (((literal-function 'f (-> Real (-> Real Real))) 'x) 'y)
;; ((f x) y)

(defn literal-function
([f] (->Function f [:exactly 1] [0] 0))
([f signature]
Expand Down Expand Up @@ -281,8 +440,8 @@
(apply d/d:+ (apply f ve) (flatten partials))))

(defn- check-argument-type
"Check that the argument provided at index i has the same type as
the exemplar expected."
"Check that the argument provided at index i has the same type as the exemplar
expected."
[f provided expected indexes]
(cond (number? expected)
(when-not (v/numerical? provided)
Expand All @@ -309,14 +468,3 @@
(if (some d/perturbed? xs)
(literal-derivative f xs)
(an/literal-number `(~(name f) ~@(map v/freeze xs)))))

;; ## Specific Generics
;;
;; We can install one more method - [[sicmutils.generic/simplify]] returns its
;; argument with the internally captured name simplified.

(defmethod g/simplify [::function] [f]
(->Function (g/simplify (name f))
(f/arity f)
(domain-types f)
(range-type f)))
Loading
0