dependencies
| (this space intentionally left almost blank) | |||||||||||||||||||||
JavaFX is used through the fn-fx
library. When the application is run through thi.ng/geom-viz is for making plots and other pretty SVG things FranzXaver is for converting the output SVGs to something that can be put into a Group in JavaFX. | (ns asparapiss.core
(:require [asparapiss.math :as math]
[asparapiss.plot :as plot]
[fn-fx.fx-dom :as dom] ;; The JavaFX libraries
[fn-fx.diff :refer [component defui render should-update?]]
[fn-fx.controls :as ui])) | |||||||||||||||||||||
Globals | ||||||||||||||||||||||
(def main-font (ui/font :family "Helvetica" :size 20)) | ||||||||||||||||||||||
Event Handler | ||||||||||||||||||||||
This is the event handler multimethod through which all events go through. It will 'switch' on the :event key | (defmulti handle-event
(fn [state event]
(:event event))) | |||||||||||||||||||||
ClickyGraphThe area of the window where you click to add point. The points are accumulated into the state map and are then are used to generate a plot | ||||||||||||||||||||||
(defui ClickyGraph
(render [this {:keys [width height points degree]}]
(ui/pane
:on-mouse-pressed {:event :mouse-click ;; this part is black-magic
:fn-fx/include {:fn-fx/event #{:x :y}}}
:children [(plot/plot-points points degree width height)]))) | ||||||||||||||||||||||
(defmethod handle-event :mouse-click
[state {:keys [fn-fx/includes]}]
(let [{:keys [x y]} (:fn-fx/event includes)]
(cond (and (> x 0) (> y 0))
(update-in state [:points] conj [x y])
:else
state))) | ||||||||||||||||||||||
MainWindowthe root node of the scene-graph. It will track the scene size and redraw the plot when it changes | ||||||||||||||||||||||
(defui MainWindow
(render [this args];{:keys [points]}]
(ui/v-box
:id ::graph
:style
"-fx-base: rgb(255, 255, 255);
-fx-focus-color: transparent;"
:listen/height {:event :resize-height ;; more black-magic
:fn-fx/include {::graph #{:height}}}
:listen/width {:event :resize-width
:fn-fx/include {::graph #{:width}}}
:children [(ui/slider
:id ::degree-spinner
:min 0
:max (double (count (:points args)))
:show-tick-marks true
:show-tick-labels true
:major-tick-unit 1
:block-increment 1
:value (:degree args)
:listen/value {:event :change-degree ;; more black-magic
:fn-fx/include {::degree-spinner #{:value}}} )
(clicky-graph args)]))) | ||||||||||||||||||||||
(defmethod handle-event :resize-width
[state {:keys [fn-fx/includes]}]
(assoc-in state [:width] (get-in includes [::graph :width]))) | ||||||||||||||||||||||
(defmethod handle-event :resize-height
[state {:keys [fn-fx/includes]}]
(assoc-in state [:height] (get-in includes [::graph :height]))) | ||||||||||||||||||||||
(defmethod handle-event :change-degree
[state {:keys [fn-fx/includes]}]
(assoc-in state [:degree] (get-in includes [::degree-spinner :value]))) | ||||||||||||||||||||||
Stagethe JavaFX top level container that stands for a window The stage has a scene container for all content ie. a scene-graph of nodes. Each Stage/Window displays one scene at a time | ||||||||||||||||||||||
(defui Stage
(render [this args]
(ui/stage
:title "Asparapiss"
:shown true
:scene (ui/scene
:root (main-window args))))) | ||||||||||||||||||||||
Launching fn-fx
| ||||||||||||||||||||||
This is where we initialize the whole fn-fx monster | (defn -main
[]
(let [data-state (atom {:width 500.0
:height 500.0
:points [];[[0 0][100 100][200 200]]
:degree 0})
handler-fn (fn [event]
(try
(swap! data-state handle-event event)
(catch Throwable ex
(println ex))))
ui-state (agent (dom/app (stage @data-state) handler-fn))]
(add-watch data-state
:ui (fn [_ _ _ _]
(send ui-state
(fn [old-ui]
(try
(dom/update-app
old-ui
(stage @data-state))
(catch Throwable ex
(println ex))))))))) | |||||||||||||||||||||
(ns asparapiss.math
(:require [clojure.math.numeric-tower :as math]
[clojure.core.matrix :as matrix]
[clojure.core.matrix.linear :as matrix-linear])) | ||||||||||||||||||||||
Vandermonde MatrixWe want to solve for a polynomial that will fit all the given points | ||||||||||||||||||||||
set the core.matrix backend | (matrix/set-current-implementation :vectorz) | |||||||||||||||||||||
Take a vector of numbers [a b c d ..] and makes an indexed-pair version [[0 a] [1 b] [2 c] [3 d] ..] the polynomial for each point is of the form: a0 + a1 x + a2 x^2 + a3 x^3 + ... = y So given an x we need to generate the polynomials x, x^2, x^3 ... | (defn index-vector ([vector] (index-vector vector (count vector))) ([vector length] (map (fn [i] [i (get vector i)]) (range 0 length)))) | |||||||||||||||||||||
Given an x, generate a vector of [x x^2 x^3 .. x^LENGTH] | (defn polynomial-vector [x length] (map #(math/expt x %) (range 0 length))) | |||||||||||||||||||||
Wrapper for the previous function that puts it in a row-matrix | (defn polynomial-row [x length] (matrix/row-matrix (polynomial-vector x length))) | |||||||||||||||||||||
Take a vector of x's and build a vandermonde matrix of polynomials of a given degree. By default the degree matches the number of points. ie. it's square | (defn vandermonde-matrix
([x]
(vandermonde-matrix x (count x)))
([x degree]
(let [vandermonde-rows (map #(polynomial-row % degree) x)]
(matrix/matrix
(reduce (fn [matrix next-row] (matrix/join matrix next-row))
vandermonde-rows))))) | |||||||||||||||||||||
Given polynomial factors, return the polynomial function (ie. given x, returns y) polynomial factors : a0 a1 a2 a3 ... function returned: y = a0 +a1x + a2x^2 + a3x^3 ... | (defn polynomial-function
[indexed-polynomial-factors]
(fn [x] [x (reduce
(fn [accumulated-value next-exponent]
(+ accumulated-value
(* (second next-exponent)
(math/expt x (first next-exponent)))))
0
indexed-polynomial-factors)])) | |||||||||||||||||||||
Given several points, return a polynomial function (given an x, returns a y) | (defn fit-polynomial
[points]
(cond (empty? points) ;; degenerate case
(fn [x] [x 0.0])
:else
(let [xs (map first points)
ys (map second points)
polynomial-factors
(matrix-linear/solve (vandermonde-matrix xs)
(matrix/array ys))
indexed-polynomial-factors (-> polynomial-factors
matrix/to-nested-vectors
index-vector)]
(polynomial-function indexed-polynomial-factors)))) | |||||||||||||||||||||
Fit a polynomial of a given degree using a naiive least-squares solution of the form A^T*A=A^Tb | (defn least-squares-polynomial-unstable
[points degree]
(cond (< degree 1) ;; degenerate case
(fn [x] [x 0.0])
:else
(let [xs (map first points)
ys (map second points)
A (vandermonde-matrix xs degree)
AT (matrix/transpose A)
ATA (matrix/mmul AT A)
ATb (matrix/to-vector (matrix/mmul AT (matrix/column-matrix ys)))
polynomial-factors (matrix-linear/solve ATA
ATb)
indexed-polynomial-factors (-> polynomial-factors
matrix/to-nested-vectors
index-vector)]
(polynomial-function indexed-polynomial-factors)))) | |||||||||||||||||||||
Fit a polynomial of a given degree using a naiive least-squares solution of the form A^T*A=A^Tb | (defn least-squares-polynomial
[points degree]
(cond (< degree 1) ;; degenerate case
(fn [x] [x 0.0])
:else
(let [xs (map first points)
ys (map second points)
number-of-points (count points)
A (vandermonde-matrix xs degree)
AT (matrix/transpose A)
I (matrix/identity-matrix number-of-points)
zeroes (matrix/zero-matrix degree degree)
first-block-row (matrix/join-along 1 I A)
second-block-row (matrix/join-along 1 AT zeroes)
least-squares-matrix (matrix/matrix (matrix/join-along
0
first-block-row
second-block-row))
output-vector (matrix/to-vector (matrix/join (matrix/column-matrix ys)
(matrix/zero-matrix degree 1)))
solution (matrix-linear/solve least-squares-matrix
output-vector)
polynomial-factors (matrix/submatrix solution number-of-points degree 0 1)
indexed-polynomial-factors (-> polynomial-factors
matrix/to-nested-vectors
index-vector)
]
(polynomial-function indexed-polynomial-factors)))) | |||||||||||||||||||||
(ns asparapiss.plot
(:require [asparapiss.math :as math]
[asparapiss.svg2jfx :as svg2jfx]
[thi.ng.geom.core :as g] ;; The graphing libraires
[thi.ng.math.core :as m]
[thi.ng.geom.viz.core :as viz]
[thi.ng.geom.svg.core :as svgthing])) | ||||||||||||||||||||||
Given a size (WIDTH HEIGHT) the output spec describes how the plot looks. More detail are in geom-viz. The data has been left initialized | (defn plot-spec
[points width height]
{:x-axis (viz/linear-axis
{:domain [0 width]
:range [0 width]
;; puts the axis out of view (can't show the grid with no axis)
:pos -100
:major 100
})
:y-axis (viz/linear-axis
{:domain [0 height]
:range [0 height]
;; puts the axis out of view (can't show the grid with no axis)
:pos -100
:label-dist 0
:major 100
:label-style {:text-anchor "end"}
})
:grid {:attribs {:stroke "#caa"}
:minor-x false
:minor-y false}
:data [{:values nil
:attribs {:fill "none" :stroke "#f60" :stroke-width 2.25}
:shape (viz/svg-triangle-down 6)
:layout viz/svg-scatter-plot}
{:values nil
:attribs {:fill "none" :stroke "#0af" :stroke-width 2.25}
:layout viz/svg-line-plot}
{:values nil
:attribs {:fill "none" :stroke "#0ff" :stroke-width 2.25}
:layout viz/svg-line-plot}]}) | |||||||||||||||||||||
Adds data (POINTS) to the spec and generates an SVG | (defn plot-points
[points degree output-width output-height]
(svg2jfx/svg-to-javafx-group
(-> (plot-spec points output-width output-height)
(assoc-in [:data 0 :values]
points)
(assoc-in [:data 1 :values]
(map (math/least-squares-polynomial points degree) (range 10000)))
(assoc-in [:data 2 :values]
(map (math/least-squares-polynomial-unstable points degree) (range 10000)))
(viz/svg-plot2d-cartesian)
(#(svgthing/svg {:width output-width
:height output-height}
%))
(svgthing/serialize)))) | |||||||||||||||||||||
(ns asparapiss.svg2jfx (:import [afester.javafx.svg SvgLoader])) | ||||||||||||||||||||||
Converting SVGs to JavaFX objectsTakes a string and turns it into an input stream | (defn string->stream
([s] (string->stream s "UTF-8"))
([s encoding]
(-> s
(.getBytes encoding)
(java.io.ByteArrayInputStream.)))) | |||||||||||||||||||||
Use the FranzXaver library to turn a string of XML describing an SVG into a JavaFX compatible Group Node (which shows up as a picture) This is using Batik under the hood somehow | (defn svg-to-javafx-group [svg-xml-string] (.loadSvg (SvgLoader.) (string->stream svg-xml-string))) | |||||||||||||||||||||