15 | * Instance methods operate on a user supplied uniform random number generator; they are unsynchronized.
16 | *
17 | * Static methods operate on a default uniform random number generator; they are synchronized.
18 | *
19 | *
20 | * @author Hongbo Liu hongbol@winlab.rutgers.edu
21 | * @version 0.1
22 | */
23 | public class Weibull extends AbstractContinousDoubleDistribution {
24 |
25 | protected double scale;
26 | protected double shape;
27 |
28 | // The uniform random number generated shared by all static methods.
29 | protected static Weibull shared = new Weibull(1.0, 1.5, makeDefaultGenerator());
30 |
31 | /**
32 | * Constructs a Pareto distribution.
33 | */
34 | public Weibull(double a, double b, DoubleRandomEngine randomGenerator) {
35 | setRandomGenerator(randomGenerator);
36 | this.scale = a;
37 | this.shape = b;
38 | }
39 |
40 | /**
41 | * Returns the cumulative distribution function.
42 | */
43 | public double cdf(double x) {
44 | if (x < 0)
45 | return 0.0;
46 | return 1.0 - Math.exp(-Math.pow(x/scale,shape));
47 | }
48 |
49 | /**
50 | * Returns a random number from the distribution.
51 | */
52 | public double nextDouble() {
53 | return scale*Math.pow(-Math.log(1-randomGenerator.raw()), 1/shape);
54 | }
55 |
56 | /**
57 | * Returns a random number from the distribution; bypasses the internal
58 | state.*/
59 | public double nextDouble(double a, double b) {
60 | return a*Math.pow(-Math.log(1-randomGenerator.raw()), 1/b);
61 | }
62 |
63 | /**
64 | * Returns the probability distribution function.
65 | */
66 | public double pdf(double x) {
67 | if (x < 0)
68 | return 0.0;
69 | return shape/scale*Math.pow(x/scale, shape-1)
70 | *Math.exp(-Math.pow(x/scale,shape));
71 | }
72 |
73 | /**
74 | * Sets the parameters.
75 | */
76 | public void setState(double a, double b) {
77 | this.scale = a;
78 | this.shape = b;
79 | }
80 |
81 | /**
82 | * Returns a random number from the distribution with the given
83 | * scale = k, and shape = alpha.
84 | */
85 | public static double staticNextDouble(double a, double b) {
86 | synchronized (shared) {
87 | return shared.nextDouble(a,b);
88 | }
89 | }
90 |
91 | /**
92 | * Returns a String representation of the receiver.
93 | */
94 | public String toString() {
95 | return this.getClass().getName() + "(" + scale + ", " + shape + ")";
96 | }
97 |
98 | }
99 |
100 |
--------------------------------------------------------------------------------
/data/co2.csv:
--------------------------------------------------------------------------------
1 | Plant,Type,Treatment,conc,uptake
2 | Qn1,Quebec,nonchilled, 95, 16.0
3 | Qn1,Quebec,nonchilled, 175, 30.4
4 | Qn1,Quebec,nonchilled, 250, 34.8
5 | Qn1,Quebec,nonchilled, 350, 37.2
6 | Qn1,Quebec,nonchilled, 500, 35.3
7 | Qn1,Quebec,nonchilled, 675, 39.2
8 | Qn1,Quebec,nonchilled,1000, 39.7
9 | Qn2,Quebec,nonchilled, 95, 13.6
10 | Qn2,Quebec,nonchilled, 175, 27.3
11 | Qn2,Quebec,nonchilled, 250, 37.1
12 | Qn2,Quebec,nonchilled, 350, 41.8
13 | Qn2,Quebec,nonchilled, 500, 40.6
14 | Qn2,Quebec,nonchilled, 675, 41.4
15 | Qn2,Quebec,nonchilled,1000, 44.3
16 | Qn3,Quebec,nonchilled, 95, 16.2
17 | Qn3,Quebec,nonchilled, 175, 32.4
18 | Qn3,Quebec,nonchilled, 250, 40.3
19 | Qn3,Quebec,nonchilled, 350, 42.1
20 | Qn3,Quebec,nonchilled, 500, 42.9
21 | Qn3,Quebec,nonchilled, 675, 43.9
22 | Qn3,Quebec,nonchilled,1000, 45.5
23 | Qc1,Quebec, chilled, 95, 14.2
24 | Qc1,Quebec, chilled, 175, 24.1
25 | Qc1,Quebec, chilled, 250, 30.3
26 | Qc1,Quebec, chilled, 350, 34.6
27 | Qc1,Quebec, chilled, 500, 32.5
28 | Qc1,Quebec, chilled, 675, 35.4
29 | Qc1,Quebec, chilled,1000, 38.7
30 | Qc2,Quebec, chilled, 95, 9.3
31 | Qc2,Quebec, chilled, 175, 27.3
32 | Qc2,Quebec, chilled, 250, 35.0
33 | Qc2,Quebec, chilled, 350, 38.8
34 | Qc2,Quebec, chilled, 500, 38.6
35 | Qc2,Quebec, chilled, 675, 37.5
36 | Qc2,Quebec, chilled,1000, 42.4
37 | Qc3,Quebec, chilled, 95, 15.1
38 | Qc3,Quebec, chilled, 175, 21.0
39 | Qc3,Quebec, chilled, 250, 38.1
40 | Qc3,Quebec, chilled, 350, 34.0
41 | Qc3,Quebec, chilled, 500, 38.9
42 | Qc3,Quebec, chilled, 675, 39.6
43 | Qc3,Quebec, chilled,1000, 41.4
44 | Mn1,Mississippi,nonchilled, 95, 10.6
45 | Mn1,Mississippi,nonchilled, 175, 19.2
46 | Mn1,Mississippi,nonchilled, 250, 26.2
47 | Mn1,Mississippi,nonchilled, 350, 30.0
48 | Mn1,Mississippi,nonchilled, 500, 30.9
49 | Mn1,Mississippi,nonchilled, 675, 32.4
50 | Mn1,Mississippi,nonchilled,1000, 35.5
51 | Mn2,Mississippi,nonchilled, 95, 12.0
52 | Mn2,Mississippi,nonchilled, 175, 22.0
53 | Mn2,Mississippi,nonchilled, 250, 30.6
54 | Mn2,Mississippi,nonchilled, 350, 31.8
55 | Mn2,Mississippi,nonchilled, 500, 32.4
56 | Mn2,Mississippi,nonchilled, 675, 31.1
57 | Mn2,Mississippi,nonchilled,1000, 31.5
58 | Mn3,Mississippi,nonchilled, 95, 11.3
59 | Mn3,Mississippi,nonchilled, 175, 19.4
60 | Mn3,Mississippi,nonchilled, 250, 25.8
61 | Mn3,Mississippi,nonchilled, 350, 27.9
62 | Mn3,Mississippi,nonchilled, 500, 28.5
63 | Mn3,Mississippi,nonchilled, 675, 28.1
64 | Mn3,Mississippi,nonchilled,1000, 27.8
65 | Mc1,Mississippi, chilled, 95, 10.5
66 | Mc1,Mississippi, chilled, 175, 14.9
67 | Mc1,Mississippi, chilled, 250, 18.1
68 | Mc1,Mississippi, chilled, 350, 18.9
69 | Mc1,Mississippi, chilled, 500, 19.5
70 | Mc1,Mississippi, chilled, 675, 22.2
71 | Mc1,Mississippi, chilled,1000, 21.9
72 | Mc2,Mississippi, chilled, 95, 7.7
73 | Mc2,Mississippi, chilled, 175, 11.4
74 | Mc2,Mississippi, chilled, 250, 12.3
75 | Mc2,Mississippi, chilled, 350, 13.0
76 | Mc2,Mississippi, chilled, 500, 12.5
77 | Mc2,Mississippi, chilled, 675, 13.7
78 | Mc2,Mississippi, chilled,1000, 14.4
79 | Mc3,Mississippi, chilled, 95, 10.6
80 | Mc3,Mississippi, chilled, 175, 18.0
81 | Mc3,Mississippi, chilled, 250, 17.9
82 | Mc3,Mississippi, chilled, 350, 17.9
83 | Mc3,Mississippi, chilled, 500, 17.9
84 | Mc3,Mississippi, chilled, 675, 18.9
85 | Mc3,Mississippi, chilled,1000, 19.9
86 |
87 |
--------------------------------------------------------------------------------
/modules/incanter-core/test/incanter/infix_tests.clj:
--------------------------------------------------------------------------------
1 | ;;; infix-tests.clj -- Unit tests of Incanter infix expression functions
2 |
3 | ;; by Michael Nygard http://incanter.org
4 | ;; Sept 16 2011
5 |
6 | ;; Copyright (c) David Edgar Liebke, 2009. All rights reserved. The use
7 | ;; and distribution terms for this software are covered by the Eclipse
8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
9 | ;; which can be found in the file epl-v10.html at the root of this
10 | ;; distribution. By using this software in any fashion, you are
11 | ;; agreeing to be bound by the terms of this license. You must not
12 | ;; remove this notice, or any other, from this software.
13 |
14 |
15 |
16 | (ns incanter.infix-tests
17 | (:use clojure.test
18 | (incanter core infix)))
19 |
20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 | ;; UNIT TESTS FOR incanter.infix.clj
22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 |
24 | (deftest basic-arithmetic
25 | (is (= ($= 7 + 8 - 2 * 6 / 2) 9))
26 | (is (= ($= [1 2 3] + 5) '(6 7 8)))
27 | (is (= ($= [1 2 3] + [4 5 6]) '(5 7 9)))
28 | (is (= ($= [1 2 3] * [1 2 3]) '(1 4 9)))
29 | (is (= ($= [1 2 3] / [1 2 3]) '(1 1 1)))
30 | (is (= ($= (matrix [[1 2] [4 5]]) + 6) (matrix [[7 8] [10 11]])))
31 | (is (= ($= (trans [[1 2] [4 5]]) + 6) (matrix [[7 10] [8 11]])))
32 | (is (= ($= 8 ** 3) 512.0))
33 | (is (= ($= 8 ** 1/2) 2.8284271247461903))
34 | (is (= ($= 2 ** -2) 0.25))
35 | (is (= ($= [1 2 3] ** 2) '(1.0 4.0 9.0)))
36 | (is (= ($= 10 + 20 * (4 - 5) / 6) 20/3))
37 | (is (= ($= (10 + 20) * 4 - 5 / 6) 715/6))
38 | (is (= ($= 10 + 20 * (4 - 5 / 6)) 220/3))
39 | (is (= ($= ((((5 + 4) * 5)))) 45)))
40 |
41 | (deftest functions-in-infix-expressions
42 | (is (= (let [x 10 y -5] ($= x + y / -10)) 21/2))
43 | (is (= ($= (sqrt 5) * 5 + 3 * 3) 20.18033988749895))
44 | (is (= ($= sq [1 2 3] + [1 2 3]) [2 6 12]))
45 | (is (= ($= sin 2 * Math/PI * 2) 5.713284232087328))
46 | (is (= ($= (cos 0) * 10) 10.0))
47 | (is (= ($= (tan 2) * Math/PI * 10) -68.64505182223235))
48 | (is (= ($= (asin 1/2) * 10) 5.23598775598299))
49 | (is (= ($= (acos 1/2) * 10) 10.47197551196598))
50 | (is (= ($= (atan 1/2) * 10) 4.636476090008061))
51 | (is (= ($= [1 2 3] / (sq [1 2 3]) + [5 6 7]) '(6 13/2 22/3)))
52 | (is (= ($= [1 2 3] + (sin [4 5 6])) '(0.2431975046920718 1.0410757253368614 2.720584501801074)))
53 | (is (= ($= 3 > (5 * 2/7)) true))
54 | (is (= ($= 3 <= (5 * 2/7)) false))
55 | (is (= ($= 3 != (5 * 2/7)) true))
56 | (is (= ($= 3 == (5 * 2/7)) false))
57 | (is (= ($= 3 != 8 || 6 > 12) true)))
58 |
59 | (deftest matrix-products-in-infix
60 | (is (= ($= [1 2 3] <*> (trans [1 2 3])) (matrix [[1 2 3] [2 4 6] [3 6 9]])))
61 | (is (= ($= (trans [[1 2] [4 5]]) <*> (matrix [[1 2] [4 5]])) (matrix [[17 22] [22 29]])))
62 | (is (= ($= (trans [1 2 3 4]) <*> [1 2 3 4]) 30.0))
63 | (is (= ($= [1 2 3 4] <*> (trans [1 2 3 4])) (matrix [[1 2 3 4] [2 4 6 8] [3 6 9 12] [4 8 12 16]]))))
64 |
65 | (deftest kronecker-product-in-infix
66 | (is (= ($= [1 2 3] [1 2 3]) (matrix [1 2 3 2 4 6 3 6 9])))
67 | (is (= ($= (matrix [[1 2] [3 4] [5 6]]) 4) (matrix [[4 8] [12 16] [20 24]])))
68 | (is (= ($= (matrix [[1 2] [3 4] [5 6]]) (matrix [[1 2] [3 4]])) (matrix [[1 2 2 4] [3 4 6 8] [3 6 4 8] [9 12 12 16] [5 10 6 12] [15 20 18 24]])))
69 | (is (= ($= [1 2 3 4] 4) (matrix [4 8 12 16])))
70 | (is (= ($= [1 2 3 4] (trans [1 2 3 4])) (matrix [[1 2 3 4] [2 4 6 8] [3 6 9 12] [4 8 12 16]]))))
71 |
72 |
--------------------------------------------------------------------------------
/examples/processing/simple_rgb_cube.clj:
--------------------------------------------------------------------------------
1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 | ; Simple 3d Clojure code example for Incanter and Processing
3 | ; Adapted by James Swift (james at 3dengineer com)
4 | ; from the simple_interation.clj example that comes with incanter
5 | ; and the RGB cube example here http://processing.org/learning/3d/rgbcube.html
6 |
7 | (ns example
8 | (:use [incanter core processing]))
9 |
10 | ;; set up variable references to use in the sketch object
11 | (let [X (ref nil)
12 | Y (ref nil)
13 | nX (ref nil)
14 | nY (ref nil)
15 | delay 16
16 |
17 | ;; define a sketch object (i.e. PApplet)
18 | sktch (sketch
19 |
20 | ;; define the setup function
21 | (setup []
22 | (doto this
23 | (no-stroke)
24 | (size 790 590 P3D)
25 | (color-mode RGB 1))
26 | (dosync
27 | (ref-set X (/ (width this) 2))
28 | (ref-set Y (/ (width this) 2))
29 | (ref-set nX @X)
30 | (ref-set nY @Y)))
31 |
32 | ;; define the draw function
33 | (draw []
34 | (doto this
35 | (background (color 0xFFFFFF))
36 | (push-matrix)
37 | (translate (/ (width this) 2) (/ (height this) 2) -30)
38 | (rotate-x (- @nX))
39 | (rotate-y (- @nY))
40 | (scale 90)
41 | (begin-shape QUADS)
42 | (fill 0 1 1) (vertex -1 1 1)
43 | (fill 1 1 1) (vertex 1 1 1)
44 | (fill 1 0 1) (vertex 1 -1 1)
45 | (fill 0 0 1) (vertex -1 -1 1)
46 |
47 | (fill 1 1 1) (vertex 1 1 1)
48 | (fill 1 1 0) (vertex 1 1 -1)
49 | (fill 1 0 0) (vertex 1 -1 -1)
50 | (fill 1 0 1) (vertex 1 -1 1)
51 |
52 | (fill 1 1 0) (vertex 1 1 -1)
53 | (fill 0 1 0) (vertex -1 1 -1)
54 | (fill 0 0 0) (vertex -1 -1 -1)
55 | (fill 1 0 0) (vertex 1 -1 -1)
56 |
57 | (fill 0 1 0) (vertex -1 1 -1)
58 | (fill 0 1 1) (vertex -1 1 1)
59 | (fill 0 0 1) (vertex -1 -1 1)
60 | (fill 0 0 0) (vertex -1 -1 -1)
61 |
62 | (fill 0 1 0) (vertex -1 1 -1)
63 | (fill 1 1 0) (vertex 1 1 -1)
64 | (fill 1 1 1) (vertex 1 1 1)
65 | (fill 0 1 1) (vertex -1 1 1)
66 |
67 | (fill 0 0 0) (vertex -1 -1 -1)
68 | (fill 1 0 0) (vertex 1 -1 -1)
69 | (fill 1 0 1) (vertex 1 -1 1)
70 | (fill 0 0 1) (vertex -1 -1 1)
71 | (end-shape)
72 | (pop-matrix)
73 | ))
74 |
75 | ;; define mouseMoved function (mouseMoved and mouseDraw
76 | ;; require a 'mouse-event' argument unlike the standard Processing
77 | ;; methods)
78 | (mouseMoved [mouse-event]
79 | (dosync
80 | ;; mouse-x and mouse-y take the mouse-event as an argument
81 | (ref-set nX (* (/ (mouse-y mouse-event) (width this)) TWO_PI))
82 | (ref-set nY (* (/ (mouse-x mouse-event) (height this)) TWO_PI)))))]
83 |
84 | ;; use the view function to display the sketch
85 | (view sktch :size [800 600]))
86 |
87 |
--------------------------------------------------------------------------------
/modules/incanter-io/test/incanter/io_tests.clj:
--------------------------------------------------------------------------------
1 |
2 | ;;; test-cases.clj -- Unit tests of Incanter functions
3 |
4 | ;; by David Edgar Liebke http://incanter.org
5 | ;; March 12, 2009
6 |
7 | ;; Copyright (c) David Edgar Liebke, 2009. All rights reserved. The use
8 | ;; and distribution terms for this software are covered by the Eclipse
9 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
10 | ;; which can be found in the file epl-v10.html at the root of this
11 | ;; distribution. By using this software in any fashion, you are
12 | ;; agreeing to be bound by the terms of this license. You must not
13 | ;; remove this notice, or any other, from this software.
14 |
15 | ;; CHANGE LOG
16 | ;; March 12, 2009: First version
17 |
18 | ;; to run these tests:
19 | ;; (use 'tests test-cases)
20 | ;; need to load this file to define data variables
21 | ;; (use 'clojure.contrib.test-is)
22 | ;; then run tests
23 | ;; (run-tests 'incanter.tests.test-cases)
24 |
25 | (ns incanter.io-tests
26 | (:use clojure.test
27 | (incanter core io)))
28 |
29 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 | ;; UNIT TESTS FOR incanter.io.clj
31 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 |
33 | ;(def incanter-home (System/getProperty "incanter.home"))
34 | (def incanter-home "../../")
35 |
36 | ;; read in a dataset from a space delimited file
37 | (def test-data (read-dataset
38 | (str incanter-home "data/cars.dat")
39 | :delim \space
40 | :header true)) ; default delimiter: \,
41 | ;; read in a dataset from a comma delimited file
42 | (def test-csv-data (read-dataset
43 | (str incanter-home "data/cars.csv")
44 | :header true))
45 | ;; read in a dataset from a tab delimited file
46 | (def test-tdd-data (read-dataset
47 | (str incanter-home "data/cars.tdd")
48 | :header true
49 | :delim \tab))
50 | ;; read in the iris dataset from a space delimited file
51 | (def iris-data (read-dataset
52 | (str incanter-home "data/iris.dat")
53 | :delim \space
54 | :header true))
55 | ;; read in the social science survey dataset from a space delimited file
56 | (def ols-data (to-matrix (read-dataset
57 | (str incanter-home "data/olsexamp.dat")
58 | :delim \space
59 | :header true)))
60 |
61 | ;; convert the space-delimited dataset into a matrix
62 | (def test-mat (to-matrix test-data))
63 | ;; convert the csv dataset into a matrix
64 | (def test-csv-mat (to-matrix test-csv-data))
65 | ;; convert the tab-delimited dataset into a matrix
66 | (def test-tdd-mat (to-matrix test-tdd-data))
67 | ;; convert the iris-data into a matrix, encoding strings into multiple dummy variables
68 | (def iris-mat (to-matrix iris-data))
69 | (def iris-mat-dummies (to-matrix iris-data :dummies true))
70 |
71 |
72 | (deftest io-validation
73 | ;; validate matrices read from files
74 | (is (= (reduce plus test-mat) (matrix [770 2149] 2)))
75 | (is (= (reduce plus test-csv-mat) (matrix [770 2149] 2)))
76 | (is (= (reduce plus test-tdd-mat) (matrix [770 2149] 2)))
77 | ;; confirm that iris species factor was converted to two dummy variables
78 | (is (= (first iris-mat) (matrix [5.10 3.50 1.40 0.20 0] 5)))
79 | (is (= (first iris-mat-dummies) (matrix [5.10 3.50 1.40 0.20 0 0] 6)))) ;; end of io-validation tests
80 |
81 | (deftest read-dataset-validation
82 | (doseq [[name cars-dataset]
83 | [["dat" test-data]
84 | ["csv" test-csv-data]
85 | ["tdd" test-tdd-data]]]
86 | (is (= [:speed :dist] (:column-names cars-dataset)) (str "Reading column names for " name " failed"))
87 | (is (= 50 (count (:rows cars-dataset)))) (str "Reading rows for " name " failed"))) ;; end of read-dataset-validation tests
88 |
89 |
90 |
--------------------------------------------------------------------------------
/modules/incanter-excel/src/incanter/excel/cells.clj:
--------------------------------------------------------------------------------
1 | (ns
2 | ^{:doc "Functions for reading and writing to cells."}
3 | incanter.excel.cells
4 | (:import [org.apache.poi.ss.usermodel Cell CellStyle DateUtil]
5 | [org.apache.poi.ss.usermodel Row Sheet]))
6 |
7 | (defmulti
8 | write-cell
9 | #(cond
10 | (isa? (. % getClass) Number) :numeric
11 | (keyword? %) :keyword
12 | :else :other))
13 |
14 | (defmulti
15 | get-cell-formula-value
16 | "Get the value after the evaluating the formula. See http://poi.apache.org/spreadsheet/eval.html#Evaluate"
17 | (fn [evaled-cell evaled-type]
18 | evaled-type))
19 |
20 | (defmulti
21 | get-cell-value
22 | "Get the cell value depending on the cell type."
23 | (fn [cell]
24 | (let [ct (. cell getCellType)]
25 | (if (not (= Cell/CELL_TYPE_NUMERIC ct))
26 | ct
27 | (if (DateUtil/isCellDateFormatted cell)
28 | :date
29 | ct)))))
30 |
31 | (defn write-line [^Sheet sheet row-num line ^CellStyle style]
32 | (let [^Row xl-line (. sheet createRow row-num)]
33 | (dorun
34 | (map
35 | #(if (not (nil? %2))
36 | (doto (. xl-line createCell %1) (.setCellValue (write-cell %2)) (.setCellStyle style)))
37 | (iterate inc 0)
38 | (seq line)))))
39 |
40 | (defn write-line-values [{:keys [sheet bold normal workbook]} bold? row-number coll]
41 | (write-line sheet row-number coll (if bold? bold normal)))
42 | (defn cell-iterator [^Row row]
43 | (if row
44 | (for [idx (range (.getFirstCellNum row) (.getLastCellNum row))]
45 | (if-let [cell (.getCell row idx)]
46 | cell
47 | (.createCell row idx Cell/CELL_TYPE_BLANK)))
48 | ()))
49 |
50 | (defn read-line-values [row-iterator-item]
51 | (doall (map get-cell-value (cell-iterator row-iterator-item))))
52 |
53 | ;; Implementations of the multi-methods:
54 |
55 | (defmethod write-cell :keyword [k] (name k))
56 | (defmethod write-cell :other [o] (str o))
57 | (defmethod write-cell :numeric [n] (. n doubleValue))
58 |
59 | (defmethod get-cell-formula-value
60 | Cell/CELL_TYPE_BOOLEAN [evaled-cell evaled-type]
61 | (. evaled-cell getBooleanValue))
62 |
63 | (defmethod get-cell-formula-value
64 | Cell/CELL_TYPE_STRING [evaled-cell evaled-type]
65 | (. evaled-cell getStringValue))
66 |
67 | (defmethod get-cell-formula-value
68 | :number [evaled-cell evaled-type]
69 | (. evaled-cell getNumberValue))
70 |
71 | (defmethod get-cell-formula-value
72 | :date [evaled-cell evaled-type]
73 | (DateUtil/getJavaDate (. evaled-cell getNumberValue)))
74 |
75 | (defmethod get-cell-formula-value
76 | :default [evaled-cell evaled-type]
77 | (str "Unknown cell type " (. evaled-cell getCellType)))
78 |
79 | (defmethod get-cell-value Cell/CELL_TYPE_BLANK [cell])
80 | (defmethod get-cell-value Cell/CELL_TYPE_FORMULA [cell]
81 | (let [val (.
82 | (.. cell
83 | getSheet
84 | getWorkbook
85 | getCreationHelper
86 | createFormulaEvaluator)
87 | evaluate cell)
88 | evaluated-type (. val getCellType)]
89 | (get-cell-formula-value
90 | val
91 | (if (= Cell/CELL_TYPE_NUMERIC evaluated-type)
92 | (if (DateUtil/isCellInternalDateFormatted cell)
93 | ;; Check the original for date formatting hints
94 | :date
95 | :number)
96 | evaluated-type))))
97 |
98 | (defmethod get-cell-value Cell/CELL_TYPE_BOOLEAN [cell]
99 | (. cell getBooleanCellValue))
100 | (defmethod get-cell-value Cell/CELL_TYPE_STRING [cell]
101 | (. cell getStringCellValue))
102 | (defmethod get-cell-value Cell/CELL_TYPE_NUMERIC [cell]
103 | (. cell getNumericCellValue))
104 | (defmethod get-cell-value :date [cell]
105 | (. cell getDateCellValue))
106 | (defmethod get-cell-value :default [cell]
107 | (str "Unknown cell type " (. cell getCellType)))
108 |
109 |
--------------------------------------------------------------------------------
/modules/incanter-core/src/incanter/internal.clj:
--------------------------------------------------------------------------------
1 | ;;; internal.clj -- Internal functions
2 |
3 | ;; by David Edgar Liebke http://incanter.org
4 | ;; April 19, 2009
5 |
6 | ;; Copyright (c) David Edgar Liebke, 2009. All rights reserved. The use
7 | ;; and distribution terms for this software are covered by the Eclipse
8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
9 | ;; which can be found in the file epl-v10.htincanter.at the root of this
10 | ;; distribution. By using this software in any fashion, you are
11 | ;; agreeing to be bound by the terms of this license. You must not
12 | ;; remove this notice, or any other, from this software.
13 |
14 | ;; CHANGE LOG
15 | ;; April 19, 2009: First version
16 |
17 |
18 |
19 | (ns incanter.internal
20 | (:import (incanter Matrix)
21 | (cern.colt.matrix.tdouble.algo DoubleFormatter)
22 | (cern.jet.math.tdouble DoubleFunctions DoubleArithmetic)
23 | (cern.colt.function.tdouble DoubleDoubleFunction DoubleFunction)))
24 |
25 |
26 |
27 | (derive Matrix ::matrix)
28 |
29 | (defn is-matrix
30 | " Test if obj is 'derived' from ::matrix (e.g. class incanter.Matrix)."
31 | ([obj] (isa? (class obj) ::matrix)))
32 |
33 |
34 | (defn make-matrix
35 | ([data]
36 | (cond
37 | (coll? (first data))
38 | (Matrix. (into-array (map double-array data)))
39 | (number? (first data))
40 | (Matrix. (double-array data))))
41 | ([data ncol]
42 | (cond
43 | (or (coll? data) (.isArray (class data)))
44 | (Matrix. (double-array data) ncol)
45 | (number? data)
46 | (Matrix. data ncol))) ; data is the number of rows in this case
47 | ([init-val rows cols]
48 | (Matrix. rows cols init-val)))
49 |
50 |
51 |
52 |
53 | (defmacro ^Matrix transform-with [A op fun]
54 | `(cond
55 | (is-matrix ~A)
56 | (.assign (.copy ~A) (. DoubleFunctions ~fun))
57 | (and (coll? ~A) (coll? (first ~A)))
58 | (.assign ^Matrix (make-matrix ~A) (. DoubleFunctions ~fun))
59 | (coll? ~A)
60 | (map ~op ~A)
61 | (number? ~A)
62 | (~op ~A)))
63 |
64 |
65 | (defmacro combine-with [A B op fun]
66 | `(cond
67 | (and (number? ~A) (number? ~B))
68 | (~op ~A ~B)
69 | (and (is-matrix ~A) (is-matrix ~B))
70 | (.assign ^Matrix (.copy ^Matrix ~A)
71 | ^Matrix ~B
72 | ^DoubleDoubleFunction (. DoubleFunctions ~fun))
73 | (and (is-matrix ~A) (number? ~B))
74 | (.assign ^Matrix (.copy ^Matrix ~A)
75 | (make-matrix ~B (.rows ~A) (.columns ~A))
76 | ^DoubleDoubleFunction (. DoubleFunctions ~fun))
77 | (and (number? ~A) (is-matrix ~B))
78 | (.assign ^Matrix (make-matrix ~A (.rows ~B) (.columns ~B))
79 | ^Matrix ~B
80 | ^DoubleDoubleFunction (. DoubleFunctions ~fun))
81 | (and (coll? ~A) (is-matrix ~B))
82 | (.assign ^Matrix (make-matrix ~A (.columns ~B))
83 | ^Matrix (make-matrix ~B)
84 | ^DoubleDoubleFunction (. DoubleFunctions ~fun))
85 | (and (is-matrix ~A) (coll? ~B))
86 | (.assign ^Matrix (.copy ~A)
87 | ^Matrix (make-matrix ~B)
88 | ^DoubleDoubleFunction (. DoubleFunctions ~fun))
89 | (and (coll? ~A) (coll? ~B) (coll? (first ~A)))
90 | (.assign (make-matrix ~A)
91 | (make-matrix ~B)
92 | (. DoubleFunctions ~fun))
93 | (and (coll? ~A) (number? ~B) (coll? (first ~A)))
94 | (.assign (make-matrix ~A)
95 | (make-matrix ~B)
96 | (. DoubleFunctions ~fun))
97 | ;;(. DoubleFunctions (~fun ~B)))
98 | (and (number? ~A) (coll? ~B) (coll? (first ~B)))
99 | (.assign (make-matrix ~A (.rows ~B) (.columns ~B))
100 | (make-matrix ~B)
101 | (. DoubleFunctions ~fun))
102 | (and (coll? ~A) (coll? ~B))
103 | (map ~op ~A ~B)
104 | (and (number? ~A) (coll? ~B))
105 | (map ~op (replicate (count ~B) ~A) ~B)
106 | (and (coll? ~A) (number? ~B))
107 | (map ~op ~A (replicate (count ~A) ~B))
108 | ))
109 |
110 |
111 | ;; PRINT METHOD FOR COLT MATRICES
112 | (defmethod print-method Matrix [o, ^java.io.Writer w]
113 | (let [formatter (DoubleFormatter. "%1.4f")]
114 | (do
115 | (.setPrintShape formatter false)
116 | (.write w "[")
117 | (.write w (.toString formatter o))
118 | (.write w "]\n"))))
119 |
120 |
121 |
122 |
123 |
124 |
--------------------------------------------------------------------------------
/data/iran_election_2009.csv:
--------------------------------------------------------------------------------
1 | Region,Ahmadinejad,%,Rezai,%,Karrubi,%,Mousavi,%,Total votes,Invalid votes,Valid votes,Eligible voters,"Turnout, %"
2 | East Azerbaijan,1131111,56.7503455611386,16920,0.84891389695129,7246,0.36354787809155,837858,42.0371926638186,2010340,17205,1993135,2461553,80.9706311422098
3 | West Azerbaijan,623946,47.475008788202,12199,0.92820153059283,21609,1.64419271043369,656508,49.9525969707714,1334356,20094,1314262,1883144,69.7908391498473
4 | Ardabil,325911,51.1126306198079,6578,1.0316279113534,2319,0.36368883040871,302825,47.4920526384299,642005,4372,637633,804881,79.2207792207792
5 | Isfahan,1799255,68.8757766566794,51788,1.98245313838011,14579,0.55808651240526,746697,28.5836836925353,2637482,25163,2612319,2987946,87.4285880668526
6 | Ilam,199654,64.5769992107953,5221,1.68870402235649,7471,2.4164542714088,96826,31.3178424954394,312667,3495,309172,357687,86.4364654013146
7 | Bushehr,299357,61.369301921295,7608,1.55966838596462,3563,0.73042829379495,177268,36.3406013989455,493989,6193,487796,580822,83.9837333985283
8 | Tehran,3819495,51.5741025426019,147487,1.99149616944144,67334,0.90920150978167,3371523,45.525199778175,7521540,115701,7405839,8796466,84.1910717326708
9 | Chahar Mahaal and Bakhtiari,359578,73.0117991524753,22689,4.6069690330624,4127,0.8379814535435,106099,21.5432503609188,495446,2953,492493,562238,87.5951109672416
10 | South Khorasan,285984,75.0147546014684,3962,1.03924855142602,928,0.24341813622497,90363,23.7025787108806,383157,1920,381237
11 | Khorasan Razavi,2214801,70.1387795895864,44809,1.41902074932681,13561,0.42945257384947,884570,28.0127470872374,3181990,24249,3157741
12 | North Khorasan,341104,74.0035884051557,4129,0.89579956999885,2478,0.53760991389129,113218,24.5630021109542,464001,3072,460929
13 | Khuzestan,1303129,64.805753664047,139124,6.91875913494127,15934,0.79241186320228,552636,27.4830753378094,2038845,28022,2010823,2801644,71.7729661584413
14 | Zanjan,444480,76.5631997795156,7276,1.25331587832018,2223,0.38291935094912,126561,21.8005649912151,585721,5181,580540,632160,91.8343457352569
15 | Semnan,295177,77.7768116400276,4440,1.16990498474381,2147,0.56571756807319,77754,20.4875658071554,383308,3790,379518,436492,86.9472980031707
16 | Sistan and Baluchestan,450269,46.0711015158569,6616,0.67694291107962,12504,1.27939754536571,507946,51.9725580276978,982920,5585,977335,1306624,74.7984883179859
17 | Fars,1758026,70.1824156925241,23871,0.95295771791557,16277,0.64979652190992,706764,28.2148300676504,2523300,18362,2504938,2842209,88.1334905350029
18 | Qazvin,498061,72.5749740262957,7978,1.16251451685996,2690,0.39197343323556,177542,25.8705380236087,692355,6084,686271,749205,91.599895889643
19 | Qom,422457,71.6593586470693,16297,2.76438209775501,2314,0.39251274309413,148467,25.1837465120816,599040,9505,589535,655988,89.8697842033696
20 | Kurdistan,315689,52.7499611504805,7140,1.19305621233059,13862,2.31626683688048,261772,43.7407158003085,610756,12293,598463,943818,63.4087292253379
21 | Kerman,1160446,77.5860489714105,12016,0.80337556804924,4977,0.33275634172612,318250,21.2778191188141,1505814,10125,1495689,1738280,86.044193110431
22 | Kermanshah,573568,59.1421842583924,11258,1.16084354493448,10798,1.11341167154046,374188,38.5835605251327,983422,13610,969812,1231672,78.7394695990491
23 | Kohgiluyeh & Boyer-Ahmad,253962,69.4425987449243,8542,2.33569856308874,4274,1.1686695924422,98937,27.0530330995447,368707,2992,365715,415694,87.9769734468142
24 | Golestan,515211,60.1108854149044,5987,0.69851744426853,10097,1.17804086099538,325806,38.0125562798317,869453,12352,857101,1059769,80.8762098155353
25 | Gilan,998573,67.8570166568813,12022,0.81694283166982,7183,0.4881134885946,453806,30.8379270228543,1483258,11674,1471584,1576046,93.3718939675619
26 | Lorestan,677829,70.906991121837,14920,1.56076577947802,44036,4.60656044672213,219156,22.9256826519628,964270,8329,955941,1124940,84.9770654434903
27 | Mazandaran,1289257,67.7035835836046,19587,1.0285847520332,10050,0.52776212579433,585373,30.7400695385679,1919838,15571,1904267,1915240,99.4270691923728
28 | Markazi,572988,73.6423119286336,10057,1.29255888616562,4675,0.60084645449183,190349,24.464282730709,785961,7892,778069,885557,87.8621026088665
29 | Hormozgan,482990,65.5042917727347,7237,0.98149974028299,5126,0.69520072802136,241988,32.8190077589609,743024,5683,737341,919908,80.1537762471899
30 | Hamadan,765723,75.8627556464388,13117,1.29954535231975,12032,1.19205074934141,218481,21.6456482519,1019169,9816,1009353,1256250,80.3465074626866
31 | Yazd,337178,55.8289786537914,8406,1.39184168173419,2565,0.42470543821654,255799,42.3544742262579,609856,5908,603948,609341,99.114945490292
32 |
33 |
--------------------------------------------------------------------------------
/data/iris.dat:
--------------------------------------------------------------------------------
1 | Sepal.Length Sepal.Width Petal.Length Petal.Width Species
2 | 5.1 3.5 1.4 0.2 setosa
3 | 4.9 3.0 1.4 0.2 setosa
4 | 4.7 3.2 1.3 0.2 setosa
5 | 4.6 3.1 1.5 0.2 setosa
6 | 5.0 3.6 1.4 0.2 setosa
7 | 5.4 3.9 1.7 0.4 setosa
8 | 4.6 3.4 1.4 0.3 setosa
9 | 5.0 3.4 1.5 0.2 setosa
10 | 4.4 2.9 1.4 0.2 setosa
11 | 4.9 3.1 1.5 0.1 setosa
12 | 5.4 3.7 1.5 0.2 setosa
13 | 4.8 3.4 1.6 0.2 setosa
14 | 4.8 3.0 1.4 0.1 setosa
15 | 4.3 3.0 1.1 0.1 setosa
16 | 5.8 4.0 1.2 0.2 setosa
17 | 5.7 4.4 1.5 0.4 setosa
18 | 5.4 3.9 1.3 0.4 setosa
19 | 5.1 3.5 1.4 0.3 setosa
20 | 5.7 3.8 1.7 0.3 setosa
21 | 5.1 3.8 1.5 0.3 setosa
22 | 5.4 3.4 1.7 0.2 setosa
23 | 5.1 3.7 1.5 0.4 setosa
24 | 4.6 3.6 1.0 0.2 setosa
25 | 5.1 3.3 1.7 0.5 setosa
26 | 4.8 3.4 1.9 0.2 setosa
27 | 5.0 3.0 1.6 0.2 setosa
28 | 5.0 3.4 1.6 0.4 setosa
29 | 5.2 3.5 1.5 0.2 setosa
30 | 5.2 3.4 1.4 0.2 setosa
31 | 4.7 3.2 1.6 0.2 setosa
32 | 4.8 3.1 1.6 0.2 setosa
33 | 5.4 3.4 1.5 0.4 setosa
34 | 5.2 4.1 1.5 0.1 setosa
35 | 5.5 4.2 1.4 0.2 setosa
36 | 4.9 3.1 1.5 0.2 setosa
37 | 5.0 3.2 1.2 0.2 setosa
38 | 5.5 3.5 1.3 0.2 setosa
39 | 4.9 3.6 1.4 0.1 setosa
40 | 4.4 3.0 1.3 0.2 setosa
41 | 5.1 3.4 1.5 0.2 setosa
42 | 5.0 3.5 1.3 0.3 setosa
43 | 4.5 2.3 1.3 0.3 setosa
44 | 4.4 3.2 1.3 0.2 setosa
45 | 5.0 3.5 1.6 0.6 setosa
46 | 5.1 3.8 1.9 0.4 setosa
47 | 4.8 3.0 1.4 0.3 setosa
48 | 5.1 3.8 1.6 0.2 setosa
49 | 4.6 3.2 1.4 0.2 setosa
50 | 5.3 3.7 1.5 0.2 setosa
51 | 5.0 3.3 1.4 0.2 setosa
52 | 7.0 3.2 4.7 1.4 versicolor
53 | 6.4 3.2 4.5 1.5 versicolor
54 | 6.9 3.1 4.9 1.5 versicolor
55 | 5.5 2.3 4.0 1.3 versicolor
56 | 6.5 2.8 4.6 1.5 versicolor
57 | 5.7 2.8 4.5 1.3 versicolor
58 | 6.3 3.3 4.7 1.6 versicolor
59 | 4.9 2.4 3.3 1.0 versicolor
60 | 6.6 2.9 4.6 1.3 versicolor
61 | 5.2 2.7 3.9 1.4 versicolor
62 | 5.0 2.0 3.5 1.0 versicolor
63 | 5.9 3.0 4.2 1.5 versicolor
64 | 6.0 2.2 4.0 1.0 versicolor
65 | 6.1 2.9 4.7 1.4 versicolor
66 | 5.6 2.9 3.6 1.3 versicolor
67 | 6.7 3.1 4.4 1.4 versicolor
68 | 5.6 3.0 4.5 1.5 versicolor
69 | 5.8 2.7 4.1 1.0 versicolor
70 | 6.2 2.2 4.5 1.5 versicolor
71 | 5.6 2.5 3.9 1.1 versicolor
72 | 5.9 3.2 4.8 1.8 versicolor
73 | 6.1 2.8 4.0 1.3 versicolor
74 | 6.3 2.5 4.9 1.5 versicolor
75 | 6.1 2.8 4.7 1.2 versicolor
76 | 6.4 2.9 4.3 1.3 versicolor
77 | 6.6 3.0 4.4 1.4 versicolor
78 | 6.8 2.8 4.8 1.4 versicolor
79 | 6.7 3.0 5.0 1.7 versicolor
80 | 6.0 2.9 4.5 1.5 versicolor
81 | 5.7 2.6 3.5 1.0 versicolor
82 | 5.5 2.4 3.8 1.1 versicolor
83 | 5.5 2.4 3.7 1.0 versicolor
84 | 5.8 2.7 3.9 1.2 versicolor
85 | 6.0 2.7 5.1 1.6 versicolor
86 | 5.4 3.0 4.5 1.5 versicolor
87 | 6.0 3.4 4.5 1.6 versicolor
88 | 6.7 3.1 4.7 1.5 versicolor
89 | 6.3 2.3 4.4 1.3 versicolor
90 | 5.6 3.0 4.1 1.3 versicolor
91 | 5.5 2.5 4.0 1.3 versicolor
92 | 5.5 2.6 4.4 1.2 versicolor
93 | 6.1 3.0 4.6 1.4 versicolor
94 | 5.8 2.6 4.0 1.2 versicolor
95 | 5.0 2.3 3.3 1.0 versicolor
96 | 5.6 2.7 4.2 1.3 versicolor
97 | 5.7 3.0 4.2 1.2 versicolor
98 | 5.7 2.9 4.2 1.3 versicolor
99 | 6.2 2.9 4.3 1.3 versicolor
100 | 5.1 2.5 3.0 1.1 versicolor
101 | 5.7 2.8 4.1 1.3 versicolor
102 | 6.3 3.3 6.0 2.5 virginica
103 | 5.8 2.7 5.1 1.9 virginica
104 | 7.1 3.0 5.9 2.1 virginica
105 | 6.3 2.9 5.6 1.8 virginica
106 | 6.5 3.0 5.8 2.2 virginica
107 | 7.6 3.0 6.6 2.1 virginica
108 | 4.9 2.5 4.5 1.7 virginica
109 | 7.3 2.9 6.3 1.8 virginica
110 | 6.7 2.5 5.8 1.8 virginica
111 | 7.2 3.6 6.1 2.5 virginica
112 | 6.5 3.2 5.1 2.0 virginica
113 | 6.4 2.7 5.3 1.9 virginica
114 | 6.8 3.0 5.5 2.1 virginica
115 | 5.7 2.5 5.0 2.0 virginica
116 | 5.8 2.8 5.1 2.4 virginica
117 | 6.4 3.2 5.3 2.3 virginica
118 | 6.5 3.0 5.5 1.8 virginica
119 | 7.7 3.8 6.7 2.2 virginica
120 | 7.7 2.6 6.9 2.3 virginica
121 | 6.0 2.2 5.0 1.5 virginica
122 | 6.9 3.2 5.7 2.3 virginica
123 | 5.6 2.8 4.9 2.0 virginica
124 | 7.7 2.8 6.7 2.0 virginica
125 | 6.3 2.7 4.9 1.8 virginica
126 | 6.7 3.3 5.7 2.1 virginica
127 | 7.2 3.2 6.0 1.8 virginica
128 | 6.2 2.8 4.8 1.8 virginica
129 | 6.1 3.0 4.9 1.8 virginica
130 | 6.4 2.8 5.6 2.1 virginica
131 | 7.2 3.0 5.8 1.6 virginica
132 | 7.4 2.8 6.1 1.9 virginica
133 | 7.9 3.8 6.4 2.0 virginica
134 | 6.4 2.8 5.6 2.2 virginica
135 | 6.3 2.8 5.1 1.5 virginica
136 | 6.1 2.6 5.6 1.4 virginica
137 | 7.7 3.0 6.1 2.3 virginica
138 | 6.3 3.4 5.6 2.4 virginica
139 | 6.4 3.1 5.5 1.8 virginica
140 | 6.0 3.0 4.8 1.8 virginica
141 | 6.9 3.1 5.4 2.1 virginica
142 | 6.7 3.1 5.6 2.4 virginica
143 | 6.9 3.1 5.1 2.3 virginica
144 | 5.8 2.7 5.1 1.9 virginica
145 | 6.8 3.2 5.9 2.3 virginica
146 | 6.7 3.3 5.7 2.5 virginica
147 | 6.7 3.0 5.2 2.3 virginica
148 | 6.3 2.5 5.0 1.9 virginica
149 | 6.5 3.0 5.2 2.0 virginica
150 | 6.2 3.4 5.4 2.3 virginica
151 | 5.9 3.0 5.1 1.8 virginica
152 |
153 |
--------------------------------------------------------------------------------
/modules/incanter-mongodb/src/incanter/mongodb.clj:
--------------------------------------------------------------------------------
1 | (ns ^{:doc "A simple library that provides functions for persisting
2 | Incanter data structures using MongoDB.
3 |
4 | Use incanter.mongodb in combination with the somnium.congomongo library.
5 | For usage examples, see the Congomongo README at http://github.com/somnium/congomongo,
6 | and the examples/blog/mongodb_datasets.clj file in the Incanter distribution.
7 |
8 | Here are Somnium's descriptions of Congomongo's functions:
9 |
10 | (mongo! & args) : Creates a Mongo object and sets the default database.
11 | Keyword arguments include:
12 | :host -> defaults to localhost
13 | :port -> defaults to 27017
14 | :db -> defaults to nil (you'll have to set it anyway, might as well do it now.)
15 |
16 | (get-coll coll) : Returns a DBCollection object
17 |
18 | (fetch coll & options) : Fetches objects from a collection. Optional arguments include
19 | :where -> takes a query map
20 | :only -> takes an array of keys to retrieve
21 | :as -> what to return, defaults to :clojure, can also be :json or :mongo
22 | :from -> argument type, same options as above
23 | :one? -> defaults to false, use fetch-one as a shortcut
24 | :count? -> defaults to false, use fetch-count as a shortcut
25 |
26 | (fetch-one coll & options) : same as (fetch collection :one? true)
27 |
28 | (fetch-count coll & options) : same as (fetch collection :count? true)
29 |
30 | (insert! coll obj & options) : Inserts a map into collection. Will not overwrite existing maps.
31 | Takes optional from and to keyword arguments. To insert
32 | as a side-effect only specify :to as nil.
33 |
34 | (mass-insert! coll objs & options) : Inserts a sequence of maps.
35 |
36 | (update! coll old new & options) : Alters/inserts a map in a collection. Overwrites existing objects.
37 | The shortcut forms need a map with valid :_id and :_ns fields or
38 | a collection and a map with a valid :_id field.
39 |
40 | (destroy! coll query-map) : Removes map from collection. Takes a collection name and
41 | a query map
42 |
43 | (add-index! coll fields & options) : Adds an index on the collection for the specified fields if it does not exist.
44 | Options include:
45 | :unique -> defaults to false
46 | :force -> defaults to true
47 |
48 | (drop-index! coll fields) : Drops an index on the collection for the specified fields
49 |
50 | (drop-all-indexes! coll) : Drops all indexes from a collection
51 |
52 | (get-indexes coll & options) : Get index information on collection
53 |
54 | (drop-database title) : drops a database from the mongo server
55 |
56 | (set-database title) : atomically alters the current database
57 |
58 | (databases) : List databases on the mongo server
59 |
60 | (collections) : Returns the set of collections stored in the current database
61 |
62 | (drop-collection coll) : Permanently deletes a collection. Use with care.
63 |
64 | "
65 | :author "David Edgar Liebke"}
66 |
67 | incanter.mongodb
68 | (:use [incanter.core :only (dataset)]
69 | [somnium.congomongo :only (fetch mass-insert!)]))
70 |
71 |
72 | (defn fetch-dataset
73 | "Queries a MongoDB database, accepting the same arguments as
74 | somnium.congomongo/fetch, but returning an Incanter dataset instead
75 | of a sequence of maps.
76 |
77 | Examples:
78 |
79 | (use '(incanter core datasets mongodb))
80 | (use 'somnium.congomongo)
81 |
82 | ;; first load some sample data
83 | (def data (get-dataset :airline-passengers))
84 | (view data)
85 |
86 | ;; a MongoDB server must be running on the localhost on the default port
87 | ;; for the following steps.
88 |
89 | (mongo! :db \"mydb\")
90 | (mass-insert! :airline-data (:rows data))
91 |
92 | ;; and then retrieve it
93 | ;; notice that the retrieved data set has two additional columns, :_id :_ns
94 | (view (fetch-dataset :airline-data))
95 |
96 | "
97 | [& args]
98 | (let [results (apply fetch args)
99 | colnames (keys (first results))]
100 | (dataset colnames results)))
101 |
102 |
103 |
104 | (defn insert-dataset
105 | "Inserts the rows of the Incanter dataset into the given MongoDB collection.
106 |
107 | Examples:
108 |
109 | (use '(incanter core datasets mongodb))
110 | (use 'somnium.congomongo)
111 |
112 | (def data (get-dataset :airline-passengers))
113 | (view data)
114 |
115 | ;; a MongoDB server must be running on the localhost on the default port
116 | ;; for the following steps.
117 |
118 | (mongo! :db \"mydb\")
119 | (mass-insert! :airline-data (:rows data))
120 |
121 | ;; notice that the retrieved data set has two additional columns, :_id :_ns
122 | (view (fetch-dataset :airline-data))
123 |
124 |
125 | "
126 | [mongodb-coll dataset]
127 | (mass-insert! mongodb-coll (:rows dataset)))
128 |
--------------------------------------------------------------------------------
/modules/incanter-core/src/incanter/infix.clj:
--------------------------------------------------------------------------------
1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 | ;; File : infix.clj
3 | ;; Function : Infix Math library
4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5 | ;; Copyright (c) 2008, J. Bester
6 | ;; All rights reserved.
7 | ;;
8 | ;; Redistribution and use in source and binary forms, with or without
9 | ;; modification, are permitted provided that the following conditions are met:
10 | ;; * Redistributions of source code must retain the above copyright
11 | ;; notice, this list of conditions and the following disclaimer.
12 | ;; * Redistributions in binary form must reproduce the above copyright
13 | ;; notice, this list of conditions and the following disclaimer in the
14 | ;; documentation and/or other materials provided with the distribution.
15 | ;;
16 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ``AS IS'' AND ANY
17 | ;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
18 | ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
19 | ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
20 | ;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
21 | ;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
22 | ;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
23 | ;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
24 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
25 | ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 |
28 | (ns ^{:doc "Library for converting infix mathematical formula to prefix expressions"
29 | :author "J. Bester"}
30 | incanter.infix)
31 |
32 |
33 | ;; operator precedence for formula macro
34 | (def +precedence-table+ (ref {}))
35 |
36 | ;; symbol translation for symbols in formula
37 | ;; (only supports binary operators)
38 | (def +translation-table+ (ref {}))
39 |
40 | (def +highest-precedence+ (ref 0))
41 |
42 | (defn defop
43 | "Define operators for formula macro"
44 | ([op prec & [trans]]
45 | (dosync (ref-set +precedence-table+ (assoc @+precedence-table+ op prec)))
46 | (when-not (nil? trans)
47 | (dosync (ref-set +translation-table+ (assoc @+translation-table+ op trans))))
48 | (dosync (ref-set +highest-precedence+ (apply max (map val @+precedence-table+))))))
49 |
50 |
51 | ;; == operators ==
52 | (defop '|| 10 'or)
53 | (defop '&& 20 'and)
54 | (defop '== 30 '=)
55 | (defop '!= 30 'not=)
56 | (defop '< 40)
57 | (defop '> 40)
58 | (defop '<= 40)
59 | (defop '>= 40)
60 | (defop 'mod 90 'rem)
61 |
62 |
63 |
64 | (defn- operator?
65 | "Check if is valid operator"
66 | ([sym]
67 | (not (nil? (get @+precedence-table+ sym)))))
68 |
69 | (defn- find-lowest-precedence
70 | "find the operator with lowest precedence; search from left to right"
71 | ([col]
72 | ;; loop through terms in the coluence
73 | (loop [idx 0
74 | col col
75 | lowest-idx nil
76 | lowest-prec @+highest-precedence+]
77 | ;; nothing left to process
78 | (if (empty? col)
79 | ;; return lowest found
80 | lowest-idx
81 | ;; otherwise check if current term is lower
82 | (let [prec (get @+precedence-table+ (first col))]
83 | ;; is of lower or equal precedence
84 | (if (and prec (<= prec lowest-prec))
85 | (recur (inc idx) (rest col)
86 | idx prec)
87 | ;; is of high precedence therefore skip for now
88 | (recur (inc idx) (rest col)
89 | lowest-idx lowest-prec)))))))
90 |
91 | (defn- translate-op
92 | "Translation of symbol => symbol for binary op allows for
93 | user defined operators"
94 | ([op]
95 | (if (contains? @+translation-table+ op)
96 | (get @+translation-table+ op)
97 | op)))
98 |
99 | (defn infix-to-prefix
100 | "Convert from infix notation to prefix notation"
101 | ([col]
102 | (cond
103 | ;; handle term only
104 | (not (seq? col)) col
105 | ;; handle sequence containing one term (i.e. handle parens)
106 | (= (count col) 1) (infix-to-prefix (first col))
107 | ;; handle all other cases
108 | true (let [lowest (find-lowest-precedence col)]
109 | (if (nil? lowest) ;; nothing to split
110 | col
111 | ;; (a b c) bind a to hd, c to tl, and b to op
112 | (let [[hd [op & tl]] (split-at lowest col)]
113 | ;; recurse
114 | (list (translate-op op)
115 | (infix-to-prefix hd)
116 | (infix-to-prefix tl))))))))
117 |
118 | (defmacro formula
119 | "Convert from infix notation to prefix notation"
120 | ([& equation]
121 | (infix-to-prefix equation)))
122 |
123 |
124 |
125 |
126 |
127 |
128 |
--------------------------------------------------------------------------------
/modules/incanter-latex/src/incanter/latex.clj:
--------------------------------------------------------------------------------
1 | (ns ^{:doc "This library is used to render LaTex Math equations, based
2 | on the jLateXMath library, and applying them incanter.charts as annotations
3 | and subtitles.
4 | "
5 | :author "David Edgar Liebke"}
6 |
7 | incanter.latex
8 | (:import [org.scilab.forge.jlatexmath TeXConstants TeXIcon TeXFormula])
9 | (:use [incanter.core :only [dim]]))
10 |
11 |
12 |
13 | (defn latex
14 | " Returns the given LaTeX equation rendered as an java.awt.Image.
15 |
16 | Options:
17 | :color (default java.awt.Color/black) -- the text color
18 | :background (default java.awt.Clolor/white) -- the background color
19 | :border (default [5 5 5 5]) -- image border
20 |
21 | Examples:
22 | (use '(incanter core charts stats latex))
23 |
24 | (def latex-img (latex \"\\\\frac{(a+b)^2} {(a-b)^2}\"))
25 | (save latex-img \"/tmp/latex-example1.png\")
26 | (view \"file:///tmp/latex-example1.png\")
27 |
28 | (view (latex \"f(x)=\\\\frac {1} {\\\\sqrt {2\\\\pi \\\\sigma ^2}} e^{\\\\frac {-(x - \\\\mu)^2}{2 \\\\sigma ^2}}\"))
29 |
30 | (view (latex \"\\\\begin{pmatrix}
31 | a & b & c \\\\\\\\
32 | d & e & f \\\\\\\\
33 | g & h & i
34 | \\\\end{pmatrix}\"))
35 |
36 |
37 | "
38 | ([latex-txt & {:keys [color background border] :or {color java.awt.Color/black
39 | background java.awt.Color/white
40 | border [5 5 5 5]}}]
41 | (let [formula (org.scilab.forge.jlatexmath.TeXFormula. latex-txt)
42 | icon (doto (.createTeXIcon formula TeXConstants/STYLE_DISPLAY 20)
43 | (.setInsets (apply #(java.awt.Insets. %1 %2 %3 %4) border)))
44 | image (java.awt.image.BufferedImage. (.getIconWidth icon)
45 | (.getIconHeight icon)
46 | java.awt.image.BufferedImage/TYPE_INT_ARGB)
47 | g2 (doto (.createGraphics image)
48 | (.setColor background)
49 | (.fillRect 0 0 (.getIconWidth icon) (.getIconHeight icon)))
50 | label (doto (javax.swing.JLabel.)
51 | (.setForeground color))]
52 | (do
53 | (.paintIcon icon label g2 0 0)
54 | image))))
55 |
56 |
57 |
58 |
59 |
60 |
61 | (defn add-latex-subtitle
62 | " Adds the given LaTeX equation as a subtitle to the chart.
63 |
64 |
65 | Options:
66 | :color (default java.awt.Color/darkGray) -- the text color
67 |
68 |
69 | Examples:
70 | (use '(incanter core charts stats latex))
71 |
72 | (doto (function-plot pdf-normal -3 3)
73 | (add-latex-subtitle \"f(x)=\\\\frac{1}{\\\\sqrt{2\\\\pi \\\\sigma^2}} e^{\\\\frac{-(x - \\\\mu)^2}{2 \\\\sigma^2}}\")
74 | view)
75 |
76 | "
77 | ([chart latex-str & {:keys [color] :or {color java.awt.Color/darkGray}}]
78 | (.addSubtitle chart (org.jfree.chart.title.ImageTitle. (latex latex-str :color color)))
79 | chart))
80 |
81 |
82 |
83 |
84 | (defn add-latex
85 | " Adds an LaTeX equation annotation to the chart at the given x,y coordinates.
86 |
87 | Arguments:
88 | chart -- the chart to add the polygon to.
89 | x, y -- the coordinates to place the image
90 | latex-str -- a string of latex code
91 |
92 |
93 | Options:
94 | :color (default java.awt.Color/darkGray) -- the text color
95 |
96 |
97 | Examples:
98 | (use '(incanter core charts stats latex))
99 |
100 | (doto (function-plot pdf-normal -3 3)
101 | (add-latex 0 0.1 \"f(x)=\\\\frac{1}{\\\\sqrt{2\\\\pi \\\\sigma^2}} e^{\\\\frac{-(x - \\\\mu)^2}{2 \\\\sigma^2}}\")
102 | view)
103 |
104 | "
105 | ([chart x y latex-str & {:keys [color] :or {color java.awt.Color/darkGray}}]
106 | (let [img (latex latex-str :color color)
107 | anno (org.jfree.chart.annotations.XYImageAnnotation. x y img)]
108 | (.addAnnotation (.getPlot chart) anno)
109 | chart)))
110 |
111 | (defn to-latex
112 | "Convert an Incanter Matrix into a string of LaTeX commands to render it.
113 |
114 | Options:
115 | :mxtype (default pmatrix) -- the type of matrix to output, see LaTeX documentation for other options.
116 | Example:
117 | (use '(incanter core latex))
118 | (view (latex (to-latex (matrix [[1 0][0 1]]))))
119 | "
120 | [mx &
121 | {:keys [mxtype]
122 | :or {mxtype "pmatrix"}}]
123 | (let [dimensions (zipmap [:height :width] (dim mx))
124 | write-row (fn [coll] (apply str (interpose " & " coll)))]
125 | (str
126 | "\\begin{" mxtype "}"
127 | (apply
128 | str
129 | (interpose
130 | "\\\\"
131 | (map
132 | write-row
133 | (map
134 | (partial nth mx)
135 | (range (:height dimensions))))))
136 | "\\end{" mxtype "}")))
137 |
--------------------------------------------------------------------------------
/examples/blog/chisq_goodness_of_fit.clj:
--------------------------------------------------------------------------------
1 | ;; from the following blog post:
2 | ;; http://incanter-blog.org/2009/06/21/chi-square-goodness-of-fit/
3 |
4 | ;; Chi-square goodness-of-fit analysis of 2009 Iranian election and Benford's law
5 |
6 | (use '(incanter core stats charts io))
7 | (def votes (read-dataset "data/iran_election_2009.csv"
8 | :header true))
9 | (view votes)
10 |
11 | (def regions (sel votes :cols :Region))
12 |
13 |
14 | (def ahmadinejad-votes (sel votes :cols :Ahmadinejad))
15 | (def mousavi-votes (sel votes :cols :Mousavi))
16 | (def rezai-votes (sel votes :cols :Rezai))
17 | (def karrubi-votes (sel votes :cols :Karrubi))
18 |
19 | (defn first-digit [x]
20 | (Character/digit (first (str x)) 10))
21 |
22 | (def ahmadinejad (map first-digit ahmadinejad-votes))
23 | (def mousavi (map first-digit mousavi-votes))
24 | (def rezai (map first-digit rezai-votes))
25 | (def karrubi (map first-digit karrubi-votes))
26 |
27 |
28 | ;; define function for Benford's law
29 | (defn benford-law [d] (log10 (plus 1 (div d))))
30 | ;; calculate the probabilities for digits 1-9
31 | (def benford-probs (benford-law (range 1 11)))
32 | ;; calculate the expected frequencies for the 30 regions
33 | (def benford-freq (mult benford-probs (count regions)))
34 |
35 | (defn get-counts [digits]
36 | (map #(get (:counts (tabulate digits)) % 0)
37 | (range 1.0 10.0 1.0)))
38 |
39 |
40 | (doto (xy-plot (range 1 10) (get-counts ahmadinejad)
41 | :legend true :series-label "Ahmadinejad"
42 | :y-label "First digit frequency"
43 | :x-label "First digit"
44 | :title "First digit frequency by candidate")
45 | (add-lines (range 1 10) (get-counts mousavi)
46 | :series-label "Mousavi")
47 | (add-lines (range 1 10) benford-freq
48 | :series-label "Predicted")
49 | ;(add-lines (range 1 10) (get-counts rezai) :series-label "Rezai")
50 | ;(add-lines (range 1 10) (get-counts karrubi) :series-label "Karrubi")
51 | clear-background
52 | view)
53 |
54 |
55 | (def ahmadinejad-test
56 | (chisq-test :table (get-counts ahmadinejad)
57 | :probs benford-probs))
58 | (:X-sq ahmadinejad-test) ;; 5.439
59 | (:p-value ahmadinejad-test) ;; 0.7098
60 |
61 | (def mousavi-test
62 | (chisq-test :table (get-counts mousavi)
63 | :probs benford-probs))
64 | (:X-sq mousavi-test) ;; 5.775
65 | (:p-value mousavi-test) ;; 0.672
66 |
67 | (def rezai-test
68 | (chisq-test :table (get-counts rezai)
69 | :probs benford-probs))
70 | (:X-sq rezai-test) ;; 12.834
71 | (:p-value rezai-test) ;; 0.118
72 |
73 | (def karrubi-test
74 | (chisq-test :table (get-counts karrubi)
75 | :probs benford-probs))
76 | (:X-sq karrubi-test) ;; 8.8696
77 | (:p-value karrubi-test) ;; 0.353
78 |
79 |
80 |
81 | ;; now compare the distribution of the last digit, it should be uniform
82 | ;; based on Washington Post article:
83 | ;; http://www.washingtonpost.com/wp-dyn/content/article/2009/06/20/AR2009062000004.html?referrer=reddit
84 |
85 | (defn last-digit [x]
86 | (Character/digit (last (str x)) 10))
87 |
88 | (def ahmadinejad-last (map last-digit
89 | ahmadinejad-votes))
90 | (def mousavi-last (map last-digit
91 | mousavi-votes))
92 | (def rezai-last (map last-digit
93 | rezai-votes))
94 | (def karrubi-last (map last-digit
95 | karrubi-votes))
96 |
97 |
98 | (defn get-counts [digits]
99 | (map #(get (:counts (tabulate digits)) % 0)
100 | (range 0.0 10.0 1.0)))
101 |
102 |
103 |
104 | (doto (xy-plot (range 10)
105 | (get-counts ahmadinejad-last)
106 | :legend true
107 | :series-label "Ahmadinejad"
108 | :y-label "First digit frequency"
109 | :x-label "First digit"
110 | :title "Last digit frequency by candidate")
111 | (add-lines (range 10) (get-counts mousavi-last)
112 | :series-label "Mousavi")
113 | (add-lines (range 10) (get-counts rezai-last)
114 | :series-label "Rezai")
115 | (add-lines (range 10) (get-counts karrubi-last)
116 | :series-label "Karrubi")
117 | clear-background
118 | view)
119 |
120 |
121 | (def ahmadinejad-test
122 | (chisq-test :table (get-counts ahmadinejad-last)))
123 |
124 | (:X-sq ahmadinejad-test) ;; 4.667
125 | (:p-value ahmadinejad-test) ;; 0.862
126 |
127 | (def mousavi-test
128 | (chisq-test :table (get-counts mousavi-last)))
129 | (:X-sq mousavi-test) ;; 8.667
130 | (:p-value mousavi-test) ;; 0.469
131 |
132 | (def rezai-test
133 | (chisq-test :table (get-counts rezai-last)))
134 | (:X-sq rezai-test) ;; 15.333
135 | (:p-value rezai-test) ;; 0.0822
136 |
137 | (def karrubi-test
138 | (chisq-test :table (get-counts karrubi-last)))
139 | (:X-sq karrubi-test) ;; 4.0
140 | (:p-value karrubi-test) ;; 0.911
141 |
142 |
143 |
144 |
--------------------------------------------------------------------------------
/data/Chwirut1.dat:
--------------------------------------------------------------------------------
1 | y x
2 | 92.9000E0 0.5000E0
3 | 78.7000E0 0.6250E0
4 | 64.2000E0 0.7500E0
5 | 64.9000E0 0.8750E0
6 | 57.1000E0 1.0000E0
7 | 43.3000E0 1.2500E0
8 | 31.1000E0 1.7500E0
9 | 23.6000E0 2.2500E0
10 | 31.0500E0 1.7500E0
11 | 23.7750E0 2.2500E0
12 | 17.7375E0 2.7500E0
13 | 13.8000E0 3.2500E0
14 | 11.5875E0 3.7500E0
15 | 9.4125E0 4.2500E0
16 | 7.7250E0 4.7500E0
17 | 7.3500E0 5.2500E0
18 | 8.0250E0 5.7500E0
19 | 90.6000E0 0.5000E0
20 | 76.9000E0 0.6250E0
21 | 71.6000E0 0.7500E0
22 | 63.6000E0 0.8750E0
23 | 54.0000E0 1.0000E0
24 | 39.2000E0 1.2500E0
25 | 29.3000E0 1.7500E0
26 | 21.4000E0 2.2500E0
27 | 29.1750E0 1.7500E0
28 | 22.1250E0 2.2500E0
29 | 17.5125E0 2.7500E0
30 | 14.2500E0 3.2500E0
31 | 9.4500E0 3.7500E0
32 | 9.1500E0 4.2500E0
33 | 7.9125E0 4.7500E0
34 | 8.4750E0 5.2500E0
35 | 6.1125E0 5.7500E0
36 | 80.0000E0 0.5000E0
37 | 79.0000E0 0.6250E0
38 | 63.8000E0 0.7500E0
39 | 57.2000E0 0.8750E0
40 | 53.2000E0 1.0000E0
41 | 42.5000E0 1.2500E0
42 | 26.8000E0 1.7500E0
43 | 20.4000E0 2.2500E0
44 | 26.8500E0 1.7500E0
45 | 21.0000E0 2.2500E0
46 | 16.4625E0 2.7500E0
47 | 12.5250E0 3.2500E0
48 | 10.5375E0 3.7500E0
49 | 8.5875E0 4.2500E0
50 | 7.1250E0 4.7500E0
51 | 6.1125E0 5.2500E0
52 | 5.9625E0 5.7500E0
53 | 74.1000E0 0.5000E0
54 | 67.3000E0 0.6250E0
55 | 60.8000E0 0.7500E0
56 | 55.5000E0 0.8750E0
57 | 50.3000E0 1.0000E0
58 | 41.0000E0 1.2500E0
59 | 29.4000E0 1.7500E0
60 | 20.4000E0 2.2500E0
61 | 29.3625E0 1.7500E0
62 | 21.1500E0 2.2500E0
63 | 16.7625E0 2.7500E0
64 | 13.2000E0 3.2500E0
65 | 10.8750E0 3.7500E0
66 | 8.1750E0 4.2500E0
67 | 7.3500E0 4.7500E0
68 | 5.9625E0 5.2500E0
69 | 5.6250E0 5.7500E0
70 | 81.5000E0 .5000E0
71 | 62.4000E0 .7500E0
72 | 32.5000E0 1.5000E0
73 | 12.4100E0 3.0000E0
74 | 13.1200E0 3.0000E0
75 | 15.5600E0 3.0000E0
76 | 5.6300E0 6.0000E0
77 | 78.0000E0 .5000E0
78 | 59.9000E0 .7500E0
79 | 33.2000E0 1.5000E0
80 | 13.8400E0 3.0000E0
81 | 12.7500E0 3.0000E0
82 | 14.6200E0 3.0000E0
83 | 3.9400E0 6.0000E0
84 | 76.8000E0 .5000E0
85 | 61.0000E0 .7500E0
86 | 32.9000E0 1.5000E0
87 | 13.8700E0 3.0000E0
88 | 11.8100E0 3.0000E0
89 | 13.3100E0 3.0000E0
90 | 5.4400E0 6.0000E0
91 | 78.0000E0 .5000E0
92 | 63.5000E0 .7500E0
93 | 33.8000E0 1.5000E0
94 | 12.5600E0 3.0000E0
95 | 5.6300E0 6.0000E0
96 | 12.7500E0 3.0000E0
97 | 13.1200E0 3.0000E0
98 | 5.4400E0 6.0000E0
99 | 76.8000E0 .5000E0
100 | 60.0000E0 .7500E0
101 | 47.8000E0 1.0000E0
102 | 32.0000E0 1.5000E0
103 | 22.2000E0 2.0000E0
104 | 22.5700E0 2.0000E0
105 | 18.8200E0 2.5000E0
106 | 13.9500E0 3.0000E0
107 | 11.2500E0 4.0000E0
108 | 9.0000E0 5.0000E0
109 | 6.6700E0 6.0000E0
110 | 75.8000E0 .5000E0
111 | 62.0000E0 .7500E0
112 | 48.8000E0 1.0000E0
113 | 35.2000E0 1.5000E0
114 | 20.0000E0 2.0000E0
115 | 20.3200E0 2.0000E0
116 | 19.3100E0 2.5000E0
117 | 12.7500E0 3.0000E0
118 | 10.4200E0 4.0000E0
119 | 7.3100E0 5.0000E0
120 | 7.4200E0 6.0000E0
121 | 70.5000E0 .5000E0
122 | 59.5000E0 .7500E0
123 | 48.5000E0 1.0000E0
124 | 35.8000E0 1.5000E0
125 | 21.0000E0 2.0000E0
126 | 21.6700E0 2.0000E0
127 | 21.0000E0 2.5000E0
128 | 15.6400E0 3.0000E0
129 | 8.1700E0 4.0000E0
130 | 8.5500E0 5.0000E0
131 | 10.1200E0 6.0000E0
132 | 78.0000E0 .5000E0
133 | 66.0000E0 .6250E0
134 | 62.0000E0 .7500E0
135 | 58.0000E0 .8750E0
136 | 47.7000E0 1.0000E0
137 | 37.8000E0 1.2500E0
138 | 20.2000E0 2.2500E0
139 | 21.0700E0 2.2500E0
140 | 13.8700E0 2.7500E0
141 | 9.6700E0 3.2500E0
142 | 7.7600E0 3.7500E0
143 | 5.4400E0 4.2500E0
144 | 4.8700E0 4.7500E0
145 | 4.0100E0 5.2500E0
146 | 3.7500E0 5.7500E0
147 | 24.1900E0 3.0000E0
148 | 25.7600E0 3.0000E0
149 | 18.0700E0 3.0000E0
150 | 11.8100E0 3.0000E0
151 | 12.0700E0 3.0000E0
152 | 16.1200E0 3.0000E0
153 | 70.8000E0 .5000E0
154 | 54.7000E0 .7500E0
155 | 48.0000E0 1.0000E0
156 | 39.8000E0 1.5000E0
157 | 29.8000E0 2.0000E0
158 | 23.7000E0 2.5000E0
159 | 29.6200E0 2.0000E0
160 | 23.8100E0 2.5000E0
161 | 17.7000E0 3.0000E0
162 | 11.5500E0 4.0000E0
163 | 12.0700E0 5.0000E0
164 | 8.7400E0 6.0000E0
165 | 80.7000E0 .5000E0
166 | 61.3000E0 .7500E0
167 | 47.5000E0 1.0000E0
168 | 29.0000E0 1.5000E0
169 | 24.0000E0 2.0000E0
170 | 17.7000E0 2.5000E0
171 | 24.5600E0 2.0000E0
172 | 18.6700E0 2.5000E0
173 | 16.2400E0 3.0000E0
174 | 8.7400E0 4.0000E0
175 | 7.8700E0 5.0000E0
176 | 8.5100E0 6.0000E0
177 | 66.7000E0 .5000E0
178 | 59.2000E0 .7500E0
179 | 40.8000E0 1.0000E0
180 | 30.7000E0 1.5000E0
181 | 25.7000E0 2.0000E0
182 | 16.3000E0 2.5000E0
183 | 25.9900E0 2.0000E0
184 | 16.9500E0 2.5000E0
185 | 13.3500E0 3.0000E0
186 | 8.6200E0 4.0000E0
187 | 7.2000E0 5.0000E0
188 | 6.6400E0 6.0000E0
189 | 13.6900E0 3.0000E0
190 | 81.0000E0 .5000E0
191 | 64.5000E0 .7500E0
192 | 35.5000E0 1.5000E0
193 | 13.3100E0 3.0000E0
194 | 4.8700E0 6.0000E0
195 | 12.9400E0 3.0000E0
196 | 5.0600E0 6.0000E0
197 | 15.1900E0 3.0000E0
198 | 14.6200E0 3.0000E0
199 | 15.6400E0 3.0000E0
200 | 25.5000E0 1.7500E0
201 | 25.9500E0 1.7500E0
202 | 81.7000E0 .5000E0
203 | 61.6000E0 .7500E0
204 | 29.8000E0 1.7500E0
205 | 29.8100E0 1.7500E0
206 | 17.1700E0 2.7500E0
207 | 10.3900E0 3.7500E0
208 | 28.4000E0 1.7500E0
209 | 28.6900E0 1.7500E0
210 | 81.3000E0 .5000E0
211 | 60.9000E0 .7500E0
212 | 16.6500E0 2.7500E0
213 | 10.0500E0 3.7500E0
214 | 28.9000E0 1.7500E0
215 | 28.9500E0 1.7500E0
216 |
217 |
--------------------------------------------------------------------------------
/modules/incanter-io/src/incanter/io.clj:
--------------------------------------------------------------------------------
1 | ;;; io.clj -- Data I/O library for Clojure built on CSVReader
2 |
3 | ;; by David Edgar Liebke http://incanter.org
4 | ;; March 11, 2009
5 |
6 | ;; Copyright (c) David Edgar Liebke, 2009. All rights reserved. The use
7 | ;; and distribution terms for this software are covered by the Eclipse
8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
9 | ;; which can be found in the file epl-v10.htincanter.at the root of this
10 | ;; distribution. By using this software in any fashion, you are
11 | ;; agreeing to be bound by the terms of this license. You must not
12 | ;; remove this notice, or any other, from this software.
13 |
14 | ;; CHANGE LOG
15 | ;; March 11, 2009: First version
16 |
17 |
18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 | ;; DATA IO FUNCTIONS
20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 |
22 | (ns
23 | ^{:doc
24 | "Library for reading and writing Incanter datasets and matrices."}
25 |
26 | incanter.io
27 | (:import (java.io FileReader FileWriter File)
28 | (au.com.bytecode.opencsv CSVReader))
29 | (:use [incanter.core :only (dataset save get-input-reader)]))
30 |
31 | (defn- parse-string [value]
32 | (if (re-matches #"\d+" value)
33 | (try (Integer/parseInt value)
34 | (catch NumberFormatException _ value))
35 | (try (Double/parseDouble value)
36 | (catch NumberFormatException _ value))))
37 |
38 |
39 | (defn read-dataset
40 | "
41 | Returns a dataset read from a file or a URL.
42 |
43 | Options:
44 | :delim (default \\,), other options (\\tab \\space \\| etc)
45 | :quote (default \\\") character used for quoting strings
46 | :skip (default 0) the number of lines to skip at the top of the file.
47 | :header (default false) indicates the file has a header line
48 | :compress-delim (default true if delim = \\space, false otherwise) means
49 | compress multiple adjacent delimiters into a single delimiter
50 | "
51 | ([filename & {:keys [delim keyword-headers quote skip header compress-delim]
52 | :or {delim \,
53 | quote \"
54 | skip 0
55 | header false
56 | keyword-headers true}}]
57 | (let [compress-delim? (or compress-delim (if (= delim \space) true false))]
58 | (with-open [reader ^CSVReader (CSVReader.
59 | (get-input-reader filename)
60 | delim
61 | quote
62 | skip)]
63 | (let [data-lines (map seq (seq (.readAll reader)))
64 | raw-data (filter #(> (count (filter (fn [field] (not= field "")) %)) 0)
65 | (if compress-delim?
66 | (map (fn [line] (filter #(not= % "") line)) data-lines)
67 | data-lines))
68 | parsed-data (into [] (map (fn [row] (into [] (map parse-string row)))
69 | raw-data))]
70 | (if header
71 | ; have header row
72 | (dataset (if keyword-headers
73 | (map keyword (first parsed-data))
74 | (first parsed-data))
75 | (rest parsed-data))
76 | ; no header row so build a default one
77 | (let [col-count (count (first parsed-data))
78 | col-names (apply vector (map str
79 | (repeat col-count "col")
80 | (iterate inc 0)))]
81 | (dataset (if keyword-headers
82 | (map keyword col-names)
83 | col-names)
84 | parsed-data))))))))
85 |
86 |
87 |
88 |
89 | (defmethod save incanter.Matrix [mat filename & {:keys [delim header append]
90 | :or {append false delim \,}}]
91 | (let [file-writer (java.io.FileWriter. filename append)]
92 | (do
93 | (when (and header (not append))
94 | (.write file-writer (str (first header)))
95 | (doseq [column-name (rest header)]
96 | (.write file-writer (str delim column-name)))
97 | (.write file-writer (str \newline)))
98 | (doseq [row mat]
99 | (if (number? row)
100 | (.write file-writer (str row \newline))
101 | (do
102 | (.write file-writer (str (first row)))
103 | (doseq [column (rest row)]
104 | (.write file-writer (str delim column)))
105 | (.write file-writer (str \newline)))))
106 | (.flush file-writer)
107 | (.close file-writer))))
108 |
109 |
110 |
111 |
112 | (defmethod save :incanter.core/dataset [dataset filename & {:keys [delim header append]
113 | :or {append false delim \,}}]
114 | (let [header (or header (map #(if (keyword? %) (name %) %) (:column-names dataset)))
115 | file-writer (java.io.FileWriter. filename append)
116 | rows (:rows dataset)
117 | columns (:column-names dataset)]
118 | (do
119 | (when (and header (not append))
120 | (.write file-writer (str (first header)))
121 | (doseq [column-name (rest header)]
122 | (.write file-writer (str delim column-name)))
123 | (.write file-writer (str \newline)))
124 | (doseq [row rows]
125 | (do
126 | (.write file-writer (str (row (first columns))))
127 | (doseq [column-name (rest columns)]
128 | (.write file-writer (str delim (row column-name))))
129 | (.write file-writer (str \newline))))
130 | (.flush file-writer)
131 | (.close file-writer))))
132 |
133 |
134 | (defmethod save java.awt.image.BufferedImage
135 | ([img filename & {:keys [format] :or {format "png"}}]
136 | (javax.imageio.ImageIO/write img
137 | format
138 | (.getAbsoluteFile (java.io.File. filename)))))
139 |
140 |
141 |
142 |
143 |
144 |
--------------------------------------------------------------------------------
/examples/bayes.clj:
--------------------------------------------------------------------------------
1 |
2 | ;;; examples/bayes.clj -- Bayesian estimation library for Clojure
3 |
4 | ;; by David Edgar Liebke http://incanter.org
5 | ;; March 11, 2009
6 |
7 | ;; Copyright (c) David Edgar Liebke, 2009. All rights reserved. The use
8 | ;; and distribution terms for this software are covered by the Eclipse
9 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
10 | ;; which can be found in the file epl-v10.html at the root of this
11 | ;; distribution. By using this software in any fashion, you are
12 | ;; agreeing to be bound by the terms of this license. You must not
13 | ;; remove this notice, or any other, from this software.
14 |
15 | ;; CHANGE LOG
16 | ;; March 11, 2009: First version
17 |
18 |
19 |
20 | (ns examples.bayes
21 | (:use (incanter core stats)))
22 |
23 |
24 |
25 | (defn bayes-regression-noref [N x y]
26 | "
27 | This function implments the Gibbs sampling example using full conditional in OLS
28 | from Scott Lynch book 'Introduction to Applied Bayesian Statistics in the Social
29 | Sciences (page 171). This version is purely functional with no immutability.
30 | "
31 | (let [lm (linear-model y x :intercept false)
32 | pars (trans (:coefs lm))
33 | xtxi (solve (mmult (trans x) x))
34 | nx (ncol x)
35 | shape (/ (- (nrow x) (ncol x)) 2)]
36 | (loop [coefs (transient [[0 0 0 0 0 0 0 0 0]])
37 | variances (transient [1])
38 | i 0]
39 | (if (= i N)
40 | {:coef (matrix (persistent! coefs)) :var (persistent! variances)}
41 | (let [b (to-list (plus pars (mmult (trans (sample-normal nx))
42 | (decomp-cholesky (mult xtxi (variances i))))))
43 | resid (minus y (mmult x b))
44 | s2 (/ 1 (sample-gamma 1 :shape shape :rate (mult (mmult (trans resid) resid) 0.5) ))]
45 | (recur (conj! coefs b) (conj! variances s2) (inc i)))))))
46 |
47 |
48 |
49 |
50 | (defn bayes-regression-full [N x y]
51 | "
52 | This function implments the Gibbs sampling example using full conditional in OLS
53 | from Scott Lynch book 'Introduction to Applied Bayesian Statistics in the Social
54 | Sciences (page 171). This version uses immutability (i.e. references)
55 | "
56 | (let [lm (linear-model y x :intercept false)
57 | pars (trans (:coefs lm))
58 | xtxi (solve (mmult (trans x) x))
59 | nx (ncol x)
60 | b (ref [[0 0 0 0 0 0 0 0 0]])
61 | s2 (ref [1])
62 | resid (ref 0)
63 | shape (/ (- (nrow x) (ncol x)) 2)]
64 | (do
65 | (dotimes [i N]
66 | (dosync
67 | (alter b conj
68 | (to-list (plus pars (mmult (trans (sample-normal nx)) (decomp-cholesky (mult xtxi (@s2 i)))))))
69 | (ref-set resid (minus y (mmult x (@b (inc i)))))
70 | (alter s2 conj (/ 1 (sample-gamma 1 :shape shape :rate (mult (mmult (trans @resid) @resid) 0.5) )))))
71 | ;; return a map with the estimated coefficients and variances
72 | {:coef (matrix @b) :var @s2})))
73 |
74 |
75 |
76 |
77 | (defn bayes-regression [N x y]
78 | "
79 | This function implments the Gibbs sampling example using the composition method
80 | in OLS from Scott Lynch book 'Introduction to Applied Bayesian Statistics in the
81 | Social Sciences (page 173)
82 | "
83 | (let [lm (linear-model y x :intercept false)
84 | pars (:coefs lm)
85 | xtxi (solve (mmult (trans x) x))
86 | resid (:residuals lm)
87 | shape (/ (- (nrow x) (ncol x)) 2)
88 | rate (mult 1/2 (mmult (trans resid) resid))
89 | s-sq (div 1 (sample-gamma N :shape shape :rate rate))]
90 | ;; return a map with the estimated coefficients and variances
91 | {:coef
92 | (matrix
93 | ;(pmap ;; run a parallel map over the values of s-sq
94 | (map
95 | (fn [s2]
96 | (to-list (plus (trans pars)
97 | (mmult (trans (sample-normal (ncol x)))
98 | (decomp-cholesky (mult s2 xtxi))))))
99 | (to-list (trans s-sq))))
100 | :var s-sq}))
101 |
102 |
103 |
104 |
105 | (defn bayes-regression-mh [N x y]
106 | "
107 | This function implments the Gibbs sampling example using Metropolis Hastings
108 | in OLS from Scott Lynch book 'Introduction to Applied Bayesian Statistics in the
109 | Social Sciences (page 168)
110 | "
111 | (let [ lm (linear-model y x :intercept false)
112 | b-scale (to-list (div (sqrt (:std-errors lm)) 2))
113 | s2-scale (/ (sd (mult (:residuals lm) (div (dec (nrow x)) (- (nrow x) (ncol x))))) 2)
114 | post-fn (fn [x y b s-sq]
115 | (let [resid (minus y (mmult x b))]
116 | (plus (mult -1157.5 (log s-sq))
117 | (mult (div -0.5 s-sq) (mmult (trans resid) resid)))))
118 | reject? (fn [x y cand-b cand-s2 old-b old-s2]
119 | (< (- (post-fn x y cand-b cand-s2)
120 | (post-fn x y old-b old-s2))
121 | (log (rand))))
122 | ncol-x (ncol x)]
123 | (loop [coefs (transient [[0 0 0 0 0 0 0 0 0]])
124 | variances (transient [1])
125 | i 0]
126 | (if (= i N)
127 | {:coef (matrix (persistent! coefs)) :var (persistent! variances)}
128 | (let [old-b (coefs i)
129 | old-s2 (variances i)
130 | cand-b (into [] (map #(+ (sample-normal 1 :mean 0 :sd %1) %2) b-scale old-b))
131 | new-b (loop [b old-b j 0]
132 | (if (= j ncol-x)
133 | b
134 | (recur
135 | (if (reject? x y (assoc b j (cand-b j)) old-s2 old-b old-s2)
136 | b
137 | (assoc b j (cand-b j)))
138 | (inc j))))
139 | cand-s2 (+ (sample-normal 1 :mean 0 :sd s2-scale) old-s2)
140 | new-s2 (if (or (< cand-s2 0) (reject? x y new-b cand-s2 new-b old-s2))
141 | old-s2
142 | cand-s2)]
143 | (recur (conj! coefs new-b) (conj! variances new-s2) (inc i)))))))
144 |
145 |
146 |
--------------------------------------------------------------------------------
/modules/incanter-zoo/test/incanter/zoo_test.clj:
--------------------------------------------------------------------------------
1 | (ns incanter.zoo-test
2 | (:use clojure.test
3 | (incanter zoo core stats))
4 | (:require [clj-time.coerce :as c]))
5 |
6 |
7 | ;; --= Tests
8 | (def integers (iterate inc 0))
9 |
10 | (deftest roll-apply-test
11 | (is (= [3 6 9 12 15]
12 | (take 5 (roll-apply #(apply + %) 3 integers)))))
13 |
14 | (deftest roll-mean-test
15 | (is (= [2 3 4 5 6 7 8 9 10 11]
16 | (take 10 (roll-mean 5 integers)))))
17 |
18 | (deftest roll-median-test
19 | (is (= [2.0 3.0 4.0 5.0 6.0]
20 | (take 5 (roll-median 5 integers)))))
21 |
22 | (deftest roll-max-test
23 | (is (= [2 3 4 5 6]
24 | (take 5 (roll-max 3 integers)))))
25 |
26 | (deftest roll-min-test
27 | (is (= [0 1 2 3 4]
28 | (take 5 (roll-min 3 integers)))))
29 |
30 | ;; --------------------
31 | ;; Standard dataset, with :index column
32 | (def ds1 (to-dataset [{:index "2012-01-01" :temp 32 :press 100}
33 | {:index "2012-01-02" :temp 35 :press 98}
34 | {:index "2012-01-03" :temp 30 :press 102}
35 | {:index "2012-01-04" :temp 31 :press 103}
36 | {:index "2012-01-05" :temp 32 :press 104}
37 | {:index "2012-01-06" :temp 33 :press 105}]))
38 |
39 | ;; Standard dataset with :date column
40 | (def ds2 (to-dataset [{:date "2012-01-01" :temp 32 :press 100}
41 | {:date "2012-01-02" :temp 35 :press 98}
42 | {:date "2012-01-03" :temp 30 :press 102}
43 | {:date "2012-01-04" :temp 31 :press 103}
44 | {:date "2012-01-05" :temp 32 :press 104}
45 | {:date "2012-01-06" :temp 33 :press 105}]))
46 |
47 | ;; Data with missing values
48 | (def ds3 (to-dataset [{:date "2012-01-01" :temp 32}
49 | {:date "2012-01-02" :press 98 :temp 32}
50 | {:date "2012-01-06" :temp 33}]))
51 |
52 | (deftest zoo-test
53 | (is (zoo ds1))
54 | (is (zoo ds2 :date))
55 | (is (zoo ds3 :date))
56 | (testing "Check ordering"
57 | (let [ts (zoo (to-dataset [{:index "2012-01-01" :a 1}
58 | {:index "2012-01-02" :a 2}
59 | {:index "2012-01-03" :a 3}]))]
60 | (is (= ts
61 | (zoo (to-dataset [{:index "2012-01-01" :a 1}
62 | {:index "2012-01-03" :a 3}
63 | {:index "2012-01-02" :a 2}]))))
64 | (is (= ts
65 | (zoo (to-dataset [{:index "2012-01-03" :a 3}
66 | {:index "2012-01-02" :a 2}
67 | {:index "2012-01-01" :a 1}])))))))
68 |
69 | (deftest $$-test
70 | ;; Time slicing
71 | (let [ts1 (zoo ds1)]
72 | (testing "Single date slice"
73 | (is (= ($$ "2012-01-01" :temp ts1) 32) "Single col")
74 | (is (= ($$ "2012-01-01" :all ts1)
75 | [100 32 (to-date-time "2012-01-01")]) "Whole row")
76 | (is (= ($$ "2012-01-01" :all ts1)
77 | ($$ "2012-01-01" ts1)) "Single arity check")
78 | (is (= (nrow ($$ "2012-01-10" :all ts1)) 0) "Date out of range"))
79 |
80 | (testing "Date range slice"
81 | (let [slice ($$ "2012-01-01" "2012-01-03" :all ts1)]
82 | (is (= 3 (nrow slice)))
83 | (is (= 3 (ncol slice))))
84 | (is (= ($$ "2012-01-01" "2012-01-03" :temp ts1) [32 35 30]) "Single col"))
85 |
86 | (testing "Native Joda as index"
87 | (is (= ($$ (c/from-string "2012-01-03") :temp ts1) 30)))
88 |
89 | (testing "End point overlaps"
90 | (is (= ($$ "2012-01-01" "2012-01-06" :all ts1)
91 | ($$ "2012-01-01" "2012-06-10" :all ts1)) "RHS")
92 | (is (= ($$ "2012-01-01" "2012-01-06" :all ts1)
93 | ($$ "2011-01-01" "2012-06-10" :all ts1)) "LHS&RHS"))))
94 |
95 | (deftest aligned?-test
96 | (let [ts1 (zoo ds1)
97 | ts2 (zoo ds2 :date)]
98 | (aligned? ts1 ts2)
99 | (is (not (aligned? ts1
100 | (zoo (to-dataset [{:index "2012-01-01" :a 1}
101 | {:index "2012-01-02" :a 2}]))))
102 | "Unequal length")
103 | (is (not (aligned? (zoo (to-dataset [{:index "2012-01-01" :a 1}
104 | {:index "2012-01-02" :a 2}]))
105 | (zoo (to-dataset [{:index "2012-01-02" :a 1}
106 | {:index "2012-01-03" :a 2}]))))
107 | "Different indices")))
108 |
109 | (deftest within-zoo?-test
110 | (let [ts1 (zoo ds1)]
111 | (is (within-zoo? "2012-01-01" ts1))
112 | (is (within-zoo? "2012-01-04" ts1))
113 | (is (not (within-zoo? "2012-01-11" ts1)))
114 | (is (within-zoo? (c/from-string "2012-01-02T01:03:03") ts1) "Needn't be same frequency")))
115 |
116 | (deftest lag-test
117 | (let [ts1 (zoo ds1)
118 | ls1 (lag ts1)]
119 | (is (aligned? ts1 ls1) "Indices equal")
120 | (is (aligned? ts1 (lag ls1)) "Indices equal")
121 | (is (aligned? ts1 (lag ts1 3)) "Indices equal")
122 |
123 | (is (= ($ 0 [:press :temp] ls1)
124 | [nil nil]) "Nil pad the front values")
125 | (is (= ($ 0 [:press :temp] ts1)
126 | ($ 1 [:press :temp] ls1)) "Second vals of lag = first of ts")
127 | (is (= ($ 0 [:press :temp] ts1)
128 | ($ 2 [:press :temp] (lag ts1 2))) "Multiperiod lag")
129 | (is (= ($ 2 [:press :temp] (-> ts1 lag lag))
130 | ($ 2 [:press :temp] (lag ts1 2))) "Multiperiod lag")))
131 |
132 | (deftest zoo-apply-test
133 | (let [ts (zoo ds1)
134 | zs (zoo-apply #(apply min %) 2 ts :temp)]
135 | (aligned? ts zs)
136 | (is (= (rest ($ :temp zs))
137 | (roll-min 2 ($ :temp ts))))))
138 |
139 | ;; Helper for test below
140 | (defn- map-diff
141 | "Return a map with the different values of v2 - v1"
142 | [m1 m2]
143 | (into {} (map (fn [[k1 v1] [k2 v2]]
144 | (if (and v1 v2)
145 | {k2 (- v1 v2)}
146 | {k2 nil}))
147 | m1 m2)))
148 |
149 | (deftest zoo-row-map-test
150 | (let [ts1 (zoo ds1)
151 | ms1 (zoo-row-map map-diff ts1 ts1)
152 | ms2 (zoo-row-map map-diff ts1 (lag ts1))]
153 | (is (every? (partial = 0) ($ :temp ms1)))
154 | ms2
155 | (is (= ($ :press ms2) [nil -2 4 1 1 1]))))
156 |
157 |
--------------------------------------------------------------------------------
/modules/incanter-excel/src/incanter/excel.clj:
--------------------------------------------------------------------------------
1 | (ns
2 | ^{
3 | :doc "Excel module for reading and writing Incanter datasets. Recognises both old and new
4 | Excel file formats (.xls and .xlsx)."
5 | :author "David James Humphreys"}
6 | incanter.excel
7 | (:import
8 | [java.io FileOutputStream FileInputStream])
9 | (:use
10 | [incanter.core :only [dataset get-input-stream dataset?]]
11 | [incanter.excel.cells :only [read-line-values write-line-values]]
12 | [incanter.excel.workbook :only [get-workbook-sheet make-workbook-map write-workbook create-workbook-object create-sheet get-all-sheets]]))
13 |
14 | (defn- commit-sheet!
15 | "Internally save the dataset into the :sheet object."
16 | [workbook-blob dataset use-bold]
17 | (let [align-row (fn [row cols] (map #(get row %1) cols))]
18 | (write-line-values workbook-blob use-bold 0 (:column-names dataset))
19 | (dorun
20 | (map
21 | (partial write-line-values workbook-blob false)
22 | (iterate inc 1)
23 | (seq (map #(align-row % (:column-names dataset)) (:rows dataset)))))))
24 |
25 | (defmulti
26 | ^{:doc "Save a dataset to an Excel file. Can save in both older and newer
27 | Excel formats, uses the filename suffix or :override-format option.
28 |
29 | By passing in a collection of datasets and names it is possible to write more than
30 | one sheet at a time: e.g.
31 | (save-xls [\"first sheet\" dataset1 \"second\" dataset2] my-file)
32 |
33 | Options are:
34 | :sheet defaults to \"dataset\" if not provided.
35 | :use-bold defaults to true. Set the header line in bold.
36 | :override-format If nil use the filename suffix to guess the Excel file format.
37 | If :xls or :xlsx override the suffix check.
38 |
39 | Examples:
40 | (use '(incanter core datasets excel))
41 | (save-xls (get-dataset :cars) \"/tmp/cars.xls\")
42 |
43 | "}
44 | save-xls
45 |
46 | (fn [dataset
47 | ^String filename
48 | & {:keys [use-bold sheet override-format]
49 | :or {use-bold true sheet "dataset" override-format nil}}]
50 | (if (dataset? dataset)
51 | :incanter.core/dataset
52 | :collection)))
53 |
54 | (defmethod
55 | save-xls
56 | :incanter.core/dataset
57 | [dataset
58 | ^String filename
59 | & {:keys [use-bold sheet override-format]
60 | :or {use-bold true sheet "dataset" override-format nil}}]
61 | (write-workbook
62 | (let [workbook-blob (make-workbook-map (create-workbook-object filename override-format) sheet)]
63 | (commit-sheet! workbook-blob dataset use-bold)
64 | (:workbook workbook-blob))
65 | filename))
66 |
67 | (defmethod
68 | save-xls
69 | :collection
70 | [datasets
71 | ^String filename
72 | & {:keys [use-bold override-format]
73 | :or {use-bold true override-format nil}}]
74 | (if (not (zero? (mod (count datasets) 2)))
75 | (throw (Exception. "dataset count must be even: a name then a dataset."))
76 | (write-workbook
77 | (loop [workbook-blob (make-workbook-map (create-workbook-object filename override-format))
78 | [sheet-name dataset & others] (doall datasets)]
79 | (if (and sheet-name dataset)
80 | (let [next-blob (create-sheet workbook-blob sheet-name)]
81 | (commit-sheet! next-blob dataset use-bold)
82 | (recur next-blob others))
83 | (:workbook workbook-blob)))
84 | filename)))
85 |
86 | (defn- read-sheet [rows-it header-keywords]
87 | (let [colnames (read-line-values (first rows-it))]
88 | (dataset
89 | (if header-keywords
90 | (map keyword colnames)
91 | colnames)
92 | (map
93 | read-line-values
94 | (rest rows-it)))))
95 |
96 | (defmulti
97 | ^{:doc "Read an Excel file into a dataset. Note: cells containing formulas will be
98 | empty upon import. Can read both older and newer Excel file formats, uses the filename suffix
99 | or :override-format option.
100 |
101 | Options are:
102 | :sheet either a String for the tab name or an int for the sheet index -- defaults to 0
103 | :header-keywords convert the incoming header line to keywords -- defaults to false (no conversion)
104 | :override-format If nil use the filename suffix to guess the Excel file format. If :xls
105 | or :xlsx override the suffix check.
106 | :all-sheets? true to try to read in all sheets of data (false by default).
107 |
108 | Examples:
109 | (use '(incanter core io excel))
110 | (view (read-xls \"http://incanter.org/data/aus-airline-passengers.xls\"))
111 |
112 | (use '(incanter core charts excel))
113 | ;; read .xls file of Australian airline passenger data from the 1950s.
114 | (with-data (read-xls \"http://incanter.org/data/aus-airline-passengers.xls\")
115 | (view $data)
116 | ;; time-series-plot needs time in millisecs
117 | ;; create a function, to-millis, to convert a sequence of Date objects
118 | ;; to a sequence of milliseconds
119 | (let [to-millis (fn [dates] (map #(.getTime %) dates))]
120 | (view (time-series-plot (to-millis ($ :date)) ($ :passengers)))))
121 |
122 | "}
123 |
124 | read-xls
125 | (fn [^String filename
126 | & {:keys [sheet header-keywords override-format all-sheets?]
127 | :or {sheet 0 header-keywords false override-format nil all-sheets? false}}]
128 | (if all-sheets?
129 | :collection
130 | :singleton)))
131 | (defmethod
132 | read-xls
133 | :singleton
134 | [^String filename
135 | & {:keys [sheet header-keywords override-format]
136 | :or {sheet 0 header-keywords false override-format nil}}]
137 | (with-open [in-fs (get-input-stream filename)]
138 | (let [rows-it (iterator-seq
139 | (. (get-workbook-sheet
140 | (create-workbook-object filename override-format in-fs)
141 | sheet)
142 | iterator))]
143 | (read-sheet rows-it header-keywords))))
144 |
145 | (defmethod
146 | read-xls
147 | :collection
148 | [^String filename
149 | & {:keys [sheet header-keywords override-format all-sheets?]
150 | :or {sheet 0 header-keywords false override-format nil all-sheets? false}}]
151 | (with-open [in-fs (get-input-stream filename)]
152 | (let [workbook (create-workbook-object filename override-format in-fs)]
153 | (if all-sheets?
154 | (for [current-sheet (get-all-sheets workbook)]
155 | (let [rows-it (iterator-seq (. current-sheet iterator))]
156 | (read-sheet rows-it header-keywords)))))))
157 |
--------------------------------------------------------------------------------
/examples/blog/kmeans.clj:
--------------------------------------------------------------------------------
1 |
2 | (use '(incanter core stats charts))
3 |
4 | ;(defn init-k-means
5 | ; ""
6 | ; ([k data]
7 | ; (let [dist-fn [a b] (sq (minus a b))
8 | ; ]
9 | ; (loop [
10 | ; dists []
11 | ; centroids [(sample data)]
12 | ; ]
13 | ; (if (= k (count centroids))
14 | ; centroids
15 | ; (recur
16 | ; (loop [])))))))
17 |
18 | (defn index-of [coll value]
19 | "
20 | Examples:
21 |
22 | (use '(incanter core stats))
23 |
24 | (def data [2 4 6 7 5 3 1])
25 | (index-of data (apply max data))
26 |
27 |
28 | (def data (diag (repeat 10 1)))
29 | (map #(index-of % (apply max %)) data)
30 |
31 | "
32 | (loop [i 0]
33 | (if (= value (nth coll i))
34 | i
35 | (recur (inc i)))))
36 |
37 |
38 | (defn indices-of [coll value]
39 | "
40 | Examples:
41 |
42 | (use '(incanter core stats))
43 |
44 | (def data [2 7 4 6 7 5 3 1])
45 | (indices-of data (apply max data))
46 |
47 |
48 | (def data (diag (repeat 10 1)))
49 | (map #(indices-of % (apply max %)) data)
50 |
51 | "
52 | (for [i (range (count coll)) :when (= value (nth coll i))] i))
53 |
54 |
55 | (defn k-means
56 | "
57 | Examples:
58 |
59 | (use 'incanter.datasets)
60 | (def iris (sel (to-matrix (get-dataset :iris)) :cols (range 4)))
61 |
62 | (def clusters (k-means iris 3))
63 | (dim (:dist-matrix clusters))
64 | (dim (:cluster-indices clusters))
65 |
66 | (count (first (:dist-matrix clusters)))
67 | (count (second (:dist-matrix clusters)))
68 | (count (nth (:dist-matrix clusters) 2))
69 |
70 | clusters
71 |
72 | "
73 | ([data k]
74 | (let [p (ncol data)
75 | W (diag (repeat p 1))
76 | dist (fn [a b]
77 | (mahalanobis-dist a
78 | :centroid (trans b)
79 | :W W))
80 | n (nrow data)]
81 | (loop [centroids (sample data :size k)
82 | last-members nil
83 | member-indices nil
84 | i 0]
85 | (let [last-members member-indices
86 | dist-mat (trans (map #(dist data %) centroids))
87 | ;dist-mat (trans
88 | ; (map #(mahalanobis-dist data %)
89 | ; (trans (sel data :rows %))
90 | member-indices (map #(index-of % (apply min %)) dist-mat)
91 | cluster-indices (map (fn [idx]
92 | (indices-of member-indices idx))
93 | (range k))
94 | centroids (matrix (map #(map mean (trans (sel data :rows %)) )
95 | cluster-indices))
96 | ]
97 | (if (= member-indices last-members)
98 | ;(if true
99 | { :dist-matrix dist-mat
100 | :cluster-indices cluster-indices
101 | :centroids centroids
102 | :member-indices member-indices
103 | :iterations i}
104 | (recur centroids last-members member-indices (inc i))))))))
105 |
106 |
107 |
108 | ;(trans (map #(mahalanobis-dist iris :centroid (trans %) :W (diag (repeat (ncol iris) 1))) (sample iris :size 3)))
109 |
110 |
111 |
112 |
113 | (defn k-means
114 | "
115 | Examples:
116 |
117 | (use 'incanter.datasets)
118 | (def iris (sel (to-matrix (get-dataset :iris)) :cols (range 4)))
119 |
120 | (def clusters (k-means iris 3))
121 | ;(:member-indices clusters)
122 | (partition 50 (:member-indices clusters))
123 | (:iterations clusters)
124 |
125 | ;; calculate average distance of all the observations are from
126 | ;; its cluster's centroid
127 | (:mean-sq-dist clusters)
128 |
129 |
130 | (def mahalanobis-clusters (k-means iris 3 :mahalanobis true))
131 | ;(:member-indices mahalanobis-clusters)
132 | (partition 50 (:member-indices mahalanobis-clusters))
133 | (:iterations mahalanobis-clusters)
134 |
135 | "
136 | ([data k & options]
137 | (let [opts (when options (apply assoc {} options))
138 | mahalanobis (:mahalanobis opts)
139 | p (ncol data)
140 | W (diag (repeat p 1))
141 | euclid-dist (fn [a b]
142 | (mahalanobis-dist
143 | a
144 | :centroid (trans b)
145 | :W W))
146 | n (nrow data)
147 | mean-sq-dist (fn [centroids membership]
148 | (mean (map (fn [obs clust-idx]
149 | (sum
150 | (sq
151 | (minus obs
152 | (sel centroids
153 | :rows clust-idx)))))
154 | data
155 | membership)))]
156 | (loop [centroids (sample data :size k)
157 | dist-mat (trans (map #(euclid-dist data %) centroids)) ;; euclidean to init
158 | last-members nil
159 | member-indices nil
160 | i 0]
161 | (let [last-members member-indices
162 | member-indices (map #(index-of % (apply min %)) dist-mat)
163 | cluster-indices (map (fn [idx]
164 | (indices-of member-indices idx))
165 | (range k))
166 | centroids (matrix (map #(map mean (trans (sel data :rows %)) )
167 | cluster-indices))
168 | dist-mat (if mahalanobis
169 | (trans
170 | (map (fn [row] (mahalanobis-dist data :y row))
171 | (map #(matrix (sel data :rows %))
172 | cluster-indices)))
173 | ;; else euclidean
174 | (trans (map #(euclid-dist data %) centroids)))
175 | ]
176 | (if (= member-indices last-members)
177 | ;(if true
178 | { :dist-matrix dist-mat
179 | :cluster-indices cluster-indices
180 | :centroids centroids
181 | :member-indices member-indices
182 | :iterations i
183 | :mean-sq-dist (mean-sq-dist centroids member-indices)}
184 | (recur centroids dist-mat last-members member-indices (inc i))))))))
185 |
186 |
187 |
188 |
--------------------------------------------------------------------------------
/modules/incanter-core/src/incanter/censored.clj:
--------------------------------------------------------------------------------
1 | (ns incanter.censored
2 | (:use [incanter.core :only (mult pow)]
3 | [incanter.stats :only (pdf-normal cdf-normal sd)]))
4 |
5 |
6 | (defn- lambda-two-sided
7 | ([a-std b-std]
8 | (/ (- (pdf-normal a-std) (pdf-normal b-std))
9 | (- (cdf-normal b-std) (cdf-normal a-std)))))
10 |
11 | (defn- lambda-lower
12 | ([a-std] (/ (pdf-normal a-std) (- 1 (cdf-normal a-std)))))
13 |
14 | (defn- lambda-upper
15 | ([b-std]
16 | (/ (- (pdf-normal b-std)) (cdf-normal b-std))))
17 |
18 | (defn- psi [y mu sigma] (/ (- y mu) sigma))
19 |
20 |
21 | (defn censored-mean-two-sided
22 | " Returns the mean of a normal distribution (with mean mu and standard
23 | deviation sigma) with the lower tail censored at 'a' and the upper
24 | tail censored at 'b'
25 | "
26 | ([a b mu sigma]
27 | (let [a-std (psi a mu sigma)
28 | b-std (psi b mu sigma)
29 | cdf-a (cdf-normal a-std)
30 | cdf-b (cdf-normal b-std)]
31 | (+ (* cdf-a a)
32 | (* (- cdf-b cdf-a) (+ mu (* sigma (lambda-two-sided a-std b-std))))
33 | (* (- 1 cdf-b) b)))))
34 |
35 |
36 | (defn censored-variance-two-sided
37 | " Returns the variance of a normal distribution (with mean mu and standard
38 | deviation sigma) with the lower tail censored at 'a' and the upper
39 | tail censored at 'b'
40 | "
41 | ([a b mu sigma]
42 | (let [a-std (psi a mu sigma)
43 | b-std (psi b mu sigma)
44 | sigma-sq (* sigma sigma)
45 | Ey (censored-mean-two-sided a b mu sigma)
46 | cdf-a (cdf-normal a-std)
47 | cdf-b (cdf-normal b-std)]
48 | (+ (* cdf-a (* a a))
49 | (* (- cdf-b cdf-a)
50 | (+ sigma-sq (* mu mu) (* 2 mu sigma (lambda-two-sided a-std b-std))))
51 | (* sigma-sq (- (* a-std (pdf-normal a-std)) (* b-std (pdf-normal b-std))))
52 | (- (* (- 1 cdf-b) (* b b)) (* Ey Ey))))))
53 |
54 |
55 |
56 | (defn censored-mean-lower
57 | " Returns the mean of a normal distribution (with mean mu and standard
58 | deviation sigma) with the lower tail censored at 'a'
59 | "
60 | ([a mu sigma]
61 | (let [a-std (psi a mu sigma)]
62 | (+ (* (cdf-normal a-std) a)
63 | (* (- 1 (cdf-normal a-std))
64 | (+ mu (* sigma (lambda-lower a-std))))))))
65 |
66 |
67 | (defn censored-variance-lower
68 | " Returns the variance of a normal distribution (with mean mu and standard
69 | deviation sigma) with the lower tail censored at 'a'
70 | "
71 | ([a mu sigma]
72 | (let [a-std (psi a mu sigma)
73 | cdf-a (cdf-normal a-std)
74 | sigma-sq (* sigma sigma)
75 | Ey (censored-mean-lower a mu sigma)]
76 | (+ (* cdf-a (* a a))
77 | (* (- 1 cdf-a)
78 | (+ sigma-sq (* mu mu) (* 2 mu sigma (lambda-lower a-std))))
79 | (* sigma-sq a-std (pdf-normal a-std))
80 | (- (* Ey Ey))))))
81 |
82 |
83 |
84 | (defn censored-mean-upper
85 | " Returns the mean of a normal distribution (with mean mu and standard
86 | deviation sigma) with the upper tail censored at 'b'
87 | "
88 | ([b mu sigma]
89 | (let [b-std (psi b mu sigma)]
90 | (+ (* (cdf-normal b-std) (+ mu (* sigma (lambda-upper b-std))))
91 | (* (- 1 (cdf-normal b-std)) b)))))
92 |
93 |
94 | (defn censored-variance-upper
95 | " Returns the variance of a normal distribution (with mean mu and standard
96 | deviation sigma) with the upper tail censored at 'b'
97 | "
98 | ([b mu sigma]
99 | (let [sigma-sq (* sigma sigma)
100 | b-std (psi b mu sigma)
101 | cdf-b (cdf-normal b-std)
102 | Ey (censored-mean-upper b mu sigma)]
103 | (+ (* cdf-b
104 | (+ sigma-sq (* mu mu) (* 2 mu sigma (lambda-upper b-std))))
105 | (- (* sigma-sq b-std (pdf-normal b-std)))
106 | (* (- 1 cdf-b) (* b b))
107 | (- (* Ey Ey))))))
108 |
109 |
110 |
111 | (defn truncated-variance
112 | " Returns the variance of a normal distribution truncated at a and b.
113 |
114 | Options:
115 | :mean (default 0) mean of untruncated normal distribution
116 | :sd (default 1) standard deviation of untruncated normal distribution
117 | :a (default -infinity) lower truncation point
118 | :b (default +infinity) upper truncation point
119 |
120 | Examples:
121 |
122 | (use '(incanter core stats))
123 | (truncated-variance :a -1.96 :b 1.96)
124 | (truncated-variance :a 0)
125 | (truncated-variance :b 0)
126 |
127 | (use 'incanter.charts)
128 | (def x (range -3 3 0.1))
129 | (def plot (xy-plot x (map #(truncated-variance :a %) x)))
130 | (view plot)
131 | (add-lines plot x (map #(truncated-variance :b %) x))
132 |
133 | (def samp (sample-normal 10000))
134 | (add-lines plot x (map #(variance (filter (fn [s] (> s %)) samp)) x))
135 | (add-lines plot x (map #(variance (mult samp (indicator (fn [s] (> s %)) samp))) x))
136 |
137 |
138 | References:
139 | DeMaris, A. (2004) Regression with social data: modeling continuous and limited response variables.
140 | Wiley-IEEE.
141 |
142 | http://en.wikipedia.org/wiki/Truncated_normal_distribution
143 | "
144 | ([& {:keys [mean sd a b]
145 | :or {mean 0
146 | sd 1
147 | a Double/NEGATIVE_INFINITY
148 | b Double/POSITIVE_INFINITY}}]
149 | (let [sigma-sq (* sd sd)
150 | lambda (fn [alpha] (/ (pdf-normal alpha) (- 1 (cdf-normal alpha))))
151 | delta (fn [alpha] (* (lambda alpha) (- (lambda alpha) alpha)))
152 | ;one-tail-var (fn [alpha s-sq]
153 | ; (* s-sq
154 | ; (- 1 (cdf-normal alpha))
155 | ; (+ (- 1 (delta alpha))
156 | ; (* (pow (- alpha (lambda alpha)) 2)
157 | ; (cdf-normal alpha)))))
158 | a-std (if (= a Double/NEGATIVE_INFINITY) Double/NEGATIVE_INFINITY (/ (- a mean) sd))
159 | b-std (if (= b Double/POSITIVE_INFINITY) Double/POSITIVE_INFINITY (/ (- b mean) sd))
160 | pdf-a (if (= a Double/NEGATIVE_INFINITY) 0 (pdf-normal a-std))
161 | pdf-b (if (= b Double/POSITIVE_INFINITY) 0 (pdf-normal b-std))
162 | cdf-a (if (= a Double/NEGATIVE_INFINITY) 0 (cdf-normal a-std))
163 | cdf-b (if (= b Double/POSITIVE_INFINITY) 1 (cdf-normal b-std))]
164 | (cond
165 | (and (= b Double/POSITIVE_INFINITY) (= a Double/NEGATIVE_INFINITY))
166 | sigma-sq
167 | (and (= b Double/POSITIVE_INFINITY) (> a Double/NEGATIVE_INFINITY))
168 | (* sigma-sq (- 1 (delta a-std)))
169 | ;(one-tail-var a-std sigma-sq)
170 | (and (= a Double/NEGATIVE_INFINITY) (< b Double/POSITIVE_INFINITY))
171 | (* sigma-sq (- 1 (delta (- 1 b-std))))
172 | ;(- sigma-sq (one-tail-var b-std sigma-sq))
173 | :else
174 | (* sigma-sq
175 | (+ 1 (/ (- (* a-std pdf-a) (* b-std pdf-b))
176 | (- cdf-b cdf-a))
177 | (- (pow (/ (- pdf-a pdf-b) (- cdf-b cdf-a)) 2))))))))
178 |
--------------------------------------------------------------------------------
/examples/mixture_em.clj:
--------------------------------------------------------------------------------
1 |
2 |
3 | (use '(incanter core stats charts))
4 |
5 | (def data [-0.39 0.12 0.94 1.67 1.76 2.44 3.72 4.28 4.92 5.53
6 | 0.06 0.48 1.01 1.68 1.80 3.25 4.12 4.60 5.28 6.22])
7 |
8 |
9 | (def mu-hats (sample data :size 2 :replacement false))
10 | ;(def mu-hats [4.5 1.0])
11 | ;(def mu-hats [5 1])
12 | (def sigma-hats [(variance data) (variance data)])
13 | ;(def sigma-hats [0.9 0.8])
14 | (def pi-hat 0.6)
15 |
16 |
17 | (defn next-gamma-hats [data mu-hats sigma-hats pi-hat]
18 | (map (fn [y_i]
19 | (/ (* pi-hat (pdf-normal y_i :mean (second mu-hats) :sd (sqrt (second sigma-hats))))
20 | (+ (* (- 1 pi-hat) (pdf-normal y_i :mean (first mu-hats) :sd (sqrt (first sigma-hats))))
21 | (* pi-hat (pdf-normal y_i :mean (second mu-hats) :sd (sqrt (second sigma-hats)))))))
22 | data))
23 |
24 | (defn next-mu-hats [data gamma-hats]
25 | [(/ (sum (mult (minus 1 gamma-hats) data))
26 | (sum (minus 1 gamma-hats)))
27 | (/ (sum (mult gamma-hats data))
28 | (sum gamma-hats))])
29 |
30 | (defn next-sigma-hats [data gamma-hats]
31 | [(/ (sum (mult (minus 1 gamma-hats) (sq (minus data (first mu-hats)))))
32 | (sum (minus 1 gamma-hats)))
33 | (/ (sum (mult gamma-hats (sq (minus data (second mu-hats)))))
34 | (sum gamma-hats))])
35 |
36 | (defn next-pi-hat [gamma-hats]
37 | (div (sum gamma-hats) (count gamma-hats)))
38 |
39 |
40 | (defn log-likelihood [data mu-hats sigma-hats pi-hat gamma-hats]
41 | (+ (sum (map (fn [y g]
42 | (plus (mult (minus 1 g) (log (pdf-normal y :mean (first mu-hats) :sd (sqrt (first sigma-hats)))))
43 | (mult g (log (pdf-normal y :mean (second mu-hats) :sd (sqrt (second sigma-hats)))))))
44 | data gamma-hats))
45 | (sum (map (fn [y g]
46 | (plus (mult (minus 1 g) (log (- 1 pi-hat))) (mult g (log pi-hat))))
47 | data gamma-hats))))
48 |
49 |
50 | (def results
51 | (pmap (fn [j]
52 | (let [mu-hats (sample data :size 2 :replacement false)]
53 | ;; main loop
54 | (loop [i 0
55 | m mu-hats
56 | s sigma-hats
57 | p pi-hat]
58 | (let [g (next-gamma-hats data m s p)
59 | m-tmp (next-mu-hats data g)
60 | s-tmp (next-sigma-hats data g)
61 | p-tmp (next-pi-hat g)
62 | diff [(minus m m-tmp) (minus s s-tmp) (minus p p-tmp)]]
63 | ;(if (or (= [0.1 0.1 0.1] diff) (= i 20))
64 | (if (= i 50)
65 | ;[i m s p diff]
66 | [i m s p (log-likelihood data m s p g)]
67 | (do
68 | ;(println [i m s p (log-likelihood data m s p g)])
69 | ;(println diff)
70 | (recur (inc i)
71 | (next-mu-hats data g)
72 | (next-sigma-hats data g)
73 | (next-pi-hat g))))))))
74 | (range 500)))
75 |
76 | (defn max-index
77 | "Returns the index of the maximum value in the given sequence."
78 | ([x]
79 | (let [max-x (reduce max x)
80 | n (length x)]
81 | (loop [i 0]
82 | (if (= (nth x i) max-x)
83 | i
84 | (recur (inc i)))))))
85 |
86 |
87 |
88 | (nth results (max-index (map #(nth % 4) results)))
89 |
90 |
91 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92 | ;; Mixture model for heart disease data
93 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 |
95 |
96 | (use '(incanter core stats charts io))
97 |
98 | ;; info available at: http://www-stat.stanford.edu/~tibs/ElemStatLearn/datasets/SAheart.info
99 |
100 | (def heart-data (to-matrix
101 | (read-dataset "http://www-stat.stanford.edu/~tibs/ElemStatLearn/datasets/SAheart.data" :header true)))
102 |
103 | (def groups (group-by heart-data 10 :cols [9 10]))
104 | (view (histogram (sel (first groups) :cols 0)))
105 | (view (histogram (sel (second groups) :cols 0)))
106 | (view (histogram (sel heart-data :cols 9)))
107 |
108 | (def data (sel heart-data :cols 9))
109 |
110 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 | (def sigma-hats [(variance data) (variance data)])
112 | ;(def sigma-hats [0.9 0.8])
113 | (def pi-hat 0.5)
114 |
115 |
116 | (defn next-gamma-hats [data mu-hats sigma-hats pi-hat]
117 | (map (fn [y_i]
118 | (/ (* pi-hat (pdf-normal y_i :mean (second mu-hats) :sd (sqrt (second sigma-hats))))
119 | (+ (* (- 1 pi-hat) (pdf-normal y_i :mean (first mu-hats) :sd (sqrt (first sigma-hats))))
120 | (* pi-hat (pdf-normal y_i :mean (second mu-hats) :sd (sqrt (second sigma-hats)))))))
121 | data))
122 |
123 | (defn next-mu-hats [data gamma-hats]
124 | [(/ (sum (mult (minus 1 gamma-hats) data))
125 | (sum (minus 1 gamma-hats)))
126 | (/ (sum (mult gamma-hats data))
127 | (sum gamma-hats))])
128 |
129 | (defn next-sigma-hats [data mu-hats gamma-hats]
130 | [(/ (sum (mult (minus 1 gamma-hats) (sq (minus data (first mu-hats)))))
131 | (sum (minus 1 gamma-hats)))
132 | (/ (sum (mult gamma-hats (sq (minus data (second mu-hats)))))
133 | (sum gamma-hats))])
134 |
135 | (defn next-pi-hat [gamma-hats]
136 | (div (sum gamma-hats) (count gamma-hats)))
137 |
138 |
139 | (defn log-likelihood [data mu-hats sigma-hats pi-hat gamma-hats]
140 | (+ (sum (map (fn [y g]
141 | (plus (mult (minus 1 g) (log (pdf-normal y :mean (first mu-hats) :sd (sqrt (first sigma-hats)))))
142 | (mult g (log (pdf-normal y :mean (second mu-hats) :sd (sqrt (second sigma-hats)))))))
143 | data gamma-hats))
144 | (sum (map (fn [y g]
145 | (plus (mult (minus 1 g) (log (- 1 pi-hat))) (mult g (log pi-hat))))
146 | data gamma-hats))))
147 |
148 |
149 | (def results
150 | (pmap (fn [j]
151 | (let [mu-hats (sample data :size 2 :replacement false)]
152 | ;; main loop
153 | (loop [i 0
154 | m mu-hats
155 | s sigma-hats
156 | p pi-hat]
157 | (let [g (next-gamma-hats data m s p)
158 | m-tmp (next-mu-hats data g)
159 | s-tmp (next-sigma-hats data m g)
160 | p-tmp (next-pi-hat g)
161 | diff [(minus m m-tmp) (minus s s-tmp) (minus p p-tmp)]]
162 | ;(if (or (= [0.1 0.1 0.1] diff) (= i 20))
163 | (if (= i 200)
164 | ;[i m s p diff]
165 | [i m s p (log-likelihood data m s p g)]
166 | (do
167 | ;(println [i m s p (log-likelihood data m s p g)])
168 | ;(println diff)
169 | (recur (inc i)
170 | (next-mu-hats data g)
171 | (next-sigma-hats data m g)
172 | (next-pi-hat g)))))) ))
173 | (range 50)))
174 |
175 |
176 | (defn max-index
177 | "Returns the index of the maximum value in the given sequence."
178 | ([x]
179 | (let [max-x (reduce max x)
180 | n (length x)]
181 | (loop [i 0]
182 | (if (= (nth x i) max-x)
183 | i
184 | (recur (inc i)))))))
185 |
186 |
187 |
188 | (println (nth results (max-index (map #(nth % 4) results))))
189 |
190 |
191 |
--------------------------------------------------------------------------------
/examples/blog/signif_testing.clj:
--------------------------------------------------------------------------------
1 | ;; from the following blog post:
2 | ;; http://incanter-blog.org/2009/06/17/randomization-significance/
3 |
4 | ;; significance testing with randomization
5 |
6 | (use '(incanter core stats datasets charts))
7 | (def data (to-matrix (get-dataset :plant-growth)))
8 |
9 | ;; Break the first column of the data into groups based on
10 | ;; treatment type (second column) using the group-by function.
11 | (def groups (group-by data 1 :cols 0))
12 |
13 | (t-test (first groups) :y (second groups))
14 | ;; returns t-stat :t-stat 1.1912603818487033
15 |
16 | (t-test (first groups) :y (last groups))
17 | ;; returns t-stat -2.1340204531240676
18 |
19 |
20 |
21 | ;; calculate the means of the three groups
22 | (map mean groups)
23 |
24 |
25 | ;; perform the t-test comparing the first two groups
26 | (def t1 (t-test (first groups) :y (second groups)))
27 | (def t2 (t-test (first groups) :y (last groups)))
28 |
29 | ;; view the test statistic and its p-value
30 | (:t-stat t1) ;; returns 1.1912603818487033
31 | (:p-value t1) ;; returns 0.25038250858754796
32 |
33 | (:t-stat t2) ;; returns -2.134
34 | (:p-value t2) ;; returns 0.0479
35 |
36 |
37 | ;; The above p-value is based on the assumption that the
38 | ;; distribution of t-test statistics when the null hypothesis,
39 | ;; that the two sample means are identical, is true. Let's see
40 | ;; if that assumption appears correct for these samples.
41 |
42 | ;; Now create 1000 permuted versions of the original two groups using
43 | ;; the sample-permutations function,
44 | (def perm-groups1 (sample-permutations 1000
45 | (first groups)
46 | (second groups)))
47 |
48 | (def perm-groups2 (sample-permutations 1000
49 | (first groups)
50 | (last groups)))
51 |
52 |
53 | ;; create a function, based on t-test, that takes two sequence and returns
54 | ;; just the :t-stat value
55 | (defn t-stat [x y] (:t-stat (t-test x :y y)))
56 |
57 | ;; calculate the t-test statistics for each of the permuted versions of
58 | ;; the two samples
59 | (def t-stats1 (map t-stat
60 | (first perm-groups1)
61 | (second perm-groups1)))
62 |
63 | (def t-stats2 (map t-stat
64 | (first perm-groups2)
65 | (second perm-groups2)))
66 |
67 | ;; plot the t-test statistics, and overlay the pdf of a t-distribution
68 | (doto (histogram t-stats1 :density true :nbins 20)
69 | (add-function #(pdf-t % :df (:df t1)) -3 3)
70 | view)
71 |
72 | ;; and view their mean, sd, and 95% confidence interval
73 | (mean t-stats1)
74 | ;; returns 0.02308030751953895
75 | (sd t-stats1)
76 | ;; returns 1.0640114204888618
77 | (quantile t-stats1 :probs [0.025 0.975])
78 | ;; returns (-2.1164160713197497 2.002005620604495)
79 |
80 |
81 | (doto (histogram t-stats2 :density true :nbins 20)
82 | (add-function #(pdf-t % :df (:df t2)) -3 3)
83 | view)
84 |
85 |
86 | ;; and view their mean, sd, and 95% confidence interval
87 | (mean t-stats2)
88 | ;; returns -0.014
89 | (sd t-stats2)
90 | ;; returns 1.054
91 | (quantile t-stats2 :probs [0.025 0.975])
92 | ;; returns (-2.075 2.122)
93 |
94 |
95 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
96 | ;; do it with raw means-differences instead of the t-test statistic
97 |
98 | ;; Define a function to calculate the difference in means between two sequences.
99 | (defn means-diff [x y]
100 | (minus (mean x) (mean y)))
101 |
102 | ;; Calculate the difference in sample means between the two groups.
103 | (def samp-mean-diff (means-diff (first groups)
104 | (second groups)))
105 |
106 | ;; and calculate the difference of means of the 1000 samples by mapping
107 | ;; the means-diff function, defined earlier, over the rows returned by
108 | ;; sample-permutations.
109 | (def perm-means-diffs1 (map means-diff
110 | (first perm-groups)
111 | (second perm-groups)))
112 |
113 |
114 | ;; Then take the mean of this sequence, which gives the proportion of times
115 | ;; that a value from the permuted sequences are more extreme than the original
116 | ;; sample mean (i.e. the p-value).
117 | (mean (indicator #(> % samp-mean-diff)
118 | perm-means-diffs1))
119 |
120 | ;; Calculate a 95% interval of the permuted differences. If the original
121 | ;; sample means-difference is outside of this range, there is evidence
122 | ;; that the two means are statistically significantly different.
123 | (quantile perm-means-diffs1 :probs [0.025 0.975])
124 |
125 | ;; Plot a histogram of the perm-means-diffs using the density option,
126 | ;; instead of the default frequency, and then add a normal pdf curve
127 | ;; with the mean and sd of perm-means-diffs data for a visual comparison.
128 | (doto (histogram perm-means-diffs1 :density true)
129 | (add-lines (range -1 1 0.01)
130 | (pdf-normal (range -1 1 0.01)
131 | :mean (mean perm-means-diffs1)
132 | :sd (sd perm-means-diffs1)))
133 | view)
134 |
135 | ;; now standardize the means and overlay the pdf of a t-distribution
136 | (doto (histogram (sweep (sweep perm-means-diffs1) :stat sd :fun div) :density true)
137 | (add-lines (range -3 3 0.01)
138 | (pdf-t (range -3 3 0.01)
139 | :df 18))
140 | view)
141 |
142 |
143 | ;; The permuted data looks normal. Now, calculate the p-values for
144 | ;; the difference in means between the control and treatment two.
145 |
146 | (def perm-groups (sample-permutations 1000
147 | (first groups)
148 | (last groups)))
149 |
150 | (def perm-means-diffs2 (map means-diff
151 | (first perm-groups)
152 | (second perm-groups)))
153 |
154 | (def samp-mean-diff (means-diff (first groups)
155 | (last groups)))
156 |
157 | (mean (indicator #(< % samp-mean-diff)
158 | perm-means-diffs2))
159 |
160 | (quantile perm-means-diffs2
161 | :probs [0.025 0.975])
162 |
163 |
164 | ;; Finally, calculate the p-values for the difference in means
165 | ;; between the treatment one and treatment two.
166 |
167 | (def perm-groups (sample-permutations 1000
168 | (second groups)
169 | (last groups)))
170 |
171 | (def perm-means-diffs3 (map means-diff (first perm-groups)
172 | (second perm-groups)))
173 |
174 | (def samp-mean-diff (means-diff (second groups)
175 | (last groups)))
176 |
177 | (mean (indicator #(< % samp-mean-diff)
178 | perm-means-diffs3))
179 |
180 | (quantile perm-means-diffs3
181 | :probs [0.025 0.975])
182 |
183 |
184 | ;; Plot box-plots of the three perm-means-diffs sequences
185 | (doto (box-plot perm-means-diffs1)
186 | (add-box-plot perm-means-diffs2)
187 | (add-box-plot perm-means-diffs3)
188 | view)
189 |
190 |
--------------------------------------------------------------------------------
/modules/incanter-core/src/incanter/som.clj:
--------------------------------------------------------------------------------
1 | ;;; som.clj -- Self-Organizing-Map Neural Network Library
2 |
3 | ;; by David Edgar Liebke http://incanter.org
4 | ;; June 13, 2009
5 |
6 | ;; Copyright (c) David Edgar Liebke, 2009. All rights reserved. The use
7 | ;; and distribution terms for this software are covered by the Eclipse
8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
9 | ;; which can be found in the file epl-v10.htincanter.at the root of this
10 | ;; distribution. By using this software in any fashion, you are
11 | ;; agreeing to be bound by the terms of this license. You must not
12 | ;; remove this notice, or any other, from this software.
13 |
14 |
15 |
16 | (ns incanter.som
17 | (:use [incanter.core :only (sel ncol nrow mult div plus minus trans to-vect sqrt sum pow)]
18 | [incanter.stats :only (mean principal-components covariance)]))
19 |
20 |
21 |
22 | (defn- som-dimensions
23 | ([pc1-sd pc2-sd]
24 | (let [dim-1 (mult 5 pc1-sd)
25 | dim-2 (mult (div pc2-sd pc1-sd) dim-1)]
26 | [dim-1 dim-2])))
27 |
28 |
29 | (defn- som-initialize-linear
30 | ([data]
31 | (let [pc (principal-components (covariance data))
32 | pc1-sd (nth (:std-dev pc) 0)
33 | pc2-sd (nth (:std-dev pc) 1)
34 | pc1 (sel (:rotation pc) :cols 0)
35 | pc2 (sel (:rotation pc) :cols 1)
36 | [dim-1 dim-2] (map #(Math/ceil %) (som-dimensions pc1-sd pc2-sd))
37 | data-mean (map mean (trans data))
38 | weight-fn (fn [i j data-mean pc1-sd dim-1 dim-2 pc1 pc2]
39 | (to-vect
40 | (plus data-mean
41 | (mult (mult 5 pc1-sd)
42 | (plus (mult pc1 (minus i (div dim-1 2)))
43 | (mult pc2 (minus j (div dim-2 2))))))))
44 | weights (reduce conj {}
45 | (for [i (range dim-1) j (range dim-2)]
46 | {[i j] (weight-fn i j data-mean pc1-sd dim-1 dim-2 pc1 pc2)} ))
47 | sets (reduce conj {}
48 | (for [i (range dim-1) j (range dim-2)]
49 | {[i j] #{}} ))]
50 | {:dims [dim-1 dim-2]
51 | :weights weights
52 | :sets sets
53 | :data-means data-mean})))
54 |
55 |
56 | (defn- dist-euclidean [x y] (sqrt (sum (pow (minus x y) 2))))
57 |
58 |
59 | (defn- get-distances
60 | ([x som]
61 | (reduce conj {}
62 | (pmap #(hash-map % (dist-euclidean x ((:weights som) %)))
63 | (keys (:weights som))))))
64 |
65 |
66 | (defn- get-min-dist
67 | ([x som]
68 | (let [distances (get-distances x som)
69 | min-dist-key (reduce #(if (<= (distances %1) (distances %2)) %1 %2)
70 | (keys distances))]
71 | {:index min-dist-key :dist (distances min-dist-key)} )))
72 |
73 |
74 | (defn- som-update-cells
75 | ([data som]
76 | (let [sets (loop [i 0 sets {}]
77 | (if (= i (nrow data))
78 | sets
79 | (let [{idx :index min-dist :dist} (get-min-dist (trans (nth data i)) som)]
80 | (recur (inc i) (assoc sets idx (conj (sets idx) i))))))]
81 | (assoc som :sets sets))))
82 |
83 |
84 | (defn- alpha-fn
85 | ([r total-cycles alpha-init]
86 | (max 0.01 (* alpha-init (- 1 (/ r total-cycles))))))
87 |
88 |
89 | (defn- beta-fn
90 | ([r beta-init]
91 | (max 0 (- beta-init r))))
92 |
93 |
94 | (defn- som-neighborhoods
95 | ([r dim-1 dim-2 total-cycles beta0]
96 | (reduce conj {}
97 | (for [i (range dim-1) j (range dim-2)]
98 | [[i j]
99 | (for [s1 (range (if (pos? (- i (beta-fn r beta0))) (- i (beta-fn r beta0)) 0)
100 | (if (<= (+ i (beta-fn r beta0)) dim-1) (+ i (beta-fn r beta0) 1) dim-1))
101 | s2 (range (if (pos? (- j (beta-fn r beta0))) (- j (beta-fn r beta0)) 0)
102 | (if (<= (+ j (beta-fn r beta0)) dim-2) (+ j (beta-fn r beta0) 1) dim-2))]
103 | [s1 s2])]))))
104 |
105 |
106 |
107 | (defn- som-update-weights [r total-cycles som alpha-init beta-init]
108 | (let [
109 | sets (:sets som)
110 | weights (:weights som)
111 | indices (keys weights)
112 | dims (:dims som)
113 | neighborhoods (som-neighborhoods r (first dims) (second dims) total-cycles beta-init)
114 | ]
115 | (assoc som :weights
116 | (reduce conj {}
117 | (pmap (fn [indx]
118 | {indx
119 | (plus (weights indx)
120 | (mult (alpha-fn r total-cycles alpha-init)
121 | (minus (if (pos? (count (sets indx)))
122 | (div (sum (sets indx))
123 | (count (sets indx)))
124 | 0)
125 | (weights indx))))} ) indices)))))
126 |
127 |
128 | (defn- som-fitness
129 | ([data som]
130 | (/ (sum (for [indx (keys (:weights som))]
131 | (sum (map #(dist-euclidean ((:weights som) indx) (trans (nth data %)))
132 | ((:sets som) indx)))))
133 | (nrow data))))
134 |
135 |
136 | (defn som-batch-train
137 | " Performs BL-SOM (batch-learning self organizing map) learning on
138 | the given data, returning a hashmap containing resulting BL-SOM
139 | values.
140 |
141 |
142 | Arguments:
143 | data -- data matrix
144 |
145 | Options:
146 | :cycles -- number of cycles of learning
147 | :alpha -- initial value of alpha learning parameter
148 | :beta -- initial value of beta learning parameter
149 |
150 |
151 | Returns: A hashmap containing the following fields:
152 |
153 | :fit -- array of fitness values for each cycle of SOM learning
154 | :weights -- hashmap of weight vectors, keyed by lattice indices
155 | :sets -- hashmap mapping data elements to lattice nodes
156 | (key lattice index) (value list of row indices from data)
157 | :dims -- dimensions of SOM lattice
158 | :data-means -- column means of input data matrix
159 |
160 |
161 | Examples:
162 |
163 | (use '(incanter core som stats charts datasets))
164 | (def data (to-matrix (sel (get-dataset :iris)
165 | :cols [\"Sepal.Length\" \"Sepal.Width\" \"Petal.Length\" \"Petal.Width\"])))
166 |
167 | (def som (som-batch-train data :cycles 10 :alpha 0.5 :beta 3))
168 |
169 | ;; plot the fitness for each cycle of training
170 | (view (xy-plot (range (count (:fit som))) (:fit som)))
171 | ;; view indices of data items in each cell
172 | (:sets som)
173 | ;; view the species in each cell
174 | (doseq [rws (vals (:sets som))]
175 | (println (sel (get-dataset :iris) :cols \"Species\" :rows rws) \\newline))
176 |
177 | ;; plot the means of the data vectors in each cell/cluster
178 | (def cell-means (map #(map mean (trans (sel data :rows ((:sets som) %)))) (keys (:sets som))))
179 | (def x (range (ncol data)))
180 | (doto (xy-plot x (first cell-means))
181 | view
182 | (add-lines x (nth cell-means 1))
183 | (add-lines x (nth cell-means 2)))
184 |
185 |
186 | References:
187 |
188 | http://en.wikipedia.org/wiki/Self-organizing_map
189 |
190 | "
191 | ([data & {:keys [alpha beta cycles]
192 | :or {alpha 0.5
193 | beta 3
194 | cycles 10}}]
195 | (loop [r 1 som (som-initialize-linear data) fit []]
196 | (if (= r cycles)
197 | (assoc som :fit fit)
198 | (let [new-som (som-update-weights r cycles (som-update-cells data som)
199 | alpha beta)]
200 | (recur (inc r) new-som (conj fit (som-fitness data new-som))))))))
201 |
--------------------------------------------------------------------------------