dylan: sicm/bk/utils.html annotate

annotate sicm/bk/utils.html @ 2:b4de894a1e2e

initial import

author	Robert McIntyre <rlm@mit.edu>
date	Fri, 28 Oct 2011 00:03:05 -0700
parents
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 »"/>
rlm@2	133 </form>
rlm@2	134 -->
rlm@2	135 </div>
rlm@2	136
rlm@2	137 <h1>aurellem <em>☉</em></h1>
rlm@2	138 <ul class="nav">
rlm@2	139 <li><a href="/">read the blog »</a></li>
rlm@2	140 <!-- li><a href="#">learn about us »</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—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 [& 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 [& 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 [& 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;">[& 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 & 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 & 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 & 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;">></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 & gs]
rlm@2	907 (<span style="color: #8cd0d3;">fn</span> [& 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 & 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 '& 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 & 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 & 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<</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> [& args] (f args))))
rlm@2	1018 (<span style="color: #f0dfaf; font-weight: bold;">def</span> <span style="color: #f0dfaf;">alphaless</span> lexical<)
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;"><=</span> min-angle x)
rlm@2	1087 (<span style="color: #8cd0d3;"><</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;"><</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;"><=</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 (<= 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 & 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 & 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;">"-->"</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>

Mercurial > dylan

annotate sicm/bk/utils.html @ 2:b4de894a1e2e