annotate sicm/bk/utils.html @ 11:1f112b4f9e8f tip

Fixed what was baroque.
author Dylan Holmes <ocsenave@gmail.com>
date Tue, 01 Nov 2011 02:30:49 -0500
parents b4de894a1e2e
children
rev   line source
rlm@2 1 <?xml version="1.0" encoding="utf-8"?>
rlm@2 2 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
rlm@2 3 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
rlm@2 4 <html xmlns="http://www.w3.org/1999/xhtml"
rlm@2 5 lang="en" xml:lang="en">
rlm@2 6 <head>
rlm@2 7 <title>Building a Classical Mechanics Library in Clojure</title>
rlm@2 8 <meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
rlm@2 9 <meta name="generator" content="Org-mode"/>
rlm@2 10 <meta name="generated" content="2011-08-09 18:41:37 EDT"/>
rlm@2 11 <meta name="author" content="Robert McIntyre & Dylan Holmes"/>
rlm@2 12 <meta name="description" content=""/>
rlm@2 13 <meta name="keywords" content=""/>
rlm@2 14 <style type="text/css">
rlm@2 15 <!--/*--><![CDATA[/*><!--*/
rlm@2 16 html { font-family: Times, serif; font-size: 12pt; }
rlm@2 17 .title { text-align: center; }
rlm@2 18 .todo { color: red; }
rlm@2 19 .done { color: green; }
rlm@2 20 .tag { background-color: #add8e6; font-weight:normal }
rlm@2 21 .target { }
rlm@2 22 .timestamp { color: #bebebe; }
rlm@2 23 .timestamp-kwd { color: #5f9ea0; }
rlm@2 24 .right {margin-left:auto; margin-right:0px; text-align:right;}
rlm@2 25 .left {margin-left:0px; margin-right:auto; text-align:left;}
rlm@2 26 .center {margin-left:auto; margin-right:auto; text-align:center;}
rlm@2 27 p.verse { margin-left: 3% }
rlm@2 28 pre {
rlm@2 29 border: 1pt solid #AEBDCC;
rlm@2 30 background-color: #F3F5F7;
rlm@2 31 padding: 5pt;
rlm@2 32 font-family: courier, monospace;
rlm@2 33 font-size: 90%;
rlm@2 34 overflow:auto;
rlm@2 35 }
rlm@2 36 table { border-collapse: collapse; }
rlm@2 37 td, th { vertical-align: top; }
rlm@2 38 th.right { text-align:center; }
rlm@2 39 th.left { text-align:center; }
rlm@2 40 th.center { text-align:center; }
rlm@2 41 td.right { text-align:right; }
rlm@2 42 td.left { text-align:left; }
rlm@2 43 td.center { text-align:center; }
rlm@2 44 dt { font-weight: bold; }
rlm@2 45 div.figure { padding: 0.5em; }
rlm@2 46 div.figure p { text-align: center; }
rlm@2 47 textarea { overflow-x: auto; }
rlm@2 48 .linenr { font-size:smaller }
rlm@2 49 .code-highlighted {background-color:#ffff00;}
rlm@2 50 .org-info-js_info-navigation { border-style:none; }
rlm@2 51 #org-info-js_console-label { font-size:10px; font-weight:bold;
rlm@2 52 white-space:nowrap; }
rlm@2 53 .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
rlm@2 54 font-weight:bold; }
rlm@2 55 /*]]>*/-->
rlm@2 56 </style>
rlm@2 57 <link rel="stylesheet" type="text/css" href="../css/aurellem.css" />
rlm@2 58 <script type="text/javascript">
rlm@2 59 <!--/*--><![CDATA[/*><!--*/
rlm@2 60 function CodeHighlightOn(elem, id)
rlm@2 61 {
rlm@2 62 var target = document.getElementById(id);
rlm@2 63 if(null != target) {
rlm@2 64 elem.cacheClassElem = elem.className;
rlm@2 65 elem.cacheClassTarget = target.className;
rlm@2 66 target.className = "code-highlighted";
rlm@2 67 elem.className = "code-highlighted";
rlm@2 68 }
rlm@2 69 }
rlm@2 70 function CodeHighlightOff(elem, id)
rlm@2 71 {
rlm@2 72 var target = document.getElementById(id);
rlm@2 73 if(elem.cacheClassElem)
rlm@2 74 elem.className = elem.cacheClassElem;
rlm@2 75 if(elem.cacheClassTarget)
rlm@2 76 target.className = elem.cacheClassTarget;
rlm@2 77 }
rlm@2 78 /*]]>*///-->
rlm@2 79 </script>
rlm@2 80 <script type="text/javascript" src="../MathJax/MathJax.js">
rlm@2 81 <!--/*--><![CDATA[/*><!--*/
rlm@2 82 MathJax.Hub.Config({
rlm@2 83 // Only one of the two following lines, depending on user settings
rlm@2 84 // First allows browser-native MathML display, second forces HTML/CSS
rlm@2 85 config: ["MMLorHTML.js"], jax: ["input/TeX"],
rlm@2 86 // jax: ["input/TeX", "output/HTML-CSS"],
rlm@2 87 extensions: ["tex2jax.js","TeX/AMSmath.js","TeX/AMSsymbols.js",
rlm@2 88 "TeX/noUndefined.js"],
rlm@2 89 tex2jax: {
rlm@2 90 inlineMath: [ ["\\(","\\)"] ],
rlm@2 91 displayMath: [ ['$$','$$'], ["\\[","\\]"], ["\\begin{displaymath}","\\end{displaymath}"] ],
rlm@2 92 skipTags: ["script","noscript","style","textarea","pre","code"],
rlm@2 93 ignoreClass: "tex2jax_ignore",
rlm@2 94 processEscapes: false,
rlm@2 95 processEnvironments: true,
rlm@2 96 preview: "TeX"
rlm@2 97 },
rlm@2 98 showProcessingMessages: true,
rlm@2 99 displayAlign: "left",
rlm@2 100 displayIndent: "2em",
rlm@2 101
rlm@2 102 "HTML-CSS": {
rlm@2 103 scale: 100,
rlm@2 104 availableFonts: ["STIX","TeX"],
rlm@2 105 preferredFont: "TeX",
rlm@2 106 webFont: "TeX",
rlm@2 107 imageFont: "TeX",
rlm@2 108 showMathMenu: true,
rlm@2 109 },
rlm@2 110 MMLorHTML: {
rlm@2 111 prefer: {
rlm@2 112 MSIE: "MML",
rlm@2 113 Firefox: "MML",
rlm@2 114 Opera: "HTML",
rlm@2 115 other: "HTML"
rlm@2 116 }
rlm@2 117 }
rlm@2 118 });
rlm@2 119 /*]]>*///-->
rlm@2 120 </script>
rlm@2 121 </head>
rlm@2 122 <body>
rlm@2 123
rlm@2 124 <div id="content">
rlm@2 125
rlm@2 126
rlm@2 127
rlm@2 128 <div class="header">
rlm@2 129 <div class="float-right">
rlm@2 130 <!--
rlm@2 131 <form>
rlm@2 132 <input type="text"/><input type="submit" value="search the blog &raquo;"/>
rlm@2 133 </form>
rlm@2 134 -->
rlm@2 135 </div>
rlm@2 136
rlm@2 137 <h1>aurellem <em>&#x2609;</em></h1>
rlm@2 138 <ul class="nav">
rlm@2 139 <li><a href="/">read the blog &raquo;</a></li>
rlm@2 140 <!-- li><a href="#">learn about us &raquo;</a></li-->
rlm@2 141 </ul>
rlm@2 142 </div>
rlm@2 143
rlm@2 144 <h1 class="title">Building a Classical Mechanics Library in Clojure</h1>
rlm@2 145
rlm@2 146
rlm@2 147
rlm@2 148
rlm@2 149
rlm@2 150
rlm@2 151
rlm@2 152 <div id="table-of-contents">
rlm@2 153 <h2>Table of Contents</h2>
rlm@2 154 <div id="text-table-of-contents">
rlm@2 155 <ul>
rlm@2 156 <li><a href="#sec-1">1 Generic Arithmetic </a></li>
rlm@2 157 <li><a href="#sec-2">2 Useful Data Types </a>
rlm@2 158 <ul>
rlm@2 159 <li><a href="#sec-2-1">2.1 Complex Numbers </a></li>
rlm@2 160 <li><a href="#sec-2-2">2.2 Tuples and Tensors </a>
rlm@2 161 <ul>
rlm@2 162 <li><a href="#sec-2-2-1">2.2.1 Contraction </a></li>
rlm@2 163 <li><a href="#sec-2-2-2">2.2.2 Matrices </a></li>
rlm@2 164 </ul>
rlm@2 165 </li>
rlm@2 166 <li><a href="#sec-2-3">2.3 Power Series </a></li>
rlm@2 167 </ul>
rlm@2 168 </li>
rlm@2 169 <li><a href="#sec-3">3 Basic Utilities </a>
rlm@2 170 <ul>
rlm@2 171 <li><a href="#sec-3-1">3.1 Sequence manipulation </a></li>
rlm@2 172 <li><a href="#sec-3-2">3.2 Ranges, Airity and Function Composition </a></li>
rlm@2 173 </ul>
rlm@2 174 </li>
rlm@2 175 <li><a href="#sec-4">4 Numerical Methods </a></li>
rlm@2 176 <li><a href="#sec-5">5 Differentiation </a></li>
rlm@2 177 <li><a href="#sec-6">6 Symbolic Manipulation </a></li>
rlm@2 178 </ul>
rlm@2 179 </div>
rlm@2 180 </div>
rlm@2 181
rlm@2 182 <div id="outline-container-1" class="outline-2">
rlm@2 183 <h2 id="sec-1"><span class="section-number-2">1</span> Generic Arithmetic </h2>
rlm@2 184 <div class="outline-text-2" id="text-1">
rlm@2 185
rlm@2 186
rlm@2 187
rlm@2 188
rlm@2 189
rlm@2 190 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">ns</span> sicm.utils)
rlm@2 191 (<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 192
rlm@2 193
rlm@2 194
rlm@2 195 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">all-equal?</span> [coll]
rlm@2 196 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">empty?</span> (<span style="color: #8cd0d3;">rest</span> coll)) true
rlm@2 197 (<span style="color: #f0dfaf; font-weight: bold;">and</span> (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">first</span> coll) (<span style="color: #8cd0d3;">second</span> coll))
rlm@2 198 (<span style="color: #f0dfaf; font-weight: bold;">recur</span> (<span style="color: #8cd0d3;">rest</span> coll)))))
rlm@2 199
rlm@2 200
rlm@2 201 (<span style="color: #f0dfaf; font-weight: bold;">defprotocol</span> <span style="color: #f0dfaf;">Arithmetic</span>
rlm@2 202 (zero [this])
rlm@2 203 (one [this])
rlm@2 204 (negate [this])
rlm@2 205 (invert [this])
rlm@2 206 (conjugate [this]))
rlm@2 207
rlm@2 208 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">zero?</span> [x]
rlm@2 209 (<span style="color: #8cd0d3;">=</span> x (zero x)))
rlm@2 210 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">one?</span> [x]
rlm@2 211 (<span style="color: #8cd0d3;">=</span> x (one x)))
rlm@2 212
rlm@2 213
rlm@2 214
rlm@2 215 (<span style="color: #8cd0d3;">extend-protocol</span> Arithmetic
rlm@2 216 java.lang.Number
rlm@2 217 (zero [x] 0)
rlm@2 218 (one [x] 1)
rlm@2 219 (negate [x] (<span style="color: #8cd0d3;">-</span> x))
rlm@2 220 (invert [x] (<span style="color: #8cd0d3;">/</span> x))
rlm@2 221 )
rlm@2 222
rlm@2 223 (<span style="color: #8cd0d3;">extend-protocol</span> Arithmetic
rlm@2 224 clojure.lang.IFn
rlm@2 225 (one [f] identity)
rlm@2 226 (negate [f] (<span style="color: #8cd0d3;">comp</span> negate f))
rlm@2 227 (invert [f] (<span style="color: #8cd0d3;">comp</span> invert f)))
rlm@2 228
rlm@2 229
rlm@2 230 (<span style="color: #8cd0d3;">extend-protocol</span> Arithmetic
rlm@2 231 clojure.lang.Seqable
rlm@2 232 (zero [this] (<span style="color: #8cd0d3;">map</span> zero this))
rlm@2 233 (one [this] (<span style="color: #8cd0d3;">map</span> one this))
rlm@2 234 (invert [this] (<span style="color: #8cd0d3;">map</span> invert this))
rlm@2 235 (negate [this] (<span style="color: #8cd0d3;">map</span> negate this)))
rlm@2 236
rlm@2 237
rlm@2 238 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">ordered-like</span>
rlm@2 239 <span style="color: #8fb28f;">"Create a comparator using the sorted collection as an</span>
rlm@2 240 <span style="color: #8fb28f;"> example. Elements not in the sorted collection are sorted to the</span>
rlm@2 241 <span style="color: #8fb28f;"> end."</span>
rlm@2 242 [sorted-coll]
rlm@2 243 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [
rlm@2 244 sorted-coll? (<span style="color: #8cd0d3;">set</span> sorted-coll)
rlm@2 245 ascending-pair?
rlm@2 246 (<span style="color: #8cd0d3;">set</span>(<span style="color: #8cd0d3;">reduce</span> concat
rlm@2 247 (map-indexed
rlm@2 248 (<span style="color: #8cd0d3;">fn</span> [n x]
rlm@2 249 (<span style="color: #8cd0d3;">map</span> #(<span style="color: #8cd0d3;">vector</span> x %) (<span style="color: #8cd0d3;">nthnext</span> sorted-coll n)))
rlm@2 250 sorted-coll)))]
rlm@2 251 (<span style="color: #8cd0d3;">fn</span> [x y]
rlm@2 252 (<span style="color: #f0dfaf; font-weight: bold;">cond</span>
rlm@2 253 (<span style="color: #8cd0d3;">=</span> x y) 0
rlm@2 254 (ascending-pair? [x y]) -1
rlm@2 255 (ascending-pair? [y x]) 1
rlm@2 256 (sorted-coll? x) -1
rlm@2 257 (sorted-coll? y) 1))))
rlm@2 258
rlm@2 259
rlm@2 260
rlm@2 261 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">type-precedence</span>
rlm@2 262 (ordered-like [incanter.Matrix]))
rlm@2 263
rlm@2 264 (<span style="color: #f0dfaf; font-weight: bold;">defmulti</span> <span style="color: #f0dfaf;">add</span>
rlm@2 265 (<span style="color: #8cd0d3;">fn</span> [x y]
rlm@2 266 (<span style="color: #8cd0d3;">sort</span> type-precedence [(<span style="color: #8cd0d3;">type</span> x)(<span style="color: #8cd0d3;">type</span> y)])))
rlm@2 267
rlm@2 268 (<span style="color: #f0dfaf; font-weight: bold;">defmulti</span> <span style="color: #f0dfaf;">multiply</span>
rlm@2 269 (<span style="color: #8cd0d3;">fn</span> [x y]
rlm@2 270 (<span style="color: #8cd0d3;">sort</span> type-precedence [(<span style="color: #8cd0d3;">type</span> x) (<span style="color: #8cd0d3;">type</span> y)])))
rlm@2 271
rlm@2 272 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">add</span> [java.lang.Number java.lang.Number] [x y] (<span style="color: #8cd0d3;">+</span> x y))
rlm@2 273 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">multiply</span> [java.lang.Number java.lang.Number] [x y] (<span style="color: #8cd0d3;">*</span> x y))
rlm@2 274
rlm@2 275 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">multiply</span> [incanter.Matrix java.lang.Integer] [x y]
rlm@2 276 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [args (<span style="color: #8cd0d3;">sort</span> #(type-precedence (<span style="color: #8cd0d3;">type</span> %1)(<span style="color: #8cd0d3;">type</span> %2)) [x y])
rlm@2 277 matrix (<span style="color: #8cd0d3;">first</span> args)
rlm@2 278 scalar (<span style="color: #8cd0d3;">second</span> args)]
rlm@2 279 (incanter.core/matrix (<span style="color: #8cd0d3;">map</span> (<span style="color: #8cd0d3;">partial</span> map (<span style="color: #8cd0d3;">partial</span> multiply scalar)) matrix))))
rlm@2 280
rlm@2 281 </pre>
rlm@2 282
rlm@2 283
rlm@2 284
rlm@2 285
rlm@2 286
rlm@2 287 </div>
rlm@2 288
rlm@2 289 </div>
rlm@2 290
rlm@2 291 <div id="outline-container-2" class="outline-2">
rlm@2 292 <h2 id="sec-2"><span class="section-number-2">2</span> Useful Data Types </h2>
rlm@2 293 <div class="outline-text-2" id="text-2">
rlm@2 294
rlm@2 295
rlm@2 296
rlm@2 297 </div>
rlm@2 298
rlm@2 299 <div id="outline-container-2-1" class="outline-3">
rlm@2 300 <h3 id="sec-2-1"><span class="section-number-3">2.1</span> Complex Numbers </h3>
rlm@2 301 <div class="outline-text-3" id="text-2-1">
rlm@2 302
rlm@2 303
rlm@2 304
rlm@2 305
rlm@2 306 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 307
rlm@2 308 (<span style="color: #f0dfaf; font-weight: bold;">defprotocol</span> <span style="color: #f0dfaf;">Complex</span>
rlm@2 309 (real-part [z])
rlm@2 310 (imaginary-part [z])
rlm@2 311 (magnitude-squared [z])
rlm@2 312 (angle [z])
rlm@2 313 (conjugate [z])
rlm@2 314 (norm [z]))
rlm@2 315
rlm@2 316 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">complex-rectangular</span>
rlm@2 317 <span style="color: #8fb28f;">"Define a complex number with the given real and imaginary</span>
rlm@2 318 <span style="color: #8fb28f;"> components."</span>
rlm@2 319 [re im]
rlm@2 320 (<span style="color: #8cd0d3;">reify</span> Complex
rlm@2 321 (real-part [z] re)
rlm@2 322 (imaginary-part [z] im)
rlm@2 323 (magnitude-squared [z] (<span style="color: #8cd0d3;">+</span> (<span style="color: #8cd0d3;">*</span> re re) (<span style="color: #8cd0d3;">*</span> im im)))
rlm@2 324 (angle [z] (java.lang.Math/atan2 im re))
rlm@2 325 (conjugate [z] (complex-rectangular re (<span style="color: #8cd0d3;">-</span> im)))
rlm@2 326
rlm@2 327 Arithmetic
rlm@2 328 (zero [z] (complex-rectangular 0 0))
rlm@2 329 (one [z] (complex-rectangular 1 0))
rlm@2 330 (negate [z] (complex-rectangular (<span style="color: #8cd0d3;">-</span> re) (<span style="color: #8cd0d3;">-</span> im)))
rlm@2 331 (invert [z] (complex-rectangular
rlm@2 332 (<span style="color: #8cd0d3;">/</span> re (magnitude-squared z))
rlm@2 333 (<span style="color: #8cd0d3;">/</span> (<span style="color: #8cd0d3;">-</span> im) (magnitude-squared z))))
rlm@2 334
rlm@2 335 Object
rlm@2 336 (toString [_]
rlm@2 337 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #f0dfaf; font-weight: bold;">and</span> (zero? re) (zero? im)) (<span style="color: #8cd0d3;">str</span> 0)
rlm@2 338 (<span style="color: #8cd0d3;">str</span>
rlm@2 339 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">not</span>(zero? re))
rlm@2 340 re)
rlm@2 341 (<span style="color: #f0dfaf; font-weight: bold;">if</span> ((<span style="color: #8cd0d3;">comp</span> not zero?) im)
rlm@2 342 (<span style="color: #8cd0d3;">str</span>
rlm@2 343 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">neg?</span> im) <span style="color: #cc9393;">"-"</span> <span style="color: #cc9393;">"+"</span>)
rlm@2 344 (<span style="color: #f0dfaf; font-weight: bold;">if</span> ((<span style="color: #8cd0d3;">comp</span> not one?) (java.lang.Math/abs im))
rlm@2 345 (java.lang.Math/abs im))
rlm@2 346 <span style="color: #cc9393;">"i"</span>)))))))
rlm@2 347
rlm@2 348 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">complex-polar</span>
rlm@2 349 <span style="color: #8fb28f;">"Define a complex number with the given magnitude and angle."</span>
rlm@2 350 [mag ang]
rlm@2 351 (<span style="color: #8cd0d3;">reify</span> Complex
rlm@2 352 (magnitude-squared [z] (<span style="color: #8cd0d3;">*</span> mag mag))
rlm@2 353 (angle [z] angle)
rlm@2 354 (real-part [z] (<span style="color: #8cd0d3;">*</span> mag (java.lang.Math/cos ang)))
rlm@2 355 (imaginary-part [z] (<span style="color: #8cd0d3;">*</span> mag (java.lang.Math/sin ang)))
rlm@2 356 (conjugate [z] (complex-polar mag (<span style="color: #8cd0d3;">-</span> ang)))
rlm@2 357
rlm@2 358 Arithmetic
rlm@2 359 (zero [z] (complex-polar 0 0))
rlm@2 360 (one [z] (complex-polar 1 0))
rlm@2 361 (negate [z] (complex-polar (<span style="color: #8cd0d3;">-</span> mag) ang))
rlm@2 362 (invert [z] (complex-polar (<span style="color: #8cd0d3;">/</span> mag) (<span style="color: #8cd0d3;">-</span> ang)))
rlm@2 363
rlm@2 364 Object
rlm@2 365 (toString [_] (<span style="color: #8cd0d3;">str</span> mag <span style="color: #cc9393;">" * e^(i"</span> ang<span style="color: #cc9393;">")"</span>))
rlm@2 366 ))
rlm@2 367
rlm@2 368
rlm@2 369 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">Numbers are complex quantities</span>
rlm@2 370
rlm@2 371 (<span style="color: #8cd0d3;">extend-protocol</span> Complex
rlm@2 372 java.lang.Number
rlm@2 373 (real-part [x] x)
rlm@2 374 (imaginary-part [x] 0)
rlm@2 375 (magnitude [x] x)
rlm@2 376 (angle [x] 0)
rlm@2 377 (conjugate [x] x))
rlm@2 378
rlm@2 379
rlm@2 380 </pre>
rlm@2 381
rlm@2 382
rlm@2 383
rlm@2 384
rlm@2 385
rlm@2 386
rlm@2 387 </div>
rlm@2 388
rlm@2 389 </div>
rlm@2 390
rlm@2 391 <div id="outline-container-2-2" class="outline-3">
rlm@2 392 <h3 id="sec-2-2"><span class="section-number-3">2.2</span> Tuples and Tensors </h3>
rlm@2 393 <div class="outline-text-3" id="text-2-2">
rlm@2 394
rlm@2 395
rlm@2 396 <p>
rlm@2 397 A tuple is a vector which is spinable&mdash;it can be either <i>spin up</i> or <i>spin down</i>. (Covariant, contravariant; dual vectors)
rlm@2 398 </p>
rlm@2 399
rlm@2 400
rlm@2 401 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 402
rlm@2 403 (<span style="color: #f0dfaf; font-weight: bold;">defprotocol</span> <span style="color: #f0dfaf;">Spinning</span>
rlm@2 404 (up? [this])
rlm@2 405 (down? [this]))
rlm@2 406
rlm@2 407 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">spin</span>
rlm@2 408 <span style="color: #8fb28f;">"Returns the spin of the Spinning s, either :up or :down"</span>
rlm@2 409 [<span style="color: #dfdfbf; font-weight: bold;">#^Spinning</span> s]
rlm@2 410 (<span style="color: #f0dfaf; font-weight: bold;">cond</span> (up? s) <span style="color: #8cd0d3;">:up</span> (down? s) <span style="color: #8cd0d3;">:down</span>))
rlm@2 411
rlm@2 412
rlm@2 413 (<span style="color: #f0dfaf; font-weight: bold;">deftype</span> <span style="color: #f0dfaf;">Tuple</span>
rlm@2 414 [spin coll]
rlm@2 415 clojure.lang.Seqable
rlm@2 416 (<span style="color: #8cd0d3;">seq</span> [this] (<span style="color: #8cd0d3;">seq</span> (.coll this)))
rlm@2 417 clojure.lang.Counted
rlm@2 418 (<span style="color: #8cd0d3;">count</span> [this] (<span style="color: #8cd0d3;">count</span> (.coll this))))
rlm@2 419
rlm@2 420 (<span style="color: #8cd0d3;">extend-type</span> Tuple
rlm@2 421 Spinning
rlm@2 422 (up? [this] (<span style="color: #8cd0d3;">=</span> <span style="color: #8cd0d3;">::up</span> (.spin this)))
rlm@2 423 (down? [this] (<span style="color: #8cd0d3;">=</span> <span style="color: #8cd0d3;">::down</span> (.spin this))))
rlm@2 424
rlm@2 425 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">print-method</span> Tuple
rlm@2 426 [o w]
rlm@2 427 (<span style="color: #8cd0d3;">print-simple</span> (<span style="color: #8cd0d3;">str</span> (<span style="color: #f0dfaf; font-weight: bold;">if</span> (up? o) 'u 'd) (.coll o)) w))
rlm@2 428
rlm@2 429
rlm@2 430
rlm@2 431 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">up</span>
rlm@2 432 <span style="color: #8fb28f;">"Create a new up-tuple containing the contents of coll."</span>
rlm@2 433 [coll]
rlm@2 434 (Tuple. <span style="color: #8cd0d3;">::up</span> coll))
rlm@2 435
rlm@2 436 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">down</span>
rlm@2 437 <span style="color: #8fb28f;">"Create a new down-tuple containing the contents of coll."</span>
rlm@2 438 [coll]
rlm@2 439 (Tuple. <span style="color: #8cd0d3;">::down</span> coll))
rlm@2 440
rlm@2 441
rlm@2 442 </pre>
rlm@2 443
rlm@2 444
rlm@2 445
rlm@2 446
rlm@2 447
rlm@2 448 </div>
rlm@2 449
rlm@2 450 <div id="outline-container-2-2-1" class="outline-4">
rlm@2 451 <h4 id="sec-2-2-1"><span class="section-number-4">2.2.1</span> Contraction </h4>
rlm@2 452 <div class="outline-text-4" id="text-2-2-1">
rlm@2 453
rlm@2 454 <p>Contraction is a binary operation that you can apply to compatible
rlm@2 455 tuples. Tuples are compatible for contraction if they have the same
rlm@2 456 length and opposite spins, and if the corresponding items in each
rlm@2 457 tuple are both numbers or both compatible tuples.
rlm@2 458 </p>
rlm@2 459
rlm@2 460
rlm@2 461
rlm@2 462 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 463
rlm@2 464 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">numbers?</span>
rlm@2 465 <span style="color: #8fb28f;">"Returns true if all arguments are numbers, else false."</span>
rlm@2 466 [&amp; xs]
rlm@2 467 (<span style="color: #8cd0d3;">every?</span> number? xs))
rlm@2 468
rlm@2 469 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">contractible?</span>
rlm@2 470 <span style="color: #8fb28f;">"Returns true if the tuples a and b are compatible for contraction,</span>
rlm@2 471 <span style="color: #8fb28f;"> else false. Tuples are compatible if they have the same number of</span>
rlm@2 472 <span style="color: #8fb28f;"> components, they have opposite spins, and their elements are</span>
rlm@2 473 <span style="color: #8fb28f;"> pairwise-compatible."</span>
rlm@2 474 [a b]
rlm@2 475 (<span style="color: #f0dfaf; font-weight: bold;">and</span>
rlm@2 476 (<span style="color: #8cd0d3;">isa?</span> (<span style="color: #8cd0d3;">type</span> a) Tuple)
rlm@2 477 (<span style="color: #8cd0d3;">isa?</span> (<span style="color: #8cd0d3;">type</span> b) Tuple)
rlm@2 478 (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">count</span> a) (<span style="color: #8cd0d3;">count</span> b))
rlm@2 479 (<span style="color: #8cd0d3;">not=</span> (spin a) (spin b))
rlm@2 480
rlm@2 481 (<span style="color: #8cd0d3;">not-any?</span> false?
rlm@2 482 (<span style="color: #8cd0d3;">map</span> #(<span style="color: #f0dfaf; font-weight: bold;">or</span>
rlm@2 483 (numbers? %1 %2)
rlm@2 484 (contractible? %1 %2))
rlm@2 485 a b))))
rlm@2 486
rlm@2 487
rlm@2 488
rlm@2 489 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">contract</span>
rlm@2 490 <span style="color: #8fb28f;">"Contracts two tuples, returning the sum of the</span>
rlm@2 491 <span style="color: #8fb28f;"> products of the corresponding items. Contraction is recursive on</span>
rlm@2 492 <span style="color: #8fb28f;"> nested tuples."</span>
rlm@2 493 [a b]
rlm@2 494 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">not</span> (contractible? a b))
rlm@2 495 (<span style="color: #f0dfaf; font-weight: bold;">throw</span>
rlm@2 496 (Exception. <span style="color: #cc9393;">"Not compatible for contraction."</span>))
rlm@2 497 (<span style="color: #8cd0d3;">reduce</span> +
rlm@2 498 (<span style="color: #8cd0d3;">map</span>
rlm@2 499 (<span style="color: #8cd0d3;">fn</span> [x y]
rlm@2 500 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (numbers? x y)
rlm@2 501 (<span style="color: #8cd0d3;">*</span> x y)
rlm@2 502 (contract x y)))
rlm@2 503 a b))))
rlm@2 504
rlm@2 505 </pre>
rlm@2 506
rlm@2 507
rlm@2 508
rlm@2 509
rlm@2 510 </div>
rlm@2 511
rlm@2 512 </div>
rlm@2 513
rlm@2 514 <div id="outline-container-2-2-2" class="outline-4">
rlm@2 515 <h4 id="sec-2-2-2"><span class="section-number-4">2.2.2</span> Matrices </h4>
rlm@2 516 <div class="outline-text-4" id="text-2-2-2">
rlm@2 517
rlm@2 518
rlm@2 519
rlm@2 520
rlm@2 521 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 522 (<span style="color: #8cd0d3;">require</span> 'incanter.core) <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">use incanter's fast matrices</span>
rlm@2 523
rlm@2 524 (<span style="color: #f0dfaf; font-weight: bold;">defprotocol</span> <span style="color: #f0dfaf;">Matrix</span>
rlm@2 525 (rows [matrix])
rlm@2 526 (cols [matrix])
rlm@2 527 (diagonal [matrix])
rlm@2 528 (trace [matrix])
rlm@2 529 (determinant [matrix])
rlm@2 530 (transpose [matrix])
rlm@2 531 (conjugate [matrix])
rlm@2 532 )
rlm@2 533
rlm@2 534 (<span style="color: #8cd0d3;">extend-protocol</span> Matrix
rlm@2 535 incanter.Matrix
rlm@2 536 (rows [rs] (<span style="color: #8cd0d3;">map</span> down (<span style="color: #8cd0d3;">apply</span> map vector (<span style="color: #8cd0d3;">apply</span> map vector rs))))
rlm@2 537 (cols [rs] (<span style="color: #8cd0d3;">map</span> up (<span style="color: #8cd0d3;">apply</span> map vector rs)))
rlm@2 538 (diagonal [matrix] (incanter.core/diag matrix) )
rlm@2 539 (determinant [matrix] (incanter.core/det matrix))
rlm@2 540 (trace [matrix] (incanter.core/trace matrix))
rlm@2 541 (transpose [matrix] (incanter.core/trans matrix))
rlm@2 542 )
rlm@2 543
rlm@2 544 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">count-rows</span> [matrix]
rlm@2 545 ((<span style="color: #8cd0d3;">comp</span> count rows) matrix))
rlm@2 546
rlm@2 547 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">count-cols</span> [matrix]
rlm@2 548 ((<span style="color: #8cd0d3;">comp</span> count cols) matrix))
rlm@2 549
rlm@2 550 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">square?</span> [matrix]
rlm@2 551 (<span style="color: #8cd0d3;">=</span> (count-rows matrix) (count-cols matrix)))
rlm@2 552
rlm@2 553 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">identity-matrix</span>
rlm@2 554 <span style="color: #8fb28f;">"Define a square matrix of size n-by-n with 1s along the diagonal and</span>
rlm@2 555 <span style="color: #8fb28f;"> 0s everywhere else."</span>
rlm@2 556 [n]
rlm@2 557 (incanter.core/identity-matrix n))
rlm@2 558
rlm@2 559
rlm@2 560
rlm@2 561
rlm@2 562
rlm@2 563 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">matrix-by-rows</span>
rlm@2 564 <span style="color: #8fb28f;">"Define a matrix by giving its rows."</span>
rlm@2 565 [&amp; rows]
rlm@2 566 (<span style="color: #f0dfaf; font-weight: bold;">if</span>
rlm@2 567 (<span style="color: #8cd0d3;">not</span> (all-equal? (<span style="color: #8cd0d3;">map</span> count rows)))
rlm@2 568 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception. <span style="color: #cc9393;">"All rows in a matrix must have the same number of elements."</span>))
rlm@2 569 (incanter.core/matrix (<span style="color: #8cd0d3;">vec</span> rows))))
rlm@2 570
rlm@2 571 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">matrix-by-cols</span>
rlm@2 572 <span style="color: #8fb28f;">"Define a matrix by giving its columns"</span>
rlm@2 573 [&amp; cols]
rlm@2 574 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">not</span> (all-equal? (<span style="color: #8cd0d3;">map</span> count cols)))
rlm@2 575 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception. <span style="color: #cc9393;">"All columns in a matrix must have the same number of elements."</span>))
rlm@2 576 (incanter.core/matrix (<span style="color: #8cd0d3;">vec</span> (<span style="color: #8cd0d3;">apply</span> map vector cols)))))
rlm@2 577
rlm@2 578 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">identity-matrix</span>
rlm@2 579 <span style="color: #8fb28f;">"Define a square matrix of size n-by-n with 1s along the diagonal and</span>
rlm@2 580 <span style="color: #8fb28f;"> 0s everywhere else."</span>
rlm@2 581 [n]
rlm@2 582 (incanter.core/identity-matrix n))
rlm@2 583
rlm@2 584
rlm@2 585
rlm@2 586 (<span style="color: #8cd0d3;">extend-protocol</span> Arithmetic
rlm@2 587 incanter.Matrix
rlm@2 588 (one [matrix]
rlm@2 589 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (square? matrix)
rlm@2 590 (identity-matrix (count-rows matrix))
rlm@2 591 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception. <span style="color: #cc9393;">"Non-square matrices have no multiplicative unit."</span>))))
rlm@2 592 (zero [matrix]
rlm@2 593 (<span style="color: #8cd0d3;">apply</span> matrix-by-rows (<span style="color: #8cd0d3;">map</span> zero (rows matrix))))
rlm@2 594 (negate [matrix]
rlm@2 595 (<span style="color: #8cd0d3;">apply</span> matrix-by-rows (<span style="color: #8cd0d3;">map</span> negate (rows matrix))))
rlm@2 596 (invert [matrix]
rlm@2 597 (incanter.core/solve matrix)))
rlm@2 598
rlm@2 599
rlm@2 600
rlm@2 601 (<span style="color: #f0dfaf; font-weight: bold;">defmulti</span> <span style="color: #f0dfaf;">coerce-to-matrix</span>
rlm@2 602 <span style="color: #8fb28f;">"Converts x into a matrix, if possible."</span>
rlm@2 603 type)
rlm@2 604
rlm@2 605 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">coerce-to-matrix</span> incanter.Matrix [x] x)
rlm@2 606 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">coerce-to-matrix</span> Tuple [x]
rlm@2 607 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">apply</span> numbers? (<span style="color: #8cd0d3;">seq</span> x))
rlm@2 608 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (up? x)
rlm@2 609 (matrix-by-cols (<span style="color: #8cd0d3;">seq</span> x))
rlm@2 610 (matrix-by-rows (<span style="color: #8cd0d3;">seq</span> x)))
rlm@2 611 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception. <span style="color: #cc9393;">"Non-numerical tuple cannot be converted into a matrix."</span>))))
rlm@2 612
rlm@2 613
rlm@2 614
rlm@2 615
rlm@2 616
rlm@2 617 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(defn matrix-by-cols</span>
rlm@2 618 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">"Define a matrix by giving its columns."</span>
rlm@2 619 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">[&amp; cols]</span>
rlm@2 620 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(cond</span>
rlm@2 621 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(not (all-equal? (map count cols)))</span>
rlm@2 622 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(throw (Exception. "All columns in a matrix must have the same number of elements."))</span>
rlm@2 623 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">:else</span>
rlm@2 624 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(reify Matrix</span>
rlm@2 625 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(cols [this] (map up cols))</span>
rlm@2 626 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(rows [this] (map down (apply map vector cols)))</span>
rlm@2 627 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(diagonal [this] (map-indexed (fn [i col] (nth col i) cols)))</span>
rlm@2 628 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(trace [this]</span>
rlm@2 629 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(if (not= (count-cols this) (count-rows this))</span>
rlm@2 630 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(throw (Exception.</span>
rlm@2 631 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">"Cannot take the trace of a non-square matrix."))</span>
rlm@2 632 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(reduce + (diagonal this))))</span>
rlm@2 633
rlm@2 634 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(determinant [this]</span>
rlm@2 635 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(if (not= (count-cols this) (count-rows this))</span>
rlm@2 636 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(throw (Exception.</span>
rlm@2 637 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">"Cannot take the determinant of a non-square matrix."))</span>
rlm@2 638 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(reduce * (map-indexed (fn [i col] (nth col i)) cols))))</span>
rlm@2 639 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">)))</span>
rlm@2 640
rlm@2 641 (<span style="color: #8cd0d3;">extend-protocol</span> Matrix Tuple
rlm@2 642 (rows [this] (<span style="color: #f0dfaf; font-weight: bold;">if</span> (down? this)
rlm@2 643 (<span style="color: #8cd0d3;">list</span> this)
rlm@2 644 (<span style="color: #8cd0d3;">map</span> (<span style="color: #8cd0d3;">comp</span> up vector) this)))
rlm@2 645
rlm@2 646 (cols [this] (<span style="color: #f0dfaf; font-weight: bold;">if</span> (up? this)
rlm@2 647 (<span style="color: #8cd0d3;">list</span> this)
rlm@2 648 (<span style="color: #8cd0d3;">map</span> (<span style="color: #8cd0d3;">comp</span> down vector) this))
rlm@2 649 ))
rlm@2 650
rlm@2 651 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">matrix-multiply</span>
rlm@2 652 <span style="color: #8fb28f;">"Returns the matrix resulting from the matrix multiplication of the given arguments."</span>
rlm@2 653 ([A] (coerce-to-matrix A))
rlm@2 654 ([A B] (incanter.core/mmult (coerce-to-matrix A) (coerce-to-matrix B)))
rlm@2 655 ([M1 M2 &amp; Ms] (<span style="color: #8cd0d3;">reduce</span> matrix-multiply (matrix-multiply M1 M2) Ms)))
rlm@2 656
rlm@2 657 </pre>
rlm@2 658
rlm@2 659
rlm@2 660
rlm@2 661
rlm@2 662
rlm@2 663 </div>
rlm@2 664 </div>
rlm@2 665
rlm@2 666 </div>
rlm@2 667
rlm@2 668 <div id="outline-container-2-3" class="outline-3">
rlm@2 669 <h3 id="sec-2-3"><span class="section-number-3">2.3</span> Power Series </h3>
rlm@2 670 <div class="outline-text-3" id="text-2-3">
rlm@2 671
rlm@2 672
rlm@2 673
rlm@2 674
rlm@2 675 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 676 (<span style="color: #8cd0d3;">use</span> 'clojure.contrib.def)
rlm@2 677
rlm@2 678
rlm@2 679
rlm@2 680 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">series-fn</span>
rlm@2 681 <span style="color: #8fb28f;">"The function corresponding to the given power series."</span>
rlm@2 682 [series]
rlm@2 683 (<span style="color: #8cd0d3;">fn</span> [x]
rlm@2 684 (<span style="color: #8cd0d3;">reduce</span> +
rlm@2 685 (map-indexed (<span style="color: #8cd0d3;">fn</span>[n x] (<span style="color: #8cd0d3;">*</span> (<span style="color: #8cd0d3;">float</span> (<span style="color: #8cd0d3;">nth</span> series n)) (<span style="color: #8cd0d3;">float</span>(java.lang.Math/pow (<span style="color: #8cd0d3;">float</span> x) n)) ))
rlm@2 686 (<span style="color: #8cd0d3;">range</span> 20)))))
rlm@2 687
rlm@2 688 (<span style="color: #f0dfaf; font-weight: bold;">deftype</span> <span style="color: #f0dfaf;">PowerSeries</span>
rlm@2 689 [coll]
rlm@2 690 clojure.lang.Seqable
rlm@2 691 (<span style="color: #8cd0d3;">seq</span> [this] (<span style="color: #8cd0d3;">seq</span> (.coll this)))
rlm@2 692
rlm@2 693 clojure.lang.Indexed
rlm@2 694 (<span style="color: #8cd0d3;">nth</span> [this n] (<span style="color: #8cd0d3;">nth</span> (.coll this) n 0))
rlm@2 695 (<span style="color: #8cd0d3;">nth</span> [this n not-found] (<span style="color: #8cd0d3;">nth</span> (.coll this) n not-found))
rlm@2 696
rlm@2 697 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">clojure.lang.IFn</span>
rlm@2 698 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(call [this] (throw(Exception.)))</span>
rlm@2 699 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(invoke [this &amp; args] args</span>
rlm@2 700 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(let [f </span>
rlm@2 701 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">)</span>
rlm@2 702 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(run [this] (throw(Exception.)))</span>
rlm@2 703 )
rlm@2 704
rlm@2 705 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">power-series</span>
rlm@2 706 <span style="color: #8fb28f;">"Returns a power series with the items of the coll as its</span>
rlm@2 707 <span style="color: #8fb28f;"> coefficients. Trailing zeros are added to the end of coll."</span>
rlm@2 708 [coeffs]
rlm@2 709 (PowerSeries. coeffs))
rlm@2 710
rlm@2 711 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">power-series-indexed</span>
rlm@2 712 <span style="color: #8fb28f;">"Returns a power series consisting of the result of mapping f to the non-negative integers."</span>
rlm@2 713 [f]
rlm@2 714 (PowerSeries. (<span style="color: #8cd0d3;">map</span> f (<span style="color: #8cd0d3;">range</span>))))
rlm@2 715
rlm@2 716
rlm@2 717 (<span style="color: #f0dfaf; font-weight: bold;">defn-memo</span> <span style="color: #f0dfaf;">nth-partial-sum</span>
rlm@2 718 ([series n]
rlm@2 719 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (zero? n) (<span style="color: #8cd0d3;">first</span> series)
rlm@2 720 (<span style="color: #8cd0d3;">+</span> (<span style="color: #8cd0d3;">nth</span> series n)
rlm@2 721 (nth-partial-sum series (<span style="color: #8cd0d3;">dec</span> n))))))
rlm@2 722
rlm@2 723 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">partial-sums</span> [series]
rlm@2 724 (<span style="color: #8cd0d3;">lazy-seq</span> (<span style="color: #8cd0d3;">map</span> nth-partial-sum (<span style="color: #8cd0d3;">range</span>))))
rlm@2 725
rlm@2 726
rlm@2 727
rlm@2 728
rlm@2 729 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">cos-series</span>
rlm@2 730 (power-series-indexed
rlm@2 731 (<span style="color: #8cd0d3;">fn</span>[n]
rlm@2 732 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">odd?</span> n) 0
rlm@2 733 (<span style="color: #8cd0d3;">/</span>
rlm@2 734 (<span style="color: #8cd0d3;">reduce</span> *
rlm@2 735 (<span style="color: #8cd0d3;">reduce</span> * (<span style="color: #8cd0d3;">repeat</span> (<span style="color: #8cd0d3;">/</span> n 2) -1))
rlm@2 736 (<span style="color: #8cd0d3;">range</span> 1 (<span style="color: #8cd0d3;">inc</span> n)))
rlm@2 737 )))))
rlm@2 738
rlm@2 739 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">sin-series</span>
rlm@2 740 (power-series-indexed
rlm@2 741 (<span style="color: #8cd0d3;">fn</span>[n]
rlm@2 742 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">even?</span> n) 0
rlm@2 743 (<span style="color: #8cd0d3;">/</span>
rlm@2 744 (<span style="color: #8cd0d3;">reduce</span> *
rlm@2 745 (<span style="color: #8cd0d3;">reduce</span> * (<span style="color: #8cd0d3;">repeat</span> (<span style="color: #8cd0d3;">/</span> (<span style="color: #8cd0d3;">dec</span> n) 2) -1))
rlm@2 746 (<span style="color: #8cd0d3;">range</span> 1 (<span style="color: #8cd0d3;">inc</span> n)))
rlm@2 747 )))))
rlm@2 748
rlm@2 749 </pre>
rlm@2 750
rlm@2 751
rlm@2 752
rlm@2 753
rlm@2 754
rlm@2 755 </div>
rlm@2 756 </div>
rlm@2 757
rlm@2 758 </div>
rlm@2 759
rlm@2 760 <div id="outline-container-3" class="outline-2">
rlm@2 761 <h2 id="sec-3"><span class="section-number-2">3</span> Basic Utilities </h2>
rlm@2 762 <div class="outline-text-2" id="text-3">
rlm@2 763
rlm@2 764
rlm@2 765
rlm@2 766 </div>
rlm@2 767
rlm@2 768 <div id="outline-container-3-1" class="outline-3">
rlm@2 769 <h3 id="sec-3-1"><span class="section-number-3">3.1</span> Sequence manipulation </h3>
rlm@2 770 <div class="outline-text-3" id="text-3-1">
rlm@2 771
rlm@2 772
rlm@2 773
rlm@2 774
rlm@2 775
rlm@2 776 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">ns</span> sicm.utils)
rlm@2 777
rlm@2 778 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">do-up</span>
rlm@2 779 <span style="color: #8fb28f;">"Apply f to each number from low to high, presumably for</span>
rlm@2 780 <span style="color: #8fb28f;"> side-effects."</span>
rlm@2 781 [f low high]
rlm@2 782 (<span style="color: #f0dfaf; font-weight: bold;">doseq</span> [i (<span style="color: #8cd0d3;">range</span> low high)] (f i)))
rlm@2 783
rlm@2 784 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">do-down</span>
rlm@2 785 <span style="color: #8fb28f;">"Apply f to each number from high to low, presumably for</span>
rlm@2 786 <span style="color: #8fb28f;"> side-effects."</span>
rlm@2 787 [f high low]
rlm@2 788 (<span style="color: #f0dfaf; font-weight: bold;">doseq</span> [i (<span style="color: #8cd0d3;">range</span> high low -1)] (f i)))
rlm@2 789
rlm@2 790
rlm@2 791 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">all-equal?</span> [coll]
rlm@2 792 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">empty?</span> (<span style="color: #8cd0d3;">rest</span> coll)) true
rlm@2 793 (<span style="color: #f0dfaf; font-weight: bold;">and</span> (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">first</span> coll) (<span style="color: #8cd0d3;">second</span> coll))
rlm@2 794 (<span style="color: #f0dfaf; font-weight: bold;">recur</span> (<span style="color: #8cd0d3;">rest</span> coll))))))
rlm@2 795
rlm@2 796 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">multiplier</span>
rlm@2 797 <span style="color: #8fb28f;">"Returns a function that 'multiplies' the members of a collection,</span>
rlm@2 798 <span style="color: #8fb28f;">returning unit if called on an empty collection."</span>
rlm@2 799 [multiply unit]
rlm@2 800 (<span style="color: #8cd0d3;">fn</span> [coll] ((<span style="color: #8cd0d3;">partial</span> reduce multiply unit) coll)))
rlm@2 801
rlm@2 802 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">divider</span>
rlm@2 803 <span style="color: #8fb28f;">"Returns a function that 'divides' the first element of a collection</span>
rlm@2 804 <span style="color: #8fb28f;">by the 'product' of the rest of the collection."</span>
rlm@2 805 [divide multiply invert unit]
rlm@2 806 (<span style="color: #8cd0d3;">fn</span> [coll]
rlm@2 807 (<span style="color: #8cd0d3;">apply</span>
rlm@2 808 (<span style="color: #8cd0d3;">fn</span>
rlm@2 809 ([] unit)
rlm@2 810 ([x] (invert x))
rlm@2 811 ([x y] (divide x y))
rlm@2 812 ([x y &amp; zs] (divide x (<span style="color: #8cd0d3;">reduce</span> multiply y zs))))
rlm@2 813 coll)))
rlm@2 814
rlm@2 815 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">left-circular-shift</span>
rlm@2 816 <span style="color: #8fb28f;">"Remove the first element of coll, adding it to the end of coll."</span>
rlm@2 817 [coll]
rlm@2 818 (<span style="color: #8cd0d3;">concat</span> (<span style="color: #8cd0d3;">rest</span> coll) (<span style="color: #8cd0d3;">take</span> 1 coll)))
rlm@2 819
rlm@2 820 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">right-circular-shift</span>
rlm@2 821 <span style="color: #8fb28f;">"Remove the last element of coll, adding it to the front of coll."</span>
rlm@2 822 [coll]
rlm@2 823 (<span style="color: #8cd0d3;">cons</span> (<span style="color: #8cd0d3;">last</span> coll) (<span style="color: #8cd0d3;">butlast</span> coll)))
rlm@2 824 </pre>
rlm@2 825
rlm@2 826
rlm@2 827
rlm@2 828
rlm@2 829
rlm@2 830
rlm@2 831
rlm@2 832 </div>
rlm@2 833
rlm@2 834 </div>
rlm@2 835
rlm@2 836 <div id="outline-container-3-2" class="outline-3">
rlm@2 837 <h3 id="sec-3-2"><span class="section-number-3">3.2</span> Ranges, Airity and Function Composition </h3>
rlm@2 838 <div class="outline-text-3" id="text-3-2">
rlm@2 839
rlm@2 840
rlm@2 841
rlm@2 842
rlm@2 843 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 844 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">infinity</span> Double/POSITIVE_INFINITY)
rlm@2 845 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">infinite?</span> [x] (Double/isInfinite x))
rlm@2 846 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">finite?</span> (<span style="color: #8cd0d3;">comp</span> not infinite?))
rlm@2 847
rlm@2 848 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">arity-min</span>
rlm@2 849 <span style="color: #8fb28f;">"Returns the smallest number of arguments f can take."</span>
rlm@2 850 [f]
rlm@2 851 (<span style="color: #8cd0d3;">apply</span>
rlm@2 852 min
rlm@2 853 (<span style="color: #8cd0d3;">map</span> (<span style="color: #8cd0d3;">comp</span> alength #(.getParameterTypes %))
rlm@2 854 (<span style="color: #8cd0d3;">filter</span> (<span style="color: #8cd0d3;">comp</span> (<span style="color: #8cd0d3;">partial</span> = <span style="color: #cc9393;">"invoke"</span>) #(.getName %))
rlm@2 855 (.getDeclaredMethods (<span style="color: #8cd0d3;">class</span> f))))))
rlm@2 856
rlm@2 857 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">arity-max</span>
rlm@2 858 <span style="color: #8fb28f;">"Returns the largest number of arguments f can take, possibly</span>
rlm@2 859 <span style="color: #8fb28f;"> Infinity."</span>
rlm@2 860 [f]
rlm@2 861 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [methods (.getDeclaredMethods (<span style="color: #8cd0d3;">class</span> f))]
rlm@2 862 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">not-any?</span> (<span style="color: #8cd0d3;">partial</span> = <span style="color: #cc9393;">"doInvoke"</span>) (<span style="color: #8cd0d3;">map</span> #(.getName %) methods))
rlm@2 863 (<span style="color: #8cd0d3;">apply</span> max
rlm@2 864 (<span style="color: #8cd0d3;">map</span> (<span style="color: #8cd0d3;">comp</span> alength #(.getParameterTypes %))
rlm@2 865 (<span style="color: #8cd0d3;">filter</span> (<span style="color: #8cd0d3;">comp</span> (<span style="color: #8cd0d3;">partial</span> = <span style="color: #cc9393;">"invoke"</span>) #(.getName %)) methods)))
rlm@2 866 infinity)))
rlm@2 867
rlm@2 868
rlm@2 869 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">^</span>{<span style="color: #8cd0d3;">:arglists</span> '([f])
rlm@2 870 <span style="color: #8cd0d3;">:doc</span> <span style="color: #cc9393;">"Returns a two-element list containing the minimum and</span>
rlm@2 871 <span style="color: #cc9393;"> maximum number of args that f can take."</span>}
rlm@2 872 arity-interval
rlm@2 873 (<span style="color: #8cd0d3;">juxt</span> arity-min arity-max))
rlm@2 874
rlm@2 875
rlm@2 876
rlm@2 877 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">--- intervals</span>
rlm@2 878
rlm@2 879 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">intersect</span>
rlm@2 880 <span style="color: #8fb28f;">"Returns the interval of overlap between interval-1 and interval-2"</span>
rlm@2 881 [interval-1 interval-2]
rlm@2 882 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #f0dfaf; font-weight: bold;">or</span> (<span style="color: #8cd0d3;">empty?</span> interval-1) (<span style="color: #8cd0d3;">empty?</span> interval-2)) []
rlm@2 883 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [left (<span style="color: #8cd0d3;">max</span> (<span style="color: #8cd0d3;">first</span> interval-1) (<span style="color: #8cd0d3;">first</span> interval-2))
rlm@2 884 right (<span style="color: #8cd0d3;">min</span> (<span style="color: #8cd0d3;">second</span> interval-1) (<span style="color: #8cd0d3;">second</span> interval-2))]
rlm@2 885 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">&gt;</span> left right) []
rlm@2 886 [left right]))))
rlm@2 887
rlm@2 888 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">same-endpoints?</span>
rlm@2 889 <span style="color: #8fb28f;">"Returns true if the left endpoint is the same as the right</span>
rlm@2 890 <span style="color: #8fb28f;"> endpoint."</span>
rlm@2 891 [interval]
rlm@2 892 (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">first</span> interval) (<span style="color: #8cd0d3;">second</span> interval)))
rlm@2 893
rlm@2 894 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">naturals?</span>
rlm@2 895 <span style="color: #8fb28f;">"Returns true if the left endpoint is 0 and the right endpoint is</span>
rlm@2 896 <span style="color: #8fb28f;">infinite."</span>
rlm@2 897 [interval]
rlm@2 898 (<span style="color: #f0dfaf; font-weight: bold;">and</span> (zero? (<span style="color: #8cd0d3;">first</span> interval))
rlm@2 899 (infinite? (<span style="color: #8cd0d3;">second</span> interval))))
rlm@2 900
rlm@2 901
rlm@2 902 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">fan-in</span>
rlm@2 903 <span style="color: #8fb28f;">"Returns a function that pipes its input to each of the gs, then</span>
rlm@2 904 <span style="color: #8fb28f;"> applies f to the list of results. Consequently, f must be able to</span>
rlm@2 905 <span style="color: #8fb28f;"> take a number of arguments equal to the number of gs."</span>
rlm@2 906 [f &amp; gs]
rlm@2 907 (<span style="color: #8cd0d3;">fn</span> [&amp; args]
rlm@2 908 (<span style="color: #8cd0d3;">apply</span> f (<span style="color: #8cd0d3;">apply</span> (<span style="color: #8cd0d3;">apply</span> juxt gs) args))))
rlm@2 909
rlm@2 910 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">fan-in</span>
rlm@2 911 <span style="color: #8fb28f;">"Returns a function that pipes its input to each of the gs, then applies f to the list of results. The resulting function takes any number of arguments, but will fail if given arguments that are incompatible with any of the gs."</span>
rlm@2 912 [f &amp; gs]
rlm@2 913 (<span style="color: #8cd0d3;">comp</span> (<span style="color: #8cd0d3;">partial</span> apply f) (<span style="color: #8cd0d3;">apply</span> juxt gs)))
rlm@2 914
rlm@2 915
rlm@2 916
rlm@2 917 (<span style="color: #f0dfaf; font-weight: bold;">defmacro</span> <span style="color: #f0dfaf;">airty-blah-sad</span> [f n more?]
rlm@2 918 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [syms (<span style="color: #8cd0d3;">vec</span> (<span style="color: #8cd0d3;">map</span> (<span style="color: #8cd0d3;">comp</span> gensym (<span style="color: #8cd0d3;">partial</span> str <span style="color: #cc9393;">"x"</span>)) (<span style="color: #8cd0d3;">range</span> n)))
rlm@2 919 optional (<span style="color: #8cd0d3;">gensym</span> <span style="color: #cc9393;">"xs"</span>)]
rlm@2 920 (<span style="color: #f0dfaf; font-weight: bold;">if</span> more?
rlm@2 921 `(<span style="color: #8cd0d3;">fn</span> <span style="color: #f0dfaf;">~</span>(<span style="color: #8cd0d3;">conj</span> syms '&amp; optional)
rlm@2 922 (<span style="color: #8cd0d3;">apply</span> ~f ~@syms ~optional))
rlm@2 923 `(<span style="color: #8cd0d3;">fn</span> <span style="color: #f0dfaf;">~syms</span> (~f ~@syms)))))
rlm@2 924
rlm@2 925 (<span style="color: #f0dfaf; font-weight: bold;">defmacro</span> <span style="color: #f0dfaf;">airt-whaa*</span> [f n more?]
rlm@2 926 `(airty-blah-sad ~f ~n ~more?))
rlm@2 927
rlm@2 928
rlm@2 929
rlm@2 930
rlm@2 931 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">fan-in*</span>
rlm@2 932 <span style="color: #8fb28f;">"Returns a function that pipes its input to each of the gs, then</span>
rlm@2 933 <span style="color: #8fb28f;"> applies f to the list of results. Unlike fan-in, fan-in* strictly</span>
rlm@2 934 <span style="color: #8fb28f;"> enforces arity: it will fail if the gs do not have compatible</span>
rlm@2 935 <span style="color: #8fb28f;"> arities."</span>
rlm@2 936 [f &amp; gs]
rlm@2 937 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [arity-in (<span style="color: #8cd0d3;">reduce</span> intersect (<span style="color: #8cd0d3;">map</span> arity-interval gs))
rlm@2 938 left (<span style="color: #8cd0d3;">first</span> arity-in)
rlm@2 939 right (<span style="color: #8cd0d3;">second</span> arity-in)
rlm@2 940 composite (fan-in f gs)
rlm@2 941 ]
rlm@2 942 (<span style="color: #f0dfaf; font-weight: bold;">cond</span>
rlm@2 943 (<span style="color: #8cd0d3;">empty?</span> arity-in)
rlm@2 944 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception. <span style="color: #cc9393;">"Cannot compose functions with incompatible arities."</span>))
rlm@2 945
rlm@2 946 (<span style="color: #8cd0d3;">not</span>
rlm@2 947 (<span style="color: #f0dfaf; font-weight: bold;">or</span> (<span style="color: #8cd0d3;">=</span> left right)
rlm@2 948 (<span style="color: #f0dfaf; font-weight: bold;">and</span> (finite? left)
rlm@2 949 (<span style="color: #8cd0d3;">=</span> right infinity))))
rlm@2 950
rlm@2 951 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception.
rlm@2 952 <span style="color: #cc9393;">"Compose can only handle arities of the form [n n] or [n infinity]"</span>))
rlm@2 953 <span style="color: #8cd0d3;">:else</span>
rlm@2 954 (airty-blah-sad composite left (<span style="color: #8cd0d3;">=</span> right infinity)))))
rlm@2 955
rlm@2 956
rlm@2 957
rlm@2 958 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">compose-n</span> <span style="color: #8fb28f;">"Compose any number of functions together."</span>
rlm@2 959 ([] identity)
rlm@2 960 ([f] f)
rlm@2 961 ([f &amp; fs]
rlm@2 962 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [fns (<span style="color: #8cd0d3;">cons</span> f fs)]
rlm@2 963 (compose-bin (<span style="color: #8cd0d3;">reduce</span> fan-in (<span style="color: #8cd0d3;">butlast</span> fs)) (<span style="color: #8cd0d3;">last</span> fs))))
rlm@2 964 )
rlm@2 965
rlm@2 966
rlm@2 967
rlm@2 968
rlm@2 969
rlm@2 970
rlm@2 971 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">iterated</span>
rlm@2 972 ([f n id] (<span style="color: #8cd0d3;">reduce</span> comp id (<span style="color: #8cd0d3;">repeat</span> n f)))
rlm@2 973 ([f n] (<span style="color: #8cd0d3;">reduce</span> comp identity (<span style="color: #8cd0d3;">repeat</span> n f))))
rlm@2 974
rlm@2 975 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">iterate-until-stable</span>
rlm@2 976 <span style="color: #8fb28f;">"Repeatedly applies f to x, returning the first result that is close</span>
rlm@2 977 <span style="color: #8fb28f;">enough to its predecessor."</span>
rlm@2 978 [f close-enough? x]
rlm@2 979 (<span style="color: #8cd0d3;">second</span> (swank.util/find-first
rlm@2 980 (<span style="color: #8cd0d3;">partial</span> apply close-enough?)
rlm@2 981 (<span style="color: #8cd0d3;">partition</span> 2 1 (<span style="color: #8cd0d3;">iterate</span> f x)))))
rlm@2 982
rlm@2 983 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">lexical&lt;</span> [x y]
rlm@2 984 (<span style="color: #8cd0d3;">neg?</span> (<span style="color: #8cd0d3;">compare</span> (<span style="color: #8cd0d3;">str</span> x) (<span style="color: #8cd0d3;">str</span> y))))
rlm@2 985
rlm@2 986
rlm@2 987 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">do-up</span>
rlm@2 988 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">do-down</span>
rlm@2 989 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">make-pairwise-test</span> comparator)
rlm@2 990 <span style="color: #708070;">;;</span><span style="color: #7f9f7f;">all-equal?</span>
rlm@2 991 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">accumulation</span> multiplier)
rlm@2 992 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">inverse-accumulation</span> divider)
rlm@2 993 <span style="color: #708070;">;;</span><span style="color: #7f9f7f;">left-circular-shift</span>
rlm@2 994 <span style="color: #708070;">;;</span><span style="color: #7f9f7f;">right-circular-shift</span>
rlm@2 995 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">exactly-n?</span> same-endpoints?)
rlm@2 996 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">any-number?</span> naturals?)
rlm@2 997 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">TODO compose</span>
rlm@2 998 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">TODO compose-n</span>
rlm@2 999 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">identity</span>
rlm@2 1000 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">compose-2</span> fan-in)
rlm@2 1001 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">compose-bin</span> fan-in*)
rlm@2 1002 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">any?</span> (<span style="color: #8cd0d3;">constantly</span> true))
rlm@2 1003 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">none?</span> (<span style="color: #8cd0d3;">constantly</span> false))
rlm@2 1004 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">constant</span> constantly)
rlm@2 1005 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">joint-arity</span> intersect)
rlm@2 1006 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">a-reduce</span> reduce)
rlm@2 1007 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">filter</span>
rlm@2 1008 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">make-map</span> (<span style="color: #8cd0d3;">partial</span> partial map) )
rlm@2 1009 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">bracket</span> juxt)
rlm@2 1010 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">TODO apply-to-all</span>
rlm@2 1011 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">TODO nary-combine</span>
rlm@2 1012 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">TODO binary-combine</span>
rlm@2 1013 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">TODO unary-combine</span>
rlm@2 1014 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">iterated</span>
rlm@2 1015 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">iterate-until-stable</span>
rlm@2 1016 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">make-function-of-vector</span> (<span style="color: #8cd0d3;">partial</span> partial map))
rlm@2 1017 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">make-function-of-arguments</span> (<span style="color: #8cd0d3;">fn</span> [f] (<span style="color: #8cd0d3;">fn</span> [&amp; args] (f args))))
rlm@2 1018 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">alphaless</span> lexical&lt;)
rlm@2 1019
rlm@2 1020 </pre>
rlm@2 1021
rlm@2 1022
rlm@2 1023
rlm@2 1024
rlm@2 1025
rlm@2 1026
rlm@2 1027
rlm@2 1028
rlm@2 1029
rlm@2 1030
rlm@2 1031
rlm@2 1032
rlm@2 1033 </div>
rlm@2 1034 </div>
rlm@2 1035
rlm@2 1036 </div>
rlm@2 1037
rlm@2 1038 <div id="outline-container-4" class="outline-2">
rlm@2 1039 <h2 id="sec-4"><span class="section-number-2">4</span> Numerical Methods </h2>
rlm@2 1040 <div class="outline-text-2" id="text-4">
rlm@2 1041
rlm@2 1042
rlm@2 1043
rlm@2 1044
rlm@2 1045 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 1046 (<span style="color: #f0dfaf; font-weight: bold;">import</span> java.lang.Math)
rlm@2 1047 (<span style="color: #8cd0d3;">use</span> 'clojure.contrib.def)
rlm@2 1048
rlm@2 1049 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">---- USEFUL CONSTANTS</span>
rlm@2 1050
rlm@2 1051 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">machine-epsilon</span>
rlm@2 1052 <span style="color: #8fb28f;">"Smallest value representable on your machine, as determined by</span>
rlm@2 1053 <span style="color: #8fb28f;">successively dividing a number in half until consecutive results are</span>
rlm@2 1054 <span style="color: #8fb28f;">indistinguishable."</span>
rlm@2 1055 []
rlm@2 1056 (<span style="color: #8cd0d3;">ffirst</span>
rlm@2 1057 (<span style="color: #8cd0d3;">drop-while</span>
rlm@2 1058 (<span style="color: #8cd0d3;">comp</span> not zero? second)
rlm@2 1059 (<span style="color: #8cd0d3;">partition</span> 2 1
rlm@2 1060 (<span style="color: #8cd0d3;">iterate</span> (<span style="color: #8cd0d3;">partial</span> * 0.5) 1)))))
rlm@2 1061
rlm@2 1062
rlm@2 1063 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">pi</span> (Math/PI))
rlm@2 1064 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">two-pi</span> (<span style="color: #8cd0d3;">*</span> 2 pi))
rlm@2 1065
rlm@2 1066 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">eulers-gamma</span> 0.5772156649015328606065)
rlm@2 1067
rlm@2 1068 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">phi</span> (<span style="color: #8cd0d3;">/</span> (<span style="color: #8cd0d3;">inc</span> (Math/sqrt 5)) 2))
rlm@2 1069
rlm@2 1070 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">ln2</span> (Math/log 2))
rlm@2 1071 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">ln10</span> (Math/log 10))
rlm@2 1072 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">exp10</span> #(Math/pow 10 %))
rlm@2 1073 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">exp2</span> #(Math/pow 2 %))
rlm@2 1074
rlm@2 1075
rlm@2 1076 <span style="color: #708070;">;;</span>
rlm@2 1077
rlm@2 1078 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">---- ANGLES AND TRIGONOMETRY</span>
rlm@2 1079
rlm@2 1080 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">angle-restrictor</span>
rlm@2 1081 <span style="color: #8fb28f;">"Returns a function that ensures that angles lie in the specified interval of length two-pi."</span>
rlm@2 1082 [max-angle]
rlm@2 1083 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [min-angle (<span style="color: #8cd0d3;">-</span> max-angle two-pi)]
rlm@2 1084 (<span style="color: #8cd0d3;">fn</span> [x]
rlm@2 1085 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #f0dfaf; font-weight: bold;">and</span>
rlm@2 1086 (<span style="color: #8cd0d3;">&lt;=</span> min-angle x)
rlm@2 1087 (<span style="color: #8cd0d3;">&lt;</span> x max-angle))
rlm@2 1088 x
rlm@2 1089 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [corrected-x (<span style="color: #8cd0d3;">-</span> x (<span style="color: #8cd0d3;">*</span> two-pi (Math/floor (<span style="color: #8cd0d3;">/</span> x two-pi))))]
rlm@2 1090 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">&lt;</span> corrected-x max-angle)
rlm@2 1091 corrected-x
rlm@2 1092 (<span style="color: #8cd0d3;">-</span> corrected-x two-pi)))))))
rlm@2 1093
rlm@2 1094 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">angle-restrict-pi</span>
rlm@2 1095 <span style="color: #8fb28f;">"Coerces angles to lie in the interval from -pi to pi."</span>
rlm@2 1096 [angle]
rlm@2 1097 ((angle-restrictor pi) angle))
rlm@2 1098
rlm@2 1099 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">angle-restrict-two-pi</span>
rlm@2 1100 <span style="color: #8fb28f;">"Coerces angles to lie in the interval from zero to two-pi"</span>
rlm@2 1101 [angle]
rlm@2 1102 ((angle-restrictor two-pi) angle))
rlm@2 1103
rlm@2 1104
rlm@2 1105
rlm@2 1106
rlm@2 1107 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">invert</span> [x] (<span style="color: #8cd0d3;">/</span> x))
rlm@2 1108 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">negate</span> [x] (<span style="color: #8cd0d3;">-</span> x))
rlm@2 1109
rlm@2 1110 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">exp</span> [x] (Math/exp x))
rlm@2 1111
rlm@2 1112 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">sin</span> [x] (Math/sin x))
rlm@2 1113 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">cos</span> [x] (Math/cos x))
rlm@2 1114 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">tan</span> [x] (Math/tan x))
rlm@2 1115
rlm@2 1116 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">sec</span> (<span style="color: #8cd0d3;">comp</span> invert cos))
rlm@2 1117 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">csc</span> (<span style="color: #8cd0d3;">comp</span> invert sin))
rlm@2 1118
rlm@2 1119 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">sinh</span> [x] (Math/sinh x))
rlm@2 1120 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">cosh</span> [x] (Math/cosh x))
rlm@2 1121 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">tanh</span> [x] (Math/tanh x))
rlm@2 1122
rlm@2 1123 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">sech</span> (<span style="color: #8cd0d3;">comp</span> invert cosh))
rlm@2 1124 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">csch</span> (<span style="color: #8cd0d3;">comp</span> invert sinh))
rlm@2 1125
rlm@2 1126
rlm@2 1127 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">------------</span>
rlm@2 1128
rlm@2 1129 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">factorial</span>
rlm@2 1130 <span style="color: #8fb28f;">"Computes the factorial of the nonnegative integer n."</span>
rlm@2 1131 [n]
rlm@2 1132 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">neg?</span> n)
rlm@2 1133 (<span style="color: #f0dfaf; font-weight: bold;">throw</span> (Exception. <span style="color: #cc9393;">"Cannot compute the factorial of a negative number."</span>))
rlm@2 1134 (<span style="color: #8cd0d3;">reduce</span> * 1 (<span style="color: #8cd0d3;">range</span> 1 (<span style="color: #8cd0d3;">inc</span> n)))))
rlm@2 1135
rlm@2 1136 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">exact-quotient</span> [n d] (<span style="color: #8cd0d3;">/</span> n d))
rlm@2 1137
rlm@2 1138 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">binomial-coefficient</span>
rlm@2 1139 <span style="color: #8fb28f;">"Computes the number of different ways to choose m elements from n."</span>
rlm@2 1140 [n m]
rlm@2 1141 (<span style="color: #8cd0d3;">assert</span> (<span style="color: #8cd0d3;">&lt;=</span> 0 m n))
rlm@2 1142 (<span style="color: #f0dfaf; font-weight: bold;">let</span> [difference (<span style="color: #8cd0d3;">-</span> n m)]
rlm@2 1143 (exact-quotient
rlm@2 1144 (<span style="color: #8cd0d3;">reduce</span> * (<span style="color: #8cd0d3;">range</span> n (<span style="color: #8cd0d3;">max</span> difference m) -1 ))
rlm@2 1145 (factorial (<span style="color: #8cd0d3;">min</span> difference m)))))
rlm@2 1146
rlm@2 1147 (<span style="color: #f0dfaf; font-weight: bold;">defn-memo</span> <span style="color: #f0dfaf;">stirling-1</span>
rlm@2 1148 <span style="color: #cc9393;">"Stirling numbers of the first kind: the number of permutations of n</span>
rlm@2 1149 <span style="color: #cc9393;"> elements with exactly m permutation cycles. "</span>
rlm@2 1150 [n k]
rlm@2 1151 <span style="color: #708070;">;</span><span style="color: #7f9f7f;">(assert (&lt;= 1 k n))</span>
rlm@2 1152 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (zero? n)
rlm@2 1153 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (zero? k) 1 0)
rlm@2 1154 (<span style="color: #8cd0d3;">+</span> (stirling-1 (<span style="color: #8cd0d3;">dec</span> n) (<span style="color: #8cd0d3;">dec</span> k))
rlm@2 1155 (<span style="color: #8cd0d3;">*</span> (<span style="color: #8cd0d3;">dec</span> n) (stirling-1 (<span style="color: #8cd0d3;">dec</span> n) k)))))
rlm@2 1156
rlm@2 1157 (<span style="color: #f0dfaf; font-weight: bold;">defn-memo</span> <span style="color: #f0dfaf;">stirling-2</span> <span style="color: #708070;">;;</span><span style="color: #7f9f7f;">count-partitions</span>
rlm@2 1158 <span style="color: #cc9393;">"Stirling numbers of the second kind: the number of ways to partition a set of n elements into k subsets."</span>
rlm@2 1159 [n k]
rlm@2 1160 (<span style="color: #f0dfaf; font-weight: bold;">cond</span>
rlm@2 1161 (<span style="color: #8cd0d3;">=</span> k 1) 1
rlm@2 1162 (<span style="color: #8cd0d3;">=</span> k n) 1
rlm@2 1163 <span style="color: #8cd0d3;">:else</span> (<span style="color: #8cd0d3;">+</span> (stirling-2 (<span style="color: #8cd0d3;">dec</span> n) (<span style="color: #8cd0d3;">dec</span> k))
rlm@2 1164 (<span style="color: #8cd0d3;">*</span> k (stirling-2 (<span style="color: #8cd0d3;">dec</span> n) k)))))
rlm@2 1165
rlm@2 1166 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">harmonic-number</span> [n]
rlm@2 1167 (<span style="color: #8cd0d3;">/</span> (stirling-1 (<span style="color: #8cd0d3;">inc</span> n) 2)
rlm@2 1168 (factorial n)))
rlm@2 1169
rlm@2 1170
rlm@2 1171 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">sum</span>
rlm@2 1172 [f low high]
rlm@2 1173 (<span style="color: #8cd0d3;">reduce</span> + (<span style="color: #8cd0d3;">map</span> f (<span style="color: #8cd0d3;">range</span> low (<span style="color: #8cd0d3;">inc</span> high)))))
rlm@2 1174
rlm@2 1175 </pre>
rlm@2 1176
rlm@2 1177
rlm@2 1178
rlm@2 1179
rlm@2 1180
rlm@2 1181
rlm@2 1182
rlm@2 1183
rlm@2 1184
rlm@2 1185
rlm@2 1186
rlm@2 1187
rlm@2 1188
rlm@2 1189
rlm@2 1190
rlm@2 1191 </div>
rlm@2 1192
rlm@2 1193 </div>
rlm@2 1194
rlm@2 1195 <div id="outline-container-5" class="outline-2">
rlm@2 1196 <h2 id="sec-5"><span class="section-number-2">5</span> Differentiation </h2>
rlm@2 1197 <div class="outline-text-2" id="text-5">
rlm@2 1198
rlm@2 1199
rlm@2 1200 <p>
rlm@2 1201 We compute derivatives by passing special <b>differential objects</b> \([x,
rlm@2 1202 dx]\) through functions. Roughly speaking, applying a function \(f\) to a
rlm@2 1203 differential object \([x, dx]\) should produce a new differential
rlm@2 1204 object \([f(x),\,Df(x)\cdot dx]\).
rlm@2 1205 </p>
rlm@2 1206
rlm@2 1207
rlm@2 1208 \([x,\,dx]\xrightarrow{\quad f \quad}[f(x),\,Df(x)\cdot dx]\)
rlm@2 1209 <p>
rlm@2 1210 Notice that you can obtain the derivative of \(f\) from this
rlm@2 1211 differential object, as it is the coefficient of the \(dx\) term. Also,
rlm@2 1212 as you apply successive functions using this rule, you get the
rlm@2 1213 chain-rule answer you expect:
rlm@2 1214 </p>
rlm@2 1215
rlm@2 1216
rlm@2 1217 \([f(x),\,Df(x)\cdot dx]\xrightarrow{\quad g\quad} [gf(x),\,
rlm@2 1218 Dgf(x)\cdot Df(x) \cdot dx ]\)
rlm@2 1219
rlm@2 1220 <p>
rlm@2 1221 In order to generalize to multiple variables and multiple derivatives,
rlm@2 1222 we use a <b>power series of differentials</b>, a sortred infinite sequence which
rlm@2 1223 contains all terms like \(dx\cdot dy\), \(dx^2\cdot dy\), etc.
rlm@2 1224 </p>
rlm@2 1225
rlm@2 1226
rlm@2 1227
rlm@2 1228
rlm@2 1229 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 1230
rlm@2 1231 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">differential-seq</span>
rlm@2 1232 <span style="color: #8fb28f;">"Constructs a sequence of differential terms from a numerical</span>
rlm@2 1233 <span style="color: #8fb28f;">coefficient and a list of keys for variables. If no coefficient is supplied, uses 1."</span>
rlm@2 1234 ([variables] (differential-seq* 1 variables))
rlm@2 1235 ([coefficient variables &amp; cvs]
rlm@2 1236 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">number?</span> coefficient)
rlm@2 1237 (<span style="color: #8cd0d3;">conj</span> (<span style="color: #8cd0d3;">assoc</span> {} (<span style="color: #8cd0d3;">apply</span> sorted-set variables) coefficient)
rlm@2 1238 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">empty?</span> cvs)
rlm@2 1239 nil
rlm@2 1240 (<span style="color: #8cd0d3;">apply</span> differential-seq* cvs)))
rlm@2 1241 (<span style="color: #8cd0d3;">apply</span> differential-seq* 1 coefficient 1 variables cvs)
rlm@2 1242 )))
rlm@2 1243
rlm@2 1244
rlm@2 1245
rlm@2 1246 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">differential-add</span>
rlm@2 1247 <span style="color: #8fb28f;">"Add two differential sequences by combining like terms."</span>
rlm@2 1248 [dseq1 dseq2]
rlm@2 1249 (<span style="color: #8cd0d3;">merge-with</span> + dseq1 dseq2))
rlm@2 1250
rlm@2 1251 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">differential-multiply</span>
rlm@2 1252 <span style="color: #8fb28f;">"Multiply two differential sequences. The square of any differential variable is zero since differential variables are infinitesimally small."</span>
rlm@2 1253 [dseq1 dseq2]
rlm@2 1254 (<span style="color: #8cd0d3;">reduce</span>
rlm@2 1255 (<span style="color: #8cd0d3;">fn</span> [m [[vars1 coeff1] [vars2 coeff2]]]
rlm@2 1256 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">empty?</span> (clojure.set/<span style="color: #dfdfbf; font-weight: bold;">intersection</span> vars1 vars2))
rlm@2 1257 (<span style="color: #8cd0d3;">assoc</span> m (clojure.set/<span style="color: #dfdfbf; font-weight: bold;">union</span> vars1 vars2) (<span style="color: #8cd0d3;">*</span> coeff1 coeff2))
rlm@2 1258 m))
rlm@2 1259 {}
rlm@2 1260 (clojure.contrib.combinatorics/cartesian-product
rlm@2 1261 dseq1
rlm@2 1262 dseq2)))
rlm@2 1263
rlm@2 1264
rlm@2 1265
rlm@2 1266 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">big-part</span>
rlm@2 1267 <span style="color: #8fb28f;">"Returns the 'finite' part of the differential sequence."</span>
rlm@2 1268 [dseq]
rlm@2 1269 (<span style="color: #f0dfaf; font-weight: bold;">let</span>
rlm@2 1270 [keys (<span style="color: #8cd0d3;">sort-by</span> count (<span style="color: #8cd0d3;">keys</span> dseq))
rlm@2 1271 pivot-key (<span style="color: #8cd0d3;">first</span> (<span style="color: #8cd0d3;">last</span> keys))]
rlm@2 1272
rlm@2 1273 (<span style="color: #8cd0d3;">apply</span> hash-map
rlm@2 1274 (<span style="color: #8cd0d3;">reduce</span> concat
rlm@2 1275 (<span style="color: #8cd0d3;">filter</span> (<span style="color: #8cd0d3;">comp</span> pivot-key first) dseq)
rlm@2 1276 ))))
rlm@2 1277
rlm@2 1278
rlm@2 1279 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">small-part</span>
rlm@2 1280 <span style="color: #8fb28f;">"Returns the 'infinitesimal' part of the differential sequence."</span>
rlm@2 1281 [dseq]
rlm@2 1282 (<span style="color: #f0dfaf; font-weight: bold;">let</span>
rlm@2 1283 [keys (<span style="color: #8cd0d3;">sort-by</span> count (<span style="color: #8cd0d3;">keys</span> dseq))
rlm@2 1284 pivot-key (<span style="color: #8cd0d3;">first</span> (<span style="color: #8cd0d3;">last</span> keys))]
rlm@2 1285
rlm@2 1286 (<span style="color: #8cd0d3;">apply</span> hash-map
rlm@2 1287 (<span style="color: #8cd0d3;">reduce</span> concat
rlm@2 1288 (<span style="color: #8cd0d3;">remove</span> (<span style="color: #8cd0d3;">comp</span> pivot-key first) dseq)
rlm@2 1289 ))))
rlm@2 1290
rlm@2 1291
rlm@2 1292
rlm@2 1293
rlm@2 1294
rlm@2 1295
rlm@2 1296
rlm@2 1297
rlm@2 1298
rlm@2 1299 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">;; A differential term consists of a numerical coefficient and a</span>
rlm@2 1300 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">;; sorted </span>
rlm@2 1301 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(defrecord DifferentialTerm [coefficient variables])</span>
rlm@2 1302 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(defmethod print-method DifferentialTerm</span>
rlm@2 1303 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">[o w]</span>
rlm@2 1304 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(print-simple</span>
rlm@2 1305 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(apply str (.coefficient o)(map (comp (partial str "d") name) (.variables o)))</span>
rlm@2 1306 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">w))</span>
rlm@2 1307
rlm@2 1308
rlm@2 1309 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(defn differential-seq</span>
rlm@2 1310 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">"Constructs a sequence of differential terms from a numerical</span>
rlm@2 1311 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">coefficient and a list of keywords for variables. If no coefficient is</span>
rlm@2 1312 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">supplied, uses 1."</span>
rlm@2 1313 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">([variables] (differential-seq 1 variables))</span>
rlm@2 1314 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">([coefficient variables]</span>
rlm@2 1315 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(list</span>
rlm@2 1316 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(DifferentialTerm. coefficient (apply sorted-set variables))))</span>
rlm@2 1317 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">([coefficient variables &amp; cvs]</span>
rlm@2 1318 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(sort-by</span>
rlm@2 1319 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">#(vec(.variables %))</span>
rlm@2 1320 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">(concat (differential-seq coefficient variables) (apply differential-seq cvs)))))</span>
rlm@2 1321
rlm@2 1322 </pre>
rlm@2 1323
rlm@2 1324
rlm@2 1325
rlm@2 1326
rlm@2 1327
rlm@2 1328
rlm@2 1329
rlm@2 1330
rlm@2 1331
rlm@2 1332
rlm@2 1333
rlm@2 1334
rlm@2 1335
rlm@2 1336
rlm@2 1337
rlm@2 1338
rlm@2 1339 </div>
rlm@2 1340
rlm@2 1341 </div>
rlm@2 1342
rlm@2 1343 <div id="outline-container-6" class="outline-2">
rlm@2 1344 <h2 id="sec-6"><span class="section-number-2">6</span> Symbolic Manipulation </h2>
rlm@2 1345 <div class="outline-text-2" id="text-6">
rlm@2 1346
rlm@2 1347
rlm@2 1348
rlm@2 1349
rlm@2 1350
rlm@2 1351 <pre class="src src-clojure">(<span style="color: #f0dfaf; font-weight: bold;">in-ns</span> 'sicm.utils)
rlm@2 1352
rlm@2 1353 (<span style="color: #f0dfaf; font-weight: bold;">deftype</span> <span style="color: #f0dfaf;">Symbolic</span> [type expression]
rlm@2 1354 Object
rlm@2 1355 (equals [this that]
rlm@2 1356 (<span style="color: #f0dfaf; font-weight: bold;">cond</span>
rlm@2 1357 (<span style="color: #8cd0d3;">=</span> (.expression this) (.expression that)) true
rlm@2 1358 <span style="color: #8cd0d3;">:else</span>
rlm@2 1359 (Symbolic.
rlm@2 1360 java.lang.Boolean
rlm@2 1361 (<span style="color: #8cd0d3;">list</span> '= (.expression this) (.expression that)))
rlm@2 1362 )))
rlm@2 1363
rlm@2 1364
rlm@2 1365
rlm@2 1366
rlm@2 1367 (<span style="color: #f0dfaf; font-weight: bold;">deftype</span> <span style="color: #f0dfaf;">AbstractSet</span> [glyph membership-test])
rlm@2 1368 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">member?</span> [abstract-set x]
rlm@2 1369 ((.membership-test abstract-set) x))
rlm@2 1370
rlm@2 1371 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">------------ Some important AbstractSets</span>
rlm@2 1372
rlm@2 1373
rlm@2 1374 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">Real</span>
rlm@2 1375 (AbstractSet.
rlm@2 1376 'R
rlm@2 1377 (<span style="color: #8cd0d3;">fn</span>[x](<span style="color: #8cd0d3;">number?</span> x))))
rlm@2 1378
rlm@2 1379
rlm@2 1380 <span style="color: #708070;">;; </span><span style="color: #7f9f7f;">------------ Create new AbstractSets from existing ones</span>
rlm@2 1381
rlm@2 1382 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">abstract-product</span>
rlm@2 1383 <span style="color: #8fb28f;">"Gives the cartesian product of abstract sets."</span>
rlm@2 1384 ([sets]
rlm@2 1385 (<span style="color: #f0dfaf; font-weight: bold;">if</span> (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">count</span> sets) 1) (<span style="color: #8cd0d3;">first</span> sets)
rlm@2 1386 (AbstractSet.
rlm@2 1387 (<span style="color: #8cd0d3;">symbol</span>
rlm@2 1388 (<span style="color: #8cd0d3;">apply</span> str
rlm@2 1389 (<span style="color: #8cd0d3;">interpose</span> 'x (<span style="color: #8cd0d3;">map</span> #(.glyph %) sets))))
rlm@2 1390 (<span style="color: #8cd0d3;">fn</span> [x]
rlm@2 1391 (<span style="color: #f0dfaf; font-weight: bold;">and</span>
rlm@2 1392 (<span style="color: #8cd0d3;">coll?</span> x)
rlm@2 1393 (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">count</span> sets) (<span style="color: #8cd0d3;">count</span> x))
rlm@2 1394 (<span style="color: #8cd0d3;">reduce</span> #(<span style="color: #f0dfaf; font-weight: bold;">and</span> %1 %2)
rlm@2 1395 true
rlm@2 1396 (<span style="color: #8cd0d3;">map</span> #(member? %1 %2) sets x)))))))
rlm@2 1397 ([abstract-set n]
rlm@2 1398 (abstract-product (<span style="color: #8cd0d3;">repeat</span> n abstract-set))))
rlm@2 1399
rlm@2 1400
rlm@2 1401
rlm@2 1402 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">abstract-up</span>
rlm@2 1403 <span style="color: #8fb28f;">"Returns the abstract set of all up-tuples whose items belong to the</span>
rlm@2 1404 <span style="color: #8fb28f;"> corresponding abstract sets in coll."</span>
rlm@2 1405 ([coll]
rlm@2 1406 (AbstractSet.
rlm@2 1407 (<span style="color: #8cd0d3;">symbol</span> (<span style="color: #8cd0d3;">str</span> <span style="color: #cc9393;">"u["</span>
rlm@2 1408 (<span style="color: #8cd0d3;">apply</span> str
rlm@2 1409 (<span style="color: #8cd0d3;">interpose</span> <span style="color: #cc9393;">" "</span>
rlm@2 1410 (<span style="color: #8cd0d3;">map</span> #(.glyph %) coll)))
rlm@2 1411 <span style="color: #cc9393;">"]"</span>))
rlm@2 1412 (<span style="color: #8cd0d3;">fn</span> [x]
rlm@2 1413 (<span style="color: #f0dfaf; font-weight: bold;">and</span>
rlm@2 1414 (<span style="color: #8cd0d3;">satisfies?</span> Spinning x)
rlm@2 1415 (up? x)
rlm@2 1416 (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">count</span> coll) (<span style="color: #8cd0d3;">count</span> x))
rlm@2 1417 (<span style="color: #8cd0d3;">reduce</span>
rlm@2 1418 #(<span style="color: #f0dfaf; font-weight: bold;">and</span> %1 %2)
rlm@2 1419 true
rlm@2 1420 (<span style="color: #8cd0d3;">map</span> #(member? %1 %2) coll x))))))
rlm@2 1421 ([abstract-set n]
rlm@2 1422 (abstract-up (<span style="color: #8cd0d3;">repeat</span> n abstract-set))))
rlm@2 1423
rlm@2 1424
rlm@2 1425 (<span style="color: #f0dfaf; font-weight: bold;">defn</span> <span style="color: #f0dfaf;">abstract-down</span>
rlm@2 1426 <span style="color: #8fb28f;">"Returns the abstract set of all down-tuples whose items belong to the</span>
rlm@2 1427 <span style="color: #8fb28f;"> corresponding abstract sets in coll."</span>
rlm@2 1428 ([coll]
rlm@2 1429 (AbstractSet.
rlm@2 1430 (<span style="color: #8cd0d3;">symbol</span> (<span style="color: #8cd0d3;">str</span> <span style="color: #cc9393;">"d["</span>
rlm@2 1431 (<span style="color: #8cd0d3;">apply</span> str
rlm@2 1432 (<span style="color: #8cd0d3;">interpose</span> <span style="color: #cc9393;">" "</span>
rlm@2 1433 (<span style="color: #8cd0d3;">map</span> #(.glyph %) coll)))
rlm@2 1434 <span style="color: #cc9393;">"]"</span>))
rlm@2 1435 (<span style="color: #8cd0d3;">fn</span> [x]
rlm@2 1436 (<span style="color: #f0dfaf; font-weight: bold;">and</span>
rlm@2 1437 (<span style="color: #8cd0d3;">satisfies?</span> Spinning x)
rlm@2 1438 (down? x)
rlm@2 1439 (<span style="color: #8cd0d3;">=</span> (<span style="color: #8cd0d3;">count</span> coll) (<span style="color: #8cd0d3;">count</span> x))
rlm@2 1440 (<span style="color: #8cd0d3;">reduce</span>
rlm@2 1441 #(<span style="color: #f0dfaf; font-weight: bold;">and</span> %1 %2)
rlm@2 1442 true
rlm@2 1443 (<span style="color: #8cd0d3;">map</span> #(member? %1 %2) coll x))))))
rlm@2 1444 ([abstract-set n]
rlm@2 1445 (abstract-down (<span style="color: #8cd0d3;">repeat</span> n abstract-set))))
rlm@2 1446
rlm@2 1447
rlm@2 1448
rlm@2 1449
rlm@2 1450
rlm@2 1451 <span style="color: #708070;">;</span><span style="color: #7f9f7f;">-------ABSTRACT FUNCTIONS</span>
rlm@2 1452 (<span style="color: #f0dfaf; font-weight: bold;">defrecord</span> <span style="color: #f0dfaf;">AbstractFn</span>
rlm@2 1453 [<span style="color: #dfdfbf; font-weight: bold;">#^AbstractSet</span> domain <span style="color: #dfdfbf; font-weight: bold;">#^AbstractSet</span> codomain])
rlm@2 1454
rlm@2 1455
rlm@2 1456 (<span style="color: #f0dfaf; font-weight: bold;">defmethod</span> <span style="color: #f0dfaf;">print-method</span> AbstractFn
rlm@2 1457 [o w]
rlm@2 1458 (<span style="color: #8cd0d3;">print-simple</span>
rlm@2 1459 (<span style="color: #8cd0d3;">str</span>
rlm@2 1460 <span style="color: #cc9393;">"f:"</span>
rlm@2 1461 (.glyph (<span style="color: #8cd0d3;">:domain</span> o))
rlm@2 1462 <span style="color: #cc9393;">"--&gt;"</span>
rlm@2 1463 (.glyph (<span style="color: #8cd0d3;">:codomain</span> o))) w))
rlm@2 1464 </pre>
rlm@2 1465
rlm@2 1466
rlm@2 1467
rlm@2 1468
rlm@2 1469
rlm@2 1470
rlm@2 1471
rlm@2 1472 </div>
rlm@2 1473 </div>
rlm@2 1474 <div id="postamble">
rlm@2 1475 <p class="date">Date: 2011-08-09 18:41:37 EDT</p>
rlm@2 1476 <p class="author">Author: Robert McIntyre & Dylan Holmes</p>
rlm@2 1477 <p class="creator">Org version 7.6 with Emacs version 23</p>
rlm@2 1478 <a href="http://validator.w3.org/check?uri=referer">Validate XHTML 1.0</a>
rlm@2 1479 </div>
rlm@2 1480 </div>
rlm@2 1481 </body>
rlm@2 1482 </html>