├── circlebars.png ├── circlelines.png ├── src ├── java │ └── geex │ │ ├── test │ │ ├── Mjao.java │ │ ├── EmptyInterface.java │ │ ├── NumericInterface1.java │ │ ├── StaticVarClass.java │ │ ├── NumberToMapInterface.java │ │ ├── MapInterface.java │ │ ├── Add1ToSomething.java │ │ └── MethodOverloading.java │ │ ├── Mode.java │ │ ├── ContinueException.java │ │ ├── Flags.java │ │ ├── LocalStruct.java │ │ ├── SeedParameters.java │ │ ├── LocalVars.java │ │ ├── StateSettings.java │ │ ├── Optional.java │ │ ├── LocalVar.java │ │ ├── ISeed.java │ │ ├── Referents.java │ │ ├── SeedState.java │ │ ├── TypedSeed.java │ │ ├── SeedUtils.java │ │ ├── DynamicSeed.java │ │ ├── Dependencies.java │ │ ├── AFn.java │ │ ├── ForwardFn.java │ │ └── State.java └── clj │ └── geex │ ├── core │ ├── loop.clj │ ├── seedtype.clj │ ├── stringutils.clj │ ├── defs.clj │ ├── jvm.clj │ ├── seed.clj │ ├── xplatform.clj │ ├── utils.clj │ └── datatypes.clj │ ├── java │ ├── try_block.clj │ ├── defs.clj │ ├── reflect.clj │ └── class.clj │ └── graphviz.clj ├── ns-dep-graph.png ├── docsource └── build.sh ├── test ├── examples │ ├── todo.txt │ ├── square_test.clj │ ├── sqrt_test.clj │ ├── expr_templates_test.clj │ ├── ad_test.clj │ ├── covariance_test.clj │ ├── matrix_test.clj │ ├── nbody_test.clj │ ├── circle_fit_test.clj │ └── cljd_circle_test.clj └── geex │ ├── core │ ├── loop_test.clj │ ├── xplatform_test.clj │ └── datatypes_test.clj │ ├── failing_test.clj │ ├── State_test.clj │ ├── java │ ├── try_block_test.clj │ ├── reflect_test.clj │ └── class_test.clj │ ├── Seed_test.clj │ ├── ebmd │ └── type_test.clj │ ├── resolved_test.clj │ ├── feature_test.clj │ └── core_test.clj ├── .gitignore ├── sample-project ├── src │ ├── java │ │ ├── sample │ │ │ └── project │ │ │ │ └── Scaler.java │ │ └── geex_defclass │ │ │ └── Kattskit.java │ └── clj │ │ └── sample_project │ │ └── core.clj ├── test │ └── sample_project │ │ └── core_test.clj ├── README.md └── project.clj ├── CHANGELOG.md ├── project.clj ├── othernotes.md ├── README.md └── LICENSE /circlebars.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonasseglare/geex/HEAD/circlebars.png -------------------------------------------------------------------------------- /circlelines.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonasseglare/geex/HEAD/circlelines.png -------------------------------------------------------------------------------- /src/java/geex/test/Mjao.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public class Mjao {} 4 | -------------------------------------------------------------------------------- /ns-dep-graph.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonasseglare/geex/HEAD/ns-dep-graph.png -------------------------------------------------------------------------------- /src/java/geex/Mode.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | public enum Mode {Pure, Ordered, SideEffectful, Code}; 4 | -------------------------------------------------------------------------------- /src/java/geex/test/EmptyInterface.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public interface EmptyInterface {} 4 | -------------------------------------------------------------------------------- /src/java/geex/ContinueException.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | public class ContinueException extends Exception {} 4 | -------------------------------------------------------------------------------- /docsource/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | java -jar ../../exampler/target/exampler-0.1.0-standalone.jar tutorialize core.clj ../doc/tutorial.md 3 | -------------------------------------------------------------------------------- /src/java/geex/test/NumericInterface1.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public interface NumericInterface1 { 4 | public double apply(double x); 5 | } 6 | -------------------------------------------------------------------------------- /test/examples/todo.txt: -------------------------------------------------------------------------------- 1 | flood fill 2 | regression tree, kx + m 3 | rotation axis between point clouds 4 | dynamic programming: Betalar 100 varje gång vi köper aktier. 5 | -------------------------------------------------------------------------------- /src/java/geex/test/StaticVarClass.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public class StaticVarClass { 4 | public static int A = 0; 5 | public static double B = 1.0; 6 | } 7 | -------------------------------------------------------------------------------- /src/java/geex/test/NumberToMapInterface.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public interface NumberToMapInterface { 4 | public clojure.lang.IPersistentMap apply(double x); 5 | } 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | sample-project/target/ -------------------------------------------------------------------------------- /src/java/geex/test/MapInterface.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public interface MapInterface { 4 | public clojure.lang.IPersistentMap apply( 5 | clojure.lang.IPersistentMap x); 6 | } 7 | -------------------------------------------------------------------------------- /test/examples/square_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.square-test 2 | (:require [geex.common :as common] 3 | [geex.java :as java])) 4 | 5 | (java/typed-defn 6 | geex-square [Double/TYPE x] 7 | (common/* x x)) 8 | -------------------------------------------------------------------------------- /src/java/geex/test/Add1ToSomething.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public class Add1ToSomething { 4 | public double something() { 5 | return 118.0; 6 | } 7 | 8 | public double add1() { 9 | return 1.0 + something(); 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /sample-project/src/java/sample/project/Scaler.java: -------------------------------------------------------------------------------- 1 | package sample.project; 2 | 3 | public class Scaler { 4 | /* Various definitions */ 5 | public double factor; 6 | 7 | public double scale(final double arg00) { 8 | return (1000L + ((this.factor) * arg00)); 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /src/java/geex/test/MethodOverloading.java: -------------------------------------------------------------------------------- 1 | package geex.test; 2 | 3 | public class MethodOverloading { 4 | 5 | public static String add(String x, String y) { 6 | return x + y; 7 | } 8 | 9 | public static long add(long a, long b) { 10 | return a + b; 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /src/java/geex/Flags.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | public class Flags { 4 | public boolean disp = false; 5 | public boolean dispTrace = false; 6 | public boolean dispState = false; 7 | public boolean dispCompilationResults = false; 8 | public boolean dispTime = false; 9 | public boolean format = false; 10 | }; 11 | -------------------------------------------------------------------------------- /test/geex/core/loop_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.loop-test 2 | (:require [clojure.test :refer :all] 3 | [geex.core.loop :refer :all])) 4 | 5 | (deftest loop-arg-parse-test 6 | (is (= (parse-loop-args [['a 3 'b 4] '(+ a b c)]) 7 | {:bindings [{:vars 'a, :expr 3} 8 | {:vars 'b, :expr 4}], 9 | :body '((+ a b c))}))) 10 | -------------------------------------------------------------------------------- /sample-project/test/sample_project/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns sample-project.core-test 2 | (:require [clojure.test :refer :all] 3 | [sample-project.core :refer :all])) 4 | 5 | (deftest some-test 6 | (let [s (make-scaler 3.0)] 7 | (is (= 1009.0 (.scale s 3.0))))) 8 | 9 | (deftest a-test 10 | (let [inst (.newInstance kattskit)] 11 | (is (= (.wrap inst "Mjao") 12 | {:x "Mjao"})))) 13 | -------------------------------------------------------------------------------- /sample-project/src/java/geex_defclass/Kattskit.java: -------------------------------------------------------------------------------- 1 | package geex_defclass ; public class Kattskit { /* Various definitions */ static clojure.lang.Keyword INTERNED__Keyword___cx = clojure.lang.Keyword.intern( "x" ) ; public clojure.lang.IPersistentMap wrap ( final java.lang.String arg00 ) { return clojure.lang.PersistentHashMap.create( (java.lang.Object)( INTERNED__Keyword___cx ) , (java.lang.Object)( arg00 ) ) ; } } -------------------------------------------------------------------------------- /src/java/geex/LocalStruct.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.LocalVar; 4 | 5 | public class LocalStruct { 6 | private Object _typeSignature = null; 7 | private LocalVar[] _flatVars = null; 8 | 9 | public LocalStruct(Object tpSig, LocalVar[] fvi) { 10 | _typeSignature = tpSig; 11 | _flatVars = fvi; 12 | } 13 | 14 | public Object getTypeSignature() { 15 | return _typeSignature; 16 | } 17 | 18 | public LocalVar[] getFlatVars() { 19 | return _flatVars; 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /src/java/geex/SeedParameters.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.Mode; 4 | import clojure.lang.IFn; 5 | import clojure.lang.APersistentMap; 6 | 7 | public class SeedParameters { 8 | public boolean hasValue = true; 9 | public Object type = null; 10 | public Mode mode = null; 11 | public String description = null; 12 | public IFn compiler = null; 13 | public Object data = null; 14 | public Boolean bind = null; 15 | public APersistentMap rawDeps = null; 16 | public IFn callable = null; 17 | } 18 | -------------------------------------------------------------------------------- /test/geex/failing_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.failing-test 2 | (:require [geex.core :as core] 3 | [geex.core.seed :as seed] 4 | [geex.java :as java] 5 | [geex.common :as c] 6 | [clojure.test :refer :all])) 7 | 8 | (def darr (c/array-type Double/TYPE)) 9 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 | ;;; 11 | ;;; Namespace dedicated for reproducing things that don't work. 12 | ;;; 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | 15 | 16 | -------------------------------------------------------------------------------- /src/java/geex/LocalVars.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.LocalVar; 4 | import java.util.ArrayList; 5 | 6 | public class LocalVars { 7 | private ArrayList _vars = new ArrayList(); 8 | 9 | public LocalVar declare() { 10 | int index = _vars.size(); 11 | LocalVar lvar = new LocalVar(index); 12 | _vars.add(lvar); 13 | return lvar; 14 | } 15 | 16 | public LocalVar get(int i) { 17 | if (0 <= i && i < _vars.size()) { 18 | return _vars.get(i); 19 | } 20 | throw new RuntimeException( 21 | "Local variable index out of bounds " + i); 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /src/clj/geex/core/loop.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.loop 2 | (:require [clojure.spec.alpha :as spec])) 3 | 4 | (spec/def ::binding (spec/cat :vars any? 5 | :expr any?)) 6 | 7 | (spec/def ::loop-args (spec/cat :bindings (spec/spec 8 | (spec/* ::binding)) 9 | :body (spec/* any?))) 10 | 11 | (defn parse-loop-args [args] 12 | (let [parsed (spec/conform ::loop-args args)] 13 | (if (= parsed ::spec/invalid) 14 | (throw (ex-info 15 | (str "Failed to parse loop arguments: " 16 | (spec/explain-str ::loop-args args)))) 17 | parsed))) 18 | -------------------------------------------------------------------------------- /src/clj/geex/core/seedtype.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.seedtype 2 | (:require [geex.core.seed :as sd] 3 | [geex.core.datatypes :as dt]) 4 | (:refer-clojure :exclude [boolean char void byte short int long float double])) 5 | 6 | (defmacro inject-seed-defs [] 7 | `(do 8 | ~@(map (fn [info] 9 | `(def ~(symbol (str (.getName (:unboxed-type info)))) 10 | (sd/typed-seed ~(dt/unboxed-type-symbol (:unboxed-name info))))) 11 | dt/primitive-type-list))) 12 | 13 | (inject-seed-defs) 14 | 15 | (defmacro def-seed-type [name-sym class-sym] 16 | `(def ~name-sym (sd/typed-seed ~class-sym))) 17 | 18 | (def-seed-type string java.lang.String) 19 | -------------------------------------------------------------------------------- /test/geex/State_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.State-test 2 | (:import [geex 3 | State 4 | StateSettings] 5 | [clojure.lang PersistentHashMap]) 6 | (:require [clojure.test :refer :all] 7 | [bluebell.utils.wip.java :as jutils :refer [set-field]])) 8 | 9 | (deftest construct-state-test 10 | (let [state (State. 11 | (doto (StateSettings.) 12 | (set-field platform :clojure) 13 | (set-field generateSeedSymbol (fn [] ;;TODO 14 | )) 15 | (set-field closeScope (fn [] (assert false)))))] 16 | (is state) 17 | (is (.isEmpty state)))) 18 | -------------------------------------------------------------------------------- /src/clj/geex/java/try_block.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.try-block 2 | (:require [clojure.spec.alpha :as spec])) 3 | 4 | 5 | (spec/def ::body fn?) 6 | (spec/def ::finally fn?) 7 | (spec/def ::type class?) 8 | (spec/def ::catch (spec/keys :req-un [::type ::body])) 9 | (spec/def ::catches (spec/* ::catch)) 10 | (spec/def ::try-block (spec/keys :req-un [::body] 11 | :opt-un [::catches 12 | ::finally])) 13 | 14 | (defn validate [x] 15 | (when (not (spec/valid? ::try-block x)) 16 | (throw (ex-info 17 | (str "Not a valid try-block: " 18 | (spec/explain-str ::try-block x)) 19 | {:block x}))) 20 | x) 21 | -------------------------------------------------------------------------------- /src/java/geex/StateSettings.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import clojure.lang.IFn; 4 | 5 | public class StateSettings { 6 | public Object platform = null; 7 | public IFn forwardedFunction = null; 8 | public IFn closeScope = null; 9 | public IFn generateSeedSymbol = null; 10 | public IFn checkCompilationResult = null; 11 | 12 | void check() { 13 | if (platform == null) { 14 | throw new RuntimeException("No platform specified"); 15 | } 16 | if (closeScope == null) { 17 | throw new RuntimeException( 18 | "No function to close the scope"); 19 | } 20 | if (generateSeedSymbol == null) { 21 | throw new RuntimeException("No generate seed symbol"); 22 | } 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /test/geex/core/xplatform_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.xplatform-test 2 | (:require [geex.core.xplatform :refer :all] 3 | [geex.core.defs :as defs] 4 | [clojure.test :refer :all]) 5 | (:refer-clojure :exclude [get])) 6 | 7 | 8 | (deftest basic-test 9 | (register :kattskit {:exp (fn [r] [:exponent r])}) 10 | (register :kattskit {:log (fn [x] [:logarithm x]) 11 | :pi 3.14159}) 12 | 13 | (defs/with-platform :kattskit 14 | (is (= 3.14159 (get :pi))) 15 | (is (= [:logarithm 3] (call :log 3))) 16 | (is (= [:exponent 4] (call :exp 4)))) 17 | (defs/with-platform :mjao 18 | (is (thrown? Exception (get :pi)))) 19 | (is (contains? (set (list-platforms)) :kattskit)) 20 | (swap! platform-map #(dissoc % :kattskit)) 21 | (is (not (contains? (set (list-platforms)) :kattskit)))) 22 | -------------------------------------------------------------------------------- /sample-project/README.md: -------------------------------------------------------------------------------- 1 | # sample-project 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | 9 | ## License 10 | 11 | Copyright © 2019 FIXME 12 | 13 | This program and the accompanying materials are made available under the 14 | terms of the Eclipse Public License 2.0 which is available at 15 | http://www.eclipse.org/legal/epl-2.0. 16 | 17 | This Source Code may also be made available under the following Secondary 18 | Licenses when the conditions for such availability set forth in the Eclipse 19 | Public License, v. 2.0 are satisfied: GNU General Public License as published by 20 | the Free Software Foundation, either version 2 of the License, or (at your 21 | option) any later version, with the GNU Classpath Exception which is available 22 | at https://www.gnu.org/software/classpath/license.html. 23 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). 3 | 4 | ## [Unreleased] 5 | ### Changed 6 | - Add a new arity to `make-widget-async` to provide a different widget shape. 7 | 8 | ## [0.1.1] - 2017-10-04 9 | ### Changed 10 | - Documentation on how to make the widgets. 11 | 12 | ### Removed 13 | - `make-widget-sync` - we're all async, all the time. 14 | 15 | ### Fixed 16 | - Fixed widget maker to keep working when daylight savings switches over. 17 | 18 | ## 0.1.0 - 2017-10-04 19 | ### Added 20 | - Files from the new template. 21 | - Widget maker public API - `make-widget-sync`. 22 | 23 | [Unreleased]: https://github.com/your-name/lime/compare/0.1.1...HEAD 24 | [0.1.1]: https://github.com/your-name/lime/compare/0.1.0...0.1.1 25 | -------------------------------------------------------------------------------- /test/examples/sqrt_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.sqrt-test 2 | (:require [geex.common :as c] 3 | [geex.java :as java] 4 | [geex.core :as gx] 5 | [clojure.test :refer :all])) 6 | 7 | (defn sqrt-iteration [k x] 8 | (c/- x (c// (c/- (c/* x x) k) 9 | (c/* 2.0 x)))) 10 | 11 | (java/typed-defn unrolled-sqrt [Double/TYPE x] 12 | 13 | ;; Display time and generated code: 14 | ;;(gx/set-flag! :disp :disp-time :format) 15 | 16 | (->> x 17 | (iterate (partial sqrt-iteration x)) 18 | (take 10) 19 | last)) 20 | 21 | 22 | (unrolled-sqrt 2.0) 23 | ;; => 1.4142135623730951 24 | 25 | (deftest sqrt-test 26 | (is (< (Math/abs (- (unrolled-sqrt 2) 27 | (Math/sqrt 2))) 28 | 1.0e-6))) 29 | -------------------------------------------------------------------------------- /test/geex/java/try_block_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.try-block-test 2 | (:require [geex.java.try-block :refer :all] 3 | [clojure.test :refer :all])) 4 | 5 | (deftest validation-test 6 | (is (validate {:body (fn [])})) 7 | (is (thrown? Exception (validate {}))) 8 | (is (thrown? Exception (validate {:body [{:type 9}]}))) 9 | (is (validate {:body identity 10 | :catches [{:type Integer/TYPE 11 | :body (fn [x] x)}]})) 12 | (is (validate {:body identity 13 | :catches [{:type Integer/TYPE 14 | :body (fn [x] x)}] 15 | :finally identity})) 16 | (is (thrown? 17 | Exception 18 | (validate {:body identity 19 | :catches [{:type Integer/TYPE 20 | :body (fn [x] x)}] 21 | :finally :kattskit})))) 22 | -------------------------------------------------------------------------------- /src/java/geex/Optional.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | 4 | // Can also have null as a value 5 | public class Optional { 6 | private boolean _hasValue = false; 7 | public T _value = null; 8 | 9 | public Optional(T x) { 10 | _hasValue = true; 11 | _value = x; 12 | } 13 | 14 | public Optional() {} 15 | 16 | public boolean hasValue() { 17 | return _hasValue; 18 | } 19 | 20 | public boolean isPresent() { 21 | return _hasValue; 22 | } 23 | 24 | public T get() { 25 | if (!_hasValue) { 26 | throw new RuntimeException("No value present"); 27 | } 28 | return _value; 29 | } 30 | 31 | public static Optional of(T value) { 32 | return new Optional(value); 33 | } 34 | 35 | public static Optional empty() { 36 | return new Optional(); 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /src/java/geex/LocalVar.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.Optional; 4 | import geex.SeedUtils; 5 | 6 | public class LocalVar { 7 | 8 | private int _index = -1; 9 | private Optional _type = Optional.empty(); 10 | 11 | public LocalVar(int i) { 12 | _index = i; 13 | } 14 | 15 | public int getIndex() { 16 | return _index; 17 | } 18 | 19 | public Optional getType() { 20 | return _type; 21 | } 22 | 23 | public void setType(Object tp) { 24 | SeedUtils.checkSeedType(tp); 25 | if (_type.isPresent()) { 26 | if (!(_type.get() == tp)) { 27 | throw new RuntimeException( 28 | "Trying to set type of lvar " + _index 29 | + " that currently has type " + _type.get() 30 | + " to have type " + tp); 31 | } 32 | } else { 33 | _type = Optional.of(tp); 34 | } 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /sample-project/project.clj: -------------------------------------------------------------------------------- 1 | (defproject sample-project "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0" 5 | :url "https://www.eclipse.org/legal/epl-2.0/"} 6 | :dependencies [[org.clojure/clojure "1.10.0"] 7 | [geex "0.10.2"]] 8 | 9 | :source-paths ["src/clj"] 10 | :java-source-paths ["src/java"] 11 | 12 | 13 | :aot :all 14 | 15 | :profiles {:dev {:jvm-opts ["-Dgeex_mode=development"]} ; OK 16 | :test {:jvm-opts ["-Dgeex_mode=test"]} 17 | :production {:jvm-opts ["-Dgeex_mode=production"]} 18 | :repl {:jvm-opts ["-Dgeex_mode=repl"]} ; OK --- Use this to check 19 | :uberjar {:jvm-opts ["-Dgeex_mode=uberjar"]} ; OK 20 | } 21 | 22 | :jvm-opts [ 23 | ;; Where generated Geex code should be put 24 | "-Dgeex_java_output_path=src/java"] 25 | 26 | :main sample-project.core 27 | 28 | :omit-source true 29 | 30 | :repl-options {:init-ns sample-project.core}) 31 | -------------------------------------------------------------------------------- /src/clj/geex/core/stringutils.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.stringutils 2 | (:require [clojure.string :as cljstr])) 3 | 4 | ;; Convention: Whenever risk of ambiguity, 5 | ;; a function should wrap its output in parenthesis. 6 | ;; But it is not its responsibility to wrap its input. 7 | (defn wrap-in-parens [x] 8 | ["(" x ")"]) 9 | 10 | (defn join-spaced 11 | ([x] x) 12 | ([a b] 13 | (str a " " b))) 14 | 15 | (defn nested-to-string 16 | [x] 17 | (cond 18 | (string? x) x 19 | (number? x) (str x) 20 | (vector? x) (transduce 21 | (map nested-to-string) 22 | join-spaced 23 | "" 24 | x) 25 | (seq? x) 26 | (throw (ex-info 27 | "Sequences are not supported, as they may be lazy" 28 | {:value x})) 29 | 30 | :default (throw (ex-info "Cannot convert to string" 31 | {:value x})))) 32 | 33 | (defn- kebab-from-camel-char [dst x] 34 | (if (Character/isUpperCase x) 35 | (str dst "-" (cljstr/lower-case x)) 36 | (str dst x))) 37 | 38 | (defn kebab-from-camel-case [src] 39 | (reduce 40 | kebab-from-camel-char 41 | "" 42 | src)) 43 | -------------------------------------------------------------------------------- /src/java/geex/ISeed.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import java.util.ArrayList; 4 | import geex.Dependencies; 5 | import geex.Referents; 6 | import geex.Mode; 7 | import geex.State; 8 | import clojure.lang.IPersistentMap; 9 | import clojure.lang.APersistentMap; 10 | import clojure.lang.IFn; 11 | 12 | public interface ISeed { 13 | static int UNDEFINED_ID = Integer.MIN_VALUE; 14 | 15 | public Object getType(); 16 | public void setId(int id); 17 | public int getId(); 18 | public Mode getMode(); 19 | public boolean hasValue(); 20 | public String getDescription(); 21 | 22 | public boolean equals(Object other); 23 | public int hashCode(); 24 | 25 | public APersistentMap getRawDeps(); 26 | 27 | public Dependencies deps(); 28 | public Referents refs(); 29 | 30 | public SeedState getState(); 31 | 32 | // Local vars 33 | public String generateVarName(); 34 | 35 | public Object compile(State s); 36 | 37 | public Boolean shouldBind(); 38 | public void setBind(Boolean value); 39 | 40 | // Used to make it callable. 41 | public void setForwardedFunction(IFn f); 42 | 43 | // Extra data 44 | Object getData(); 45 | void setData(Object o); 46 | } 47 | -------------------------------------------------------------------------------- /sample-project/src/clj/sample_project/core.clj: -------------------------------------------------------------------------------- 1 | (ns sample-project.core 2 | (:require [geex.core :as gx] 3 | [geex.java :as java] 4 | [geex.common :as c]) 5 | (:gen-class)) 6 | 7 | (java/def-class scaler-type 8 | {:name "Scaler" 9 | :package "sample.project" 10 | 11 | :variables [{:name "factor" 12 | :type Double/TYPE}] 13 | 14 | :methods [{:name "scale" 15 | :ret Double/TYPE 16 | :arg-types [Double/TYPE] 17 | :fn (fn [this x] 18 | (gx/set-flag! :format) 19 | (c/+ 1000 (c/* (this "factor") x)))}]}) 20 | 21 | (defn make-scaler [factor] 22 | (let [dst (.newInstance scaler-type)] 23 | (set! (.factor dst) factor) 24 | dst)) 25 | 26 | (java/def-class kattskit {:name "Kattskit" 27 | ;;:mode :production 28 | :methods [{:name "wrap" 29 | :arg-types [String] 30 | :fn (fn [this x] 31 | (gx/set-flag! :disp-time) 32 | {:x x})}]}) 33 | 34 | (defn -main [& args] 35 | (println "Wrapping the first arg...") 36 | (let [inst (.newInstance kattskit)] 37 | (println "It is wrapped as" (.wrap inst (first args))))) 38 | 39 | 40 | -------------------------------------------------------------------------------- /src/clj/geex/core/defs.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.defs 2 | 3 | "Common definitions that are shared between different modules of the code." 4 | 5 | (:import [geex State])) 6 | 7 | (def ^:dynamic global-state nil) 8 | 9 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 | ;;; 11 | ;;; The state used for book-keeping when generating code. 12 | ;;; 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | 15 | (def default-platform :clojure) 16 | 17 | (def ^:dynamic the-platform default-platform) 18 | 19 | ;; Keys are unique within a context. That way, we should always generate the same expression 20 | ;; for the same data, and can thus compare values for equality to see if something changed. 21 | (defn contextual-gensym 22 | ([] (contextual-gensym "untagged")) 23 | ([prefix0] 24 | (let [prefix (str prefix0)] 25 | (assert (not (nil? global-state))) 26 | (symbol (str "gs-" prefix 27 | "-" (.generateSymbolIndex 28 | global-state)))))) 29 | 30 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 | ;;; 32 | ;;; Platforms 33 | ;;; 34 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35 | 36 | (defn get-platform 37 | "Get the platform identifier, or :clojure if undefined." 38 | [] 39 | the-platform) 40 | 41 | (defmacro with-platform [p & body] 42 | `(binding [the-platform ~p] 43 | ~@body)) 44 | -------------------------------------------------------------------------------- /src/java/geex/Referents.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import java.util.HashSet; 4 | import java.util.Iterator; 5 | import java.util.Objects; 6 | 7 | public class Referents { 8 | class Item { 9 | Object key; 10 | Integer ref; 11 | 12 | public String toString() { 13 | return ref.toString(); 14 | } 15 | 16 | public Item(Object k, Integer r) { 17 | key = k; 18 | ref = r; 19 | } 20 | 21 | public boolean equals(Object other) { 22 | if (other == null) { 23 | return false; 24 | } 25 | if (!(other instanceof Item)) { 26 | return false; 27 | } 28 | Item y = (Item)other; 29 | return key.equals(y.key) && ref.equals(y.ref); 30 | } 31 | 32 | public int hashCode() { 33 | return Objects.hash(key, ref); 34 | } 35 | }; 36 | 37 | HashSet _set = new HashSet(); 38 | 39 | public void add(Object key, int refId) { 40 | _set.add(new Item(key, refId)); 41 | } 42 | 43 | static String indent = " "; 44 | 45 | public void disp() { 46 | if (!_set.isEmpty()) { 47 | String dst = indent + "Refd by"; 48 | Iterator iter = _set.iterator(); 49 | while (iter.hasNext()) { 50 | dst += " " + iter.next(); 51 | } 52 | System.out.println(dst); 53 | } 54 | } 55 | 56 | public int count() { 57 | return _set.size(); 58 | } 59 | } 60 | -------------------------------------------------------------------------------- /src/clj/geex/core/jvm.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.jvm 2 | 3 | "Platform specific code needed by the compiler" 4 | 5 | (:require [bluebell.utils.ebmd :as ebmd] 6 | [bluebell.utils.ebmd.ops :as eops] 7 | [bluebell.utils.ebmd.type :as type] 8 | [geex.ebmd.type :as etype] 9 | [geex.core.seed :as seed])) 10 | 11 | 12 | ;;;------- Common type signatures for JVM platforms ------- 13 | 14 | (ebmd/declare-poly get-type-signature) 15 | 16 | (ebmd/def-arg-spec nil-arg {:pred nil? 17 | :pos [nil] 18 | :neg [:a]}) 19 | 20 | (ebmd/def-poly get-type-signature 21 | [etype/seed-with-class x] 22 | (seed/datatype x)) 23 | 24 | (ebmd/def-poly get-type-signature 25 | [etype/nothing-seed x] 26 | Void/TYPE) 27 | 28 | (ebmd/def-poly get-type-signature 29 | [nil-arg x] 30 | Void/TYPE) 31 | 32 | (ebmd/def-poly get-type-signature 33 | [etype/class-arg x] 34 | x) 35 | 36 | (ebmd/def-poly get-type-signature 37 | [type/map x] 38 | clojure.lang.IPersistentMap) 39 | 40 | (ebmd/def-poly get-type-signature 41 | [type/set x] 42 | clojure.lang.IPersistentSet) 43 | 44 | (ebmd/def-poly get-type-signature 45 | [type/any x] 46 | (if (vector? x) 47 | clojure.lang.IPersistentVector 48 | java.lang.Object)) 49 | 50 | 51 | ;; Get a type signature that can be compiled 52 | (ebmd/declare-poly get-compilable-type-signature) 53 | 54 | (ebmd/def-poly get-compilable-type-signature 55 | [type/any x] 56 | (get-type-signature x)) 57 | 58 | (ebmd/def-poly get-compilable-type-signature 59 | [(eops/and etype/seed-with-class 60 | (eops/not etype/compilable-seed)) x] 61 | clojure.lang.IPersistentMap) 62 | 63 | -------------------------------------------------------------------------------- /test/geex/core/datatypes_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.datatypes-test 2 | (:require [geex.core.datatypes :refer :all] 3 | [clojure.test :refer :all] 4 | [clojure.set :as cljset] 5 | [clojure.reflect :as r] 6 | [bluebell.utils.wip.core :as utils])) 7 | 8 | (deftest unboxing-test 9 | (is (= java.lang.Long/TYPE 10 | (unboxed-class-of 9)))) 11 | 12 | (deftest math-op-test 13 | (let [a Integer/TYPE 14 | b Integer/TYPE 15 | c Integer/TYPE] 16 | (is (= c (binary-math-op-result-type a b)))) 17 | (let [a Boolean/TYPE 18 | b Character/TYPE 19 | c Integer/TYPE] 20 | (is (= c (binary-math-op-result-type a b)))) 21 | (let [a Long/TYPE 22 | b Character/TYPE 23 | c Long/TYPE] 24 | (is (= c (binary-math-op-result-type a b)))) 25 | (let [a Long/TYPE 26 | b Float/TYPE 27 | c Float/TYPE] 28 | (is (= c (binary-math-op-result-type a b)))) 29 | (let [a Character/TYPE 30 | b Double/TYPE 31 | c Double/TYPE] 32 | (is (= c (binary-math-op-result-type a b)))) 33 | 34 | (is (= Integer/TYPE 35 | (unary-plus-minus-result-type Character/TYPE))) 36 | (is (= Long/TYPE 37 | (unary-plus-minus-result-type Long/TYPE))) 38 | 39 | (is (= Integer/TYPE 40 | (bit-op-result-type [Character/TYPE]))) 41 | 42 | (is (= Long/TYPE 43 | (bit-op-result-type [Long/TYPE]))) 44 | 45 | ) 46 | 47 | (deftest typename-test 48 | (is (= "double[][]" 49 | (r/typename (class (into-array [(double-array [])]))))) 50 | #_(do 51 | (is (= (typename (class (double-array []))) 52 | "double[]")) 53 | (is (= (typename (class 9)) 54 | "java.lang.Long")) 55 | (is (= (typename Long/TYPE) 56 | "long")))) 57 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject geex "0.11.1-SNAPSHOT" 2 | :description "Generative Expressions (Geex) is a code generation tool for writing high-level Clojure code that generates fast low-level code." 3 | 4 | :url "https://github.com/jonasseglare/geex" 5 | :license {:name "Eclipse Public License" 6 | :url "http://www.eclipse.org/legal/epl-v10.html"} 7 | 8 | ;; run `lein codox` to produce documentation. 9 | :codox {:metadata {:doc/format :markdown}} 10 | 11 | :source-paths ["src/clj"] 12 | :java-source-paths ["src/java"] 13 | 14 | :test-paths ["test"] 15 | 16 | :aot :all 17 | 18 | :javac-options ["-Xlint:unchecked" "-Xlint:deprecation" 19 | "-target" "1.8" "-source" "1.8"] 20 | 21 | ;; Used to decide whether to compile on-the-fly or import. 22 | :profiles {:dev {:jvm-opts ["-Dgeex_mode=development"]} ; OK 23 | :test {:jvm-opts ["-Dgeex_mode=test"]} 24 | :production {:jvm-opts ["-Dgeex_mode=production"]} 25 | :repl {:jvm-opts ["-Dgeex_mode=repl"]} ; OK --- Use this to check 26 | :uberjar {:jvm-opts ["-Dgeex_mode=uberjar"]} ; OK 27 | } 28 | 29 | 30 | :jvm-opts [;; To avoid stack overflow when compiling bloated code... 31 | ;; (needed for the N-body example) 32 | "-Xss16M" 33 | 34 | ;; Where generated Geex code should be put 35 | "-Dgeex_java_output_path=/tmp/geexjava"] 36 | 37 | :dependencies 38 | [ ;; Clojure version to use 39 | [org.clojure/clojure "1.10.0"] 40 | 41 | ;; Utility library 42 | [bluebell/utils "0.1.11"] 43 | 44 | ;; Embeddable Java compiler 45 | [org.codehaus.janino/janino "3.0.8"] 46 | 47 | ;; Java code source formatter 48 | [com.google.googlejavaformat/google-java-format "1.6"]]) 49 | -------------------------------------------------------------------------------- /src/clj/geex/core/seed.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.seed 2 | (:import [geex ISeed TypedSeed]) 3 | (:require [clojure.spec.alpha :as spec] 4 | [bluebell.utils.wip.party :as party] 5 | [bluebell.utils.wip.core :as utils] 6 | [bluebell.utils.wip.tag.core :as tg] 7 | [bluebell.utils.wip.java :refer [set-field]])) 8 | 9 | 10 | (def seed? (partial instance? ISeed)) 11 | 12 | ;; The dependencies of a seed 13 | (defn access-deps [x] 14 | {:pre [(seed? x)]} 15 | (.deps x)) 16 | 17 | (defn deps-map [^ISeed x] 18 | (.getMap (.deps x))) 19 | 20 | (defn access-mode [^ISeed x] 21 | (.getMode x)) 22 | 23 | (defn typed-seed? [x] 24 | (instance? TypedSeed x)) 25 | 26 | (defn compilable-seed? 27 | "A seed that can be compiled" 28 | [x] 29 | (and (seed? x) 30 | (not (typed-seed? x)))) 31 | 32 | (defn only-numeric-keys [m] 33 | (filter (fn [[k v]] (number? k)) m)) 34 | 35 | (def access-indexed-map 36 | (party/wrap-accessor 37 | {:desc "access-indexed-map" 38 | :getter (fn [x] (mapv second (sort-by first (only-numeric-keys x)))) 39 | :setter (fn [x y] (merge x (zipmap (range (count y)) y)))})) 40 | 41 | (defn access-compiled-indexed-deps 42 | ([^ISeed seed] 43 | {:pre [(instance? ISeed seed)]} 44 | (.compilationResultsToArray (.deps seed)))) 45 | 46 | (defn datatype [^ISeed x] 47 | {:pre [(seed? x)]} 48 | (.getType x)) 49 | 50 | (defn description [x] 51 | (.getDescription x)) 52 | 53 | (defn typed-seed [tp] 54 | (TypedSeed. tp)) 55 | 56 | (defn strip-seed [seed] 57 | (typed-seed (datatype seed))) 58 | 59 | (defn access-compiled-deps [sd] 60 | {:pre [(seed? sd)]} 61 | (.getCompilationResults (.deps sd))) 62 | 63 | (defn access-seed-data [x] 64 | {:pre [(seed? x)]} 65 | (.getData x)) 66 | 67 | (defn compilation-result [^ISeed seed] 68 | (.getCompilationResult (.getState seed))) 69 | 70 | (defn set-seed-type! [seed new-type] 71 | (let [p (.getParams seed)] 72 | (set-field p type new-type) 73 | seed)) 74 | -------------------------------------------------------------------------------- /test/geex/java/reflect_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.reflect-test 2 | (:require [geex.java.reflect :refer :all] 3 | [clojure.test :refer :all])) 4 | 5 | (deftest arglist-matches-test 6 | (is (arglist-matches? 7 | [clojure.lang.IPersistentVector] 8 | [clojure.lang.IPersistentCollection])) 9 | (is (not (arglist-matches? 10 | [clojure.lang.IPersistentCollection] 11 | [clojure.lang.IPersistentVector]))) 12 | (is (not (arglist-matches? 13 | [clojure.lang.IPersistentCollection] 14 | [clojure.lang.IPersistentVector 15 | clojure.lang.IPersistentVector]))) 16 | (is (not (arglist-matches? 17 | [clojure.lang.IPersistentCollection] 18 | [clojure.lang.IPersistentVector 19 | clojure.lang.IPersistentVector]))) 20 | (is (arglist-matches? 21 | [clojure.lang.IPersistentVector Double/TYPE] 22 | [clojure.lang.IPersistentCollection Double]))) 23 | 24 | (deftest list-matching-methods-test 25 | (is (= 1 (count 26 | (list-matching-methods 27 | clojure.lang.RT "conj" 28 | [clojure.lang.IPersistentVector 29 | java.lang.Object]))))) 30 | 31 | (def dominates-scores 32 | [[clojure.lang.IPersistentCollection 33 | clojure.lang.IPersistentCollection 0] 34 | [clojure.lang.IPersistentCollection 35 | clojure.lang.IPersistentVector -1] 36 | [Double 37 | clojure.lang.IPersistentVector nil]]) 38 | 39 | (defn neg [x] 40 | (if (nil? x) 41 | nil 42 | (- x))) 43 | 44 | (deftest domination-test 45 | (doseq [[a b score] dominates-scores] 46 | (is (= score (dominates-score a b))) 47 | (is (= (neg score) (dominates-score b a))))) 48 | 49 | (deftest matching-method-test 50 | (is (get-matching-method 51 | clojure.lang.RT 52 | "conj" 53 | [clojure.lang.IPersistentVector 54 | Object])) 55 | (is (thrown? 56 | Exception 57 | (get-matching-method 58 | clojure.lang.RT 59 | "conj" 60 | [clojure.lang.IPersistentVector])))) 61 | -------------------------------------------------------------------------------- /src/clj/geex/core/xplatform.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.xplatform 2 | (:require [geex.core.defs :as defs] 3 | [clojure.core :as c] 4 | [clojure.set :as cljset] 5 | [bluebell.utils.wip.debug :as debug]) 6 | (:refer-clojure :exclude [get])) 7 | 8 | 9 | 10 | 11 | 12 | (def platform-map (atom {})) 13 | 14 | (defonce gotten (atom #{})) 15 | 16 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17 | ;;; 18 | ;;; Interface 19 | ;;; 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | 22 | (defn all-keys [] 23 | (->> platform-map 24 | deref 25 | vals 26 | (apply merge) 27 | keys 28 | set)) 29 | 30 | (defn register 31 | "Add a map of values" 32 | [platform-key value-map] 33 | {:pre [(map? value-map) 34 | (every? (complement nil?) (vals value-map))]} 35 | (swap! 36 | platform-map 37 | (fn [dst] 38 | (update dst platform-key #(merge % value-map))))) 39 | 40 | (defn list-platforms 41 | "List the available platforms" 42 | [] 43 | (-> platform-map 44 | deref 45 | keys)) 46 | 47 | (defn never-queried [] 48 | (cljset/difference (all-keys) 49 | (-> gotten deref))) 50 | 51 | (defn get [key] 52 | (swap! gotten conj key) 53 | (let [platform (defs/get-platform) 54 | data (deref platform-map)] 55 | (if (contains? data platform) 56 | (let [specific (c/get data platform)] 57 | (if (contains? specific key) 58 | (c/get specific key) 59 | (throw (ex-info "No such key" 60 | {:key key 61 | :platform platform 62 | :available-keys (keys specific)})))) 63 | (throw (ex-info "No such platform" 64 | {:non-existing-platform platform 65 | :available-platforms (keys data)}))))) 66 | 67 | (defn call [f & args] 68 | (debug/exception-hook 69 | (apply (get f) args) 70 | (println "Error when xplatform calling" f))) 71 | 72 | (defn caller [f] 73 | (partial call f)) 74 | -------------------------------------------------------------------------------- /test/geex/Seed_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.Seed-test 2 | (:import [geex ISeed DynamicSeed 3 | SeedParameters Mode TypedSeed 4 | SeedUtils]) 5 | (:require [clojure.test :refer :all] 6 | [bluebell.utils.wip.java :as java :refer [set-field]])) 7 | 8 | (defn params-with-type [t] 9 | (doto (SeedParameters.) 10 | (set-field type t) 11 | (set-field description "Default") 12 | (set-field mode Mode/Pure) 13 | (set-field compiler identity))) 14 | 15 | (deftest mode-test 16 | (let [src [0 1 2 3]] 17 | (is (= src 18 | (mapv (fn [x] 19 | (SeedUtils/intFromMode 20 | (SeedUtils/modeFromInt x))) 21 | src))) 22 | (is (= Mode/Ordered (SeedUtils/max 23 | Mode/Pure 24 | Mode/Ordered))))) 25 | 26 | (deftest seed-test 27 | (let [p0 (params-with-type Double/TYPE) 28 | p1 (params-with-type Double/TYPE) 29 | 30 | s0 (doto (DynamicSeed. p0) (.setId 119)) 31 | s1 (doto (DynamicSeed. p1) (.setId 119)) 32 | 33 | q0 (doto (DynamicSeed. 34 | (params-with-type Integer/TYPE)) 35 | (.setId 119)) 36 | r0 (doto (DynamicSeed. 37 | (params-with-type Double/TYPE)) 38 | (.setId 120))] 39 | (is (.equals s0 s1)) 40 | (is (= s0 s1)) 41 | (is (= s1 s0)) 42 | (is (not= p0 q0)) 43 | (is (not= p0 r0)) 44 | (is (not= r0 q0)) 45 | (is (= (TypedSeed. Character/TYPE) 46 | (DynamicSeed. (params-with-type Character/TYPE)))) 47 | (is (not= (TypedSeed. Character/TYPE) 48 | (DynamicSeed. (params-with-type Boolean/TYPE)))) 49 | (is (not= s0 nil)) 50 | (is (= {s0 2 r0 3} 51 | {s1 2 r0 3})) 52 | (is (not= {s0 3 r0 3} 53 | {s1 2 r0 3})) 54 | (is (= 1 (count (conj #{s0} s1)))) 55 | (is (= 2 (count (conj #{s0} q0)))) 56 | 57 | (do 58 | (.addDep (.deps s0) :kattskit r0) 59 | (.setData s0 :kattskit) 60 | (is (= :kattskit (.getData s0)))) 61 | 62 | 63 | #_(is (= (DynamicSeed. p0) 64 | (DynamicSeed. p0) 65 | 66 | )))) 67 | -------------------------------------------------------------------------------- /src/clj/geex/core/utils.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.utils) 2 | 3 | (defn partial-wrapping-args [f pre-defined & arg-wrappers] 4 | (fn [& args] 5 | {:pre [(fn? f) 6 | (sequential? pre-defined) 7 | (every? fn? arg-wrappers)]} 8 | (when (not= (count args) 9 | (count arg-wrappers)) 10 | (throw (ex-info "The number of arguments does not match the number of argument wrappers" 11 | {:f f 12 | :predefined pre-defined 13 | :args args 14 | :arg-wrappers arg-wrappers}))) 15 | (apply f (into (vec pre-defined) 16 | (map (fn [w x] (w x)) 17 | arg-wrappers 18 | args))))) 19 | 20 | (defn arity-partial [& all-args] 21 | {:pre [(<= 2 (count all-args))]} 22 | (let [[f & args0] all-args 23 | args (vec (butlast args0)) 24 | arity-arg (last args0) 25 | _ (assert (or (sequential? arity-arg) 26 | (set? arity-arg)))] 27 | (if (set? arity-arg) 28 | (let [arities arity-arg] 29 | (fn [& input] 30 | (let [args (into args input)] 31 | (when (not (contains? arities (count args))) 32 | (throw (ex-info 33 | "Function called with wrong number of arguments" 34 | (merge {:f f 35 | :args args 36 | :acceptable-arities arities})))) 37 | (apply f args)))) 38 | (let [arity-count (count arity-arg)] 39 | (fn [& input] 40 | (when (not= (count input) arity-count) 41 | (throw (ex-info "Bad number of arguments provided to partial function" 42 | {:f f 43 | :base-args args 44 | :extra-args input 45 | :expected arity-arg}))) 46 | (apply f (into args input))))))) 47 | 48 | (defn environment [] 49 | {:mode (keyword (System/getProperty "geex_mode")) 50 | :java-output-path (System/getProperty "geex_java_output_path")}) 51 | 52 | (defn merge-onto [a b] 53 | {:pre [(map? a) 54 | (map? b)]} 55 | (merge a (select-keys b (keys a)))) 56 | -------------------------------------------------------------------------------- /src/java/geex/SeedState.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.Optional; 4 | 5 | public class SeedState { 6 | 7 | /* 8 | 9 | Three possible compilation states: 10 | - Not listed, the code is inserted as is. 11 | - Pure expressions 12 | - Code expressions 13 | - Listed, but not bound. 14 | - Side-effectful *statements* 15 | - Listed, and bound to a variable: 16 | - Pure expressions shared by many 17 | - Side-effectful expressions 18 | 19 | 20 | Rules: 21 | Always set compilation result 22 | if explicit listing true or false, then let that decide 23 | otherwise: 24 | SideEffectful or (Many referents && not code) => list 25 | list && hasValue => bind 26 | 27 | */ 28 | 29 | 30 | /* 31 | 32 | Setters 33 | 34 | */ 35 | public void setCompilationResult(Object v) { 36 | _value = Optional.of(v); 37 | } 38 | 39 | public void list() { 40 | _listed = true; 41 | } 42 | 43 | public void bind(Object k) { 44 | _key = Optional.of(k); 45 | } 46 | 47 | 48 | 49 | /* 50 | 51 | Getters 52 | 53 | */ 54 | public String toString() { 55 | return "SeedState(listed? " 56 | + (_listed? "yes" : "no") 57 | + ", key=" 58 | + (_key.hasValue()? _key.get().toString() : "nil") 59 | + ", value=" 60 | + (_value.hasValue()? _value.get().toString() : "nil") 61 | + ")"; 62 | } 63 | 64 | public boolean isBound() { 65 | return _key.hasValue(); 66 | } 67 | 68 | public boolean hasCompilationResult() { 69 | return _value.hasValue(); 70 | } 71 | 72 | void checkHasCompilationResult() { 73 | if (!hasCompilationResult()) { 74 | throw new RuntimeException("No compilation result"); 75 | } 76 | } 77 | 78 | public Object getCompilationResult() { 79 | checkHasCompilationResult(); 80 | return _key.hasValue()? _key.get() : _value.get(); 81 | } 82 | 83 | public Object getKey() { 84 | return _key.get(); 85 | } 86 | 87 | public Object getValue() { 88 | return _value.get(); 89 | } 90 | 91 | public boolean isListed() { 92 | return _listed; 93 | } 94 | 95 | private boolean _listed = false; 96 | private Optional _key = Optional.empty(); 97 | private Optional _value = Optional.empty(); 98 | }; 99 | -------------------------------------------------------------------------------- /src/java/geex/TypedSeed.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import java.lang.RuntimeException; 4 | import geex.ISeed; 5 | import geex.Dependencies; 6 | import geex.SeedUtils; 7 | import geex.Mode; 8 | import clojure.lang.IFn; 9 | import clojure.lang.APersistentMap; 10 | 11 | public class TypedSeed implements ISeed { 12 | Object _type = null; 13 | 14 | public APersistentMap getRawDeps() { 15 | throw new RuntimeException("TypedSeed has no raw deps"); 16 | } 17 | 18 | public TypedSeed(Object type) { 19 | SeedUtils.checkSeedType(type); 20 | _type = type; 21 | } 22 | 23 | public String getDescription() { 24 | return "TypedSeed"; 25 | } 26 | 27 | public Object getType() { 28 | return _type; 29 | } 30 | 31 | public int getId() { 32 | return ISeed.UNDEFINED_ID; 33 | } 34 | 35 | public void setId(int id) { 36 | throw new RuntimeException("Cannot set id of TypedSeed"); 37 | } 38 | 39 | public Mode getMode() { 40 | return Mode.Pure; 41 | } 42 | 43 | public boolean equals(Object other) { 44 | return SeedUtils.equals(this, other); 45 | } 46 | 47 | public int hashCode() { 48 | return SeedUtils.hashCode(this); 49 | } 50 | 51 | public Dependencies deps() { 52 | throw new RuntimeException( 53 | "A typed seed cannot have dependencies"); 54 | } 55 | 56 | public Referents refs() { 57 | throw new RuntimeException( 58 | "A typed seed cannot have referents"); 59 | } 60 | 61 | public boolean hasValue() { 62 | return true; 63 | } 64 | 65 | public SeedState getState() { 66 | throw new RuntimeException( 67 | "TypedSeed does not have state"); 68 | } 69 | 70 | public Object compile(State state) { 71 | throw new RuntimeException("Cannot compile a TypedSeed"); 72 | } 73 | 74 | public Object getData() { 75 | throw new RuntimeException("Cannot get data of typed seed"); 76 | } 77 | 78 | public void setData(Object o) { 79 | throw new RuntimeException( 80 | "Cannot set data of runtime exception"); 81 | } 82 | 83 | public Boolean shouldBind() { 84 | throw new RuntimeException("Not bindable"); 85 | } 86 | 87 | public void setBind(Boolean v) { 88 | throw new RuntimeException("Not bindable"); 89 | } 90 | 91 | public String generateVarName() { 92 | throw new RuntimeException( 93 | "Cannot generateVarName for typed seed"); 94 | } 95 | 96 | public String toString() { 97 | return SeedUtils.toString(this); 98 | } 99 | 100 | public void setForwardedFunction(IFn f) {} 101 | } 102 | -------------------------------------------------------------------------------- /test/geex/ebmd/type_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.ebmd.type-test 2 | (:require [geex.ebmd.type :as type] 3 | [bluebell.utils.ebmd :as ebmd] 4 | [clojure.test :refer :all] 5 | [geex.core.seed :as seed])) 6 | 7 | (deftest primitive-test 8 | (is (ebmd/matches-arg-spec? ::type/double-value 3.0)) 9 | (is (ebmd/matches-arg-spec? ::type/float-value (float 3.0))) 10 | (is (ebmd/matches-arg-spec? ::type/int-value (int 3))) 11 | (is (ebmd/matches-arg-spec? ::type/long-value (long 3))) 12 | (is (ebmd/matches-arg-spec? ::type/short-value (short 3))) 13 | (is (ebmd/matches-arg-spec? ::type/byte-value (byte 3))) 14 | (is (ebmd/matches-arg-spec? ::type/char-value (char 3))) 15 | (is (ebmd/matches-arg-spec? ::type/boolean-value (boolean false)))) 16 | 17 | 18 | (ebmd/declare-poly add-0) 19 | 20 | (ebmd/def-poly add-0 [::type/boolean-value a 21 | ::type/boolean-value b] 22 | (or a b)) 23 | 24 | 25 | (ebmd/def-poly add-0 [::type/double-value a 26 | ::type/double-value b] 27 | [:double (+ a b)]) 28 | 29 | (ebmd/def-poly add-0 [::type/float-value a 30 | ::type/float-value b] 31 | [:float (+ a b)]) 32 | 33 | (deftest add-0-test 34 | (is (= true (add-0 false true))) 35 | (is (= [:double 3.7] (add-0 2 1.7))) 36 | (is (= [:float 3.0] (add-0 2 (float 1.0))))) 37 | 38 | 39 | (ebmd/declare-poly add-1) 40 | 41 | (ebmd/def-poly add-1 [::type/real-value a 42 | ::type/real-value b] 43 | [:real (+ a b)]) 44 | 45 | (ebmd/def-poly add-1 [::type/integer-value a 46 | ::type/integer-value b] 47 | [:integer (+ a b)]) 48 | 49 | (ebmd/def-poly add-1 [::type/coll-value a 50 | ::type/coll-value b] 51 | (into a b)) 52 | 53 | 54 | (ebmd/def-poly add-1 [::type/real-array-value a 55 | ::type/real-array-value b] 56 | (double-array (map + (vec a) (vec b)))) 57 | 58 | (ebmd/def-poly add-1 [::type/real a 59 | ::type/real b] 60 | [:common-real a b]) 61 | 62 | (deftest add-1-test 63 | (is (= [:real 3.4] (add-1 1.4 2))) 64 | (is (= [:integer 3] (add-1 1 2))) 65 | (is (= #{1 2 3} (add-1 #{1 2} [3]))) 66 | (is (= [11.0 22.0 33.0] 67 | (vec (add-1 (double-array [1 2 3]) 68 | (int-array [10 20 30]))))) 69 | (is (= (first (add-1 (seed/typed-seed Double/TYPE) 70 | 3)) 71 | :common-real))) 72 | 73 | 74 | 75 | (deftest resolve-type-test 76 | (is (nil? (type/resolve-type :kattskit))) 77 | (is (= :kattskit 78 | (type/resolve-type 79 | (seed/typed-seed :kattskit)))) 80 | (is (= java.lang.AbstractMethodError 81 | (type/resolve-type 82 | java.lang.AbstractMethodError))) 83 | (is (= Long/TYPE 84 | (type/resolve-type ::type/long)))) 85 | -------------------------------------------------------------------------------- /src/java/geex/SeedUtils.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.ISeed; 4 | import java.util.Objects; 5 | import geex.Mode; 6 | 7 | 8 | public class SeedUtils { 9 | public static void checkSeedType(Object o) { 10 | if (o instanceof ISeed) { 11 | throw new RuntimeException( 12 | "A seed having a seed as type is likely an error"); 13 | } 14 | } 15 | 16 | public static boolean equalTypes(Object a, Object b) { 17 | if (a == null) { 18 | return b == null; 19 | } else if (b == null) { 20 | return false; 21 | } 22 | return a.equals(b); 23 | } 24 | 25 | public static boolean equals(ISeed a, Object other) { 26 | if (other == null) { 27 | return a == null; 28 | } else if (a == null) { 29 | return false; 30 | } else if (a == other) { 31 | return true; 32 | } else if (other instanceof ISeed) { 33 | ISeed b = (ISeed)other; 34 | return a.getId() == b.getId() 35 | && equalTypes(a.getType(), b.getType()); 36 | } 37 | return false; 38 | } 39 | 40 | public static String toString(ISeed x) { 41 | Object tp = x.getType(); 42 | int id = x.getId(); 43 | return "ISeed(type=" + ( tp == null? "nil" : tp.toString() ) 44 | + (id == ISeed.UNDEFINED_ID? "" : (", id=" + id)) 45 | + ", desc=" + x.getDescription() 46 | + ", mode=" + x.getMode().toString() + ")"; 47 | } 48 | 49 | public static int hashCode(ISeed x) { 50 | return Objects.hash(x.getType(), x.getId()); 51 | } 52 | 53 | public static boolean isRegistered(ISeed x) { 54 | return x.getId() != ISeed.UNDEFINED_ID; 55 | } 56 | 57 | public static int intFromMode(Mode m) { 58 | if (m == null) { 59 | throw new RuntimeException( 60 | "The mode must not be null"); 61 | } if (m == Mode.Pure) { 62 | return 0; 63 | } else if (m == Mode.Ordered) { 64 | return 1; 65 | } else if (m == Mode.SideEffectful) { 66 | return 2; 67 | } else { 68 | return 3; 69 | } 70 | } 71 | 72 | public static Mode modeFromInt(int m) { 73 | if (m == 0) { 74 | return Mode.Pure; 75 | } else if (m == 1) { 76 | return Mode.Ordered; 77 | } else if (m == 2) { 78 | return Mode.SideEffectful; 79 | } else if (m == 3) { 80 | return Mode.Code; 81 | } { 82 | throw new RuntimeException( 83 | "Cannot map " + m + " to mode"); 84 | } 85 | } 86 | 87 | public static Mode max(Mode a, Mode b) { 88 | return modeFromInt( 89 | Math.max(intFromMode(a), intFromMode(b))); 90 | } 91 | 92 | public static boolean hasCompilationResult(ISeed x) { 93 | return x.getState().hasCompilationResult(); 94 | } 95 | } 96 | -------------------------------------------------------------------------------- /test/geex/java/class_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.class-test 2 | (:require [geex.java.class :refer :all :as jc] 3 | [geex.core :as core] 4 | [bluebell.utils.dsl :as dsl] 5 | [clojure.spec.alpha :as spec] 6 | [clojure.test :refer :all])) 7 | 8 | 9 | (deftest class-def-test 10 | (is (class-def? {:name "Kattskit"})) 11 | (is (not (class-def? {:name 119}))) 12 | (is (class-def? 13 | {:name "Mjao" 14 | :methods 15 | [{:name "Kattskit" 16 | :arg-types [Integer/TYPE] 17 | :fn (fn [x] 18 | (+ x 1))}]})) 19 | (is (not 20 | (class-def? 21 | {:name "Mjao" 22 | :methods 23 | [{:name "Kattskit" 24 | :arg-types [Integer/TYPE] 25 | :fn :adsf}]}))) 26 | 27 | 28 | (is (valid? 29 | (validate-class-def 30 | {:name "Mjao" 31 | :methods [{:name "Mjao" 32 | :arg-types [Integer/TYPE] 33 | :fn identity}]}))) 34 | (is (thrown? Exception 35 | (validate-class-def 36 | {:name "Mjao" 37 | :methods [{:name "Mjao" 38 | :arg-types [Integer/TYPE] 39 | :fn identity} 40 | {:name "Mjao" 41 | :arg-types [Integer/TYPE] 42 | :fn +}]}))) 43 | (let [cd0 {:name "Mjao" 44 | :methods [{:name "a" 45 | :arg-types [Double/TYPE]}]} 46 | cd (validate-class-def 47 | cd0)] 48 | (is (abstract? cd0)) 49 | (is (abstract? cd)) 50 | (is (not (interface? cd))) 51 | (is (valid? cd))) 52 | (let [cd0 {:name "Mjao" 53 | :methods [{:name "a" 54 | :arg-types [Double/TYPE] 55 | :fn (fn [x] x)}]} 56 | cd (validate-class-def 57 | cd0)] 58 | (is (not (abstract? cd0))) 59 | (is (not (abstract? cd))) 60 | (is (not (interface? cd))) 61 | (is (valid? cd))) 62 | (let [cd0 {:name "Mjao" 63 | :interface? true 64 | :methods [{:name "a" 65 | :arg-types [Double/TYPE] 66 | :ret Double/TYPE}]} 67 | cd (validate-class-def 68 | cd0)] 69 | 70 | (is (abstract? cd0)) 71 | (is (abstract? cd)) 72 | (is (interface? cd)) 73 | (is (valid? cd))) 74 | (let [cd0 {:name "Mjao" 75 | :interface? true 76 | :methods [{:name "a" 77 | :static? true 78 | :arg-types [Double/TYPE] 79 | :ret Double/TYPE}]}] 80 | (is (thrown? Exception (validate-class-def cd0)))) 81 | (let [cd0 {:name "Mjao" 82 | :methods [{:name "a" 83 | :arg-types [Double/TYPE] 84 | :ret Double/TYPE}]} 85 | cd (validate-class-def cd0)] 86 | 87 | (is (abstract? cd0)) 88 | (is (abstract? cd)) 89 | (is (not (interface? cd))) 90 | (is (valid? cd)))) 91 | -------------------------------------------------------------------------------- /test/examples/expr_templates_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.expr-templates-test 2 | (:require [geex.common :as l] 3 | [clojure.spec.alpha :as spec] 4 | [geex.java :as java] 5 | [geex.core :as core] 6 | [clojure.test :refer :all])) 7 | 8 | ;; "Expression templates" is a technique used in C++ to 9 | ;; implement efficient matrix operations: 10 | ;; 11 | ;; https://en.wikipedia.org/wiki/Expression_templates 12 | ;; 13 | ;; Here, we demonstrate this technique in Clojure and Geex. 14 | 15 | (spec/def ::size any?) 16 | (spec/def ::get fn?) 17 | (spec/def ::expr (spec/keys :req-un [::size ::get])) 18 | 19 | (def expr? (partial spec/valid? ::expr)) 20 | 21 | 22 | 23 | ;;;------- Some common expression templates ------- 24 | 25 | (defn fill [n value] 26 | {:post [(expr? %)]} 27 | {:size n 28 | :get (fn [_] value)}) 29 | 30 | (defn array-expr [src-array] 31 | {:post [(expr? %)]} 32 | {:size (l/count src-array) 33 | :get (fn [i] (l/aget src-array (l/cast Integer/TYPE i)))}) 34 | 35 | (defn range-expr [n] 36 | {:post [(expr? %)]} 37 | {:size n 38 | :get (fn [i] i)}) 39 | 40 | (defn add [a b] 41 | {:pre [(expr? a) 42 | (expr? b)] 43 | :post [(expr? %)]} 44 | {:size (:size a) 45 | :get (fn [i] (l/+ ((:get a) i) 46 | ((:get b) i)))}) 47 | 48 | (defn mul [a b] 49 | {:pre [(expr? a) 50 | (expr? b)] 51 | :post [(expr? %)]} 52 | {:size (:size a) 53 | :get (fn [i] (l/* ((:get a) i) 54 | ((:get b) i)))}) 55 | 56 | ;; Note: This is not exactly the same thing 57 | ;; as (mul x x), because there we call the (:get ) function twice... 58 | (defn sqr [x] 59 | {:size (:size x) 60 | :get (fn [i] (let [y ((:get x) i)] 61 | (l/* y y)))}) 62 | 63 | (defn reverse-expr [x] 64 | {:pre [(expr? x)] 65 | :post [(expr? x)]} 66 | {:size (:size x) 67 | :get (fn [i] 68 | ((:get x) (l/- (:size x) i 1)))}) 69 | 70 | ;;;------- Turns an expression into an array ------- 71 | 72 | (defn evaluate [expr] 73 | {:pre [(expr? expr)]} 74 | (let [n (:size expr) 75 | dst (l/make-array Double/TYPE n) 76 | g (:get expr)] 77 | (l/doseq [i (l/range (l/wrap 0) (l/wrap n))] 78 | (l/aset dst (l/cast Integer/TYPE i) (g i))) 79 | dst)) 80 | 81 | ;;;------- Tests ------- 82 | (java/typed-defn add-to-array [(l/array-type Double/TYPE) arr 83 | Double/TYPE offset] 84 | ;(core/set-flag! :disp-time) 85 | (evaluate (add (array-expr arr) 86 | (fill (l/alength arr) offset)))) 87 | 88 | 89 | 90 | (defmacro eval-expr [& expr] 91 | `(vec (java/eval (evaluate ~@expr)))) 92 | 93 | (deftest various-tests 94 | (is (= (eval-expr (fill 3 119.0)) 95 | [119.0 119.0 119.0])) 96 | (is (= (eval-expr (range-expr 3)) 97 | [0.0 1.0 2.0])) 98 | (is (= (eval-expr (reverse-expr (range-expr 4))) 99 | [3.0 2.0 1.0 0.0])) 100 | (is (= (vec (add-to-array 101 | (double-array [7 17 119]) 102 | 1000.0)) 103 | [1007.0 1017.0 1119.0])) 104 | (is (= (eval-expr 105 | (do 106 | ;(core/set-flag! :disp) 107 | (sqr (add (range-expr 9) 108 | (fill 9 -4))))) 109 | [16.0 9.0 4.0 1.0 0.0 1.0 4.0 9.0 16.0]))) 110 | -------------------------------------------------------------------------------- /othernotes.md: -------------------------------------------------------------------------------- 1 | ## Issues and features to address 2 | 3 | Important or easy to implement: 4 | * Simplifications of the core: 5 | - Sort out the recur-spaghetti... or simplify it. 6 | - Fewer mutations, if possible. Concentrate them to SeedState. 7 | * Sequence stuff: drop, take, take-while, filter, etc. 8 | * array and vec functions: Export a lazy seq to a vector. 9 | * Refactor, so that a seed has typeInfo, instead of type. And typeInfo wraps the type with meda data. 10 | 11 | Less important: 12 | * Provide JavaSourceClassLoader as parent class loader to SimpleCompiler. This will allow it to use previously compiled classes. Or maybe better, whenever we cook something, we set the parent class loader to be the new class loader. 13 | * A class registry, mapping full class name to a function producing a class. It will first look in the class loader (which is a JavaSourceClassLoader). This registry is used for structs and struct arrays, so that structurally equivalent things map the same. 14 | * An export function that is called on all values returned. By default, it returns the value unchanged. But it can be extended, so that for ::iterables it turns them into lazy seqs, and for matrix expressions it turns them into MDArrays. 15 | * Implement ILookUp etc for seeds, so that we can apply keywords and nth and count to seeds. 16 | * Figure out namespace 17 | * Add dependencies between stateful, respect scope. 18 | * Prohibit some chars in typed-defn names, such as >, < 19 | * Strip away operations without sideeffects if they are not needed. 20 | * Unite identical pure operations. 21 | * Contiguous structured arrays. 22 | * Calling super of class that we extend. 23 | * Cartesian product 24 | * Better management of homogenization of slightly different values between branches in conditional forms: Maybe, if there is no change in the value, we reset the type??? 25 | 26 | ## Design 27 | 28 | ### Getting the current namespace 29 | 30 | ``` 31 | (defmacro this-ns [] 32 | (let [s (gensym)] 33 | `(do (def ~s) 34 | (-> (var ~s) 35 | (.ns) 36 | ;(.getName) 37 | ;name 38 | )))) 39 | ``` 40 | 41 | ### Structs and Struct array 42 | Add a module ```geex/java/struct```, interface ```IStruct``` and interface ```IStructArray```. 43 | 44 | ```IStruct``` has methods ```getData```, ```setData```, ```make```, ```getFloat0```, ```getTypeSignature```. 45 | ```IStructArray``` has methods ```getData```, ```setData```, ```getStruct```, ```setStruct```, ```getFloats```, ```getDoubles```, ```getTypeSignature```. 46 | 47 | A struct is a structural type. Its class can be defined on-the-fly e.g. ```(struct {:a Double})```. In the background, it does the following: 48 | * Generates a unique name for it based on its shape. 49 | * In a map, if a java.lang.Class already exists at that key, then return it. Otherwise, save it to disk and load it again with the JavaSourceClassLoader of Janino. 50 | 51 | There is also a construct, ```data-class-template```, that lets us defined polymorphic classes, e.g. 52 | 53 | ```clj 54 | (def-data-class-template my-bbox 55 | (fn [data-shape] 56 | {:interfaces [IBBox] 57 | :methods [{:name "extend" 58 | :arg-types [Object] 59 | :fn (fn [this x] ...)}})) 60 | ``` 61 | and then we can simply call ```(my-bbox {:minv [Double Double] :maxv [Double Double]})``` to generate a specialized class implementing these methods... that has polymorphic behaviour. 62 | -------------------------------------------------------------------------------- /src/clj/geex/java/defs.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.defs 2 | (:require [clojure.spec.alpha :as spec] 3 | [bluebell.utils.wip.specutils :as specutils] 4 | [geex.core.datatypes :as dt])) 5 | 6 | (spec/def ::typed-argument (spec/cat :type any? 7 | :name symbol?)) 8 | 9 | (defn parsed-typed-argument? [x] 10 | (and (map? x) 11 | (contains? x :type) 12 | (contains? x :name))) 13 | 14 | (defn parsed-typed-arguments? [x] 15 | (and (or (sequential? x) 16 | (nil? x)) 17 | (every? parsed-typed-argument? x))) 18 | 19 | (spec/def ::typed-arguments (spec/spec (spec/* ::typed-argument))) 20 | 21 | (spec/def ::defn-args (spec/cat :name symbol? 22 | :arglist ::typed-arguments 23 | :body (spec/* any?))) 24 | 25 | (defn parsed-defn-args? [x] 26 | (and (map? x) 27 | (parsed-typed-arguments? (:arglist x)) 28 | (symbol? (:name x)) 29 | (let [b (:body x)] 30 | (or (sequential? b) 31 | (nil? b))))) 32 | 33 | ;; https://docs.oracle.com/javase/tutorial/java/nutsandbolts/opsummary.html 34 | 35 | (def binary-math-operators ["+" "-" "*" "/"]) 36 | 37 | (def comparison-operators ["<" "<=" ">=" ">" "==" "!="]) 38 | 39 | (def logical-operators ["&&" "||" "!"]) 40 | 41 | (def bit-operators ["~" 42 | "<<" 43 | ">>" 44 | ">>>" 45 | "&" 46 | "^" 47 | "|"]) 48 | 49 | (def boolean-result (constantly Boolean/TYPE)) 50 | 51 | (defn make-operator-info-map [result-fn operators] 52 | (into {} (map (fn [s] 53 | [s {:result-fn result-fn 54 | :name s}]) 55 | operators))) 56 | 57 | 58 | 59 | (def operator-info-map 60 | (merge 61 | 62 | (make-operator-info-map 63 | dt/math-op-result-type 64 | binary-math-operators) 65 | 66 | (make-operator-info-map 67 | boolean-result 68 | comparison-operators) 69 | 70 | (make-operator-info-map 71 | boolean-result 72 | logical-operators) 73 | 74 | (make-operator-info-map 75 | dt/bit-op-result-type 76 | bit-operators))) 77 | 78 | 79 | (spec/def ::math-fn-decl (spec/cat :key (spec/? keyword?) 80 | :java-name string? 81 | :arg-count (spec/? number?))) 82 | 83 | (defn normalize-math-fn-decl [sp] 84 | (let [conformed (specutils/force-conform ::math-fn-decl (if (string? sp) [sp] sp))] 85 | [(or (:key conformed) 86 | (keyword (:java-name conformed))) 87 | (:java-name conformed) 88 | (or (:arg-count conformed) 89 | 1)])) 90 | 91 | (def math-functions 92 | (mapv normalize-math-fn-decl 93 | ["asin" 94 | "atan" 95 | ["atan2" 2] 96 | "cbrt" 97 | "ceil" 98 | ["copySign" 2] 99 | "cos" 100 | "cosh" 101 | "exp" 102 | "expm1" 103 | "floor" 104 | ["floorDiv" 2] 105 | ["floorMod" 2] 106 | "getExponent" 107 | ["hypot" 2] 108 | "log" 109 | "log10" 110 | "log1p" 111 | [:math-min "max" 2] 112 | [:math-max "min" 2] 113 | "nextDown" 114 | "nextUp" 115 | "negateExact" 116 | ["multiplyExact" 2] 117 | ["pow" 2] 118 | "rint" 119 | "round" 120 | ["scalb" 2] 121 | "signum" 122 | "sin" 123 | "sinh" 124 | "signum" 125 | "sqrt" 126 | "tan" 127 | "tanh" 128 | "toDegrees" 129 | "toIntExact" 130 | "toRadians" 131 | "ulp" 132 | ])) 133 | -------------------------------------------------------------------------------- /src/java/geex/DynamicSeed.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import geex.ISeed; 4 | import geex.SeedUtils; 5 | import java.util.ArrayList; 6 | import geex.Dependencies; 7 | import java.lang.RuntimeException; 8 | import clojure.lang.APersistentMap; 9 | import geex.Mode; 10 | import clojure.lang.IFn; 11 | import geex.ForwardFn; 12 | import geex.SeedState; 13 | 14 | public class DynamicSeed extends ForwardFn implements ISeed { 15 | private SeedParameters _params = null; 16 | private Object _compilationResult = null; 17 | private Dependencies _deps = new Dependencies(); 18 | private Referents _refs = new Referents(); 19 | private int _id = ISeed.UNDEFINED_ID; 20 | private int _varCounter = 0; 21 | private boolean _hasResult = false; 22 | private SeedState _state = new SeedState(); 23 | 24 | public DynamicSeed(SeedParameters p) { 25 | super("This seed (" + (p.description == null? "no desc" : p.description) 26 | + ") cannot be used as a function"); 27 | SeedUtils.checkSeedType(p.type); 28 | 29 | if (p.description == null) { 30 | throw new RuntimeException("Missing description"); 31 | } 32 | if (p.compiler == null) { 33 | throw new RuntimeException("Missing compiler"); 34 | } 35 | if (p.mode == null) { 36 | throw new RuntimeException( 37 | "Seed mode has not been defined"); 38 | } 39 | _params = p; 40 | 41 | if (p.callable != null) { 42 | this.setForwardedFunction(p.callable); 43 | } 44 | } 45 | 46 | public APersistentMap getRawDeps() { 47 | return _params.rawDeps; 48 | } 49 | 50 | public Mode getMode() { 51 | return _params.mode; 52 | } 53 | 54 | public boolean hasValue() { 55 | return _params.hasValue; 56 | } 57 | 58 | public String getDescription() { 59 | return _params.description; 60 | } 61 | 62 | public Object getType() { 63 | return _params.type; 64 | } 65 | 66 | public void setId(int id) { 67 | _id = id; 68 | } 69 | 70 | public int getId() { 71 | return _id; 72 | } 73 | 74 | public String toString() { 75 | return SeedUtils.toString(this); 76 | } 77 | 78 | public boolean equals(Object other) { 79 | return SeedUtils.equals(this, other); 80 | } 81 | 82 | public int hashCode() { 83 | return SeedUtils.hashCode(this); 84 | } 85 | 86 | public Dependencies deps() { 87 | return _deps; 88 | } 89 | 90 | public Referents refs() { 91 | return _refs; 92 | } 93 | 94 | public SeedState getState() { 95 | return _state; 96 | } 97 | 98 | public Object compile(State state) { 99 | try { 100 | return _params.compiler.invoke(state, this); 101 | } catch (Exception e) { 102 | System.out.println( 103 | "ERROR -------> Failed to compile " + toString() 104 | + " with fn " + _params.compiler.toString()); 105 | throw e; 106 | } 107 | } 108 | 109 | public String generateVarName() { 110 | _varCounter++; 111 | return _varCounter == 1? 112 | String.format("s%04d", _id) 113 | : String.format("s%04d_%02d", _id, _varCounter); 114 | } 115 | 116 | public Boolean shouldBind() { 117 | return _params.bind; 118 | } 119 | 120 | public void setBind(Boolean value) { 121 | _params.bind = value; 122 | } 123 | 124 | 125 | public Object getData() { 126 | return _params.data; 127 | } 128 | 129 | public void setData(Object o) { 130 | _params.data = o; 131 | } 132 | 133 | public SeedParameters getParams() { 134 | return _params; 135 | } 136 | } 137 | -------------------------------------------------------------------------------- /src/clj/geex/java/reflect.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.reflect 2 | (:require [bluebell.utils.wip.pareto :as pareto])) 3 | 4 | 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;; 8 | ;;; Inteface 9 | ;;; 10 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11 | 12 | (def boxed-primitive-classes 13 | [[Character Character/TYPE] 14 | [Boolean Boolean/TYPE] 15 | [Byte Byte/TYPE] 16 | [Short Short/TYPE] 17 | [Integer Integer/TYPE] 18 | [Long Long/TYPE] 19 | [Float Float/TYPE] 20 | [Double Double/TYPE]]) 21 | 22 | (def boxed-map (into {} (map (comp vec reverse) 23 | boxed-primitive-classes))) 24 | 25 | (defn boxes-or-unboxes-to? [a b] 26 | (some 27 | (fn [[cl ucl]] 28 | (or (and (= cl a) (= ucl b)) 29 | (and (= ucl a) (= cl b)))) 30 | boxed-primitive-classes)) 31 | 32 | (defn arg-matches? [a b] 33 | (or (isa? a b) 34 | (boxes-or-unboxes-to? a b) 35 | (isa? (get boxed-map a) b))) 36 | 37 | (defn arglist-matches? [query-arglist available-arglist] 38 | {:pre [(coll? query-arglist) 39 | (coll? available-arglist)]} 40 | (and (= (count query-arglist) 41 | (count available-arglist)) 42 | (every? 43 | identity 44 | (map arg-matches? query-arglist available-arglist)))) 45 | 46 | (defn concrete? [method] 47 | (= 0 (bit-and java.lang.reflect.Modifier/ABSTRACT 48 | (.getModifiers method)))) 49 | 50 | (defn matching-method? [method-name arg-types method] 51 | (and 52 | ;(concrete? method) 53 | (= method-name (.getName method)) 54 | (let [ptypes (vec (.getParameterTypes method))] 55 | (arglist-matches? arg-types ptypes)))) 56 | 57 | (defn list-matching-methods [cl method-name arg-types] 58 | {:pre [(class? cl) 59 | (string? method-name) 60 | (coll? arg-types) 61 | (every? class? arg-types)]} 62 | (filter 63 | (partial matching-method? method-name arg-types) 64 | (.getMethods cl))) 65 | 66 | (defn dominates-score [a b] 67 | (if (arg-matches? a b) 68 | (if (arg-matches? b a) 69 | 0 70 | 1) 71 | (if (arg-matches? b a) 72 | -1 73 | nil))) 74 | 75 | (defn method-dominates? [a b] 76 | (let [a-args (vec (.getParameterTypes a)) 77 | b-args (vec (.getParameterTypes b))] 78 | (assert (= (count a-args) 79 | (count b-args))) 80 | 81 | (let [scores (mapv dominates-score a-args b-args)] 82 | (cond 83 | ;; Identical arguments: Look at other properties 84 | (= a-args b-args) (isa? ;; choose most general type: 85 | (.getReturnType b) ;; Janino is 86 | (.getReturnType a)) ;; not smart enough. 87 | 88 | ;; The other might dominate 89 | (some nil? scores) false 90 | 91 | ;; The other might dominate 92 | (some (partial = -1) scores) false 93 | 94 | 95 | :default (some (partial = 1) scores))))) 96 | 97 | (defn get-matching-method [cl method-name arg-types] 98 | (let [frontier 99 | (pareto/elements 100 | (transduce 101 | (filter 102 | (partial matching-method? method-name arg-types)) 103 | (completing pareto/insert) 104 | (pareto/frontier method-dominates?) 105 | (.getMethods cl))) 106 | n (count frontier)] 107 | (if (or (= 0 n) 108 | (<= 2 n)) 109 | (throw (ex-info 110 | (if (= 0 n) 111 | "No matching method found. Did you consider specifying the return type using :ret? Only then can the calling code know what to expect." 112 | "Ambiguous method resolution") 113 | {:class cl 114 | :method-name method-name 115 | :arg-types arg-types 116 | :methods frontier})) 117 | (first frontier)))) 118 | 119 | 120 | 121 | -------------------------------------------------------------------------------- /src/java/geex/Dependencies.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import java.util.HashMap; 4 | import java.util.Set; 5 | import java.util.Map; 6 | import java.util.Iterator; 7 | import geex.ISeed; 8 | import java.lang.RuntimeException; 9 | import clojure.lang.PersistentVector; 10 | import clojure.lang.Keyword; 11 | 12 | public class Dependencies { 13 | private static Keyword depScopeKey 14 | = Keyword.intern("depending-scope"); 15 | 16 | private HashMap _deps 17 | = new java.util.HashMap(); 18 | 19 | public void addDep(Object key, ISeed val) { 20 | if (!SeedUtils.isRegistered(val)) { 21 | throw new RuntimeException("Seed must be registered before it can be added as a dependency."); 22 | } 23 | _deps.put(key, val); 24 | } 25 | 26 | public void addGenKey(ISeed val) { 27 | addDep( 28 | PersistentVector.create( 29 | depScopeKey, _deps.size()), 30 | val); 31 | } 32 | 33 | public void addCounted(ISeed val) { 34 | addDep(_deps.size(), val); 35 | } 36 | 37 | public ISeed get(Object key) { 38 | return _deps.get(key); 39 | } 40 | 41 | public ISeed[] toArray() { 42 | int n = _deps.size(); 43 | ISeed[] dst = new ISeed[n]; 44 | for (int i = 0; i < n; i++) { 45 | dst[i] = getOrError(Long.valueOf(i)); 46 | } 47 | return dst; 48 | } 49 | 50 | public int countIndexedArgs() { 51 | int counter = 0; 52 | while (_deps.get(Long.valueOf(counter)) != null) { 53 | counter++; 54 | } 55 | return counter; 56 | } 57 | 58 | public Object[] compilationResultsToArray() { 59 | int n = countIndexedArgs(); 60 | Object[] dst = new Object[n]; 61 | for (int i = 0; i < n; i++) { 62 | dst[i] = getOrError(Long.valueOf(i)) 63 | .getState().getCompilationResult(); 64 | } 65 | return dst; 66 | } 67 | 68 | public ISeed getOrError(Object key) { 69 | ISeed result = _deps.get(key); 70 | if (result == null) { 71 | throw new RuntimeException( 72 | "No dep at '" + key.toString() + "'"); 73 | } 74 | return result; 75 | } 76 | 77 | public void addReferentsFromId(int id) { 78 | Set set = _deps.entrySet(); 79 | Iterator iterator = set.iterator(); 80 | while(iterator.hasNext()) { 81 | Map.Entry mentry = (Map.Entry)iterator.next(); 82 | Object key = mentry.getKey(); 83 | ISeed value = (ISeed)mentry.getValue(); 84 | value.refs().add(key, id); 85 | } 86 | } 87 | 88 | static String indent = " "; 89 | 90 | public void disp() { 91 | if (!_deps.isEmpty()) { 92 | String dst = indent + "Deps on"; 93 | Set set = _deps.entrySet(); 94 | Iterator iterator = set.iterator(); 95 | while(iterator.hasNext()) { 96 | Map.Entry mentry = (Map.Entry)iterator.next(); 97 | ISeed value = (ISeed)mentry.getValue(); 98 | dst += " " + value.getId(); 99 | } 100 | System.out.println(dst); 101 | } 102 | } 103 | 104 | public HashMap getMap() { 105 | return _deps; 106 | } 107 | 108 | public HashMap getCompilationResults() { 109 | HashMap dst 110 | = new HashMap(); 111 | Set set = _deps.entrySet(); 112 | Iterator iterator = set.iterator(); 113 | while(iterator.hasNext()) { 114 | Map.Entry mentry = (Map.Entry)iterator.next(); 115 | Object key = mentry.getKey(); 116 | ISeed value = (ISeed)mentry.getValue(); 117 | dst.put(key, value.getState().getCompilationResult()); 118 | } 119 | return dst; 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /test/examples/ad_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.ad-test 2 | (:require [geex.common :as lib] 3 | [geex.core :as core] 4 | [geex.java :as java] 5 | [clojure.test :refer :all])) 6 | 7 | ;;;------- Constructing ad numbers ------- 8 | 9 | ;; Forward-mode automatic differentiation using dual numbers 10 | (defn ad [x dx] 11 | {:x x :dx dx}) 12 | 13 | ;; An automatically differentiable number representing the variable 14 | ;; we are differentiating. Its derivative is 1.0 15 | (defn variable [x] 16 | (ad x 1.0)) 17 | 18 | ;; A constant has derivative 0.0 19 | (defn constant [x] 20 | (ad x 0.0)) 21 | 22 | 23 | ;;;------- Common operations ------- 24 | 25 | ;; These functions take automatically differentiable numbers 26 | ;; and return new automatically differentiable numbers 27 | (defn add [a b] 28 | {:x (lib/+ (:x a) (:x b)) 29 | :dx (lib/+ (:dx a) (:dx b))}) 30 | 31 | (defn sub [a b] 32 | {:x (lib/- (:x a) (:x b)) 33 | :dx (lib/- (:dx a) (:dx b))}) 34 | 35 | (defn mul [a b] 36 | {:x (lib/* (:x a) (:x b)) 37 | :dx (lib/+ (lib/* (:x a) (:dx b)) 38 | (lib/* (:dx a) (:x b)))}) 39 | 40 | (defn sqr [x] 41 | (mul x x)) 42 | 43 | (defn div [a b] 44 | {:x (lib// (:x a) (:x b)) 45 | :dx (lib// (lib/- (lib/* (:dx a) (:x b)) 46 | (lib/* (:x a) (:dx b))) 47 | (lib/sqr (:x b)))}) 48 | 49 | (defn pow [x n] 50 | {:pre [(number? n)]} 51 | {:x (lib/pow (:x x) n) 52 | :dx (lib/* n (lib/pow (:x x) (dec n)))}) 53 | 54 | 55 | ;;;------- Basic tests of operations ------- 56 | 57 | (deftest test-the-ops 58 | (is (= {:x 7 :dx 2.0} 59 | (java/eval (add (variable 3) (variable 4))))) 60 | (is (= {:x -1 :dx 0.0} 61 | (java/eval 62 | (sub (variable 3) (variable 4))))) 63 | (is (= (java/eval (pow (variable 3.0) 2.0)) 64 | (java/eval (sqr (variable 3.0))))) 65 | (is (= {:x 9 66 | :dx 6.0} 67 | (java/eval 68 | (sqr (variable 3)))))) 69 | 70 | 71 | 72 | ;;;------- Computing the square root ------- 73 | ;; using Newton-Raphson 74 | 75 | ;; Let f(x) = x^2 - k 76 | 77 | ;; The square root of k is th solution of f(x) = 0 78 | ;; f'(x) = 2x 79 | 80 | ;; We will do this: x_{n+1} = x_{n} - (x_{n}^2 - k)/2*x_{n} 81 | 82 | ;; This is a single iteration in the Newton-Raphson algorithm 83 | (defn sqrt-iteration [k x] 84 | (sub x (div (sub (sqr x) k) 85 | (mul (constant 2) x)))) 86 | 87 | ;; This performs n iterations 88 | (defn iterate-sqrt [n k x] 89 | (last (take n (iterate (partial sqrt-iteration k) x)))) 90 | 91 | 92 | ;; This is a loop-unrolled implementation of the square root 93 | (java/typed-defn sqrt-with-derivative [Double/TYPE x] 94 | (iterate-sqrt 10 (variable x) (constant x))) 95 | 96 | 97 | ;; This is a loop-based implementation of the square root 98 | (defn iterate-sqrt2 [n k x] 99 | (lib/iterate-while 100 | [(lib/wrap 0) (add x (variable (lib/wrap 0.0)))] 101 | (fn [[counter est]] 102 | [(lib/inc counter) 103 | (sqrt-iteration k est)]) 104 | (fn [[counter _]] 105 | (lib/< counter 10)))) 106 | 107 | 108 | ;; Using a loop 109 | (java/typed-defn 110 | sqrt-with-derivative2 [Double/TYPE x] 111 | ;;(core/set-flag! :disp :disp-time) 112 | (second 113 | (iterate-sqrt2 13 (variable x) (constant x)))) 114 | 115 | 116 | (defn expected-sqrt [x] 117 | {:x (Math/sqrt x) 118 | :dx (/ 0.5 (Math/sqrt x))}) 119 | 120 | (defn aeq [a b] 121 | (< (Math/abs (- a b)) 1.0e-6)) 122 | 123 | (defn almost-eq [a b] 124 | (and (aeq (:x a) (:x b)) 125 | (aeq (:dx a) (:dx b)))) 126 | 127 | 128 | (deftest sqrt-test 129 | (is (aeq 3.34 3.340000003)) 130 | (is (not (aeq 3.34 3.3403))) 131 | (is (map? (java/eval (sqrt-iteration (variable 2) 132 | (constant 3))))) 133 | (is (almost-eq (sqrt-with-derivative 2.0) 134 | (expected-sqrt 2.0))) 135 | (is (almost-eq (sqrt-with-derivative2 2.0) 136 | (expected-sqrt 2.0)))) 137 | 138 | 139 | 140 | 141 | 142 | -------------------------------------------------------------------------------- /test/examples/covariance_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.covariance-test 2 | (:require [geex.common :as c] 3 | [geex.java :as java] 4 | [geex.core :as gx] 5 | [clojure.test :refer :all])) 6 | 7 | (defn column-vector-from-array [arr] 8 | {:rows (c/count arr) 9 | :cols 1 10 | :get (fn [i j] (c/aget arr i))}) 11 | 12 | (defn numel [mat] 13 | (c/* (:rows mat) 14 | (:cols mat))) 15 | 16 | (defn compute-index [rows i j] 17 | (c/+ i (c/* rows j))) 18 | 19 | (defn realize [mat] 20 | "Evalutes all the elements of the input matrix and puts them in an array, then forms a new matrix referring to that array" 21 | (let [n (numel mat) 22 | dst-array (c/make-array Double/TYPE n) 23 | rows (:rows mat) 24 | cols (:cols mat) 25 | get-element (:get mat)] 26 | (c/doseq [i (c/range rows)] 27 | (c/doseq [j (c/range cols)] 28 | (c/aset dst-array (compute-index rows i j) (get-element i j)))) 29 | {:rows rows 30 | :cols cols 31 | :data dst-array 32 | :get (fn [i j] (c/aget dst-array (compute-index rows i j)))})) 33 | 34 | (defn export 35 | "Remove the :get function, because code cannot be generated from functions" 36 | [mat] 37 | (dissoc mat :get)) 38 | 39 | 40 | (defn reshape [column-matrix new-rows] 41 | "Changes a shape of a column matrix" 42 | (let [new-cols (c// (:rows column-matrix) new-rows) 43 | g (:get column-matrix)] 44 | {:rows new-rows 45 | :cols new-cols 46 | :get (fn [i j] (g (c/+ i (c/* j new-rows)) 0))})) 47 | 48 | (defn transpose [mat] 49 | (let [g (:get mat)] 50 | {:rows (:cols mat) 51 | :cols (:rows mat) 52 | :get (fn [i j] (g j i))})) 53 | 54 | (defn sub-mat [a b] 55 | (let [ga (:get a) 56 | gb (:get b)] 57 | {:rows (:rows a) 58 | :cols (:cols a) 59 | :get (fn [i j] (c/- (ga i j) (gb i j)))})) 60 | 61 | (defn mul-mat [a b] 62 | (c/check (c/= (:cols a) (:rows b)) "Not matching") 63 | (let [ga (:get a) 64 | gb (:get b)] 65 | {:rows (:rows a) 66 | :cols (:cols b) 67 | :get (fn [i j] 68 | (c/transduce 69 | (c/map (fn [k] (c/* (ga i k) (gb k j)))) 70 | c/+ 71 | 0.0 72 | (c/range (:cols a))))})) 73 | 74 | (defn ones [rows cols] 75 | {:rows rows 76 | :cols cols 77 | :get (constantly 1.0)}) 78 | 79 | (defn scale-mat [scale mat] 80 | (update mat :get (fn [g] (fn [i j] (c/* scale (g i j)))))) 81 | 82 | (java/typed-defn covariance-matrix [Long/TYPE vector-dim 83 | (c/array-type Double/TYPE) vector-data] 84 | (let [V (column-vector-from-array vector-data) 85 | X (reshape V vector-dim) 86 | N (c// (c/count vector-data) vector-dim) 87 | mu (realize 88 | (scale-mat (c// 1.0 N) 89 | (mul-mat (ones 1 N) 90 | (transpose X)))) 91 | mu-repeated (transpose (mul-mat (ones N 1) mu)) 92 | Xc (sub-mat X mu-repeated) 93 | covariance (scale-mat (c// 1.0 (c/- N 1)) 94 | (mul-mat Xc (transpose Xc)))] 95 | (-> covariance 96 | realize 97 | export))) 98 | 99 | (defn run [problem] 100 | (covariance-matrix (:dim problem) (:data problem))) 101 | 102 | 103 | (def test-data [0.5620938465270469 0.20255148746782325 0.9304891585463975 0.5976239522459676 0.602334851715159 0.8828064344295988]) 104 | 105 | ;; Octave 106 | ;; >> v = [0.5620938465270469 0.20255148746782325; 0.9304891585463975 0.5976239522459676; 0.602334851715159 0.8828064344295988] 107 | ;; v = 108 | 109 | ;; 0.56209 0.20255 110 | ;; 0.93049 0.59762 111 | ;; 0.60233 0.88281 112 | 113 | ;; >> cov(v) 114 | ;; ans = 115 | 116 | ;; 0.040837 0.013222 117 | ;; 0.013222 0.116693 118 | 119 | (def expected [0.040837 0.013222 0.013222 0.116693]) 120 | 121 | 122 | (deftest covariance-matrix-test 123 | (let [computed-covariance (vec (:data (covariance-matrix 2 (double-array test-data))))] 124 | (is (= (count computed-covariance) 125 | (count expected))) 126 | (doseq [[a b] (map vector computed-covariance expected)] 127 | (is (< (Math/abs (- a b)) 1.0e-5))))) 128 | -------------------------------------------------------------------------------- /src/java/geex/AFn.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import java.lang.RuntimeException; 4 | import clojure.lang.IFn; 5 | import clojure.lang.ISeq; 6 | 7 | public class AFn implements IFn { 8 | 9 | 10 | public Object throwArity() { 11 | throw new RuntimeException("Wrong number of arguments to " 12 | + toString()); 13 | } 14 | 15 | public Object call() { 16 | return throwArity(); 17 | } 18 | 19 | public void run(){ 20 | throw new UnsupportedOperationException(); 21 | } 22 | 23 | public Object invoke() {return throwArity();} 24 | 25 | public Object invoke(Object arg1) {return throwArity();} 26 | 27 | public Object invoke(Object arg1, Object arg2) {return throwArity();} 28 | 29 | public Object invoke(Object arg1, Object arg2, Object arg3) {return throwArity();} 30 | 31 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) {return throwArity();} 32 | 33 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) {return throwArity();} 34 | 35 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) {return throwArity();} 36 | 37 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) 38 | {return throwArity();} 39 | 40 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 41 | Object arg8) {return throwArity();} 42 | 43 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 44 | Object arg8, Object arg9) {return throwArity();} 45 | 46 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 47 | Object arg8, Object arg9, Object arg10) {return throwArity();} 48 | 49 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 50 | Object arg8, Object arg9, Object arg10, Object arg11) {return throwArity();} 51 | 52 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 53 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) {return throwArity();} 54 | 55 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 56 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) {return throwArity();} 57 | 58 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 59 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) 60 | {return throwArity();} 61 | 62 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 63 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 64 | Object arg15) {return throwArity();} 65 | 66 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 67 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 68 | Object arg15, Object arg16) {return throwArity();} 69 | 70 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 71 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 72 | Object arg15, Object arg16, Object arg17) {return throwArity();} 73 | 74 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 75 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 76 | Object arg15, Object arg16, Object arg17, Object arg18) {return throwArity();} 77 | 78 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 79 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 80 | Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) {return throwArity();} 81 | 82 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 83 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 84 | Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) 85 | {return throwArity();} 86 | 87 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 88 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 89 | Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, 90 | Object... args) 91 | {return throwArity();} 92 | 93 | public Object applyTo(ISeq arglist) {return throwArity();} 94 | } 95 | -------------------------------------------------------------------------------- /src/clj/geex/graphviz.clj: -------------------------------------------------------------------------------- 1 | (ns geex.graphviz 2 | (:import [java.io File] 3 | [java.awt Desktop]) 4 | (:require [clojure.spec.alpha :as spec] 5 | [bluebell.utils.wip.specutils :as specutils] 6 | [clojure.java.io :as io] 7 | [clojure.string :as cljstr] 8 | [clojure.reflect :as reflect] 9 | [clojure.java.shell :as shell])) 10 | 11 | (spec/def ::out-graphviz string?) 12 | (spec/def ::out-pdf string?) 13 | (spec/def ::disp? boolean?) 14 | (spec/def ::lower number?) 15 | (spec/def ::upper number?) 16 | (spec/def ::fontname string?) 17 | 18 | (spec/def ::settings 19 | (spec/keys :req-un [] 20 | :opt-un [::out-graphviz 21 | ::lower 22 | ::upper 23 | ::out-pdf 24 | ::disp? 25 | ::fontname])) 26 | 27 | (defn get-lower [state settings] 28 | (or (:lower settings) 0)) 29 | 30 | (defn get-upper [state settings] 31 | (or (:upper settings) (.getUpper state))) 32 | 33 | (defn get-out-graphviz [settings] 34 | (or (:out-graphviz settings) 35 | (.getAbsolutePath 36 | (File/createTempFile "geex" ".dot")))) 37 | 38 | (defn generate-out-pdf-file [file] 39 | {:pre [(string? file)]} 40 | (let [p file 41 | i (cljstr/last-index-of p ".")] 42 | (str 43 | (if (nil? i) 44 | p 45 | (str (subs p 0 i))) 46 | ".pdf"))) 47 | 48 | (defn get-out-pdf [out-graphviz settings] 49 | (or (:out-pdf settings) 50 | (generate-out-pdf-file out-graphviz))) 51 | 52 | (defn get-seed-label [seed] 53 | (str "\"" 54 | (.getId seed) 55 | "\\n" 56 | (.getType seed) 57 | "\\n" 58 | (.getDescription seed) 59 | "\"")) 60 | 61 | (defn get-seed-key [seed] 62 | (format "seed%d" (.getId seed))) 63 | 64 | (defn render-deps-for-seed [seed-index-set seed] 65 | (let [src (get-seed-key seed) 66 | deps (-> seed 67 | .deps 68 | .getMap) 69 | prev-index (dec (.getId seed)) 70 | add-to-previous? (and (contains? seed-index-set prev-index) 71 | (not (contains? 72 | (->> deps 73 | vals 74 | (map #(.getId %)) 75 | set) 76 | prev-index)))] 77 | (into (transduce 78 | (comp 79 | (filter (fn [[k v]] (contains? seed-index-set (.getId v)))) 80 | (map (fn [[k v]] 81 | (str src " -> " (get-seed-key v) 82 | "[label=\"" (str k) "\"]")))) 83 | conj 84 | [] 85 | deps) 86 | (if add-to-previous? 87 | [src " -> " (str "seed" prev-index)] 88 | [])))) 89 | 90 | (defn font-name-setting [what fn] 91 | (str "\n" what " [fontname=\"" fn "\"]\n")) 92 | 93 | ;; getId, getType, getDescription 94 | (defn get-graphviz-code [state lower upper settings] 95 | (let [seed-range (range lower upper) 96 | seeds (map #(.getSeed state %) seed-range) 97 | seed-code (cljstr/join "\n" 98 | (map 99 | (fn [seed] 100 | (str "\t"(get-seed-key seed) 101 | " [label=" 102 | (get-seed-label seed) 103 | "]")) 104 | seeds)) 105 | dep-code (cljstr/join 106 | "\n" 107 | (transduce 108 | (comp (map (partial render-deps-for-seed 109 | (set seed-range))) 110 | cat) 111 | conj 112 | [] 113 | seeds)) 114 | font-code (if-let [fn (:fontname settings)] 115 | (str (font-name-setting "graph" fn) 116 | (font-name-setting "edge" fn) 117 | (font-name-setting "node" fn)) 118 | "")] 119 | (str "digraph {\n" 120 | font-code 121 | "\nrankdir=BT" 122 | "\n" 123 | seed-code "\n" dep-code "\n}"))) 124 | 125 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 126 | ;;; 127 | ;;; Interface 128 | ;;; 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 130 | (defn callback [settings] 131 | (specutils/validate ::settings settings) 132 | (fn [data] 133 | (let [state (:state data) 134 | lower (get-lower state settings) 135 | upper (get-upper state settings) 136 | out-graphviz (get-out-graphviz settings) 137 | out-pdf (get-out-pdf out-graphviz settings) 138 | disp? (let [d (:disp? settings)] 139 | (or d (nil? d))) 140 | code (get-graphviz-code state lower upper settings)] 141 | (spit out-graphviz code) 142 | (shell/sh "dot" out-graphviz "-T" "pdf" "-o" out-pdf) 143 | (when disp? 144 | (.open (Desktop/getDesktop) 145 | (io/file out-pdf))) 146 | (println "Out graphviz is" out-graphviz) 147 | (println "Out pdf is" out-pdf)))) 148 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Generative Expressions 2 | 3 | Generative Expressions (Geex) is a code generation tool for writing high-level Clojure code that generates fast low-level code. 4 | 5 | ## Example 6 | 7 | Here is an implementation for computing the square-root of a number using [Newton-Raphson](https://en.wikipedia.org/wiki/Newton%27s_method): 8 | ```clj 9 | (ns examples.sqrt-test 10 | (:require [geex.common :as c] 11 | [geex.java :as java] 12 | [geex.core :as gx] 13 | [clojure.test :refer :all])) 14 | 15 | (defn sqrt-iteration [k x] 16 | (c/- x (c// (c/- (c/* x x) k) 17 | (c/* 2.0 x)))) 18 | 19 | (java/typed-defn unrolled-sqrt [Double/TYPE x] 20 | 21 | ;; Display time and generated code: 22 | (gx/set-flag! :disp :disp-time :format) 23 | 24 | (->> x 25 | (iterate (partial sqrt-iteration x)) 26 | (take 10) 27 | last)) 28 | ``` 29 | which results in a function ```unrolled-sqrt``` that we can call: 30 | ```clj 31 | (unrolled-sqrt 2.0) 32 | ;; => 1.4142135623730951 33 | ``` 34 | 35 | This is the code that was generated in order to produce this function: 36 | ```java 37 | package examples_psqrt_dtest; 38 | 39 | public class TypedDefn__unrolled_dsqrt { 40 | /* Various definitions */ 41 | public double apply(final double arg00) { 42 | final double s0012 = (arg00 - (((arg00 * arg00) - arg00) / (2.0 * arg00))); 43 | final double s0018 = (s0012 - (((s0012 * s0012) - arg00) / (2.0 * s0012))); 44 | final double s0024 = (s0018 - (((s0018 * s0018) - arg00) / (2.0 * s0018))); 45 | final double s0030 = (s0024 - (((s0024 * s0024) - arg00) / (2.0 * s0024))); 46 | final double s0036 = (s0030 - (((s0030 * s0030) - arg00) / (2.0 * s0030))); 47 | final double s0042 = (s0036 - (((s0036 * s0036) - arg00) / (2.0 * s0036))); 48 | final double s0048 = (s0042 - (((s0042 * s0042) - arg00) / (2.0 * s0042))); 49 | final double s0054 = (s0048 - (((s0048 * s0048) - arg00) / (2.0 * s0048))); 50 | return (s0054 - (((s0054 * s0054) - arg00) / (2.0 * s0054))); 51 | } 52 | } 53 | ``` 54 | 55 | ## Getting started 56 | 57 | Geex can be obtained as a Maven dependency, so in your Leiningen project, you just have to add the line 58 | ```clj 59 | [geex "0.11.0"] 60 | ``` 61 | 62 | ## Tutorial 63 | 64 | There is a *work-in-progress and incomplete* [tutorial](doc/tutorial.md) that you can read. 65 | 66 | You can also try it out by cloning this repository and looking at [the examples](test/examples), such as 67 | * How to [compute the square root](test/examples/sqrt_test.clj) using Newton-Raphson 68 | * Forward-mode [automatic differentiation](test/examples/ad_test.clj) 69 | * [Circle fitting](test/examples/circle_fit_test.clj) 70 | * [Expression templates](test/examples/expr_templates_test.clj) on vectors à la C++ 71 | * More [matrix operations](test/examples/matrix_test.clj) (without expression templates). 72 | * [Covariance matrix](test/examples/covariance_test.clj) computation. 73 | * [Another circle fitting](test/examples/cljd_circle_test.clj) example making use of operator overloading. 74 | * Naïve [N-body simulation](test/examples/nbody_test.clj). 75 | 76 | ## Benchmark 77 | 78 | To assess the effectiveness of this approach, we tried to estimate the parameters of a circle (centre x and y position, and radius) from a set of 2D observations. We do this by formulating an objective function that is minimized using gradient descent. The gradient is computed using forward mode automatic differentiation. 79 | 80 | This algorithm was implemented in high-level [Java](https://github.com/jonasseglare/cljd2019/blob/master/srcjava/cljd/CircleOpt.java), [C++](https://github.com/jonasseglare/cljd2019/blob/master/cpp/circleopt.cpp), and [Clojure](https://github.com/jonasseglare/cljd2019/blob/master/src/cljd/circle.clj) (with and without Geex). The computation times were measured for varying numbers of points to which we fit the circle parameters. 81 | 82 | Plotting the computation time as a function of number of circle points results in this plot: 83 | 84 | 85 | 86 | 87 | Specifically, for 19307 points, we get these computations times: 88 | 89 | 90 | 91 | Please note that these tests measure *high-level* implementations that *have not been optimized*. There is room for error. You may get other results than I do, depending on your setup. 92 | 93 | ## API Reference 94 | 95 | The API reference documentation can be found at [cljdoc.org](https://cljdoc.org/d/geex/geex/CURRENT). 96 | 97 | ### Module structure 98 | If you add ```[lein-ns-dep-graph "0.2.0-SNAPSHOT"]``` to your Leiningen plugins, this graph can be generated using ```lein ns-dep-graph```: 99 | ![Module graph](ns-dep-graph.png) 100 | 101 | ```geex.core``` contains the core components of code generation and analysis. 102 | 103 | ```geex.common``` is a library of common operations. 104 | 105 | ```geex.java``` contains specific support for the Java platform. 106 | 107 | ## Contributions 108 | 109 | You can contribute by filing bug issues. Fixing minor issues such as failing builds for different platforms is also important. 110 | 111 | ## License 112 | 113 | Copyright © 2019 Jonas Östlund 114 | 115 | Distributed under the Eclipse Public License either version 1.0 or (at 116 | your option) any later version. 117 | -------------------------------------------------------------------------------- /test/geex/resolved_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.resolved-test 2 | (:import [java.util ArrayList]) 3 | (:require [geex.core :as core] 4 | [geex.java :as java] 5 | [geex.common :as c] 6 | [geex.core.seed :as seed] 7 | [clojure.test :refer :all])) 8 | 9 | 10 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11 | ;;; 12 | ;;; This file is for tests that previously did not work 13 | ;;; 14 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15 | 16 | 17 | ;;; This is the one that does not work. 18 | (java/typed-defn find-index 19 | [(c/array-type Integer/TYPE) data 20 | Integer/TYPE value] 21 | (let [len (c/count data)] 22 | (core/Loop 23 | [index 0] 24 | (core/If 25 | (c/= index len) 26 | -1 27 | (let [x (c/aget data index)] 28 | (core/If (c/= x value) 29 | (c/+ 1000 index) 30 | (core/Recur (c/inc index)))))))) 31 | 32 | 33 | (deftest nested-if-problem 34 | (doseq [[number-to-find expected] (map vector 35 | [0 1 2 3 4 5 6] 36 | [-1 -1 1000 1001 1002 -1 -1])] 37 | (is (= expected (find-index (int-array [2 3 4]) 38 | number-to-find))))) 39 | 40 | 41 | (java/typed-defn set-element [] 42 | (let [dst (c/make-array Float/TYPE 1)] 43 | (c/aset dst 0 (float 3.0)))) 44 | 45 | (java/typed-defn nth-char [Long/TYPE n] 46 | (c/nth "mjao" n)) 47 | 48 | (deftest nth-char-test 49 | (is (= \j (nth-char 1)))) 50 | 51 | (def n 30) 52 | 53 | (java/typed-defn setter-test [] 54 | ;(core/set-flag! :disp :format :disp-trace) 55 | (let [dst (java/new ArrayList)] 56 | (c/doseq [i (c/range n)] 57 | (let [i (java/cast-to-int i)] 58 | (java/call-method "add" dst i nil))) 59 | dst)) 60 | 61 | (deftest calling-void-test 62 | (let [out (setter-test)] 63 | (is (= 30 (count out))) 64 | (is (every? nil? out)))) 65 | 66 | (deftest extends-test 67 | (let [c (java/make-class 68 | {:name "MyExtension" 69 | :extends geex.test.Add1ToSomething})] 70 | (is (= 119.0 (.add1 (.newInstance c)))))) 71 | 72 | (java/typed-defn 73 | disp-it [String s] 74 | (let [out (java/system-out)] 75 | (out 'println s))) 76 | 77 | (java/typed-defn type-checks [] 78 | (assert (= Integer/TYPE 79 | (seed/datatype 80 | (c/inc 81 | (c/wrap (int 0)))))) 82 | (c/doseq [i (c/range (int 3))] 83 | (assert (= Integer/TYPE 84 | (seed/datatype i)))) 85 | (let [x (c/* (c/wrap (int 3)) 86 | (int 4))] 87 | (assert (= Integer/TYPE 88 | (seed/datatype x))))) 89 | 90 | (java/typed-defn decorate [clojure.lang.IPersistentMap m] 91 | (m 'assoc :kattskit 3)) 92 | 93 | (deftest better-java-interop-test 94 | (is (= (decorate {}) 95 | {:kattskit 3}))) 96 | 97 | (java/typed-defn boxed-long-str [Long x] 98 | (c/to-string x)) 99 | 100 | (java/typed-defn primitive-long-str [Long/TYPE x] 101 | (c/to-string x)) 102 | 103 | 104 | (java/typed-defn cat-longs [Long/TYPE a 105 | Long/TYPE b] 106 | (c/str a b)) 107 | 108 | (java/typed-defn cat-longs2 [Long/TYPE b] 109 | (c/str 3 b)) 110 | 111 | (deftest various-string-tests 112 | (is (= "3" (boxed-long-str 3))) 113 | (is (= "3" (primitive-long-str 3))) 114 | (is (= "3" (c/to-string 3))) 115 | (is (= "34" (cat-longs 3 4))) 116 | (is (= "34" (cat-longs2 4))) 117 | (is (= "34" (c/str 3 4)))) 118 | 119 | 120 | 121 | (defn fib [] 122 | (c/iterate 123 | (fn [[a b]] 124 | [b (c/+ a b)]) 125 | [0 1])) 126 | 127 | (java/typed-defn iter-fn [] 128 | (let [s (fib)] 129 | (-> s 130 | c/rest 131 | c/rest 132 | c/rest 133 | c/rest 134 | c/rest 135 | c/first))) 136 | 137 | (java/typed-defn iter-fn-empty? [] 138 | (c/empty? (fib))) 139 | 140 | (java/typed-defn 141 | smallest-fib100 [] 142 | ;(core/set-flag! :disp :format) 143 | (core/Loop [s (c/map first (fib))] 144 | (let [x (c/first s)] 145 | (core/If (c/< 100 x) 146 | x 147 | (core/Recur (c/rest s)))))) 148 | 149 | (deftest iterate-test 150 | (is (= (iter-fn) [5 8])) 151 | (is (not (iter-fn-empty?))) 152 | (is (= 144 (smallest-fib100)))) 153 | 154 | 155 | (java/typed-defn drop-while-too-small 156 | [(c/array-type Double/TYPE) arr] 157 | (c/first 158 | (c/drop-while 159 | #(c/< % 10) 160 | arr))) 161 | 162 | (java/typed-defn drop-while-tr [(c/array-type Double/TYPE) arr] 163 | (c/transduce 164 | (c/drop-while #(c/< % 10)) 165 | c/+ 166 | 0.0 167 | arr)) 168 | 169 | (deftest drop-while-test 170 | (is (= 13.0 (drop-while-too-small 171 | (double-array [1 2 4 13 545])))) 172 | (is (= 45.0 (drop-while-tr (double-array [0 11 34]))))) 173 | 174 | (java/typed-defn sum-with-look-ahead [(c/array-type Double/TYPE) x] 175 | (c/reduce 176 | c/+ 177 | 0.0 178 | (c/look-ahead-seq x))) 179 | 180 | (deftest look-ahead-sum-test 181 | (is (= 15.0 (sum-with-look-ahead (double-array [1 2 3 4 5]))))) 182 | 183 | 184 | (java/typed-defn sum-of-odd [(c/array-type Double/TYPE) x] 185 | ;(core/set-flag! :format :disp) 186 | (c/reduce 187 | c/+ 188 | 0.0 189 | (c/filter c/odd? x))) 190 | 191 | (deftest odd-sum-test 192 | (is (= 9.0 (sum-of-odd (double-array [1 2 3 4 5]))))) 193 | 194 | (java/typed-defn exotic-numbers [] 195 | [[Double/NaN 196 | Double/POSITIVE_INFINITY 197 | Double/NEGATIVE_INFINITY] 198 | [Float/NaN 199 | Float/POSITIVE_INFINITY 200 | Float/NEGATIVE_INFINITY]]) 201 | 202 | (deftest exotic-number-test 203 | (let [nums (exotic-numbers)] 204 | (is (= 2 (count nums))) 205 | (doseq [[nan pos-inf neg-inf] nums] 206 | (is (Double/isNaN nan)) 207 | (is (Double/isInfinite pos-inf)) 208 | (is (Double/isInfinite neg-inf)) 209 | (is (< neg-inf 0)) 210 | (is (< 0 pos-inf))))) 211 | -------------------------------------------------------------------------------- /src/clj/geex/core/datatypes.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core.datatypes 2 | (:require [clojure.spec.alpha :as spec] 3 | [clojure.reflect :as r] 4 | [clojure.string :as cljstr] 5 | [clojure.set :as cljset]) 6 | (:refer-clojure :exclude [void char boolean byte short int long float double])) 7 | 8 | 9 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 | ;;; 11 | ;;; Declarations 12 | ;;; 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | (declare box-class) 15 | (declare unbox-class) 16 | 17 | 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | ;;; 20 | ;;; Sample values 21 | ;;; 22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 | 24 | 25 | (defn add-sample-type [dst x] 26 | (assoc dst (class x) x)) 27 | 28 | (def sample-type-map (reduce add-sample-type 29 | {} 30 | [34.0 31 | (clojure.core/float 3.4) 32 | false 33 | 34 34 | (bigint 34) 35 | (bigdec 34.0) 36 | 3/4 37 | (clojure.core/byte 3) 38 | (clojure.core/short 3) 39 | (clojure.core/int 3) 40 | \a 41 | :a])) 42 | 43 | (defn array-class-of-type [tp] 44 | (class (make-array tp 0))) 45 | 46 | (def array-class array-class-of-type) 47 | 48 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 49 | ;;; 50 | ;;; Java arrays 51 | ;;; 52 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 53 | 54 | (defn get-sample-value [x] 55 | (or (get sample-type-map x) 56 | (get sample-type-map (box-class x)))) 57 | 58 | (defn query-return-type [f args] 59 | (let [samples (map get-sample-value args)] 60 | (try 61 | (if (every? (complement nil?) samples) 62 | (unbox-class (class (apply f samples)))) 63 | (catch Throwable e nil)))) 64 | 65 | 66 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 67 | ;;; 68 | ;;; For identifying things 69 | ;;; 70 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71 | 72 | 73 | (defn boxed-type-symbol [name] 74 | (symbol (str "java.lang." name))) 75 | 76 | (defn unboxed-type-symbol [name] 77 | (symbol (str "java.lang." name "/TYPE"))) 78 | 79 | (defn make-primitive-type-info [name] 80 | (eval {:unboxed-name name 81 | :unboxed-type (unboxed-type-symbol name) 82 | :boxed-type (boxed-type-symbol name)})) 83 | 84 | (def unboxable-type-names 85 | ["Float" 86 | "Double" 87 | "Character" 88 | "Short" 89 | "Integer" 90 | "Long" 91 | "Boolean" 92 | "Void"]) 93 | 94 | (def primitive-type-list 95 | (map make-primitive-type-info 96 | unboxable-type-names)) 97 | 98 | (def boxed-primitives (set (map :boxed-type primitive-type-list))) 99 | 100 | (def common-boxed-numbers 101 | #{Float Double 102 | Character Byte 103 | Short Integer Long}) 104 | 105 | (def boxed-to-unboxed-map (into {} (map (fn [p] 106 | [(:boxed-type p) (:unboxed-type p)]) 107 | primitive-type-list))) 108 | 109 | (def unboxed-to-boxed-map (into {} (map (fn [p] 110 | [(:unboxed-type p) (:boxed-type p)]) 111 | primitive-type-list))) 112 | 113 | (defn unbox-class [x] 114 | (or (get boxed-to-unboxed-map x) x)) 115 | 116 | (defn box-class [x] 117 | (or (get unboxed-to-boxed-map x) x)) 118 | 119 | (defn unboxed-class-of [value] 120 | (-> value 121 | class 122 | unbox-class)) 123 | 124 | (defmacro inject-type-defs [] 125 | `(do 126 | ~@(map (fn [info] 127 | `(def 128 | ~(symbol (.getName (:unboxed-type info))) 129 | ~(unboxed-type-symbol (:unboxed-name info)))) 130 | primitive-type-list))) 131 | 132 | (def unboxed-type-set (into #{} (map :unboxed-type primitive-type-list))) 133 | 134 | (defn unboxed-type? [x] 135 | {:pre [(class? x)]} 136 | (contains? unboxed-type-set x)) 137 | 138 | (defn component-type [array-class] 139 | (.getComponentType array-class)) 140 | 141 | (def boxed-type? (complement unboxed-type?)) 142 | 143 | 144 | 145 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 146 | ;;; 147 | ;;; Type rules for operators 148 | ;;; 149 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 150 | ;;; See this page: 151 | ;;; https://www.math.uni-hamburg.de/doc/java/tutorial/java/nutsandbolts/arithmetic.html 152 | (def float-or-double #{Double/TYPE Float/TYPE}) 153 | 154 | 155 | 156 | 157 | ;;;; Encodes the result type of 158 | ;;;; + - * / % 159 | (defn binary-math-op-result-type [a b] 160 | {:pre [(unboxed-type? a) 161 | (unboxed-type? b)]} 162 | (let [ab (set [a b]) 163 | has-long? (contains? ab Long/TYPE) 164 | has-float? (not (empty? (cljset/intersection 165 | ab float-or-double)))] 166 | (cond 167 | (and has-long? (not has-float?)) Long/TYPE 168 | (not has-float?) Integer/TYPE 169 | (contains? ab Double/TYPE) Double/TYPE 170 | (contains? ab Float/TYPE) Float/TYPE 171 | :default 172 | (throw 173 | (ex-info 174 | "Failed to resolve return type for math operator" 175 | {:a a 176 | :b b}))))) 177 | 178 | (defn unary-plus-minus-result-type [x] 179 | {:pre [(unboxed-type? x)]} 180 | (if (contains? #{Byte/TYPE Short/TYPE Character/TYPE} 181 | x) 182 | Integer/TYPE 183 | x)) 184 | 185 | 186 | (defn math-op-result-type [args] 187 | {:pre [(sequential? args)]} 188 | (case (count args) 189 | 0 (throw (ex-info "Without any arguments the result type is undefined")) 190 | 1 (unary-plus-minus-result-type (first args)) 191 | (reduce binary-math-op-result-type args))) 192 | 193 | ;; https://en.wikipedia.org/wiki/Bitwise_operation#Shifts_in_Java 194 | ;; 195 | ;; https://en.wikiversity.org/wiki/Advanced_Java/Bitwise_Operators#Bitwise_Operations 196 | ;; 197 | ;; (Note that the operands can be any integral type; but if it is a type smaller than int, it will be promoted to an int type, and the result will be int 198 | 199 | 200 | (def integer-types 201 | [ 202 | Byte/TYPE 203 | Character/TYPE 204 | Short/TYPE 205 | Integer/TYPE 206 | Long/TYPE 207 | ]) 208 | 209 | (def primitive-number-types 210 | [ 211 | Byte/TYPE 212 | Short/TYPE 213 | Integer/TYPE 214 | Long/TYPE 215 | Character/TYPE 216 | Double/TYPE 217 | Float/TYPE 218 | ]) 219 | 220 | (def int-type-to-rank (zipmap integer-types 221 | (range (count integer-types)))) 222 | 223 | (def rank-to-int-type (zipmap (range (count integer-types)) 224 | integer-types)) 225 | 226 | (defn bit-op-result-type [input-types] 227 | {:pre [(sequential? input-types) 228 | (every? (partial contains? int-type-to-rank) 229 | input-types)]} 230 | (get rank-to-int-type 231 | (transduce 232 | (map int-type-to-rank) 233 | (completing max) 234 | (get int-type-to-rank Integer/TYPE) 235 | input-types))) 236 | 237 | (defn array-class? [x] 238 | (and (class? x) 239 | (.isArray x))) 240 | 241 | -------------------------------------------------------------------------------- /test/examples/matrix_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.matrix-test 2 | (:require [clojure.spec.alpha :as spec] 3 | [clojure.test :refer :all] 4 | [geex.common :as l] 5 | [geex.java :as java] 6 | [geex.core :as core])) 7 | 8 | (spec/def ::rows any?) 9 | (spec/def ::cols any?) 10 | (spec/def ::data any?) 11 | (spec/def ::matrix (spec/keys :req-un [::rows ::cols ::data])) 12 | 13 | (def matrix? (partial spec/valid? ::matrix)) 14 | 15 | (defn compute-index [matrix i j] 16 | (l/cast Integer/TYPE 17 | (l/+ i (l/* j (:rows matrix))))) 18 | 19 | (defn get-element [matrix i j] 20 | {:pre [(matrix? matrix)]} 21 | (l/aget (:data matrix) (compute-index matrix i j))) 22 | 23 | (defn set-element [matrix i j x] 24 | {:pre [(matrix? matrix)]} 25 | (l/aset (:data matrix) 26 | (compute-index matrix i j) x)) 27 | 28 | (defn compute-mat-mul-element [A B i j] 29 | (l/reduce 30 | (fn [sum k] 31 | (l/+ sum 32 | (l/* (get-element A i k) 33 | (get-element B k j)))) 34 | (l/wrap 0.0) 35 | (l/range (:cols A)))) 36 | 37 | (defn allocate-matrix [rows cols] 38 | {:rows rows 39 | :cols cols 40 | :data (l/make-array 41 | Double/TYPE 42 | (l/cast 43 | Integer/TYPE 44 | (l/* rows cols)))}) 45 | 46 | (defn multiply-matrices [A B] 47 | (let [rows (:rows A) 48 | cols (:cols B) 49 | C (allocate-matrix rows cols)] 50 | (l/doseq [i (l/range rows)] 51 | (l/doseq [j (l/range cols)] 52 | (set-element 53 | C i j 54 | (compute-mat-mul-element 55 | A B i j)))) 56 | C)) 57 | 58 | (defn transpose [A] 59 | (let [rows (:rows A) 60 | cols (:cols A) 61 | dst (allocate-matrix cols rows)] 62 | (l/doseq [i (l/range rows)] 63 | (l/doseq [j (l/range cols)] 64 | (set-element 65 | dst j i 66 | (get-element A i j)))) 67 | dst)) 68 | 69 | (defn squared-element-sum [A] 70 | (l/reduce 71 | (fn [sum x] 72 | (l/+ sum (l/* x x))) 73 | (l/wrap 0.0) 74 | (l/sliceable-array (:data A)))) 75 | 76 | (defn normalize-matrix-elements [A] 77 | (let [sq-sum (squared-element-sum A) 78 | norm (l/sqrt sq-sum) 79 | factor (l// 1.0 norm) 80 | rows (:rows A) 81 | cols (:cols A) 82 | dst (allocate-matrix rows cols) 83 | ] 84 | 85 | ;;;;; TODO DOESNTB BUILD 86 | (l/doseq [i (l/range rows)] 87 | (l/doseq [j (l/range cols)] 88 | (set-element 89 | dst 90 | i j 91 | (l/* factor 92 | (get-element A i j))))) 93 | dst)) 94 | 95 | 96 | 97 | 98 | 99 | 100 | ;;;------- Testing code ------- 101 | 102 | (def MatrixType {:rows Long/TYPE 103 | :cols Long/TYPE 104 | :data (l/array-type Double/TYPE)}) 105 | 106 | 107 | 108 | (def test-mat {:rows 3 109 | :cols 2 110 | :data (double-array (range 6))}) 111 | ; [0 3; 1 4; 2 5] 112 | 113 | (def test-mat-2 {:rows 2 114 | :cols 3 115 | :data (double-array 116 | [1 9 3 4 4 5])}) 117 | ; [1 3 4; 9 4 5] 118 | 119 | (java/typed-defn sq-elem-sum-fn [MatrixType x] 120 | (squared-element-sum x)) 121 | 122 | (set! *print-length* nil) 123 | 124 | (java/typed-defn normalize-fn [MatrixType x] 125 | ;(core/set-flag! :disp-state) 126 | (normalize-matrix-elements x)) 127 | 128 | (java/typed-defn transpose-fn [MatrixType X] 129 | (transpose X)) 130 | 131 | 132 | ;; Just to check that get-element works 133 | (java/typed-defn 134 | get-element-f 135 | [MatrixType matrix 136 | Long/TYPE i 137 | Long/TYPE j] 138 | (get-element matrix i j)) 139 | 140 | (java/typed-defn 141 | dot-product 142 | [(l/array-type Double/TYPE) A 143 | (l/array-type Double/TYPE) B] 144 | (compute-mat-mul-element 145 | {:rows 1 146 | :cols (l/count A) 147 | :data A} 148 | {:rows (l/count B) 149 | :cols 1 150 | :data B} 151 | 0 0)) 152 | 153 | (java/typed-defn 154 | mat-mul-fn [MatrixType a 155 | MatrixType b] 156 | (multiply-matrices a b)) 157 | 158 | (deftest various-tests 159 | (is (= (get-element-f 160 | {:rows 3 161 | :cols 2 162 | :data 163 | (double-array (range 6))} 164 | 1 1) 165 | 4.0)) 166 | (is (= (vec 167 | (:data 168 | (java/eval 169 | (let [arr (l/make-array Double/TYPE 3) 170 | matrix {:rows 1 171 | :cols 3 172 | :data arr}] 173 | (set-element matrix 0 1 119.0) 174 | matrix)))) 175 | [0.0 119.0 0.0])) 176 | (is (= (dot-product (double-array [1 2 3]) 177 | (double-array [1 2 1])) 178 | 8.0)) 179 | (is (= (sq-elem-sum-fn test-mat) 180 | 55.0)) 181 | (let [m (transpose-fn 182 | {:rows 1 183 | :cols 2 184 | :data (double-array [7 17])})] 185 | (is (= (:rows m) 2)) 186 | (is (= (:cols m) 1)) 187 | (is (= (-> m :data vec) 188 | [7.0 17.0]))) 189 | (let [prod (mat-mul-fn test-mat test-mat-2)] 190 | (is (= 3 (:rows prod))) 191 | (is (= 3 (:cols prod))) 192 | (is (= (vec (:data (mat-mul-fn 193 | test-mat test-mat-2))) 194 | [27.0 37.0 47.0 12.0 19.0 26.0 195 | 15.0 24.0 33.0])))) 196 | 197 | 198 | 199 | 200 | 201 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 202 | ;;; 203 | ;;; Power method 204 | ;;; 205 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 206 | 207 | ;; Computing the maximum eigenvector of a matrix 208 | 209 | ;; This is the matrix we will be testing on. 210 | (def test-mat-3 (mat-mul-fn 211 | test-mat 212 | (transpose-fn test-mat))) 213 | 214 | (defn power-iteration [A X] 215 | (let [Y (multiply-matrices A X) 216 | Yhat (normalize-matrix-elements Y)] 217 | Yhat)) 218 | 219 | (defn initialize-power-iter-vec [n] 220 | (let [dst (allocate-matrix n 1)] 221 | (l/doseq [i (l/range n)] 222 | (set-element dst i 0 1.0)) 223 | dst)) 224 | 225 | (defn power-method [A] 226 | (second 227 | (l/iterate-while 228 | 229 | ;; Initial state 230 | [(l/wrap 0) 231 | (initialize-power-iter-vec (:rows A))] 232 | 233 | ;; Iteration 234 | (fn [[counter X]] 235 | [(l/inc counter) 236 | (power-iteration A X)]) 237 | 238 | ;; Condition for looping 239 | (fn [[counter _]] 240 | (l/< counter 12))))) 241 | 242 | 243 | (java/typed-defn 244 | power-method-fn [MatrixType A] 245 | 246 | ;;(core/set-flag! :disp-time) 247 | 248 | (power-method A)) 249 | 250 | (deftest power-method-test 251 | (let [max-vec (vec (:data 252 | (power-method-fn 253 | test-mat-3))) 254 | 255 | ;; This is the actual 256 | ;; maximum Eigenvector 257 | expected [0.392541 258 | 0.560772 259 | 0.729004]] 260 | 261 | (is (= (count max-vec) 262 | (count expected))) 263 | (doseq [[ours truth] 264 | (map vector max-vec expected)] 265 | (is (< (Math/abs (- ours truth)) 266 | 0.001))))) 267 | ;; 2018-10-02 268 | ;; --- Time report --- 269 | ;; Start: 0.00 270 | ;; Evaluated state: 0.508 271 | ;; Generated code: 0.839 272 | ;; Composed class: 0.839 273 | ;; Formatted code: 0.854 274 | ;; Compiled it: 0.863 275 | 276 | ;; Number of seeds: 423 277 | ;; Time per seed: 0.0020401894905324805 278 | -------------------------------------------------------------------------------- /src/java/geex/ForwardFn.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import clojure.lang.IFn; 4 | import clojure.lang.ISeq; 5 | 6 | public class ForwardFn implements IFn { 7 | private String _error_message; 8 | private IFn _f; 9 | 10 | public void setForwardedFunction(IFn f) { 11 | _f = f; 12 | } 13 | 14 | public ForwardFn(String em) { 15 | _error_message = em; 16 | } 17 | 18 | public ForwardFn(IFn f) { 19 | _f = f; 20 | } 21 | 22 | private IFn f() { 23 | if (_f == null) { 24 | throw new RuntimeException(_error_message); 25 | } 26 | return _f; 27 | } 28 | 29 | public Object call() throws Exception { 30 | return f().invoke(this); 31 | } 32 | 33 | public void run() { 34 | f().invoke(this); 35 | } 36 | 37 | public Object invoke() { 38 | return f().invoke(this); 39 | } 40 | 41 | public Object invoke(Object arg1) { 42 | return f().invoke(this, arg1); 43 | } 44 | 45 | public Object invoke(Object arg1, Object arg2) { 46 | return f().invoke(this, arg1, arg2); 47 | } 48 | 49 | public Object invoke(Object arg1, Object arg2, Object arg3) { 50 | return f().invoke(this, arg1, arg2, arg3); 51 | } 52 | 53 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) { 54 | return f().invoke(this, arg1, arg2, arg3, arg4); 55 | } 56 | 57 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) { 58 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5); 59 | } 60 | 61 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) { 62 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6); 63 | } 64 | 65 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7) 66 | { 67 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7); 68 | } 69 | 70 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 71 | Object arg8) { 72 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); 73 | } 74 | 75 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 76 | Object arg8, Object arg9) { 77 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9); 78 | } 79 | 80 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 81 | Object arg8, Object arg9, Object arg10) { 82 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10); 83 | } 84 | 85 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 86 | Object arg8, Object arg9, Object arg10, Object arg11) { 87 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11); 88 | } 89 | 90 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 91 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) { 92 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12); 93 | } 94 | 95 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 96 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13) 97 | { 98 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13); 99 | } 100 | 101 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 102 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14) 103 | { 104 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14); 105 | } 106 | 107 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 108 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 109 | Object arg15) { 110 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15); 111 | } 112 | 113 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 114 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 115 | Object arg15, Object arg16) { 116 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16); 117 | } 118 | 119 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 120 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 121 | Object arg15, Object arg16, Object arg17) { 122 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17); 123 | } 124 | 125 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 126 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 127 | Object arg15, Object arg16, Object arg17, Object arg18) { 128 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18); 129 | } 130 | 131 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 132 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 133 | Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) { 134 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19); 135 | } 136 | 137 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 138 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 139 | Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20) { 140 | return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20); 141 | } 142 | 143 | 144 | public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7, 145 | Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14, 146 | Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20, 147 | Object... args) { 148 | throw new RuntimeException("This arity is not implemented"); 149 | //return f().invoke(this, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20, args); 150 | } 151 | 152 | public Object applyTo(ISeq arglist) { 153 | return f().applyTo(arglist.cons(this)); 154 | } 155 | } 156 | -------------------------------------------------------------------------------- /test/geex/feature_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.feature-test 2 | (:import [java.util ArrayList] 3 | [java.awt Point]) 4 | (:require [geex.core :as core] 5 | [geex.java :as java] 6 | [geex.common :as c] 7 | [clojure.test :refer :all])) 8 | 9 | (def darr (c/array-type Double/TYPE)) 10 | 11 | ;; New features are tested here 12 | 13 | (java/typed-defn array-call-get [(c/array-type Double/TYPE) x] 14 | (x 1)) 15 | 16 | (java/typed-defn array-call-set [(c/array-type Double/TYPE) x] 17 | (x 1 119.0)) 18 | 19 | (deftest array-call-test 20 | (is (= 34.0 (array-call-get (double-array [9 34 2])))) 21 | (let [dst (double-array [0 0 0])] 22 | (array-call-set dst) 23 | (is (= 119.0 (aget dst 1))))) 24 | 25 | (java/typed-defn 26 | build-array-list [] 27 | (let [dst (java/new ArrayList)] 28 | (dst 'add (java/new Integer (int 3))) 29 | (dst 'add (java/new Integer (int 4))) 30 | (dst 'add (java/new Integer (int 5))) 31 | dst)) 32 | 33 | (deftest method-call-test 34 | (is (= (build-array-list) 35 | [3 4 5]))) 36 | 37 | (java/typed-defn point-to-clojure [Point pt] 38 | [(pt "x") 39 | (pt "y")]) 40 | 41 | (java/typed-defn make-point [] 42 | (let [dst (java/new Point)] 43 | (dst "x" 9) 44 | (dst "y" 20) 45 | dst)) 46 | 47 | (deftest field-access 48 | (is (= (point-to-clojure (Point. 3 4)) 49 | [3 4])) 50 | (is (= (point-to-clojure 51 | (make-point)) 52 | [9 20]))) 53 | 54 | (java/typed-defn get-key-in-map [clojure.lang.IPersistentMap m] 55 | (m :kattskit)) 56 | 57 | (java/typed-defn set-key-in-map [clojure.lang.IPersistentMap m] 58 | (m :kattskit 119)) 59 | 60 | (deftest kwd-access 61 | (is (= 119 (get-key-in-map {:kattskit 119}))) 62 | (is (= {:kattskit 119} (set-key-in-map {})))) 63 | 64 | (java/typed-defn ops-on-a-map [] 65 | (let [rng (c/range 12) 66 | m (c/map c/sqr rng)] 67 | {:count (c/count m) 68 | :first (c/first m) 69 | :first-of-rest-rest (-> m 70 | c/rest 71 | c/rest 72 | c/first) 73 | :fifth (c/nth m 4) ;; zero-based indexing ;-) 74 | :slice-info (let [sliced (c/slice m 7 11)] 75 | {:count (c/count sliced) 76 | :first (c/first sliced)})})) 77 | 78 | (deftest map-test 79 | (is (= (ops-on-a-map) 80 | {:fifth 16, 81 | :slice-info {:count 4, :first 49}, 82 | :count 12, 83 | :first 0, 84 | :first-of-rest-rest 4}))) 85 | 86 | (java/typed-defn every-some-test-fn [] 87 | (let [less-than-10 #(c/< % 10) 88 | at-least-10 (c/complement less-than-10)] 89 | {:a (c/every? 90 | less-than-10 91 | (c/range 5)) 92 | :b (c/every? 93 | less-than-10 94 | (c/range 100)) 95 | :c (c/some 96 | less-than-10 97 | (c/range 100)) 98 | :d (c/some 99 | at-least-10 100 | (c/range 7))})) 101 | 102 | (deftest test-of-every-and-some 103 | (is (= (every-some-test-fn) 104 | {:a true :b false :c true :d false}))) 105 | 106 | (java/typed-defn dot-product [(c/array-type Double/TYPE) a 107 | (c/array-type Double/TYPE) b] 108 | (c/reduce c/+ 0.0 (c/map c/* a b))) 109 | 110 | (deftest dot-product-test 111 | (let [a [3 4 5] 112 | b [9 2 4]] 113 | (is (= (double (apply + (map * a b))) 114 | (dot-product (double-array a) 115 | (double-array b)))))) 116 | 117 | (java/typed-defn equal-integers? [(c/array-type Integer/TYPE) a 118 | (c/array-type Integer/TYPE) b] 119 | (c/every? 120 | identity 121 | (c/map 122 | c/= 123 | a 124 | b))) 125 | 126 | 127 | (deftest int-eq-test 128 | (is (equal-integers? (int-array [1 4 7]) 129 | (int-array [1 4 7]))) 130 | (is (not (equal-integers? (int-array [1 4 8]) 131 | (int-array [1 4 7]))))) 132 | 133 | (java/typed-defn undefined-f [Boolean/TYPE x] 134 | (core/If x 135 | 119.0 136 | ::core/undefined)) 137 | 138 | (deftest undef-test 139 | (is (= 119.0 (undefined-f true))) 140 | (is (= 0.0 (undefined-f false)))) 141 | 142 | (java/typed-defn first-or-whatever [(c/array-type Double/TYPE) x] 143 | (c/first-or-undefined x)) 144 | 145 | (java/typed-defn look-ahead-f [(c/array-type Double/TYPE) x] 146 | (-> x 147 | c/look-ahead-seq 148 | c/rest 149 | c/rest 150 | c/first 151 | )) 152 | 153 | (java/typed-defn only-odd [(c/array-type Double/TYPE) x] 154 | (let [s (c/filter c/odd? x)] 155 | [(c/first s) 156 | (-> s c/rest c/first) 157 | ])) 158 | 159 | (deftest filter-test 160 | (is (= 5.0 (look-ahead-f (double-array [3 4 5 6 ])))) 161 | (is (= {:defined? false :value 0.0} 162 | (first-or-whatever (double-array [])))) 163 | (is (= {:defined? true :value 9.0} 164 | (first-or-whatever (double-array [9])))) 165 | (is (= (only-odd (double-array [1 2 3 4])) 166 | [1.0 3.0]))) 167 | 168 | 169 | 170 | (java/typed-defn drop-comp-lazy [darr x] 171 | (->> x 172 | (c/drop-while c/even?) 173 | (c/drop-while c/odd?) 174 | c/first)) 175 | 176 | (java/typed-defn drop-comp-tr [darr x] 177 | (c/transduce 178 | (comp (c/drop-while #(c/= 2.0 %)) 179 | (c/drop-while #(c/= 1.0 %))) 180 | c/+ 181 | 0.0 182 | x)) 183 | 184 | (deftest lazy-drop-test 185 | (is (= (drop-comp-lazy (double-array [1 2 3 4])) 186 | 2.0)) 187 | (is (= (drop-comp-lazy (double-array [2 3 4 5])) 188 | 4.0))) 189 | 190 | (deftest transduce-drop-test 191 | (is (= 6.0 (drop-comp-tr (double-array [3 2 1])))) 192 | (is (= 5.0 (drop-comp-tr (double-array [1 3 2])))) 193 | (is (= 5.0 (drop-comp-tr (double-array [1 2 3])))) 194 | (is (= 3.0 (drop-comp-tr (double-array [2 1 3]))))) 195 | 196 | 197 | (java/typed-defn take-while-odd [darr x] 198 | (c/transduce 199 | (c/take-while c/odd?) 200 | c/+ 201 | 0.0 202 | x)) 203 | 204 | (deftest take-while-test 205 | (is (= 11.0 (take-while-odd (double-array [1 3 7 0 2 4 5]))))) 206 | 207 | (java/typed-defn take-while-odd-lazy [darr x] 208 | (c/reduce c/+ 0.0 (c/take-while c/odd? x))) 209 | 210 | (deftest lazy-take-while-test 211 | (is (= 4.0 212 | (take-while-odd-lazy 213 | (double-array [1 1 1 1 2 1]))))) 214 | 215 | (java/typed-defn 216 | compute-squares [Integer/TYPE n] 217 | (let [dst (c/make-array Double/TYPE n)] 218 | (c/dotimes [i n] 219 | (c/aset dst i (c/* i i))) 220 | dst)) 221 | 222 | (deftest dotimes-test 223 | (is (= (vec (compute-squares 5)) 224 | [0.0 1.0 4.0 9.0 16.0]))) 225 | -------------------------------------------------------------------------------- /test/examples/nbody_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.nbody-test 2 | 3 | (:require [geex.common :as c] 4 | [geex.java :as java] 5 | [geex.core :as geex] 6 | [clojure.test :refer :all])) 7 | 8 | (def pi 3.141592653589793) 9 | (def solar-mass (* 4.0 pi pi)) 10 | (def days-per-year 365.24) 11 | 12 | (def init-bodies 13 | {:jupiter 14 | {:pos [4.84143144246472090e+00 15 | -1.16032004402742839e+00 16 | -1.03622044471123109e-01] 17 | :vel [(* days-per-year 1.66007664274403694e-03) 18 | (* days-per-year 7.69901118419740425e-03) 19 | (* days-per-year -6.90460016972063023e-05)] 20 | :mass (* solar-mass 9.54791938424326609e-04)} 21 | 22 | :saturn 23 | {:pos [8.34336671824457987e+00 24 | 4.12479856412430479e+00 25 | -4.03523417114321381e-01] 26 | :vel [(* days-per-year -2.76742510726862411e-03) 27 | (* days-per-year 4.99852801234917238e-03) 28 | (* days-per-year 2.30417297573763929e-05)] 29 | :mass (* solar-mass 2.85885980666130812e-04)} 30 | 31 | :uranus 32 | {:pos [1.28943695621391310e+01 33 | -1.51111514016986312e+01 34 | -2.23307578892655734e-01] 35 | :vel [(* days-per-year 2.96460137564761618e-03) 36 | (* days-per-year 2.37847173959480950e-03) 37 | (* days-per-year -2.96589568540237556e-05)] 38 | :mass (* solar-mass 4.36624404335156298e-05)} 39 | 40 | :neptune 41 | {:pos [1.53796971148509165e+01 42 | -2.59193146099879641e+01 43 | 1.79258772950371181e-01] 44 | :vel [(* days-per-year 2.68067772490389322e-03) 45 | (* days-per-year 1.62824170038242295e-03) 46 | (* days-per-year -9.51592254519715870e-05)] 47 | :mass (* solar-mass 5.15138902046611451e-05)} 48 | 49 | :sun 50 | {:pos [0.0 0.0 0.0] 51 | :vel [0.0 0.0 0.0] 52 | :mass solar-mass}}) 53 | 54 | ;; Checking 55 | (comment 56 | (defn body-from-java [j] 57 | {:pos [(.x j) (.y j) (.z j)] 58 | :vel [(.vx j) (.vy j) (.vz j)] 59 | :mass (.mass j)}) 60 | 61 | (assert (= (:jupiter bodies) 62 | (body-from-java (Body/jupiter)))) 63 | (assert (= (:saturn bodies) 64 | (body-from-java (Body/saturn)))) 65 | (assert (= (:uranus bodies) 66 | (body-from-java (Body/uranus)))) 67 | (assert (= (:neptune bodies) 68 | (body-from-java (Body/neptune)))) 69 | (assert (= (:sun bodies) 70 | (body-from-java (Body/sun))))) 71 | 72 | (defn scale-vector [s v] 73 | (mapv (fn [x] (c/* s x)) v)) 74 | 75 | (defn div-vector [v s] 76 | (mapv (fn [x] (c// x s)) v)) 77 | 78 | (defn add-vectors [a b] 79 | (mapv c/+ a b)) 80 | 81 | (defn sub-vectors [a b] 82 | (mapv c/- a b)) 83 | 84 | (defn dot-product [a b] 85 | (apply c/+ (map c/* a b))) 86 | 87 | (defn squared-norm [x] 88 | (dot-product x x)) 89 | 90 | (defn norm [x] 91 | (c/sqrt (squared-norm x))) 92 | 93 | (defn offset-momentum [body p] 94 | (update 95 | body 96 | :vel 97 | (fn [v] 98 | (scale-vector -1.0 (div-vector p solar-mass))))) 99 | 100 | ;; (offset-momentum (:neptune init-bodies) [1 2 3000000]) 101 | 102 | (defn compute-total-momentum [bodies] 103 | (transduce 104 | (map (fn [[k body]] 105 | (scale-vector (:mass body) 106 | (:vel body)))) 107 | (completing add-vectors) 108 | [0.0 0.0 0.0] 109 | bodies)) 110 | 111 | (defn offset-bodies [bodies] 112 | (let [tot (compute-total-momentum bodies)] 113 | (update bodies :sun #(offset-momentum % tot)))) 114 | 115 | ;; (compute-total-momentum init-bodies) 116 | ;; (compute-total-momentum (offset-bodies init-bodies)) 117 | 118 | #_(java/typed-defn tot-mom-gen [] 119 | ;(geex/set-flag! :disp) 120 | (compute-total-momentum init-bodies)) 121 | 122 | (def sorted-vec (comp vec sort)) 123 | 124 | (defn all-unordered-pairs [data] 125 | (filter 126 | (comp (partial = 2) count) 127 | (map 128 | vec 129 | (set (for [a data 130 | b data] 131 | (conj #{a} b)))))) 132 | 133 | (defn all-pairs [data] 134 | (sort 135 | (map 136 | sorted-vec 137 | (all-unordered-pairs data)))) 138 | 139 | ;; (all-pairs [:a :b :c]) 140 | 141 | (defn energy [bodies] 142 | 143 | ;; Per body 144 | (c/+ 145 | (transduce 146 | (map (fn [body] 147 | (c/* 0.5 (:mass body) 148 | (squared-norm (:vel body))))) 149 | c/+ 150 | 0.0 151 | (vals bodies)) 152 | 153 | ;; Per pair 154 | (transduce 155 | (map (fn [[a b]] 156 | (let [distance (norm 157 | (sub-vectors 158 | (:pos a) 159 | (:pos b)))] 160 | (c/- (c// (c/* (:mass a) (:mass b)) 161 | distance))))) 162 | c/+ 163 | 0.0 164 | (all-unordered-pairs (vals bodies))))) 165 | 166 | ;; (- (.energy (NBodySystem.)) (energy (offset-bodies init-bodies))) 167 | 168 | (defn update-body-vel [bodies body-key change] 169 | (update-in bodies [body-key :vel] 170 | (partial add-vectors change))) 171 | 172 | (defn update-pair-velocities [dt bodies [i j]] 173 | (let [ibody (get bodies i) 174 | jbody (get bodies j) 175 | pos-dif (sub-vectors (:pos ibody) 176 | (:pos jbody)) 177 | squared-distance (squared-norm pos-dif) 178 | distance (c/sqrt squared-distance) 179 | mag (c// dt (c/* distance squared-distance)) 180 | jmass (:mass jbody)] 181 | (-> bodies 182 | (update-body-vel i (scale-vector 183 | (c/* -1.0 mag (:mass jbody)) 184 | pos-dif)) 185 | (update-body-vel j (scale-vector 186 | (c/* mag (:mass ibody)) 187 | pos-dif))))) 188 | 189 | (defn update-velocities [bodies dt] 190 | (reduce 191 | (partial update-pair-velocities dt) 192 | bodies 193 | (all-pairs (keys bodies)))) 194 | 195 | (defn update-body-pos [dt body] 196 | (update body :pos (partial add-vectors 197 | (scale-vector dt (:vel body))))) 198 | 199 | (defn update-positions [bodies dt] 200 | (zipmap 201 | (keys bodies) 202 | (map (partial update-body-pos dt) (vals bodies)))) 203 | 204 | (defn advance [bodies dt] 205 | (-> bodies 206 | (update-velocities dt) 207 | (update-positions dt))) 208 | 209 | (defn iterate-bodies [bodies iterations dt] 210 | (geex/Loop [bodies bodies 211 | counter 0] 212 | (geex/If (c/= iterations counter) 213 | bodies 214 | (geex/Recur 215 | (advance bodies dt) 216 | (c/inc counter))))) 217 | 218 | (java/typed-defn 219 | run [{:iterations Integer/TYPE 220 | :step-size Double/TYPE} problem] 221 | {:energy 222 | (energy 223 | (iterate-bodies 224 | (offset-bodies init-bodies) 225 | (:iterations problem) 226 | (:step-size problem)))}) 227 | 228 | (def vec-type (vec (repeat 3 Double/TYPE))) 229 | (def body-type {:pos vec-type 230 | :vel vec-type 231 | :mass Double/TYPE}) 232 | 233 | (def system-type (zipmap 234 | (keys init-bodies) 235 | (repeat (count init-bodies) body-type))) 236 | 237 | (java/typed-defn advance-system [system-type system 238 | Double/TYPE dt] 239 | (advance system dt)) 240 | 241 | (defn system-seq [dt] 242 | (iterate #(advance-system % dt) (offset-bodies init-bodies))) 243 | 244 | ;; (run {:step-size 0.01 :iterations 10000000}) 245 | 246 | 247 | (defn run-for [n] 248 | (run {:step-size 0.01 249 | :iterations (int n)})) 250 | 251 | (deftest run-it-test 252 | (let [init (run-for 0) 253 | long-run (run-for 300)] 254 | #_(is (= -0.1690751638285245 (:energy init))) 255 | 256 | (is (< (Math/abs (- -0.1690751638285245 (:energy init))) 257 | 1.0e-6)) 258 | 259 | (is (not= (:energy init) 260 | (:energy long-run))) 261 | (is (< (Math/abs (- (:energy init) 262 | (:energy long-run))) 263 | 0.001)))) 264 | -------------------------------------------------------------------------------- /src/clj/geex/java/class.clj: -------------------------------------------------------------------------------- 1 | (ns geex.java.class 2 | (:require [clojure.spec.alpha :as spec] 3 | [clojure.reflect :as r] 4 | [geex.core :as core])) 5 | 6 | (spec/def ::name string?) 7 | (spec/def ::visibility #{:public :private :protected}) 8 | (spec/def ::static? boolean?) 9 | (spec/def ::fn fn?) 10 | (spec/def ::class class?) 11 | 12 | (spec/def ::type any?) ;; anything that we can call type-sig on 13 | (spec/def ::arg-type ::type) 14 | (spec/def ::ret ::type) 15 | (spec/def ::arg-types (spec/* ::arg-type)) 16 | (spec/def ::init any?) 17 | (spec/def ::final? boolean?) 18 | 19 | (spec/def ::method (spec/keys 20 | :req-un [::name 21 | ::arg-types] 22 | :opt-un [::fn 23 | ::visibility 24 | ::static? 25 | ::ret 26 | ::final?])) 27 | 28 | (defn abstract-method? [x] 29 | (not (contains? x :fn))) 30 | 31 | (spec/def ::abstract-method abstract-method?) 32 | 33 | (defn dynamic? [x] 34 | (not (:static? x))) 35 | 36 | (spec/def ::dynamic dynamic?) 37 | 38 | (spec/def ::interface-method 39 | (spec/and 40 | ::abstract-method 41 | ::dynamic 42 | (spec/keys :req-un [::name 43 | ::arg-types 44 | ::ret]))) 45 | 46 | (spec/def ::constructor 47 | (spec/keys :req-un [::arg-types 48 | ::fn] 49 | :opt-un [::visibility])) 50 | 51 | (spec/def ::interface-methods (spec/* ::interface-method)) 52 | 53 | (spec/def ::variable (spec/keys 54 | :req-un [::name] 55 | :opt-un [::visibility 56 | ::type 57 | ::static? 58 | ::init 59 | ::final?])) 60 | 61 | (spec/def ::method-map (spec/map-of string? ::method)) 62 | (spec/def ::variable-map (spec/map-of string? ::variable)) 63 | (spec/def ::methods (spec/* ::method)) 64 | (spec/def ::variables (spec/* ::variable)) 65 | (spec/def ::classes (spec/* ::class)) 66 | (spec/def ::extends ::class) 67 | (spec/def ::implements ::classes) 68 | (spec/def ::super ::class) 69 | (spec/def ::package string?) 70 | (spec/def ::key string?) 71 | (spec/def ::flags (spec/* core/valid-flags)) 72 | (spec/def ::private-stub class?) 73 | (spec/def ::public-stub class?) 74 | (spec/def ::interface? boolean?) 75 | (spec/def ::constructors (spec/* ::constructor)) 76 | (spec/def ::local-classes (spec/* ::class-def)) 77 | (spec/def ::format? boolean?) 78 | 79 | (spec/def ::class-def (spec/keys :opt-un [::name 80 | ::constructors 81 | ::flags 82 | ::visibility 83 | ::methods 84 | ::variables 85 | ::extends 86 | ::implements 87 | ::super 88 | ::final? 89 | ::key 90 | ::method-map 91 | ::variable-name 92 | ::package 93 | ::private-stub 94 | ::public-stub 95 | ::local-classes 96 | ::interface? 97 | ::format?])) 98 | 99 | (defn make-map-from-named [coll] 100 | (transduce 101 | (map (fn [x] [(:name x) x])) 102 | conj 103 | {} 104 | coll)) 105 | 106 | (defn add-kv-pair-non-dup [msg m [k v]] 107 | (when (contains? m k) 108 | (throw (ex-info msg 109 | {:key k 110 | :value-a (get m k) 111 | :value-b v}))) 112 | (assoc m k v)) 113 | 114 | (defn check-non-dup [msg kv-pairs] 115 | (reduce 116 | (partial add-kv-pair-non-dup msg) 117 | {} 118 | kv-pairs)) 119 | 120 | (defn method-signature [method] 121 | (select-keys method [:name :arg-types])) 122 | 123 | (defn var-signature [method] 124 | (select-keys method [:name])) 125 | 126 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 127 | ;;; 128 | ;;; Interface 129 | ;;; 130 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131 | 132 | (def class-def? (partial spec/valid? ::class-def)) 133 | 134 | (defn anonymous? [x] 135 | (contains? x :super)) 136 | 137 | (defn visibility [x] 138 | (or (:visibility x) 139 | :public)) 140 | 141 | (defn visibility-str [v] 142 | {:pre [(spec/valid? ::visibility v)]} 143 | (name v)) 144 | 145 | (defn static? [x] 146 | (:static? x)) 147 | 148 | (defn valid? [x] 149 | (and (map? x) 150 | (::valid? x))) 151 | 152 | (defn abstract? [class-def] 153 | (if (valid? class-def) 154 | (:abstract? class-def) 155 | (some abstract-method? (:methods class-def)))) 156 | 157 | 158 | (defn validate-class-def [class-def] 159 | (if (valid? class-def) 160 | class-def 161 | (do 162 | 163 | (when (not (spec/valid? ::class-def class-def)) 164 | (throw (ex-info 165 | (str "Class-def does not conform with spec: " 166 | (spec/explain-str ::class-def class-def)) 167 | {}))) 168 | (check-non-dup 169 | "Duplicate method" 170 | (mapv (fn [method] 171 | [(method-signature method) method]) 172 | (:methods class-def))) 173 | (check-non-dup 174 | "Duplicate variable" 175 | (mapv (fn [v] 176 | [(var-signature v) v]) 177 | (:variables class-def))) 178 | 179 | (when (:interface? class-def) 180 | (let [cl (:local-classes class-def)] 181 | (when (not (empty? cl)) 182 | (throw (ex-info "An interface cannot have local classes" 183 | {:local-classes cl})))) 184 | (let [ext (:extends class-def)] 185 | (when (not (empty? ext)) 186 | (throw (ex-info "An interface cannot extend classes" 187 | {:extends ext})))) 188 | 189 | (doseq [method (:methods class-def)] 190 | (do (when (not (spec/valid? ::interface-method method)) 191 | (throw 192 | (ex-info 193 | (str 194 | "Invalid interface method: " 195 | (spec/explain-str ::interface-method method)) 196 | {:method method}))))) 197 | 198 | (when (not (empty? (:variables class-def))) 199 | (throw (ex-info 200 | "An interface does not have variables" 201 | {:variables (:variables class-def)}))) 202 | (let [cst (:constructors class-def)] 203 | (if (not (empty? cst)) 204 | (throw (ex-info "An interface does not have constructors" 205 | {:constructors cst}))))) 206 | 207 | (when 208 | (and (contains? class-def :super) 209 | (or (not (empty? (:extends class-def))) 210 | (not (empty? (:implements class-def))))) 211 | (throw (ex-info "I don't think you are allowed to create an anonymous class that inherits or extends other classes"))) 212 | (merge class-def {::valid? true 213 | :method-map (make-map-from-named 214 | (:methods class-def)) 215 | :variable-map (make-map-from-named 216 | (:variables class-def)) 217 | :abstract? (abstract? class-def)})))) 218 | 219 | (defn named? [x] 220 | (contains? x :name)) 221 | 222 | (defn implements-code [class-def] 223 | (let [classes (:implements class-def)] 224 | (if (empty? classes) 225 | [] 226 | (vec 227 | (butlast 228 | (reduce 229 | into ["implements"] 230 | (map (fn [x] 231 | [(r/typename x) ", "]) 232 | classes))))))) 233 | 234 | (defn extends-code [class-def] 235 | (if-let [e (:extends class-def)] 236 | ["extends" (r/typename e)] 237 | [])) 238 | 239 | (defn has-key? [x] 240 | (contains? x :key)) 241 | 242 | (defn full-java-class-name 243 | ([package-name class-name] 244 | (if (nil? package-name) 245 | class-name 246 | (str package-name 247 | "." 248 | class-name))) 249 | ([class-def] 250 | {:pre [(valid? class-def) 251 | (named? class-def)]} 252 | (full-java-class-name (:package class-def) (:name class-def)))) 253 | 254 | (defn has-stubs? [x] 255 | (and (class? (:private-stub x)) 256 | (class? (:public-stub x)))) 257 | 258 | (defn interface? [x] 259 | (:interface? x)) 260 | 261 | (defn format? [x] 262 | (:format? x)) 263 | -------------------------------------------------------------------------------- /test/examples/circle_fit_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.circle-fit-test 2 | (:require [geex.common :as lib] 3 | [geex.core :as core] 4 | [geex.java :as java] 5 | [clojure.spec.alpha :as spec] 6 | [clojure.test :refer :all])) 7 | 8 | (spec/def ::derivatives (spec/coll-of any?)) 9 | (spec/def ::value any?) 10 | (spec/def ::ad (spec/keys :req-un [::value ::derivatives])) 11 | 12 | (spec/def ::params (spec/cat :center (spec/* any?) 13 | :radius any?)) 14 | 15 | (def ad? (partial spec/valid? ::ad)) 16 | 17 | 18 | ;;;------- Common operations on automatically differentiable numbers ------- 19 | ;;; Normally, it would probably make more sense to overload the operators in lib, 20 | ;;; such as lib/+, lib/*, lib/-, etc, but here we define them as functions for 21 | ;;; the sake of clarity. 22 | 23 | (defn add [x y] 24 | {:pre [(ad? x) 25 | (ad? y)] 26 | :post [(ad? %)]} 27 | {:value (lib/+ (:value x) (:value y)) 28 | :derivatives (map lib/+ 29 | (:derivatives x) 30 | (:derivatives y))}) 31 | 32 | (defn mul [x y] 33 | {:pre [(ad? x) 34 | (ad? y)] 35 | :post [(ad? %)]} 36 | {:value (lib/* (:value x) (:value y)) 37 | :derivatives (mapv (fn [dx dy] 38 | (lib/+ (lib/* (:value x) dy) 39 | (lib/* (:value y) dx))) 40 | (:derivatives x) 41 | (:derivatives y))}) 42 | 43 | (defn sqr [x] 44 | (mul x x)) 45 | 46 | (defn negate [x] 47 | {:value (lib/negate (:value x)) 48 | :derivatives (mapv lib/negate (:derivatives x))}) 49 | 50 | (defn sub [x y] 51 | (add x (negate y))) 52 | 53 | (defn sqrt [x] 54 | (let [value (lib/sqrt (:value x))] 55 | {:value value 56 | :derivatives (mapv (fn [d] (lib/* d (lib// 0.5 value))) 57 | (:derivatives x))})) 58 | 59 | 60 | ;; Test the automatic differentiation 61 | (deftest various-ad-tests 62 | (is (= (java/eval 63 | (add {:value 3.0 64 | :derivatives [2 3]} 65 | {:value 4.0 66 | :derivatives [5 8]})) 67 | {:value 7.0 :derivatives [7 11]})) 68 | (is (= (java/eval 69 | (mul {:value 3.0 70 | :derivatives [2 3]} 71 | {:value 4.0 72 | :derivatives [5 8]})) 73 | {:value 12.0 :derivatives [23.0 36.0]}))) 74 | 75 | 76 | 77 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 78 | ;;; 79 | ;;; Objective function 80 | ;;; 81 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 82 | (defn zeros [n] 83 | (vec (repeat n (lib/wrap 0.0)))) 84 | 85 | ;; A variable automatically differentiable number 86 | (defn variable [x i] 87 | {:value x 88 | :derivatives (assoc (zeros 3) i (lib/wrap 1.0))}) 89 | 90 | ;; A constant automatically differentiable number 91 | (defn constant [x] 92 | {:value x 93 | :derivatives (zeros 3)}) 94 | 95 | ;; Evaluates the fitness for a single observed circle point 96 | (defn evaluate-point-fit [[cx cy radius] [x y]] 97 | {:pre [(ad? cx) 98 | (ad? cy) 99 | (ad? radius) 100 | (ad? x) 101 | (ad? y)]} 102 | (let [dif-x (sub cx x) 103 | dif-y (sub cy y) 104 | dist (sqrt (add (sqr dif-x) (sqr dif-y)))] 105 | (sqr (sub dist radius)))) 106 | 107 | ;; Wraps the parameter vector as a vector 108 | ;; of automatically differentiable numbers 109 | (defn ad-wrap-params [params] 110 | (mapv variable params (range (count params)))) 111 | 112 | ;; Turns the coordinates of a point into automatically 113 | ;; differentiable numbers 114 | (defn ad-wrap-point [pt] 115 | (mapv constant pt)) 116 | 117 | ;; Wraps the array of x/y pairs as 118 | (defn array-to-pts [arr] 119 | (lib/wrap-struct-array [(lib/typed-seed Double/TYPE) 120 | (lib/typed-seed Double/TYPE)] arr)) 121 | 122 | ;; Evaluates the objective function and returns the gradient 123 | (defn evaluate-objf-gradient [params point-array] 124 | (:derivatives 125 | (let [ad-params (ad-wrap-params params)] 126 | (lib/transduce 127 | (lib/map (fn [pt] 128 | (let [wrapped (ad-wrap-point pt)] 129 | (evaluate-point-fit ad-params wrapped)))) 130 | (completing add) 131 | (constant (lib/wrap 0.0)) 132 | point-array)))) 133 | 134 | 135 | 136 | 137 | ;; Returns a function that performs one iteration in gradient descent. 138 | (defn gradient-stepper [step-size points] 139 | (fn [params] 140 | (let [gradient (evaluate-objf-gradient 141 | params 142 | points)] 143 | (mapv (fn [p g] (lib/- p (lib/* step-size g))) 144 | params gradient)))) 145 | 146 | 147 | 148 | 149 | 150 | ;;;------- The top level optimization routine ------- 151 | 152 | (java/typed-defn 153 | optimize [{:center [Double/TYPE Double/TYPE] 154 | :radius Double/TYPE} initial-params 155 | 156 | (lib/array-type Double/TYPE) point-array 157 | 158 | {:step-size Double/TYPE 159 | :iterations Long/TYPE} settings] 160 | 161 | 162 | ;;(core/set-flag! :disp-time) 163 | 164 | (let [flat-params (spec/unform ::params initial-params) 165 | points (array-to-pts point-array) 166 | step (gradient-stepper (:step-size settings) points) 167 | opt (lib/iterate-times (:iterations settings) 168 | flat-params 169 | step)] 170 | (spec/conform ::params opt))) 171 | ;; 2018-10-02 172 | ;; --- Time report --- 173 | ;; Start: 0.00 174 | ;; Evaluated state: 0.234 175 | ;; Generated code: 0.351 176 | ;; Composed class: 0.352 177 | ;; Formatted code: 0.361 178 | ;; Compiled it: 0.371 179 | 180 | ;; Number of seeds: 254 181 | ;; Time per seed: 0.0014606301240095002 182 | 183 | 184 | ;; 2018-10-12 185 | ;; --- Time report --- 186 | ;; Start: 0.00 187 | ;; Evaluated state: 0.0210 188 | ;; Generated code: 0.0270 189 | ;; Composed class: 0.0270 190 | ;; Formatted code: 0.0500 191 | ;; Compiled it: 0.0650 192 | 193 | ;; Number of seeds: 257 194 | ;; Time per seed: 2.5291851058544353E-4 195 | 196 | 197 | 198 | 199 | 200 | ;;;------- Test data generation ------- 201 | 202 | (defn uniform-rand [a b] 203 | (+ a (* (rand) (- b a)))) 204 | 205 | (defn generate-samples [n noise true-circle] 206 | {:pre [(int? n) 207 | (spec/valid? ::params true-circle)]} 208 | (let [[cx cy] (:center true-circle) 209 | radius (:radius true-circle)] 210 | (double-array 211 | (reduce 212 | into 213 | [] 214 | (take 215 | n 216 | (repeatedly 217 | (fn [] 218 | (let [angle (* (rand) 2.0 Math/PI) 219 | extra (uniform-rand (- noise) noise) 220 | rad (+ extra radius) 221 | x (+ cx (* rad (Math/cos angle))) 222 | y (+ cy (* rad (Math/sin angle)))] 223 | [x y])))))))) 224 | 225 | 226 | (def test-params {:center [3 4] 227 | :radius 12}) 228 | 229 | (def test-data (double-array 230 | [7.144107820956012 -7.322348332791618 3.230223305650983 16.140177639691125 4.424385175093361 -8.007161790032917 12.97253408831454 -2.8110006118856043 6.998682852633783 15.63064600733553 7.13540665807617 15.36914329195822 -8.753210789051327 0.4078942279769384 -6.8362221246073585 -2.446448511479189 11.245522096884292 -4.411810894431028 -9.212521320220691 4.065980192518594])) 231 | 232 | 233 | 234 | ;;;------- Testing circle fitting with gradient descent ------- 235 | 236 | 237 | ;; For testing the gradient calculation 238 | (java/typed-defn 239 | eval-grad-fn 240 | [(lib/array-type Double/TYPE) arr] 241 | ;(core/set-flag! :disp :disp-state) 242 | (let [wrapped-arr (array-to-pts arr)] 243 | (evaluate-objf-gradient 244 | [1.0 2.0 5.0] 245 | wrapped-arr))) 246 | 247 | (deftest basic-tests 248 | (is (ad? 249 | (java/eval 250 | (evaluate-point-fit (ad-wrap-params [1.0 2.0 1.5]) 251 | (ad-wrap-point [5.0 5.0]))))) 252 | (is (= (eval-grad-fn (double-array [4 6])) 253 | [0.0 0.0 0.0])) 254 | (is (not= (eval-grad-fn (double-array [4 7])) 255 | [0.0 0.0 0.0])) 256 | (let [params (optimize {:center [0.0 0.0] 257 | :radius 1.0} 258 | (double-array [-1 -1 259 | 1 1 260 | -1 1 261 | 1 -1]) 262 | {:step-size 0.1 263 | :iterations 10})] 264 | (is (< (Math/abs (- (:radius params) 265 | (Math/sqrt 2.0))) 266 | 1.0e-5))) 267 | (let [params (optimize 268 | {:center [0.0 0.0] 269 | :radius 1.0} 270 | test-data 271 | {:step-size 0.01 272 | :iterations 100}) 273 | [cx cy] (:center params) 274 | radius (:radius params)] 275 | (is (< (Math/abs (- cx 3)) 0.2)) 276 | (is (< (Math/abs (- cy 4)) 0.2)) 277 | (is (< (Math/abs (- radius 12)) 0.2)))) 278 | -------------------------------------------------------------------------------- /src/java/geex/State.java: -------------------------------------------------------------------------------- 1 | package geex; 2 | 3 | import java.util.ArrayList; 4 | import java.util.Stack; 5 | import java.util.HashMap; 6 | import java.util.HashSet; 7 | import geex.ISeed; 8 | import geex.SeedUtils; 9 | import java.lang.RuntimeException; 10 | import geex.LocalVars; 11 | import geex.LocalStruct; 12 | import clojure.lang.Keyword; 13 | import clojure.lang.IFn; 14 | import geex.Flags; 15 | import clojure.lang.PersistentHashMap; 16 | 17 | public class State { 18 | 19 | private ArrayList _upperSeeds = new ArrayList(); 20 | private StateSettings _settings = null; 21 | private LocalVars _lvars = new LocalVars(); 22 | private HashMap _localStructs 23 | = new HashMap(); 24 | private int _symbolCounter = 0; 25 | private Flags _flags = new Flags(); 26 | private HashMap _varMap 27 | = new HashMap(); 28 | private Stack> _scopes 29 | = new Stack>(); 30 | private ISeed _lastOrdered = null; 31 | 32 | 33 | public void openScope() { 34 | _scopes.push(new ArrayList()); 35 | } 36 | 37 | public ISeed closeScope() { 38 | ArrayList lastScope = _scopes.pop(); 39 | Mode maxMode = Mode.Pure; 40 | boolean hasValue = false; 41 | Object type = null; 42 | int n = lastScope.size(); 43 | for (int i = 0; i < n; i++) { 44 | ISeed seed = lastScope.get(i); 45 | maxMode = SeedUtils.max( 46 | maxMode, seed.getMode()); 47 | } 48 | if (!lastScope.isEmpty()) { 49 | ISeed last = lastScope.get(lastScope.size()-1); 50 | hasValue = last.hasValue(); 51 | type = last.getType(); 52 | } 53 | SeedParameters params = new SeedParameters(); 54 | params.type = type; 55 | params.hasValue = hasValue; 56 | params.mode = maxMode; 57 | params.description = "Closed scope"; 58 | params.compiler = _settings.closeScope; 59 | 60 | ISeed seed = new DynamicSeed(params); 61 | for (int i = 0; i < n; i++) { 62 | seed.deps().addDep(i, lastScope.get(i)); 63 | } 64 | addSeed(seed); 65 | return seed; 66 | } 67 | 68 | public State(StateSettings s) { 69 | if (s == null) { 70 | throw new RuntimeException("No settings provided"); 71 | } 72 | s.check(); 73 | _settings = s; 74 | openScope(); 75 | openScope(); // When this scope is finalized, the resulting seed needs a scope where to go. 76 | } 77 | 78 | public LocalVars getLocalVars() { 79 | return _lvars; 80 | } 81 | 82 | public Object getPlatform() { 83 | return _settings.platform; 84 | } 85 | 86 | public int getLower() { 87 | return 0; 88 | } 89 | 90 | public int getUpper() { 91 | return _upperSeeds.size(); 92 | } 93 | 94 | int nextUpperIndex() { 95 | return _upperSeeds.size(); 96 | } 97 | 98 | void checkNonEmptyScopes() { 99 | if (_scopes.isEmpty()) { 100 | throw new RuntimeException("Empty scopes"); 101 | } 102 | } 103 | 104 | 105 | public void addSeed(ISeed x) { 106 | if (SeedUtils.isRegistered(x)) { 107 | throw new RuntimeException( 108 | "Cannot add seed with id " 109 | + x.getId() + " because it is already registered"); 110 | } 111 | x.setId(nextUpperIndex()); 112 | _upperSeeds.add(x); 113 | x.setForwardedFunction(_settings.forwardedFunction); 114 | checkNonEmptyScopes(); 115 | ArrayList currentScope = _scopes.peek(); 116 | currentScope.add(x); 117 | } 118 | 119 | public ISeed getSeed(int index) { 120 | if (0 <= index && index < _upperSeeds.size()) { 121 | return _upperSeeds.get(index); 122 | } else { 123 | throw new RuntimeException( 124 | "Seed index out of bounds"); 125 | } 126 | } 127 | 128 | public int getSeedCount() { 129 | return _upperSeeds.size(); 130 | } 131 | 132 | public boolean isEmpty() { 133 | return getSeedCount() == 0; 134 | } 135 | 136 | 137 | /*build-referents 138 | build-ids-to-visit 139 | check-referent-visibility 140 | check-scope-stacks*/ 141 | 142 | private void buildReferents() { 143 | int lower = getLower(); 144 | int upper = getUpper(); 145 | for (int i = 0; i < upper; i++) { 146 | ISeed seed = getSeed(i); 147 | int id = seed.getId(); 148 | seed.deps().addReferentsFromId(id); 149 | } 150 | } 151 | 152 | public void finalizeState() { 153 | closeScope(); 154 | if (_scopes.size() != 1) { 155 | throw new RuntimeException( 156 | "After closing the scope, there should be exactly one element on the stack."); 157 | } 158 | buildReferents(); 159 | } 160 | 161 | public void disp() { 162 | System.out.println("=== State ==="); 163 | int lower = getLower(); 164 | int upper = getUpper(); 165 | for (int i = lower; i < upper; i++) { 166 | ISeed seed = getSeed(i); 167 | System.out.println( 168 | String.format( 169 | " - %4d %s", 170 | i, seed.toString())); 171 | seed.deps().disp(); 172 | seed.refs().disp(); 173 | } 174 | } 175 | 176 | private ISeed advanceToNextSeed(int index) { 177 | while (index < getUpper()) { 178 | ISeed seed = getSeed(index); 179 | if (seed != null) { 180 | return seed; 181 | } 182 | } 183 | return null; 184 | } 185 | 186 | 187 | 188 | 189 | 190 | private boolean shouldList(ISeed seed) { 191 | Boolean b = seed.shouldBind(); 192 | int refCount = seed.refs().count() - 1/*scope*/; 193 | if (b == null) { 194 | switch (seed.getMode()) { 195 | case Pure: return 2 <= refCount; 196 | case Ordered: return 1 <= refCount; 197 | case SideEffectful: return true; 198 | 199 | /* In general, don't list code. For instance, 200 | we don't want to list the branches of an 201 | if-statement in code. But when generating 202 | methods, we might want to list the code. 203 | */ 204 | case Code: return false; 205 | } 206 | return true; 207 | } else { 208 | return b.booleanValue(); 209 | } 210 | } 211 | /* 212 | 213 | Examples: 214 | * A conditional branch in Java: 215 | - hasValue = false 216 | - Mode = Pure (inserted where it is used) 217 | 218 | * A Java void method call 219 | - hasValue = false 220 | - Mode = SideEffectful 221 | 222 | * A call to recur 223 | - hasValue = true 224 | - Mode = Pure (it is the value returned). 225 | 226 | */ 227 | 228 | // By bind, we mean "producing a statement in order", 229 | // possibly with a symbol bound to it. 230 | private void compileSeed(ISeed seed) { 231 | Object result = seed.compile(this); 232 | if (_settings.checkCompilationResult != null) { 233 | _settings.checkCompilationResult.invoke( 234 | seed, result); 235 | } 236 | 237 | SeedState state = seed.getState(); 238 | state.setCompilationResult(result); 239 | 240 | if (shouldList(seed)) { 241 | state.list(); 242 | } 243 | if (seed.hasValue() && state.isListed() 244 | && seed.getMode() != Mode.Code) { 245 | state.bind(_settings.generateSeedSymbol.invoke(seed)); 246 | } 247 | } 248 | 249 | public Object generateCode() { 250 | if (isEmpty()) { 251 | throw new RuntimeException( 252 | "Cannot generate code, because empty"); 253 | } 254 | boolean dispTrace = _flags.dispTrace; 255 | boolean dispCompResults = _flags.dispCompilationResults; 256 | for (int i = getLower(); i < getUpper(); i++) { 257 | ISeed seed = getSeed(i); 258 | if (dispTrace) { 259 | System.out.println("Generate code for " 260 | + seed.toString()); 261 | } 262 | compileSeed(seed); 263 | if (dispCompResults) { 264 | System.out.println(" Compilation result: " 265 | + seed.getState().getValue().toString()); 266 | } 267 | } 268 | ISeed last = getSeed(getUpper()-1); 269 | return last.getState().getValue(); 270 | } 271 | 272 | public LocalVar declareLocalVar() { 273 | LocalVar lvar = _lvars.declare(); 274 | if (scopedLocalVars == null) { 275 | throw new RuntimeException( 276 | "No local variable scope"); 277 | } 278 | scopedLocalVars.add(lvar); 279 | return lvar; 280 | } 281 | 282 | public LocalVar[] declareLocalVars(int n) { 283 | LocalVar[] dst = new LocalVar[n]; 284 | for (int i = 0; i < n; i++) { 285 | dst[i] = declareLocalVar(); 286 | } 287 | return dst; 288 | } 289 | 290 | public LocalStruct allocateLocalStruct( 291 | Object key, Object tpSig, LocalVar[] vars) { 292 | if (_localStructs.containsKey(key)) { 293 | throw new RuntimeException( 294 | "Struct with key " + key.toString() 295 | + " already declared"); 296 | } 297 | LocalStruct ls = new LocalStruct(tpSig, vars); 298 | _localStructs.put( 299 | key, ls); 300 | return ls; 301 | } 302 | 303 | public LocalStruct getLocalStruct(Object key) { 304 | return _localStructs.get(key); 305 | } 306 | 307 | public int generateSymbolIndex() { 308 | return _symbolCounter++; 309 | } 310 | 311 | 312 | public ISeed getLastSeed() { 313 | return getSeed(_upperSeeds.size()-1); 314 | } 315 | 316 | public Flags getFlags() { 317 | return _flags; 318 | } 319 | 320 | public ArrayList scopedLocalVars; 321 | 322 | public HashMap getVarMap() { 323 | return _varMap; 324 | } 325 | } 326 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /test/examples/cljd_circle_test.clj: -------------------------------------------------------------------------------- 1 | (ns examples.cljd-circle-test 2 | (:require [geex.ebmd.type :as etype] 3 | [clojure.pprint :as pp] 4 | [clojure.java.io :as io] 5 | [clojure.test :refer :all])) 6 | 7 | (require '[geex.common :as c] 8 | '[geex.java :as java] 9 | '[geex.core :as g]) 10 | 11 | 12 | (def default-settings {:ranges {:cx [-1 1] 13 | :cy [-1 1] 14 | :r [0.5 2]} 15 | :noise 0.1 16 | :count 30 17 | 18 | :step-size 0.25 19 | :iterations 30 20 | 21 | :output-dir "./circledata" 22 | 23 | :opt-count 10}) 24 | 25 | (defn sample-range [[a b]] 26 | (+ a (* (- b a) (Math/random)))) 27 | 28 | (defn sample-circle-parameters [settings] 29 | (let [ranges (:ranges settings)] 30 | (zipmap (keys ranges) 31 | (map sample-range (vals ranges))))) 32 | 33 | 34 | ;;;------- Point generation ------- 35 | 36 | (defn generate-point [params] 37 | (let [noise #(c/rand (c/- (:noise params)) 38 | (:noise params)) 39 | angle (c/rand (* 2.0 Math/PI))] 40 | [(c/+ (:cx params) 41 | (c/* (:r params) (c/cos angle)) 42 | (noise)) 43 | (c/+ (:cy params) 44 | (c/* (:r params) (c/sin angle)) 45 | (noise))])) 46 | 47 | (java/typed-defn 48 | generate-circle-points [{:r Double/TYPE 49 | :cx Double/TYPE 50 | :cy Double/TYPE 51 | :count Long/TYPE 52 | :noise Double/TYPE} params] 53 | (let [result (c/make-array Double/TYPE (c/* 2 (:count params)))] 54 | (g/Loop 55 | [i 0] 56 | (g/If (c/< i (:count params)) 57 | (let [[x y] (generate-point params) 58 | at (c/* 2 i)] 59 | (c/aset result (c/+ at 0) x) 60 | (c/aset result (c/+ at 1) y) 61 | (g/Recur (c/inc i))) 62 | 119)) 63 | result)) 64 | 65 | ;; (vec (generate-circle-points (merge (sample-circle-parameters settings) 66 | {:count 3 :noise 0.1} 67 | 68 | 69 | ;;;------- Evaluating it ------- 70 | 71 | 72 | (require '[geex.common :as c]) 73 | 74 | (defn sqr [x] (c/* x x)) 75 | 76 | (defn evaluate-point [{:keys [cx cy r]} ;; $\leftarrow$ Circle parameters 77 | [x y]] ;; $\leftarrow$ The point 78 | (let [dist-to-centre (c/sqrt (c/+ (sqr (c/- x cx)) 79 | (sqr (c/- y cy)))) 80 | dist-to-circle (c/- dist-to-centre r)] 81 | (sqr dist-to-circle))) 82 | 83 | 84 | 85 | (evaluate-point 86 | {:cx 0.0 :cy 0.0 :r 1.0} 87 | [1.0 0.0]) 88 | 89 | 90 | 91 | (evaluate-point 92 | {:cx 0.0 :cy 0.0 :r 1.0} 93 | [3.0 0.0]) 94 | 95 | 96 | (java/typed-defn test-eval-pt [{:cx Double/TYPE 97 | :cy Double/TYPE 98 | :r Double/TYPE} params 99 | [Double/TYPE Double/TYPE] pt] 100 | (evaluate-point params pt)) 101 | ;; (test-eval-pt {:cx 0.0 :cy 0.0 :r 1.0} [3.0 0.0]) 102 | 103 | (defn get-point-2d [src-array index] ;; $\leftarrow Helper function$ 104 | (let [offset (c/* 2 index)] 105 | [(c/aget src-array (c/+ offset 0)) 106 | (c/aget src-array (c/+ offset 1))])) 107 | 108 | 109 | (defn circle-fitness-cost [circle-params point-array init-cost] 110 | (let [n (c/quot (c/cast Long/TYPE (c/count point-array)) 2)] 111 | (c/* (c// 1.0 n) 112 | (c/transduce 113 | (c/map (comp (partial evaluate-point circle-params) 114 | (partial get-point-2d point-array))) 115 | c/+ 116 | init-cost ;; $\leftarrow$ Typically 0 117 | (c/range n))))) 118 | 119 | 120 | (java/typed-defn eval-circle-fitness-cost 121 | [{:cx Double/TYPE 122 | :cy Double/TYPE 123 | :r Double/TYPE} circle-params 124 | (c/array-type Double/TYPE) points] 125 | ;(g/set-flag! :disp) 126 | (circle-fitness-cost 127 | circle-params ;; $\leftarrow c_x, c_y, r$ 128 | points ;; $\leftarrow$ double-array 129 | 0.0 ;; $\leftarrow$ initial cost 130 | )) 131 | 132 | (defn test-eval-objf [] 133 | (let [true-params {:cx 0.0 :cy 0.0 :r 1.0 :count 10 :noise 0.0} 134 | bad-params {:cx 0.0 :cy 0.0 :r 2.0} 135 | pts (generate-circle-points true-params)] 136 | {:true-fit (eval-circle-fitness-cost true-params pts) 137 | :bad-fit (eval-circle-fitness-cost bad-params pts)})) 138 | 139 | ;; (test-eval-objf) 140 | 141 | 142 | 143 | ;;;------- Automatic differentiation ------- 144 | (defn variable [x] 145 | {:value x 146 | :deriv 1.0}) ;; $\frac{dx}{dx} = 1$ 147 | 148 | (defn constant [c] 149 | {:value c 150 | :deriv 0.0}) ;; $\frac{dc}{dx} = 0$, $c$ being a constant 151 | 152 | (require '[bluebell.utils.ebmd :as ebmd]) 153 | 154 | (defn ad-number? [x] 155 | (and (map? x) (contains? x :value) (contains? x :deriv))) 156 | 157 | (ebmd/def-arg-spec 158 | ::ad ;; $\leftarrow$ Name of the spec 159 | {:pred ad-number? ;; $\leftarrow$ Predicate function 160 | 161 | ;; Examples disambiguate overlapping predicates: 162 | :pos [(variable 3.0) (constant 5.0)] ;; $\leftarrow$ Matching examples 163 | :neg [2.0 :kwd {:kattskit 119}]}) ;; $\leftarrow$ Non-matching examples 164 | 165 | (ebmd/def-poly c/binary-add [::ad a 166 | ::ad b] 167 | {:value (c/+ (:value a) 168 | (:value b)) 169 | :deriv (c/+ (:deriv a) 170 | (:deriv b))}) 171 | 172 | (let [x (variable 3)] 173 | (c/+ x x)) 174 | 175 | ;; (c/+ (variable 3) 4) 176 | 177 | (require '[geex.ebmd.type :as etype]) 178 | 179 | (ebmd/register-promotion 180 | ::ad ;; Destination type 181 | constant ;; Promoter 182 | ::etype/real) ;; Source type 183 | 184 | (c/+ (variable 3) 4) 185 | 186 | (ebmd/def-poly c/binary-mul [::ad a 187 | ::ad b] 188 | {:value (c/* (:value a) (:value b)) 189 | 190 | ;; Recall that $(a \cdot b)^{\prime} = a^{\prime} \cdot b + a \cdot b^{\prime}$ 191 | :deriv (c/+ (c/* (:value a) 192 | (:deriv b)) 193 | (c/* (:deriv a) 194 | (:value b)))}) 195 | 196 | (let [x (variable 9.0)] 197 | (c/* x x x)) 198 | 199 | (ebmd/def-poly c/binary-sub [::ad a 200 | ::ad b] 201 | {:value (c/- (:value a) (:value b)) 202 | :deriv (c/- (:deriv a) 203 | (:deriv b))}) 204 | 205 | (ebmd/def-poly c/sqrt [::ad x] 206 | (let [s (c/sqrt (:value x))] 207 | {:value s 208 | :deriv (c/* (c// 0.5 s) 209 | (:deriv x))})) 210 | 211 | (c/sqrt (variable 2.0)) 212 | 213 | (defn derivative-for-key [circle-params points k] 214 | (:deriv (circle-fitness-cost ;; $\leftarrow$ Derivative of objective function 215 | (update circle-params k variable) ;; $\leftarrow$ 'k' is a variable 216 | points 217 | (constant 0.0)))) 218 | 219 | (java/typed-defn gradient 220 | [{:cx Double/TYPE :cy Double/TYPE :r Double/TYPE} circle-params 221 | (c/array-type Double/TYPE) points] 222 | ;(g/set-flag! :disp) 223 | {:cx (derivative-for-key circle-params points :cx) ;; $\leftarrow \frac{df}{dc_x}$ 224 | :cy (derivative-for-key circle-params points :cy) ;; $\leftarrow \frac{df}{dc_y}$ 225 | :r (derivative-for-key circle-params points :r)}) ;; $\leftarrow \frac{df}{dr}$ 226 | 227 | (defn test-eval-objf-dr [] 228 | (let [true-params {:cx 0.0 :cy 0.0 :r 1.0 :count 10 :noise 0.0} 229 | bad-params {:cx 0.0 :cy 0.0 :r 2.0} 230 | pts (generate-circle-points true-params)] 231 | {:true-fit (gradient true-params pts) 232 | :bad-fit (gradient bad-params pts)})) 233 | 234 | ;; (test-eval-objf-dr) 235 | 236 | (defn gradient-step [params point-array step-size] 237 | (let [grad (gradient params point-array) 238 | ks (keys grad)] 239 | (zipmap ks 240 | (map (fn [k] 241 | (let [derivative (get grad k) 242 | value (get params k)] 243 | (- value (* derivative step-size)))) 244 | ks)))) 245 | 246 | (defn optimize [init-params point-array 247 | iterations step-size] 248 | (first 249 | (drop 250 | iterations 251 | (iterate #(gradient-step % point-array step-size) 252 | init-params)))) 253 | 254 | 255 | (defn test-optimize [] 256 | (let [true-params {:cx 2.0 257 | :cy 3.0 258 | :r 1.5 259 | :noise 0.1 260 | :count 100} 261 | point-array (generate-circle-points true-params) 262 | init-params {:cx 1.0 263 | :cy 1.0 264 | :r 1.0}] 265 | (optimize init-params 266 | point-array 267 | 10 268 | 0.5))) 269 | 270 | ;; (test-optimize) 271 | 272 | 273 | 274 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 275 | ;;; 276 | ;;; Produce sample data 277 | ;;; 278 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 279 | (defn decorate-parameters-with-objf [params points] 280 | (merge params 281 | {:cost (eval-circle-fitness-cost params points) 282 | :gradient (gradient params points)})) 283 | 284 | (defn opt-seq [init-params point-array 285 | iterations step-size] 286 | (vec 287 | (take 288 | iterations 289 | (map 290 | #(decorate-parameters-with-objf % point-array) 291 | (iterate #(gradient-step % point-array step-size) 292 | init-params))))) 293 | 294 | 295 | (defn make-test-seq [] 296 | (let [settings default-settings 297 | params (sample-circle-parameters settings) 298 | points (generate-circle-points (merge settings params)) 299 | iterations 2 300 | step-size (:step-size settings)] 301 | (opt-seq (sample-circle-parameters settings) points iterations step-size))) 302 | 303 | ;; (pp/pprint (make-test-seq)) 304 | 305 | ;; (def opt-samples (produce-sample-circles-and-points)) 306 | 307 | 308 | 309 | 310 | ;;;------- Clojure implementation ------- 311 | (defn clj-constant [x] 312 | {:value x 313 | :deriv 0.0}) 314 | 315 | (defn clj-variable [x] 316 | {:value x 317 | :deriv 1.0}) 318 | 319 | (defn clj-add [a b] 320 | {:value (+ (:value a) (:value b)) 321 | :deriv (+ (:deriv a) (:deriv b))}) 322 | 323 | (defn clj-sub [a b] 324 | {:value (- (:value a) (:value b)) 325 | :deriv (- (:deriv a) (:deriv b))}) 326 | 327 | (defn clj-mul [a b] 328 | {:value (* (:value a) (:value b)) 329 | :deriv (+ (* (:value a) (:deriv b)) 330 | (* (:deriv a) (:value b)))}) 331 | 332 | (defn clj-sqrt [x] 333 | (let [s (Math/sqrt (:value x))] 334 | {:value s 335 | :deriv (* (/ 0.5 s) (:deriv x))})) 336 | 337 | (defn clj-sqr [x] 338 | (clj-mul x x)) 339 | 340 | 341 | (defn clj-get-point-2d [array i] 342 | (let [at (* 2 i)] 343 | [(clj-constant (aget array (+ at 0))) 344 | (clj-constant (aget array (+ at 1)))])) 345 | 346 | (defn clj-evaluate-point [{:keys [cx cy r]} 347 | [x y]] ;; $\leftarrow$ The point 348 | (let [dist-to-centre (clj-sqrt 349 | (clj-add (clj-sqr 350 | (clj-sub x cx)) 351 | (clj-sqr 352 | (clj-sub y cy)))) 353 | dist-to-circle (clj-sub dist-to-centre r)] 354 | (clj-sqr dist-to-circle))) 355 | 356 | (defn clj-evaluate [params array] 357 | (let [N (quot (alength array) 2)] 358 | (clj-mul (clj-constant (/ 1.0 N)) 359 | (transduce 360 | (map (comp (partial clj-evaluate-point params) 361 | (partial clj-get-point-2d array))) 362 | (completing clj-add) 363 | (clj-constant 0.0) 364 | (range N))))) 365 | 366 | (defn clj-derivative [params array k] 367 | (let [ad-params (zipmap 368 | (keys params) 369 | (map clj-constant (vals params))) 370 | ad-params (assoc ad-params k (clj-variable 371 | (get params k)))] 372 | (:deriv (clj-evaluate ad-params array)))) 373 | 374 | (defn clj-gradient [params array] 375 | {:cx (clj-derivative params array :cx) 376 | :cy (clj-derivative params array :cy) 377 | :r (clj-derivative params array :r)}) 378 | 379 | (defn clj-step [params array step-size] 380 | (let [grad (clj-gradient params array)] 381 | (into {} 382 | (map (fn [k] 383 | [k (- (get params k) 384 | (* step-size (get grad k)))]) 385 | (keys params))))) 386 | 387 | (defn clj-optimize [params array iterations step-size] 388 | (first 389 | (drop 390 | iterations 391 | (iterate 392 | #(clj-step % array step-size) 393 | params)))) 394 | 395 | 396 | 397 | 398 | ;;;------- The benchmark ------- 399 | (defn array-from-vecs [v] 400 | (double-array (reduce into [] v))) 401 | 402 | (def problem-points :points) 403 | (def problem-step-size (comp :step-size :settings)) 404 | (def problem-iterations (comp :iterations :settings)) 405 | (def problem-params :init-params) 406 | 407 | (defn benchmark-clj [problem] 408 | (clj-optimize 409 | (problem-params problem) 410 | (problem-points problem) 411 | (problem-iterations problem) 412 | (problem-step-size problem))) 413 | 414 | (defn clj-import [problem] 415 | (update problem :points array-from-vecs)) 416 | 417 | (defn benchmark-geex [problem] 418 | (optimize 419 | (:init-params problem) 420 | (problem-points problem) 421 | (problem-iterations problem) 422 | (problem-step-size problem))) 423 | 424 | 425 | (def problem 426 | {:settings 427 | {:ranges {:cx [-1 1], :cy [-1 1], :r [0.5 2]}, 428 | :noise 0.1, 429 | :count 30, 430 | :step-size 0.25, 431 | :iterations 30, 432 | :output-dir "./circledata", 433 | :opt-count 10}, 434 | :true-params 435 | {:cx -0.8909834954959839, 436 | :cy 0.1275074136409482, 437 | :r 1.6924200889247751}, 438 | :init-params 439 | {:cx 0.8470531641015153, 440 | :cy -0.23643186601703037, 441 | :r 1.8813854709986932}, 442 | :points 443 | [[0.4512665523085643 0.9220653919083143] 444 | [0.8536009162944576 -0.03476543157258946] 445 | [-0.5928022244880031 -1.471289836284194] 446 | [0.587703987644064 -0.73285069584352] 447 | [0.1583769089811083 1.5612758637951776] 448 | [-1.0194404261111467 1.8923473452195179] 449 | [0.7075951522088312 0.3762342529917818] 450 | [-2.509424062643524 0.008613111284491604] 451 | [0.7166394182451459 0.38741727394627445] 452 | [-2.3949265030988807 -0.6316537750594432] 453 | [0.45510933331358194 1.088530940143869] 454 | [0.47632757288054317 1.1575276280947369] 455 | [-2.472227972528737 0.7853534063050429] 456 | [0.5667705729271931 -0.5712243455137761] 457 | [-1.3038883742133676 1.8262764894674783] 458 | [-0.6826030501712917 -1.6164106929168345] 459 | [-0.7281601217756662 -1.6051308288309736] 460 | [-2.155786906518754 1.181526142786242] 461 | [-0.7228728682217355 -1.6266150805617559] 462 | [-1.528531726149816 1.651613816802768] 463 | [-1.738861226721658 1.5618840887466308] 464 | [-2.0921670590939403 1.3247235658618484] 465 | [-2.4687555888158332 0.8994298425047641] 466 | [0.20198088652994634 -1.1212114459603024] 467 | [-0.23413126496040065 -1.5129950413100164] 468 | [-1.079511667890468 -1.4908971769989376] 469 | [-0.18406771984189535 -1.5099445744817972] 470 | [0.7537833491497294 -0.16542090291823164] 471 | [-2.486839453356033 0.8762259746605392] 472 | [-0.551533697665864 -1.5848938191540451]]}) 473 | 474 | (deftest optimization-test 475 | (let [input (clj-import problem) 476 | results (benchmark-geex input) 477 | clj-results (benchmark-clj input) 478 | true-params (:true-params problem)] 479 | (is (= clj-results results)) 480 | (doseq [p [:cx :cy :r]] 481 | (is (< (Math/abs (- (p results) (p true-params))) 482 | 0.02))))) 483 | -------------------------------------------------------------------------------- /test/geex/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns geex.core-test 2 | (:import [geex SeedParameters Mode]) 3 | (:require [clojure.test :refer :all] 4 | [geex.core.defs :as defs] 5 | [geex.core :refer :all :as jcore] 6 | [geex.core.seed :as seed] 7 | [geex.core.defs :as defs] 8 | [geex.core.datatypes :as datatypes] 9 | [bluebell.utils.wip.check :refer [checked-defn]] 10 | [bluebell.utils.wip.java :as jutils :refer [set-field]]) 11 | (:refer-clojure :exclude [cast])) 12 | 13 | (deftest op-tests 14 | (eval-body 15 | clojure-state-settings 16 | (is (= (type-signature [9 9 (to-seed 10)]) 17 | [9 9 (typed-seed Long/TYPE)])) 18 | 19 | (is (= (type-signature {:a (to-seed 10.0)}) 20 | {:a (typed-seed Double/TYPE)})) 21 | (is (not (= (to-seed 10.0) (to-seed 10)))) 22 | 23 | (type-signature [:a {:b 'k}]) 24 | )) 25 | 26 | 27 | (deftest with-state-test 28 | (let [s (with-state-fn clojure-state-settings 29 | (fn [] defs/global-state))] 30 | (is (state? s))) 31 | (is (nil? defs/global-state)) 32 | (is (thrown? Exception (#'jcore/get-state))) 33 | (is (state? (with-state-fn clojure-state-settings 34 | #(#'jcore/get-state)))) 35 | (let [s (with-state clojure-state-settings 36 | (to-seed ::defs/nothing))] 37 | (is (state? s))) 38 | (let [s (with-state clojure-state-settings 39 | (wrap 1) 40 | (wrap 2) 41 | (wrap 3))] 42 | (is (= 3 (.getSeedCount s)))) 43 | (let [s (eval-body clojure-state-settings 44 | (wrap 1) (wrap 2) (wrap 3))] 45 | (is (state? s))) 46 | 47 | (is (= 1 (demo-embed (wrap 1)))) 48 | (is (= 119 (demo-embed (wrap 119)))) 49 | (is (= [1 2] (demo-embed (wrap [1 2])))) 50 | (is (= (demo-embed (let [x [1 2]] (wrap [x x]))) 51 | [[1 2] [1 2]])) 52 | (is (= (demo-embed (wrap :a)) 53 | :a)) 54 | (is (= (demo-embed (wrap "Kattskit")) 55 | "Kattskit")) 56 | (is (= [[1 2] [1 2]] 57 | (demo-embed (let [x (wrap [1 2])] (wrap [x x]))))) 58 | (is (nil? (demo-embed (wrap nil)))) 59 | (is (= (demo-embed (wrap [:a :b {:c 3}])) 60 | [:a :b {:c 3}])) 61 | (is (nil? (demo-embed (open-scope!) (close-scope!)))) 62 | (is (= 9 (demo-embed (open-scope!) 63 | (wrap 9) 64 | (close-scope!)))) 65 | (is (nil? (demo-embed (open-scope!) 66 | 9 67 | (close-scope!))))) 68 | 69 | (defn demo-compile-call-fn [state seed] 70 | (let [compiled-deps (seed/access-compiled-indexed-deps seed)] 71 | `(~(.getData seed) ~@compiled-deps))) 72 | 73 | (checked-defn demo-call-fn [:when check-debug 74 | 75 | _ mode 76 | symbol? f 77 | sequential? args 78 | 79 | :post ::defs/seed] 80 | (make-seed! 81 | (doto (SeedParameters.) 82 | (set-field data f) 83 | (set-field description (str "call " f)) 84 | (set-field mode mode) 85 | (set-field rawDeps (seed/access-indexed-map {} args)) 86 | (set-field type nil) 87 | (set-field compiler demo-compile-call-fn)))) 88 | 89 | (defmacro demo-make-fn [mode f] 90 | `(fn [& args#] 91 | (demo-call-fn ~mode (quote ~f) args#))) 92 | 93 | (defn demo-sub-step-counter [dst counter-key] 94 | (swap! dst #(update % counter-key (fn [x] (inc (or x 0)))))) 95 | 96 | (def demo-pure-add (demo-make-fn Mode/Pure +)) 97 | 98 | (def demo-step-counter (demo-make-fn 99 | Mode/SideEffectful 100 | demo-sub-step-counter)) 101 | 102 | (deftest pure-add-test 103 | (is (= 6 (demo-embed (demo-pure-add 1 2 3)))) 104 | (is (= (demo-embed 105 | (let [k (demo-pure-add 1 2 3) 106 | j (demo-pure-add k k)] 107 | (wrap [k j k]))) 108 | [6 12 6]))) 109 | 110 | (deftest side-effect-test 111 | (is (= (let [s (atom {})] 112 | #_(demo-sub-step-counter s :kattskit) 113 | (demo-embed (demo-step-counter 's :kattskit))) 114 | {:kattskit 1})) 115 | (is (= [{:katt 3} {:katt 2} {:katt 1}] 116 | (let [s (atom {})] 117 | (demo-embed 118 | (wrap (vec (reverse 119 | [(demo-step-counter 's :katt) 120 | (demo-step-counter 's :katt) 121 | (demo-step-counter 's :katt)])))))))) 122 | 123 | (deftest seq-coll-test 124 | (is (= '(1 2 3) (demo-embed (wrap '(1 2 3)))))) 125 | 126 | 127 | (deftest side-effects-in-scope-test 128 | (is (= {:a 2 :b 1} 129 | (let [s (atom {}) ] 130 | (demo-embed 131 | (open-scope!) 132 | (demo-step-counter 's :a) 133 | (demo-step-counter 's :a) 134 | (close-scope!) 135 | (demo-step-counter 's :b))))) 136 | (is (= {:a 2 :b 1} 137 | (let [s (atom {}) ] 138 | (demo-embed 139 | (open-scope!) 140 | (demo-step-counter 's :a) 141 | (demo-step-counter 's :a) 142 | (close-scope!) 143 | (demo-step-counter 's :b))))) 144 | (is (= {:a 2 :b 1} 145 | (let [s (atom {}) ] 146 | (demo-embed 147 | (open-scope!) 148 | (demo-step-counter 's :a) 149 | (demo-step-counter 's :a) 150 | (close-scope!) 151 | (demo-step-counter 's :b))))) 152 | (is (= {:b 1} 153 | (let [s (atom {}) ] 154 | (demo-embed 155 | (open-scope!) 156 | (demo-step-counter 's :b) 157 | (close-scope!)) 158 | (deref s)))) 159 | (is (= {:b 1} 160 | (let [s (atom {})] 161 | (demo-embed 162 | (open-scope!) 163 | (open-scope!) 164 | (close-scope!) 165 | (demo-step-counter 's :b) 166 | (close-scope!)) 167 | (deref s)))) 168 | (is (= {:b 1} 169 | (let [s (atom {}) ] 170 | (demo-embed 171 | (open-scope!) 172 | (open-scope!) 173 | (close-scope!) 174 | (open-scope!) 175 | (demo-step-counter 's :b) 176 | (close-scope!) 177 | (close-scope!)) 178 | (deref s)))) 179 | (is (= {:b 1} 180 | (let [s (atom {}) ] 181 | (demo-embed 182 | (open-scope!) 183 | (open-scope!) 184 | (close-scope!) 185 | (open-scope!) 186 | (open-scope!) 187 | (demo-step-counter 's :b) 188 | (close-scope!) 189 | (open-scope!) 190 | (close-scope!) 191 | (close-scope!) 192 | (close-scope!)) 193 | (deref s)))) 194 | (is (= {:b 1} 195 | (let [s (atom {}) ] 196 | (demo-embed 197 | (open-scope!) 198 | (open-scope!) 199 | (close-scope!) 200 | (open-scope!) 201 | (open-scope!) 202 | (open-scope!)(close-scope!) 203 | (open-scope!)(close-scope!) 204 | (open-scope!)(close-scope!) 205 | (demo-step-counter 's :b) 206 | (open-scope!)(close-scope!) 207 | (open-scope!)(close-scope!) 208 | (open-scope!)(close-scope!) 209 | (close-scope!) 210 | (open-scope!) 211 | (close-scope!) 212 | (close-scope!) 213 | (close-scope!)) 214 | (deref s)))) 215 | (is (= {:a 2, :b 2} 216 | (let [s (atom {}) ] 217 | (demo-embed 218 | (open-scope!) 219 | (open-scope!) 220 | (close-scope!) 221 | (open-scope!) 222 | (demo-step-counter 's :a) 223 | (open-scope!) 224 | (open-scope!)(close-scope!) 225 | (open-scope!)(close-scope!) 226 | (demo-step-counter 's :a) 227 | (open-scope!)(close-scope!) 228 | (demo-step-counter 's :b) 229 | (open-scope!)(close-scope!) 230 | (open-scope!)(close-scope!) 231 | (open-scope!)(close-scope!) 232 | (close-scope!) 233 | (open-scope!) 234 | (close-scope!) 235 | (demo-step-counter 's :b) 236 | (close-scope!) 237 | (close-scope!)) 238 | (deref s)))) 239 | (is (= {:a 3, :b 2} 240 | (let [s (atom {}) ] 241 | (demo-embed 242 | (open-scope!) 243 | (close-scope!) 244 | (open-scope!) 245 | (demo-step-counter 's :a) 246 | (demo-step-counter 's :a) 247 | (demo-step-counter 's :b) 248 | 249 | (open-scope!) 250 | (demo-step-counter 's :a) 251 | (close-scope!) 252 | (demo-step-counter 's :b) 253 | (close-scope!)) 254 | (deref s)))) 255 | (is (= (let [s (atom {}) ] 256 | (demo-embed 257 | (wrap 258 | (reverse 259 | [[(do (open-scope!) 260 | (demo-step-counter 's :a) 261 | (close-scope!))] 262 | [(do (open-scope!) 263 | (demo-step-counter 's :a) 264 | (close-scope!))]])))) 265 | '([{:a 2}] 266 | [{:a 1}])))) 267 | 268 | (deftest local-vars-test 269 | (is (= [0 1] 270 | (demo-embed 271 | (with-local-var-section 272 | (wrap 273 | [(declare-local-var!) 274 | (declare-local-var!)]))))) 275 | (is (= 119.0 (demo-embed 276 | (with-local-var-section 277 | (let [id (declare-local-var!)] 278 | (set-local-var! id 119.0)))))) 279 | (is (thrown? Exception 280 | (generate-and-eval 281 | (with-local-var-section 282 | (let [id (declare-local-var!)] 283 | (set-local-var! id 119.0) 284 | (set-local-var! id [])))))) 285 | (is (= 120.0 286 | (generate-and-eval 287 | (with-local-var-section 288 | (let [id (declare-local-var!)] 289 | (set-local-var! id 119.0) 290 | (set-local-var! id 120.0)))))) 291 | (is (= 119.0 (demo-embed 292 | (with-local-var-section 293 | (let [id (declare-local-var!)] 294 | (set-local-var! id 119.0) 295 | (get-local-var! id)))))) 296 | (is (= 120.0 297 | (demo-embed 298 | (with-local-var-section 299 | (let [id (declare-local-var!)] 300 | (set-local-var! id 119.0) 301 | (set-local-var! id 120.0) 302 | (get-local-var! id))))))) 303 | 304 | (deftest local-struct-test 305 | (is (= 119.0 (demo-embed 306 | (with-local-var-section 307 | (set-local-struct! :kattskit {:a (wrap 9) 308 | :b (wrap 10)}) 309 | (wrap 119.0))))) 310 | 311 | (is (= (demo-embed 312 | (with-local-var-section 313 | (set-local-struct! :kattskit {:a (wrap 9)}) 314 | (wrap (get-local-struct! :kattskit)))) 315 | {:a 9})) 316 | (is (= (demo-embed 317 | (with-local-var-section 318 | (set-local-struct! :kattskit {:a (wrap 11) 319 | :b (wrap 20)}) 320 | (set-local-struct! :kattskit {:a (wrap 9) 321 | :b (wrap 10)}) 322 | (wrap (get-local-struct! :kattskit)))) 323 | {:a 9 :b 10})) 324 | (is (= (demo-embed 325 | (with-local-var-section 326 | (set-local-struct! :kattskit {:a (wrap 11) 327 | :b (wrap 20)}) 328 | (set-local-struct! :kattskit (get-local-struct! :kattskit)) 329 | (wrap (get-local-struct! :kattskit)))) 330 | {:a 11 :b 20})) 331 | (is (= (demo-embed 332 | (with-local-var-section 333 | (set-local-struct! :kattskit [(wrap 9) (wrap 10)]) 334 | (set-local-struct! 335 | :kattskit (reverse (get-local-struct! :kattskit))) 336 | (wrap (get-local-struct! :kattskit)))) 337 | [10 9])) 338 | (is (thrown? Exception 339 | (generate-and-eval 340 | (with-local-var-section 341 | (set-local-struct! :kattskit [(wrap 9) (wrap 10)]) 342 | (set-local-struct! :kattskit [(wrap 9) 10])))))) 343 | 344 | (deftest if-test 345 | (is (= 3.0 (demo-embed (If true (wrap 3.0) (wrap 4.0))))) 346 | (is (= 4.0 (demo-embed (If false (wrap 3.0) (wrap 4.0))))) 347 | (is (= {:a 1 :b 1 :d 1 :f 1} 348 | (let [s (atom {})] 349 | (demo-embed 350 | (demo-step-counter 's :a) 351 | (If true 352 | (do (demo-step-counter 's :b) 353 | (if false 354 | (demo-step-counter 's :e) 355 | (demo-step-counter 's :f))) 356 | (do (demo-step-counter 's :c) 357 | (demo-step-counter 's :g))) 358 | (demo-step-counter 's :d))))) 359 | (is (= {:a 1 :b 1 :d 1 :f 1 :k 1} 360 | (let [s (atom {})] 361 | (demo-embed 362 | (demo-step-counter 's :a) 363 | (If true 364 | (do (demo-step-counter 's :b) 365 | (if false 366 | (demo-step-counter 's :e) 367 | (demo-step-counter 's :f)) 368 | (demo-step-counter 's :k)) 369 | (do (demo-step-counter 's :c) 370 | (demo-step-counter 's :g))) 371 | (demo-step-counter 's :d))))) 372 | (is (= {:a 1 :c 1 :g 1 :d 1} 373 | (let [s (atom {})] 374 | (demo-embed 375 | (demo-step-counter 's :a) 376 | (If false 377 | (do (demo-step-counter 's :b) 378 | (if false 379 | (demo-step-counter 's :e) 380 | (demo-step-counter 's :f)) 381 | (demo-step-counter 's :k)) 382 | (do (demo-step-counter 's :c) 383 | (demo-step-counter 's :g))) 384 | (demo-step-counter 's :d)))))) 385 | 386 | (deftest static-if-cond-test 387 | (is (= 119.0 388 | (demo-embed 389 | (wrap 390 | (If true 391 | 119.0 392 | (assert false "This code should never get evaluated!")))))) 393 | (is (= 119.0 394 | (demo-embed 395 | (wrap 396 | (If false 397 | (assert false "This code should never get evaluated!") 398 | 119.0)))))) 399 | 400 | (deftest test-nothing 401 | (is (= nil (demo-embed ::defs/nothing)))) 402 | 403 | 404 | (deftest wrap-recursive-test 405 | (is (= {:a 119} (wrap-recursive {:a (wrap-quote 119)}))) 406 | (is (= [:a 119] (wrap-recursive [:a (wrap-quote 119)]))) 407 | 408 | ;; Check that wrapping takes place 409 | (is (= 9 (demo-embed 410 | (with-local-var-section 411 | (wrap 412 | (If (wrap true) 413 | 9 414 | 10))))))) 415 | 416 | 417 | (deftest loop-without-recur 418 | (is (= 1 419 | (demo-embed 420 | (with-local-var-section 421 | (wrap 422 | (fn-loop 423 | [0] 424 | (fn [[state]] 425 | (demo-pure-add state 1))))))))) 426 | 427 | (deftest another-mini-loop 428 | (is (= 2 429 | (demo-embed 430 | (with-local-var-section 431 | (wrap 432 | (fn-loop [(seed/set-seed-type! (wrap 9) nil)] 433 | (fn [[x]] 434 | (If (demo-call-fn Mode/Pure 'not= [2 x]) 435 | (Recur (demo-call-fn Mode/Pure 'dec [x])) 436 | x))))))))) 437 | 438 | (defn wrap-pure-fn [f-sym] 439 | {:pre [(symbol? f-sym)]} 440 | (comp (partial demo-call-fn Mode/Pure f-sym) vector)) 441 | 442 | (def mymod (wrap-pure-fn 'mod)) 443 | (def my= (wrap-pure-fn '=)) 444 | (def my* (wrap-pure-fn '*)) 445 | (def my- (wrap-pure-fn '-)) 446 | 447 | (deftest another-mini-loop-2 448 | (is (= (* 9 7 5 3 1) 449 | (demo-embed 450 | (with-local-var-section 451 | (wrap 452 | (fn-loop 453 | [(seed/set-seed-type! (wrap 9) nil) ;; counter 454 | (seed/set-seed-type! (wrap 1) nil) ;; product 455 | ] 456 | (fn [[counter product]] 457 | (If (my= 0 counter) 458 | product 459 | (If (my= 0 (mymod counter 2)) 460 | (Recur (my- counter 1) 461 | product) 462 | (Recur (my- counter 1) 463 | (my* product counter)))))))))))) 464 | 465 | 466 | (deftest modify-state-var-test 467 | (is (= [119 nil] 468 | (binding [defs/global-state (make-clojure-state)] 469 | [(with-modified-state-var "a" (fn [x] 119) 470 | (get-state-var "a")) 471 | (get-state-var "a")]))) 472 | (is (= [119 nil] 473 | (binding [defs/global-state (make-clojure-state)] 474 | [(with-new-state-var "a" 119 475 | (get-state-var "a")) 476 | (get-state-var "a")])))) 477 | --------------------------------------------------------------------------------