Last active
August 29, 2015 14:01
-
-
Save michaelt/08160822524b4a0a3bb6 to your computer and use it in GitHub Desktop.
DataHinds syntax highlighting
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> | |
| <html xmlns="http://www.w3.org/1999/xhtml"> | |
| <head> | |
| <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> | |
| <meta http-equiv="Content-Style-Type" content="text/css" /> | |
| <meta name="generator" content="pandoc" /> | |
| <title></title> | |
| <style type="text/css">code{white-space: pre;}</style> | |
| <style type="text/css"> | |
| table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode { | |
| margin: 0; padding: 0; vertical-align: baseline; border: none; } | |
| table.sourceCode { width: 100%; line-height: 100%; } | |
| td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; } | |
| td.sourceCode { padding-left: 5px; } | |
| code > span.kw { color: #007020; font-weight: bold; } | |
| code > span.dt { color: #902000; } | |
| code > span.dv { color: #40a070; } | |
| code > span.bn { color: #40a070; } | |
| code > span.fl { color: #40a070; } | |
| code > span.ch { color: #4070a0; } | |
| code > span.st { color: #4070a0; } | |
| code > span.co { color: #60a0b0; font-style: italic; } | |
| code > span.ot { color: #007020; } | |
| code > span.al { color: #ff0000; font-weight: bold; } | |
| code > span.fu { color: #06287e; } | |
| code > span.er { color: #ff0000; font-weight: bold; } | |
| </style> | |
| </head> | |
| <body> | |
| <pre class="sourceCode haskell"><code class="sourceCode haskell"> | |
| <span class="ot">{-# OPTIONS_GHC -fno-warn-dodgy-exports #-}</span> | |
| <span class="co">{- | an incomplete extension of dimensional-tf to work with hmatrix and ad</span> | |
| <span class="co">Haddocks are organized to follow hmatrix</span> | |
| <span class="co">note: for subscripting, use the 'HNat' while the units still use 'N.NumType'</span> | |
| <span class="co">TODO:</span> | |
| <span class="co">* Friendly syntax for introduction (more matD)</span> | |
| <span class="co">* Friendly syntax for elimination (matD as pattern)</span> | |
| <span class="co">* A pretty-printer that multiplies out the dimensions at each place?</span> | |
| <span class="co"> The current show instance makes you mentally multiply out row and column units</span> | |
| <span class="co"> (which helps you to see the big picture, but may be more work in other cases)</span> | |
| <span class="co">* check that all types that could could be inferred are</span> | |
| <span class="co">* default columns/rows to dimensionless?</span> | |
| <span class="co">* missing operations (check export list comments)</span> | |
| <span class="co">-}</span> | |
| <span class="kw">module</span> <span class="dt">DimMat.Internal</span> <span class="kw">where</span> | |
| <span class="kw">import </span><span class="dt">Foreign.Storable</span> (<span class="dt">Storable</span>) | |
| <span class="kw">import </span><span class="dt">GHC.Exts</span> (<span class="dt">Constraint</span>) | |
| <span class="kw">import </span><span class="dt">Data.Type.Equality</span> (type (==)) | |
| <span class="kw">import qualified</span> <span class="dt">Prelude</span> <span class="kw">as</span> <span class="dt">P</span> | |
| <span class="kw">import </span><span class="dt">Prelude</span> (<span class="dt">Double</span>) | |
| <span class="kw">import </span><span class="dt">Numeric.Units.Dimensional</span> <span class="kw">hiding</span> (<span class="dt">Mul</span>, <span class="dt">Div</span>) | |
| <span class="kw">import </span><span class="dt">Numeric.Units.Dimensional.Prelude</span> <span class="kw">hiding</span> (<span class="dt">Mul</span>, <span class="dt">Div</span>) | |
| <span class="kw">import qualified</span> <span class="dt">Numeric.Units.Dimensional</span> <span class="kw">as</span> <span class="dt">D</span> | |
| <span class="kw">import qualified</span> <span class="dt">Numeric.LinearAlgebra</span> <span class="kw">as</span> <span class="dt">H</span> | |
| <span class="kw">import qualified</span> <span class="dt">Numeric.LinearAlgebra.LAPACK</span> <span class="kw">as</span> <span class="dt">H</span> | |
| <span class="kw">import </span><span class="dt">Text.PrettyPrint.ANSI.Leijen</span> | |
| <span class="kw">import </span><span class="dt">Data.List</span> (transpose) | |
| <span class="kw">import </span><span class="dt">Data.HList.CommonMain</span> <span class="kw">hiding</span> (<span class="dt">MapFst</span>) | |
| <span class="co">-- * Replacements for Dimensional classes</span> | |
| <span class="co">-- | a version of Numeric.Units.Dimensional.'D.Mul' which</span> | |
| <span class="co">-- requires the arguments to include the 'D.Dim' type constructor</span> | |
| <span class="kw">class</span> (<span class="dt">D.Mul</span> a b c) <span class="ot">=></span> <span class="dt">Mul</span> a b c | |
| <span class="kw">instance</span> (<span class="dt">D.Mul</span> a b c, | |
| a <span class="fu">~</span> <span class="dt">Dim</span> l m t i th n j, | |
| b <span class="fu">~</span> <span class="dt">Dim</span> l' m' t' i' th' n' j', | |
| c <span class="fu">~</span> <span class="dt">Dim</span> l'' m'' t'' i'' th'' n'' j'') <span class="ot">=></span> | |
| <span class="dt">Mul</span> a b c | |
| <span class="co">-- | a version of Numeric.Units.Dimensional.'D.Div' which</span> | |
| <span class="co">-- requires the arguments to include the 'D.Dim' type constructor</span> | |
| <span class="kw">class</span> (<span class="dt">D.Div</span> a b c) <span class="ot">=></span> <span class="dt">Div</span> a b c | |
| <span class="kw">instance</span> (<span class="dt">D.Div</span> a b c, | |
| a <span class="fu">~</span> <span class="dt">Dim</span> l m t i th n j, | |
| b <span class="fu">~</span> <span class="dt">Dim</span> l' m' t' i' th' n' j', | |
| c <span class="fu">~</span> <span class="dt">Dim</span> l'' m'' t'' i'' th'' n'' j'') <span class="ot">=></span> | |
| <span class="dt">Div</span> a b c | |
| <span class="co">-- * AD</span> | |
| <span class="st">#ifdef WITH_AD</span> | |
| <span class="co">{- |</span> | |
| <span class="co">>>> let ke velocity = velocity*velocity*(1*~kilo gram)</span> | |
| <span class="co">>>> diff ke (3 *~ (metre/second))</span> | |
| <span class="co">6.0 m^-1 kg^-1 s</span> | |
| <span class="co">-}</span> | |
| <span class="ot">diff ::</span> (<span class="dt">Num</span> a) <span class="ot">=></span> | |
| (forall s<span class="fu">.</span> <span class="dt">AD.Mode</span> s <span class="ot">=></span> <span class="dt">Dimensional</span> v x (<span class="dt">AD.AD</span> s a) | |
| <span class="ot">-></span> <span class="dt">Dimensional</span> v y (<span class="dt">AD.AD</span> s a)) | |
| <span class="ot">-></span> <span class="dt">Dimensional</span> v x a <span class="ot">-></span> <span class="dt">Dimensional</span> v (<span class="dt">Div</span> x y) a | |
| diff f z <span class="fu">=</span> <span class="dt">Dimensional</span> <span class="fu">$</span> AD.diff (unD <span class="fu">.</span> f <span class="fu">.</span> <span class="dt">Dimensional</span>) (unD z) | |
| <span class="kw">where</span> unD (<span class="dt">Dimensional</span> a) <span class="fu">=</span> a | |
| <span class="st">#endif</span> | |
| <span class="co">{- $ad</span> | |
| <span class="co">TODO: gradients, hessians, etc.</span> | |
| <span class="co">Types for derivative towers can see hlist's @HList\/Data\/HList\/broken\/Lazy.hs@,</span> | |
| <span class="co">but laziness doesn't really make much sense if the @take@ that is eventually used</span> | |
| <span class="co">to get a finite list for printing etc.</span> | |
| <span class="co">Complications include the fact that AD.grad needs a traversable,</span> | |
| <span class="co">but hmatrix stuff is not traversable (due needing Storable). In ipopt-hs</span> | |
| <span class="co">I got around this problem by copying data. Perhaps that is the solution?</span> | |
| <span class="co">> BROKEN</span> | |
| <span class="co">> grad :: (Num a, AreRecips i iinv, H.Element a, Storable a,</span> | |
| <span class="co">> MapMultEq o iinv r) =></span> | |
| <span class="co">> (forall s. (AD.Mode s, H.Container H.Vector (AD.AD s a),</span> | |
| <span class="co">> Storable (AD.AD s a), H.Field (AD.AD s a))</span> | |
| <span class="co">> => DimMat '[i] (AD.AD s a)</span> | |
| <span class="co">> -> Quantity o (AD.AD s a))</span> | |
| <span class="co">> -> DimMat '[i] a</span> | |
| <span class="co">> -> DimMat '[r] a</span> | |
| <span class="co">> grad f (DimVec x) = DimMat (H.fromLists [AD.grad (unQty . f . DimVec . H.fromList) (H.toList x)])</span> | |
| <span class="co">> where unQty (Dimensional a) = a</span> | |
| <span class="co">-}</span> | |
| <span class="co">-- * GADT for linear algebra with units</span> | |
| <span class="co">{- | Generalization of 'Dimensional' to matrices and vectors. Units</span> | |
| <span class="co">in each coordinate are known at compile-time. This wraps up HMatrix.</span> | |
| <span class="co">-}</span> | |
| <span class="kw">data</span> <span class="dt">D</span> (<span class="ot">sh ::</span> ( <span class="fu">*</span>, [[ <span class="fu">*</span> ]])) e <span class="kw">where</span> | |
| <span class="dt">DMat</span><span class="ot"> ::</span> (<span class="dt">H.Container</span> <span class="dt">H.Matrix</span> e, <span class="dt">H.Field</span> e) | |
| <span class="ot">=></span> <span class="dt">H.Matrix</span> e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(r1,[r, c]) e</span> | |
| <span class="co">-- ^ the units at coordinate i,j are</span> | |
| <span class="co">-- @(r1 ': r)_i (DOne ': c)_j@</span> | |
| <span class="dt">DVec</span><span class="ot"> ::</span> (<span class="dt">H.Container</span> <span class="dt">H.Vector</span> e, <span class="dt">H.Field</span> e) | |
| <span class="ot">=></span> <span class="dt">H.Vector</span> e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(r1, '</span>[r]) e | |
| <span class="co">-- ^ the units at coordinate i are</span> | |
| <span class="co">-- @(r1 ': r)_i@</span> | |
| <span class="dt">DScal</span><span class="ot"> ::</span> (<span class="dt">H.Field</span> e) <span class="ot">=></span> e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(r1,'</span>[]) e | |
| <span class="co">-- ^ the same as Dimensional</span> | |
| <span class="kw">instance</span> (<span class="dt">Show</span> a, <span class="dt">PPUnits</span> sh) <span class="ot">=></span> <span class="dt">Pretty</span> (<span class="dt">D</span> sh a) <span class="kw">where</span> | |
| pretty (<span class="dt">DVec</span> v) <span class="fu">=</span> <span class="kw">case</span> ppUnits (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> sh) <span class="kw">of</span> | |
| [rs] <span class="ot">-></span> vcat | |
| [ dullgreen (string label) <span class="fu"><+></span> string (show e) | |
| <span class="fu">|</span> (e,label) <span class="ot"><-</span> H.toList v <span class="ot">`zip`</span> pad rs ] | |
| pretty (<span class="dt">DMat</span> m) <span class="fu">=</span> <span class="kw">case</span> ppUnits (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> sh) <span class="kw">of</span> | |
| [rs,cs] <span class="ot">-></span> | |
| vcat <span class="fu">$</span> | |
| map (hsep <span class="fu">.</span> onHead dullgreen) <span class="fu">$</span> | |
| transpose <span class="fu">$</span> map (onHead dullgreen <span class="fu">.</span> map string <span class="fu">.</span> pad) <span class="fu">$</span> | |
| zipWith (\a b <span class="ot">-></span> a<span class="fu">:</span>b) | |
| ((show (H.rows m) <span class="fu">++</span> <span class="st">"><"</span><span class="fu">++</span> show (H.cols m)) <span class="fu">:</span> cs) <span class="fu">$</span> | |
| transpose <span class="fu">$</span> | |
| zipWith (\r e <span class="ot">-></span> r <span class="fu">:</span> map show e) rs (H.toLists m) | |
| <span class="kw">where</span> | |
| onHead f (x<span class="fu">:</span>xs) <span class="fu">=</span> f x <span class="fu">:</span> xs | |
| onHead _ [] <span class="fu">=</span> [] | |
| <span class="kw">instance</span> <span class="dt">Pretty</span> (<span class="dt">D</span> sh a) <span class="ot">=></span> <span class="dt">Show</span> (<span class="dt">D</span> sh a) <span class="kw">where</span> | |
| showsPrec p x <span class="fu">=</span> showsPrec p (pretty x) | |
| <span class="co">-- ** pretty instance</span> | |
| <span class="ot">pad ::</span> [<span class="dt">String</span>] <span class="ot">-></span> [<span class="dt">String</span>] | |
| pad [] <span class="fu">=</span> [] | |
| pad xs <span class="fu">=</span> <span class="kw">let</span> | |
| w <span class="fu">=</span> maximum (map length xs) | |
| <span class="kw">in</span> map (\x <span class="ot">-></span> take w <span class="fu">$</span> x <span class="fu">++</span> replicate w <span class="ch">' '</span>) xs | |
| <span class="kw">class</span> <span class="dt">PPUnits</span> (<span class="ot">sh ::</span> k) <span class="kw">where</span> | |
| <span class="ot"> ppUnits ::</span> <span class="dt">Proxy</span> sh <span class="ot">-></span> [[<span class="dt">String</span>]] | |
| <span class="kw">instance</span> forall (<span class="ot">r1 ::</span> <span class="fu">*</span>) (<span class="ot">r::</span>[<span class="fu">*</span>]) (<span class="ot">c ::</span> [<span class="fu">*</span>]) l m t i th n j<span class="fu">.</span> | |
| (<span class="dt">PPUnits</span> [r1 <span class="ch">': r, c], Show (Quantity r1 Int), PPUnits'</span> c, <span class="dt">PPUnits'</span> r, | |
| r1 <span class="fu">~</span> <span class="dt">Dim</span> l m t i th n j) <span class="ot">=></span> <span class="dt">PPUnits</span> <span class="ch">'(r1, [r,c]) where</span> | |
| ppUnits _ <span class="fu">=</span> ppUnits (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> [r1 <span class="ch">': r, DOne '</span><span class="fu">:</span> c]) | |
| <span class="kw">instance</span> (<span class="dt">PPUnits'</span> x, <span class="dt">PPUnits</span> xs) <span class="ot">=></span> <span class="dt">PPUnits</span> (x <span class="ch">': xs) where</span> | |
| ppUnits _ <span class="fu">=</span> ppUnits' (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> x) <span class="fu">:</span> ppUnits (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> xs) | |
| <span class="kw">instance</span> <span class="dt">PPUnits</span> <span class="ch">'[] where</span> | |
| ppUnits _ <span class="fu">=</span> [] | |
| <span class="kw">class</span> <span class="dt">PPUnits'</span> (<span class="ot">sh ::</span> [ <span class="fu">*</span> ]) <span class="kw">where</span> | |
| <span class="ot"> ppUnits' ::</span> <span class="dt">Proxy</span> sh <span class="ot">-></span> [<span class="dt">String</span>] | |
| <span class="kw">instance</span> (<span class="dt">PPUnits'</span> xs) <span class="ot">=></span> <span class="dt">PPUnits'</span> (<span class="dt">DOne</span> <span class="ch">': xs) where</span> | |
| ppUnits' _ <span class="fu">=</span> <span class="st">"1"</span> <span class="fu">:</span> ppUnits' (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> xs) | |
| <span class="kw">instance</span> (<span class="dt">ShowDimSpec</span> x, <span class="dt">PPUnits'</span> xs) <span class="ot">=></span> <span class="dt">PPUnits'</span> (x <span class="ch">': xs) where</span> | |
| ppUnits' _ <span class="fu">=</span> showDimSpec (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> x) <span class="fu">:</span> ppUnits' (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> xs) | |
| <span class="kw">instance</span> <span class="dt">PPUnits'</span> <span class="ch">'[] where</span> | |
| ppUnits' _ <span class="fu">=</span> [] | |
| <span class="kw">class</span> <span class="dt">ShowDimSpec</span> a <span class="kw">where</span> | |
| <span class="ot"> showDimSpec ::</span> <span class="dt">Proxy</span> a <span class="ot">-></span> <span class="dt">String</span> | |
| <span class="kw">instance</span> (<span class="dt">Show</span> (<span class="dt">Quantity</span> a <span class="dt">Int</span>), <span class="dt">Dim</span> l m t i th n j <span class="fu">~</span> a) <span class="ot">=></span> <span class="dt">ShowDimSpec</span> a <span class="kw">where</span> | |
| showDimSpec _ <span class="fu">=</span> <span class="kw">case</span> drop <span class="dv">2</span> <span class="fu">$</span> show (<span class="dv">1</span> <span class="fu">*~</span> (<span class="dt">Dimensional</span> <span class="dv">1</span><span class="ot"> ::</span> <span class="dt">Unit</span> a <span class="dt">Int</span>)) <span class="kw">of</span> | |
| <span class="st">""</span> <span class="ot">-></span> <span class="st">"1"</span> | |
| x <span class="ot">-></span> x | |
| <span class="co">-- * Constraints</span> | |
| <span class="co">{- $justification</span> | |
| <span class="co">A major theme in this library is that type inference goes in whichever direction</span> | |
| <span class="co">it can: in ordinary haskell it is very common for argument types to be determined</span> | |
| <span class="co">by the result types. For example see any code that uses 'Num' or 'Read'.</span> | |
| <span class="co">When we use type families, things look more convenient:</span> | |
| <span class="co">@</span> | |
| <span class="co">data Nat = S Nat | Z</span> | |
| <span class="co">type family Add (a :: Nat) (b :: Nat) :: Nat</span> | |
| <span class="co">type instance Add Z b = b</span> | |
| <span class="co">type instance Add (S a) b = Add a (S b)</span> | |
| <span class="co">@</span> | |
| <span class="co">But ghc is unable to deduce things like @a ~ Z@ given evidence such as @Add Z a ~ Z@.</span> | |
| <span class="co">One way around this is to use @ConstraintKinds@:</span> | |
| <span class="co">@</span> | |
| <span class="co">type AddT (a :: Nat) (b :: Nat) (c :: Nat)</span> | |
| <span class="co"> = (Add a b ~ c, Sub c a ~ b, Sub c b ~ a)</span> | |
| <span class="co">@</span> | |
| <span class="co">Which leads to functions like @f :: AddT a b ab => ... @. This is bad for a couple reasons:</span> | |
| <span class="co">* the right-hand-side of the type can only mention type variables on the</span> | |
| <span class="co"> left-hand-side.</span> | |
| <span class="co">* the left hand side can only bind type variables. Working around this</span> | |
| <span class="co"> leads to many auxiliary type families such as Fst, Snd and Head, or</span> | |
| <span class="co"> leads to a @type family AddT@</span> | |
| <span class="co">So below many constraints expressed as classes, since they have less</span> | |
| <span class="co">of those limitations.</span> | |
| <span class="co">-}</span> | |
| <span class="co">-- | @a*b = c@ when any are lists</span> | |
| <span class="kw">class</span> <span class="dt">MultEq</span> (<span class="ot">a ::</span> k1) (<span class="ot">b ::</span> k2) (<span class="ot">c ::</span> k3) | |
| <span class="co">-- instance (Zip3 MultEq aas bbs ccs) => MultEq aas bbs ccs</span> | |
| <span class="kw">instance</span> <span class="dt">Zip3</span> <span class="dt">Mul</span> as bs cs <span class="ot">=></span> <span class="dt">MultEq</span> as bs cs | |
| <span class="kw">instance</span> <span class="dt">Zip1</span> <span class="dt">Mul</span> as b c <span class="ot">=></span> <span class="dt">MultEq</span> as b c | |
| <span class="kw">instance</span> <span class="dt">Zip1</span> <span class="dt">Mul</span> bs a c <span class="ot">=></span> <span class="dt">MultEq</span> a bs c | |
| <span class="kw">instance</span> (<span class="dt">Zip1</span> <span class="dt">Mul</span> cs aInv b, | |
| <span class="dt">Mul</span> a aInv <span class="dt">DOne</span>) <span class="ot">=></span> <span class="dt">MultEq</span> a b cs | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> as bs, | |
| <span class="dt">Zip2</span> <span class="dt">Mul</span> as bs c) <span class="ot">=></span> <span class="dt">MultEq</span> as bs c | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> as cs, | |
| <span class="dt">Zip2</span> <span class="dt">Div</span> as cs bInv, | |
| <span class="dt">Mul</span> b bInv <span class="dt">DOne</span>) <span class="ot">=></span> <span class="dt">MultEq</span> as b cs | |
| <span class="kw">instance</span> (<span class="dt">Zip2</span> <span class="dt">Div</span> bs cs aInv, | |
| <span class="dt">SameLength</span> bs cs, | |
| <span class="dt">Mul</span> a aInv <span class="dt">DOne</span>) <span class="ot">=></span> <span class="dt">MultEq</span> a bs cs | |
| <span class="kw">instance</span> <span class="dt">Mul</span> a b c <span class="ot">=></span> <span class="dt">MultEq</span> a b c | |
| <span class="co">-- ** Zip</span> | |
| <span class="kw">class</span> (<span class="dt">SameLength</span> a b, <span class="dt">SameLength</span> b c) <span class="ot">=></span> | |
| <span class="dt">Zip3</span> | |
| (<span class="ot">op ::</span> k <span class="ot">-></span> k <span class="ot">-></span> k <span class="ot">-></span> <span class="dt">Constraint</span>) | |
| (<span class="ot">a ::</span> [k]) | |
| (<span class="ot">b ::</span> [k]) | |
| (<span class="ot">c ::</span> [k]) | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> aas bbs, | |
| <span class="dt">SameLength</span> ccs bbs, | |
| op a b c, | |
| (a <span class="ch">': as) ~ aas,</span> | |
| (b <span class="ch">': bs) ~ bbs,</span> | |
| (c <span class="ch">': cs) ~ ccs,</span> | |
| <span class="dt">Zip3</span> op as bs cs) <span class="ot">=></span> <span class="dt">Zip3</span> op aas bbs ccs | |
| <span class="kw">instance</span> <span class="dt">Zip3</span> op <span class="ch">'[] '</span>[] <span class="ch">'[]</span> | |
| <span class="kw">class</span> (<span class="dt">SameLength</span> a b) <span class="ot">=></span> | |
| <span class="dt">Zip2</span> | |
| (<span class="ot">op ::</span> k <span class="ot">-></span> k <span class="ot">-></span> k <span class="ot">-></span> <span class="dt">Constraint</span>) | |
| (<span class="ot">a ::</span> [k]) | |
| (<span class="ot">b ::</span> [k]) | |
| (<span class="ot">c ::</span> k) | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> aas bbs, | |
| op a b c, | |
| (a <span class="ch">': as) ~ aas,</span> | |
| (b <span class="ch">': bs) ~ bbs,</span> | |
| <span class="dt">Zip2</span> op as bs c) <span class="ot">=></span> <span class="dt">Zip2</span> op aas bbs c | |
| <span class="kw">instance</span> <span class="dt">Zip2</span> op <span class="ch">'[] '</span>[] c | |
| <span class="kw">class</span> <span class="dt">Zip1</span> | |
| (<span class="ot">op ::</span> k <span class="ot">-></span> k <span class="ot">-></span> k <span class="ot">-></span> <span class="dt">Constraint</span>) | |
| (<span class="ot">a ::</span> [k]) | |
| (<span class="ot">b ::</span> k) | |
| (<span class="ot">c ::</span> k) | |
| <span class="kw">instance</span> ((a <span class="ch">': as) ~ aas,</span> | |
| op a b c, | |
| <span class="dt">Zip1</span> op as b c) <span class="ot">=></span> <span class="dt">Zip1</span> op aas b c | |
| <span class="kw">instance</span> <span class="dt">Zip1</span> op <span class="ch">'[] b c</span> | |
| <span class="co">{- | given @ijs :: [[Quantity a]]@ (except the : and [] constructors are</span> | |
| <span class="co">actually (,) and (), ie. a HList that doesn't use the HList constructors),</span> | |
| <span class="co">calculate a @DimMat rowUnits colUnits@, where the outer product of rowUnits</span> | |
| <span class="co">and colUnits gives the units at each index in the ijs. The first element</span> | |
| <span class="co">of colUnits is DOne.</span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> (<span class="dt">SameLength</span> a ab) <span class="ot">=></span> <span class="dt">Outer</span> a b ab | |
| <span class="kw">instance</span> <span class="dt">Outer</span> <span class="ch">'[] b '</span>[] | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> aas ccs, | |
| (a <span class="ch">': as) ~ aas,</span> | |
| (c <span class="ch">': cs) ~ ccs,</span> | |
| <span class="dt">MultEq</span> a b c, | |
| <span class="dt">Outer</span> as b cs) | |
| <span class="ot">=></span> <span class="dt">Outer</span> aas b ccs | |
| <span class="co">-- * DimMatFromTuple</span> | |
| <span class="kw">class</span> <span class="dt">DimMatFromTuple</span> ijs r1 r c e | |
| <span class="kw">type</span> family <span class="dt">TupleToHListU</span> (<span class="ot">a ::</span> <span class="fu">*</span>)<span class="ot"> ::</span> [<span class="fu">*</span>] | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">TupleToHListU</span> (a, b) <span class="fu">=</span> () <span class="ch">': TupleToHListU b</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">TupleToHListU</span> () <span class="fu">=</span> <span class="ch">'[]</span> | |
| <span class="kw">type</span> family <span class="dt">TuplesToHListU</span> (<span class="ot">a ::</span> <span class="fu">*</span>)<span class="ot"> ::</span> [[<span class="fu">*</span>]] | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">TuplesToHListU</span> (a, b) <span class="fu">=</span> <span class="dt">TupleToHListU</span> a <span class="ch">': TuplesToHListU b </span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">TuplesToHListU</span> () <span class="fu">=</span> <span class="ch">'[]</span> | |
| <span class="kw">instance</span> (<span class="dt">Outer</span> (r1 <span class="ch">': r) (DOne '</span><span class="fu">:</span> c) ijs', | |
| <span class="dt">DMFromTuple1</span> e ijs ijs', | |
| <span class="dt">SameLength</span> (<span class="dt">TuplesToHListU</span> ijs) ijs') <span class="ot">=></span> <span class="dt">DimMatFromTuple</span> ijs r1 r c e | |
| <span class="co">-- | helper for 'DimMatFromTuple'</span> | |
| <span class="kw">type</span> family <span class="dt">DMFromTuple1</span> e b (<span class="ot">b' ::</span> [[<span class="fu">*</span>]])<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> family <span class="dt">DMFromTuple2</span> e b (<span class="ot">b' ::</span> [<span class="fu">*</span>])<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> family <span class="dt">DMFromTuple3</span> e b<span class="ot"> b' ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DMFromTuple3</span> e (<span class="dt">Quantity</span> b e') b' <span class="fu">=</span> (e <span class="fu">~</span> e', b <span class="fu">~</span> b') | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DMFromTuple1</span> e (x, xs) (x' <span class="ch">': xs'</span>) <span class="fu">=</span> (<span class="dt">TupleToHListU</span> x <span class="ot">`SameLength`</span> x', | |
| <span class="dt">DMFromTuple2</span> e x x', <span class="dt">DMFromTuple1</span> e xs xs') | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DMFromTuple1</span> e () xs <span class="fu">=</span> (xs <span class="fu">~</span> <span class="ch">'[])</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DMFromTuple2</span> e (x, xs) (x' <span class="ch">': xs'</span>) <span class="fu">=</span> (<span class="dt">DMFromTuple3</span> e x x', <span class="dt">DMFromTuple2</span> e xs xs') | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DMFromTuple2</span> e () xs <span class="fu">=</span> (xs <span class="fu">~</span> <span class="ch">'[])</span> | |
| <span class="co">-- | just for types produced by the matD quasiquote</span> | |
| <span class="ot">toDM ::</span> <span class="dt">DimMatFromTuple</span> ijs r1 r c e <span class="ot">=></span> ijs <span class="ot">-></span> <span class="dt">Proxy</span> (<span class="dt">D</span> <span class="ch">'(r1, [r, c]) e)</span> | |
| toDM _ <span class="fu">=</span> <span class="dt">Proxy</span> | |
| <span class="co">-- | @InnerCxt t a b = t ~ 'H.dot' a b@</span> | |
| <span class="kw">type</span> family <span class="dt">InnerCxt</span> (<span class="ot">t ::</span> k) (<span class="ot">a ::</span> [k]) (<span class="ot">b ::</span> [k])<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">InnerCxt</span> t (a <span class="ch">': as) (b '</span><span class="fu">:</span> bs) <span class="fu">=</span> (<span class="dt">MultEq</span> a b t, <span class="dt">InnerCxt</span> t as bs) | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">InnerCxt</span> t <span class="ch">'[] '</span>[] <span class="fu">=</span> () | |
| <span class="kw">class</span> (<span class="dt">SameLength</span> a b, <span class="dt">InnerCxt</span> c a b) <span class="ot">=></span> <span class="dt">Inner</span> (<span class="ot">a ::</span> [<span class="fu">*</span>]) (<span class="ot">b ::</span> [<span class="fu">*</span>]) (<span class="ot">c ::</span> <span class="fu">*</span>) | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> aas bbs, <span class="dt">InnerCxt</span> c aas bbs) <span class="ot">=></span> <span class="dt">Inner</span> aas bbs c | |
| <span class="co">-- | @ProdEq a b@ is @product a ~ b@</span> | |
| <span class="kw">class</span> <span class="dt">ProdEq</span> a b | |
| <span class="kw">instance</span> (<span class="dt">ProdEq</span> as b', <span class="dt">Mul</span> a b' b) <span class="ot">=></span> <span class="dt">ProdEq</span> (a <span class="ch">': as) b</span> | |
| <span class="kw">instance</span> (dOne <span class="fu">~</span> <span class="dt">DOne</span>) <span class="ot">=></span> <span class="dt">ProdEq</span> <span class="ch">'[] dOne</span> | |
| <span class="co">-- | @RecipEq a aInv@ is @a*aInv ~ DOne@ (or a list of DOne)</span> | |
| <span class="kw">class</span> <span class="dt">RecipEq</span> (<span class="ot">a ::</span> k) (<span class="ot">aInv ::</span> k) | |
| <span class="kw">instance</span> (<span class="dt">MultEq</span> as aInvs <span class="dt">DOne</span>) <span class="ot">=></span> <span class="dt">RecipEq</span> as aInvs | |
| <span class="co">-- | @AtEq a n b m c@ calculates @(At a n \`Mult\` At b m) ~ c@,</span> | |
| <span class="co">-- but also can infer part of the `a` if the `b` and `c` are known</span> | |
| <span class="kw">type</span> family <span class="dt">AtEq2</span> (<span class="ot">a ::</span> [k]) (<span class="ot">n ::</span> <span class="dt">HNat</span>) (<span class="ot">b ::</span> [k]) (<span class="ot">m ::</span> <span class="dt">HNat</span>) (<span class="ot">c ::</span> k)<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AtEq2</span> (a <span class="ch">': as) HZero (b '</span><span class="fu">:</span> bs) <span class="dt">HZero</span> c <span class="fu">=</span> (<span class="dt">MultEq</span> a b c) | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AtEq2</span> (a <span class="ch">': as) (HSucc n) bs m c = AtEq2 as n bs m c</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AtEq2</span> as <span class="dt">HZero</span> (b <span class="ch">': bs) (HSucc m) c = AtEq2 as HZero bs m c</span> | |
| <span class="kw">type</span> family <span class="dt">AtEq</span> (<span class="ot">a ::</span> [k]) (<span class="ot">n ::</span> <span class="dt">HNat</span>) (<span class="ot">b ::</span> k)<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AtEq</span> (a <span class="ch">': as) HZero b = (a ~ b)</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AtEq</span> (a <span class="ch">': as) (HSucc n) b = AtEq as n b</span> | |
| <span class="co">-- | Data.Packed.Vector.'H.@>'</span> | |
| <span class="ot">(@>) ::</span> (<span class="dt">HNat2Integral</span> i, <span class="dt">AtEq</span> r i ri, <span class="dt">MultEq</span> r1 ri u) | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(r1,'</span>[r]) a | |
| <span class="ot">-></span> <span class="dt">Proxy</span> i | |
| <span class="ot">-></span> <span class="dt">Quantity</span> u a | |
| <span class="dt">DVec</span> v <span class="fu">@></span> i <span class="fu">=</span> <span class="dt">Dimensional</span> (v <span class="fu">H.@></span> hNat2Integral i) | |
| <span class="co">-- | Data.Packed.Matrix.'H.@@>'</span> | |
| <span class="ot">(@@>) ::</span> (<span class="dt">HNat2Integral</span> i, <span class="dt">HNat2Integral</span> j, <span class="dt">AtEq2</span> (r1 <span class="ch">': r) i (DOne '</span><span class="fu">:</span> c) j ty) | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(r1, [r,c]) a</span> | |
| <span class="ot">-></span> (<span class="dt">Proxy</span> i, <span class="dt">Proxy</span> j) | |
| <span class="ot">-></span> <span class="dt">Quantity</span> ty a | |
| <span class="dt">DMat</span> m <span class="fu">@@></span> (i,j) <span class="fu">=</span> <span class="dt">Dimensional</span> (m <span class="fu">H.@@></span> (hNat2Integral i,hNat2Integral j)) | |
| <span class="ot">pnorm ::</span> (<span class="dt">AllEq</span> r1 r, <span class="dt">AllEq</span> <span class="dt">DOne</span> c) | |
| <span class="ot">=></span> <span class="dt">H.NormType</span> <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(r1, [r, c]) a -> Quantity r1 (H.RealOf a)</span> | |
| pnorm normType (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">Dimensional</span> (H.pnorm normType a) | |
| <span class="co">{- | @AllEq a xs@ is like @all (all (a==)) xs@, @all (a ==) xs@, @a == xs@:</span> | |
| <span class="co">whichever amount of [ ] is peeled off before making the comparison (with ~)</span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> <span class="dt">AllEq</span> (<span class="ot">a ::</span> k1) (<span class="ot">xs ::</span> k2) | |
| <span class="kw">instance</span> (a <span class="fu">~</span> x, <span class="dt">AllEq</span> a xs) <span class="ot">=></span> <span class="dt">AllEq</span> a (x <span class="ch">': xs)</span> | |
| <span class="kw">instance</span> <span class="dt">AllEq</span> a <span class="ch">'[]</span> | |
| <span class="kw">instance</span> <span class="dt">AllEq</span> <span class="ch">'[] xs</span> | |
| <span class="kw">instance</span> (<span class="dt">AllEq</span> a xs, <span class="dt">AllEq</span> as xs) <span class="ot">=></span> <span class="dt">AllEq</span> (a <span class="ch">': as) xs</span> | |
| <span class="co">{- | @c = a `dot` b@ is one of:</span> | |
| <span class="co">> c_ij = sum_j a_ij b_jk</span> | |
| <span class="co">> c_k = sum_j a_j b_jk</span> | |
| <span class="co">> c_i = sum_j a_ij b_j</span> | |
| <span class="co">> c = sum_j a_j b_j</span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> <span class="dt">Dot</span> a b c <span class="kw">where</span> | |
| <span class="ot"> dot ::</span> <span class="dt">H.Element</span> e <span class="ot">=></span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> b e <span class="ot">-></span> <span class="dt">D</span> c e | |
| <span class="kw">instance</span> | |
| ( <span class="dt">MultEq</span> (a <span class="ch">': ra) b (c '</span><span class="fu">:</span> rc), | |
| <span class="dt">MultEq</span> ca rb b, | |
| shA <span class="fu">~</span> <span class="ch">'(a,[ra, ca]),</span> | |
| shB <span class="fu">~</span> <span class="ch">'(b, rb '</span><span class="fu">:</span> cb), | |
| shC <span class="fu">~</span> <span class="ch">'(c, rc '</span><span class="fu">:</span> cb)) | |
| <span class="ot">=></span> <span class="dt">Dot</span> shA shB shC <span class="kw">where</span> | |
| dot (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.multiply a b) | |
| dot (<span class="dt">DMat</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> <span class="dt">DVec</span> (H.mXv a b) | |
| <span class="co">{-</span> | |
| <span class="co"> dot (DVec a) (DMat b) = DVec (H.vXm a b)</span> | |
| <span class="co"> dot (DVec a) (DVec b) = DScal (H.dot a b)</span> | |
| <span class="co"> -}</span> | |
| <span class="kw">class</span> <span class="dt">Trans</span> a b <span class="kw">where</span> | |
| <span class="ot"> trans ::</span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> b e | |
| <span class="kw">instance</span> (a <span class="fu">~</span> <span class="ch">'(r1, [x,y]),</span> | |
| b <span class="fu">~</span> <span class="ch">'(r1, [y,x]))</span> | |
| <span class="ot">=></span> <span class="dt">Trans</span> a b <span class="kw">where</span> | |
| trans (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.trans a) | |
| <span class="co">{- | type for a pseudoinverse (and inverse):</span> | |
| <span class="co">The single instance comes from looking at inverses from a 2x2 matrix (let's call A):</span> | |
| <span class="co">> a b</span> | |
| <span class="co">> c d</span> | |
| <span class="co">and the inverse * determinant of the original</span> | |
| <span class="co">> d -b</span> | |
| <span class="co">> -c a</span> | |
| <span class="co">In the product A * A^-1 the diagonal is dimensionless ('DOne').</span> | |
| <span class="co">That happens if the row and column type-level unit lists are reciprocals of</span> | |
| <span class="co">eachother ('AreRecips'), so the constraint on the instance of PInv encodes</span> | |
| <span class="co">this exactly (plus some constraints requiring that sh and sh' are at least</span> | |
| <span class="co">1x1)</span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> <span class="dt">PInv</span> a b <span class="kw">where</span> | |
| <span class="ot"> pinv ::</span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> b e | |
| <span class="kw">type</span> family <span class="dt">LengthSndTwo</span> (<span class="ot">a ::</span> k)<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">LengthSndTwo</span> <span class="ch">'(a, as) = SameLength as '</span>[(), ()] | |
| <span class="kw">type</span> <span class="dt">AreRecips</span> a b <span class="fu">=</span> <span class="dt">MultEq</span> a b <span class="dt">DOne</span> | |
| <span class="kw">instance</span> (<span class="dt">MultEq</span> ra cb a, | |
| <span class="dt">MultEq</span> ca rb b, | |
| <span class="dt">AreRecips</span> a b, | |
| bSh <span class="fu">~</span> <span class="ch">'(b, [rb, cb]),</span> | |
| aSh <span class="fu">~</span> <span class="ch">'(a, [ra, ca]))</span> | |
| <span class="ot">=></span> <span class="dt">PInv</span> aSh bSh <span class="kw">where</span> | |
| pinv (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.pinv a) | |
| <span class="ot">inv ::</span> (<span class="dt">PInv</span> a b, | |
| b <span class="fu">~</span> <span class="ch">'(t1, [t2, t3]))</span> | |
| <span class="ot">=></span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> b e | |
| inv (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.inv a) | |
| <span class="ot">pinvTol ::</span> (<span class="dt">PInv</span> a b, | |
| <span class="st">#if !MIN_VERSION_hmatrix(0,15,0)</span> | |
| <span class="co">-- on hmatrix 13, the pinvTol function has type Double -> Matrix Double -> MatrixDouble, later they generalized to Field t => Double -> Matrix t -> Matrix t</span> | |
| a <span class="fu">~</span> <span class="dt">Double</span>, | |
| <span class="st">#endif</span> | |
| b <span class="fu">~</span> <span class="ch">'(t1, [t2, t3]) )</span> | |
| <span class="ot">=></span> <span class="dt">Double</span> <span class="ot">-></span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> b e | |
| pinvTol tol (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.pinvTol tol a) | |
| <span class="kw">class</span> <span class="dt">Det</span> a b <span class="kw">where</span> | |
| <span class="ot"> det ::</span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">Quantity</span> b e | |
| <span class="kw">instance</span> (<span class="dt">SameLength</span> r c, | |
| <span class="dt">ProdEq</span> (r1 <span class="ch">': r) (pr :: *),</span> | |
| <span class="dt">ProdEq</span> c (<span class="ot">pc ::</span> <span class="fu">*</span>), | |
| <span class="dt">MultEq</span> pr pc b, | |
| a <span class="fu">~</span> <span class="ch">'(r1, [r, c])) =></span> | |
| <span class="dt">Det</span> a b <span class="kw">where</span> | |
| det (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">Dimensional</span> (H.det a) | |
| <span class="co">{- | Numeric.LinearAlgebra.Algorithms.'H.expm'</span> | |
| <span class="co">@y t = expm (scale t a) \`multiply\` y0@ solves the DE @y' = Ay@ where y0 is the</span> | |
| <span class="co">value of y at time 0</span> | |
| <span class="co">-}</span> | |
| <span class="ot">expm ::</span> (<span class="dt">AreRecips</span> r c) | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(r1, [r, c]) a</span> | |
| <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(r1, [r, c]) a</span> | |
| expm (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.expm a) | |
| <span class="co">{- | Numeric.Container.'H.scale'</span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> <span class="dt">Scale</span> a b c <span class="kw">where</span> | |
| <span class="ot"> scale ::</span> <span class="dt">Quantity</span> a e <span class="ot">-></span> <span class="dt">D</span> b e <span class="ot">-></span> <span class="dt">D</span> c e | |
| <span class="ot">fromQty ::</span> <span class="dt">H.Field</span> e <span class="ot">=></span> <span class="dt">Quantity</span> a e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e | |
| fromQty (<span class="dt">Dimensional</span> a) <span class="fu">=</span> <span class="dt">DScal</span> a | |
| <span class="ot">toQty ::</span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e <span class="ot">-></span> <span class="dt">Quantity</span> a e | |
| toQty (<span class="dt">DScal</span> a) <span class="fu">=</span> <span class="dt">Dimensional</span> a | |
| <span class="kw">instance</span> (<span class="dt">MultEq</span> a (r1 <span class="ch">': r) (r1'</span> <span class="ch">': r'</span>), | |
| b <span class="fu">~</span> <span class="ch">'(r1, r '</span><span class="fu">:</span> rs), | |
| c <span class="fu">~</span> <span class="ch">'(r1'</span>, r' <span class="ch">': rs)) =></span> | |
| <span class="dt">Scale</span> a b c <span class="kw">where</span> | |
| scale (<span class="dt">Dimensional</span> t) (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.scale t a) | |
| scale (<span class="dt">Dimensional</span> t) (<span class="dt">DVec</span> a) <span class="fu">=</span> <span class="dt">DVec</span> (H.scale t a) | |
| <span class="co">{- | Numeric.Container.'H.scaleRecip'</span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> <span class="dt">ScaleRecip</span> a b c <span class="kw">where</span> | |
| <span class="ot"> scaleRecip ::</span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e <span class="ot">-></span> <span class="dt">D</span> b e <span class="ot">-></span> <span class="dt">D</span> c e | |
| <span class="kw">class</span> <span class="dt">ScaleRecip1</span> (<span class="ot">bool ::</span> <span class="dt">Bool</span>) a b c <span class="kw">where</span> | |
| <span class="ot"> scaleRecip1 ::</span> <span class="dt">Proxy</span> bool <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e <span class="ot">-></span> <span class="dt">D</span> b e <span class="ot">-></span> <span class="dt">D</span> c e | |
| <span class="kw">instance</span> | |
| (<span class="dt">ScaleRecipCxt</span> r1 r1' r r' rs rs' a b c | |
| , rs' <span class="fu">~</span> <span class="ch">'[ t1 ]</span> | |
| ) <span class="ot">=></span> <span class="dt">ScaleRecip1</span> <span class="dt">True</span> a b c <span class="kw">where</span> | |
| scaleRecip1 _ (<span class="dt">DScal</span> t) (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.scaleRecip t a) | |
| <span class="kw">instance</span> | |
| (<span class="dt">ScaleRecipCxt</span> r1 r1' r r' rs rs' a b c, | |
| rs' <span class="fu">~</span> <span class="ch">'[]) =></span> | |
| <span class="dt">ScaleRecip1</span> <span class="dt">False</span> a b c <span class="kw">where</span> | |
| scaleRecip1 _ (<span class="dt">DScal</span> t) (<span class="dt">DVec</span> a) <span class="fu">=</span> <span class="dt">DVec</span> (H.scaleRecip t a) | |
| <span class="kw">instance</span> (bool1 <span class="fu">~</span> (<span class="dt">HLength</span> bs <span class="fu">==</span> <span class="dt">HSucc</span> (<span class="dt">HSucc</span> <span class="dt">HZero</span>)), | |
| bool2 <span class="fu">~</span> (<span class="dt">HLength</span> cs <span class="fu">==</span> <span class="dt">HSucc</span> (<span class="dt">HSucc</span> <span class="dt">HZero</span>)), | |
| bool1 <span class="fu">~</span> bool2, | |
| <span class="dt">ScaleRecip1</span> bool1 a <span class="ch">'(b, bs) '</span>(c, cs)) <span class="ot">=></span> <span class="dt">ScaleRecip</span> a <span class="ch">'(b, bs) '</span>(c, cs) <span class="kw">where</span> | |
| scaleRecip <span class="fu">=</span> scaleRecip1 (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> bool1) | |
| <span class="kw">type</span> <span class="dt">ScaleRecipCxt</span> (<span class="ot">r1 ::</span> <span class="fu">*</span>) (<span class="ot">r1' ::</span> <span class="fu">*</span>) r r' rs rs' (<span class="ot">a ::</span> <span class="fu">*</span>) b c <span class="fu">=</span> | |
| (<span class="dt">MultEq</span> a (r1' <span class="ch">': r'</span>) (r1 <span class="ch">': r) ,</span> | |
| <span class="dt">MultEq</span> rs rs' <span class="dt">DOne</span>, | |
| b <span class="fu">~</span> <span class="ch">'(r1, r '</span><span class="fu">:</span> rs), | |
| c <span class="fu">~</span> <span class="ch">'(r1'</span>, r' <span class="ch">': rs'</span>)) | |
| <span class="co">-- | a shortcut for @scaleRecip (DScal 1)@</span> | |
| <span class="ot">recipMat ::</span> forall b c e<span class="fu">.</span> (<span class="dt">H.Field</span> e, <span class="dt">ScaleRecip</span> <span class="dt">DOne</span> b c) <span class="ot">=></span> <span class="dt">D</span> b e <span class="ot">-></span> <span class="dt">D</span> c e | |
| recipMat m <span class="fu">=</span> scaleRecip (<span class="dt">DScal</span> <span class="dv">1</span><span class="ot"> ::</span> <span class="dt">D</span> <span class="ch">'(DOne, '</span>[]) e) m | |
| <span class="ot">liftH2 ::</span> | |
| ( forall h f<span class="fu">.</span> (<span class="dt">H.Container</span> f e, h <span class="fu">~</span> f e) <span class="ot">=></span> h <span class="ot">-></span> h <span class="ot">-></span> h) <span class="ot">-></span> | |
| <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> a e | |
| liftH2 f (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (f a b) | |
| liftH2 f (<span class="dt">DVec</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> <span class="dt">DVec</span> (f a b) | |
| add a b <span class="fu">=</span> liftH2 H.add a b | |
| sub a b <span class="fu">=</span> liftH2 H.sub a b | |
| <span class="ot">mulMat ::</span> ( <span class="dt">MultEq</span> as bs cs, <span class="dt">MultEq</span> a b c, cs <span class="fu">~</span> <span class="ch">'[t1 , t2] )</span> | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a,as) e -> D '</span>(b,bs) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(c,cs) e</span> | |
| mulMat (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.mul a b) | |
| <span class="ot">mulVec ::</span> ( <span class="dt">MultEq</span> as bs cs, <span class="dt">MultEq</span> a b c, cs <span class="fu">~</span> <span class="ch">'[t1] )</span> | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a,as) e -> D '</span>(b,bs) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(c,cs) e</span> | |
| mulVec (<span class="dt">DVec</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> <span class="dt">DVec</span> (H.mul a b) | |
| <span class="ot">divideMat ::</span> ( <span class="dt">MultEq</span> as cs bs, <span class="dt">MultEq</span> a c b, cs <span class="fu">~</span> <span class="ch">'[t1 , t2] )</span> | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a,as) e -> D '</span>(b,bs) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(c,cs) e</span> | |
| divideMat (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.divide a b) | |
| <span class="ot">divideVec ::</span> ( <span class="dt">MultEq</span> as cs bs, <span class="dt">MultEq</span> a c b, cs <span class="fu">~</span> <span class="ch">'[t1] )</span> | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a,as) e -> D '</span>(b,bs) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(c,cs) e</span> | |
| divideVec (<span class="dt">DVec</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> <span class="dt">DVec</span> (H.divide a b) | |
| <span class="ot">arctan2 ::</span> (bs <span class="fu">~</span> <span class="dt">MapMapConst</span> <span class="dt">DOne</span> as) <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a,as) e -> D '</span>(a,as) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(b,bs) e</span> | |
| arctan2 (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.arctan2 a b) | |
| arctan2 (<span class="dt">DVec</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> <span class="dt">DVec</span> (H.arctan2 a b) | |
| <span class="ot">equal ::</span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">Bool</span> | |
| equal (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> H.equal a b | |
| equal (<span class="dt">DVec</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> H.equal a b | |
| <span class="co">{- | @cmap f m@ gives a matrix @m'@</span> | |
| <span class="co">@f@ is applied to </span> | |
| <span class="co">-}</span> | |
| <span class="kw">class</span> <span class="dt">CMap</span> f a b e e' <span class="kw">where</span> | |
| <span class="ot"> cmap ::</span> f <span class="ot">-></span> <span class="dt">D</span> a e <span class="ot">-></span> <span class="dt">D</span> b e' | |
| <span class="co">-- | Maybe there's a way to implement in terms of the real cmap (possibly</span> | |
| <span class="co">-- unsafeCoerce?)</span> | |
| <span class="kw">instance</span> | |
| (<span class="dt">ToHLists</span> sh e xs, | |
| <span class="dt">FromHLists</span> xs' sh' e', | |
| <span class="dt">SameLength</span> xs xs', | |
| <span class="dt">HMapAux</span> (<span class="dt">HMap</span> f) xs xs') <span class="ot">=></span> | |
| <span class="dt">CMap</span> f sh sh' e e' <span class="kw">where</span> | |
| cmap f m <span class="fu">=</span> fromHLists (<span class="dt">HMap</span> f <span class="ot">`hMap`</span> (toHLists<span class="ot"> m ::</span> <span class="dt">HList</span> xs)<span class="ot"> ::</span> <span class="dt">HList</span> xs') | |
| <span class="kw">type</span> family <span class="dt">AppendEq'</span> (<span class="ot">a ::</span> [k]) (<span class="ot">b ::</span> [k]) (<span class="ot">ab ::</span> [k])<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AppendEq'</span> (a <span class="ch">': as) b (a'</span> <span class="ch">': abs) = (a ~ a'</span>, <span class="dt">AppendEq'</span> as b abs) | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AppendEq'</span> <span class="ch">'[] b abs = (b ~ abs)</span> | |
| <span class="co">-- | a bit overkill?</span> | |
| <span class="co">-- @a ++ b = ab@</span> | |
| <span class="kw">type</span> <span class="dt">AppendEq</span> a b ab <span class="fu">=</span> | |
| (ab <span class="fu">~</span> <span class="dt">HAppendR</span> a b, | |
| <span class="dt">AppendEq'</span> a b ab, | |
| <span class="dt">SameLength</span> (<span class="dt">DropPrefix</span> a ab) b, | |
| <span class="dt">SameLength</span> (<span class="dt">DropPrefix</span> b ab) a) | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">HAppendR</span> (x <span class="ch">': xs) ys = x '</span><span class="fu">:</span> <span class="dt">HAppendR</span> xs ys | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">HAppendR</span> <span class="ch">'[] ys = ys</span> | |
| <span class="kw">type</span> family <span class="dt">DropPrefix</span> (<span class="ot">a ::</span> [k]) (<span class="ot">ab ::</span> [k])<span class="ot"> ::</span> [k] | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DropPrefix</span> (a <span class="ch">': as) (a'</span> <span class="ch">': abs) = DropPrefix as abs</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">DropPrefix</span> <span class="ch">'[] bs = bs</span> | |
| <span class="co">{- | the slightly involved type here exists because</span> | |
| <span class="co">ci1 and ci2 both start with DOne, but ci2's contribution</span> | |
| <span class="co">to ci3 does not need a DOne at the start. Another way to</span> | |
| <span class="co">read the constraints here is:</span> | |
| <span class="co">> map (*rem) (a11 : ri) = b11 : bi</span> | |
| <span class="co">> ci3 = ci1 ++ map (*rem) ci2</span> | |
| <span class="co">The same idea happens with vconcat.</span> | |
| <span class="co">-}</span> | |
| hconcat <span class="ot">::</span> | |
| ( <span class="dt">MultEq</span> (rem<span class="ot"> ::</span> <span class="fu">*</span>) a b, | |
| <span class="dt">MultEq</span> rem ra rb, | |
| <span class="dt">MultEq</span> rem (<span class="dt">DOne</span> <span class="ch">': cb) cb'</span>, | |
| <span class="dt">AppendEq</span> ca cb' cc ) <span class="ot">=></span> | |
| <span class="dt">D</span> <span class="ch">'(a, [ra,ca]) e -> D '</span>(b, [rb, cb]) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, [ra, cc]) e</span> | |
| hconcat (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.fromBlocks [[a, b]]) | |
| <span class="ot">vconcat ::</span> (<span class="dt">AppendEq</span> ra (b <span class="ch">': rb) rc) =></span> | |
| <span class="dt">D</span> <span class="ch">'(a, '</span>[ra,ca]) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(b, '</span>[rb,ca]) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[rc,ca]) e | |
| vconcat (<span class="dt">DMat</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.fromBlocks [[a],[b]]) | |
| rank, rows,<span class="ot"> cols ::</span> <span class="dt">D</span> t a <span class="ot">-></span> <span class="dt">Int</span> | |
| rank (<span class="dt">DMat</span> a) <span class="fu">=</span> H.rank a | |
| rows (<span class="dt">DMat</span> a) <span class="fu">=</span> H.rows a | |
| cols (<span class="dt">DMat</span> a) <span class="fu">=</span> H.cols a | |
| <span class="co">-- | H.'H.rows' except type-level</span> | |
| <span class="ot">rowsNT ::</span> <span class="dt">D</span> <span class="ch">'(a, r '</span><span class="fu">:</span> c) e <span class="ot">-></span> <span class="dt">Proxy</span> (<span class="dt">HLength</span> (a <span class="ch">': ri))</span> | |
| rowsNT _ <span class="fu">=</span> <span class="dt">Proxy</span> | |
| <span class="co">-- | H.'H.cols' except type-level</span> | |
| <span class="ot">colsNT ::</span> <span class="dt">D</span> <span class="ch">'(a, r '</span><span class="fu">:</span> c <span class="ch">': cs) e -> Proxy (HLength (DOne '</span><span class="fu">:</span> c)) | |
| colsNT _ <span class="fu">=</span> <span class="dt">Proxy</span> | |
| <span class="co">-- | (m `hasRows` n) constrains the matrix/vector @m@ to have @n@ rows</span> | |
| <span class="ot">hasRows ::</span> (<span class="dt">SameLength</span> (<span class="dt">HReplicateR</span> n ()) r, <span class="co">-- forwards</span> | |
| <span class="dt">HLength</span> r <span class="fu">~</span> n <span class="co">-- backwards</span> | |
| ) <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a, ra '</span><span class="fu">:</span> ca) e <span class="ot">-></span> <span class="dt">Proxy</span> (<span class="ot">n ::</span> <span class="dt">HNat</span>) <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, ra '</span><span class="fu">:</span> ca) e | |
| hasRows x _ <span class="fu">=</span> x | |
| <span class="co">-- | (m `hasRows` n) constrains the matrix/vector @m@ to have @n@ rows</span> | |
| <span class="ot">hasCols ::</span> (<span class="dt">SameLength</span> (<span class="dt">HReplicateR</span> n ()) ci, <span class="co">-- forwards</span> | |
| <span class="dt">HLength</span> ci <span class="fu">~</span> n <span class="co">-- backwards</span> | |
| ) <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a, ra '</span><span class="fu">:</span> ca <span class="ch">': rest) e -> Proxy (n :: HNat) -> D '</span>(a, ra <span class="ch">': ca '</span><span class="fu">:</span> rest) e | |
| hasCols x _ <span class="fu">=</span> x | |
| <span class="co">-- | H.'H.scalar'</span> | |
| <span class="kw">class</span> (<span class="dt">MapConst</span> <span class="ch">'[] as ~ as) => Scalar as where</span> | |
| <span class="ot"> scalar ::</span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, as) e</span> | |
| <span class="kw">instance</span> <span class="dt">Scalar</span> <span class="ch">'[ '</span>[] ] <span class="kw">where</span> | |
| scalar (<span class="dt">DScal</span> a) <span class="fu">=</span> <span class="dt">DVec</span> (H.scalar a) | |
| <span class="kw">instance</span> <span class="dt">Scalar</span> <span class="ch">'[ '</span>[], <span class="ch">'[] ] where</span> | |
| scalar (<span class="dt">DScal</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.scalar a) | |
| <span class="co">{- | Numeric.Container.'H.konst', but the size is determined by the type.</span> | |
| <span class="co">>>> let n = hSucc (hSucc hZero) -- 2</span> | |
| <span class="co">>>> konst ((1::Double) *~ second) `hasRows` n `hasCols` n</span> | |
| <span class="co">2><2 1 1 </span> | |
| <span class="co">s 1.0 1.0</span> | |
| <span class="co">s 1.0 1.0</span> | |
| <span class="co">-}</span> | |
| <span class="ot">konst ::</span> forall e a ra ca<span class="fu">.</span> | |
| (<span class="dt">H.Field</span> e, | |
| <span class="dt">HNat2Integral</span> (<span class="dt">HLength</span> (a <span class="ch">': ra)),</span> | |
| <span class="dt">HNat2Integral</span> (<span class="dt">HLength</span> (<span class="dt">DOne</span> <span class="ch">': ca)),</span> | |
| <span class="dt">AllEq</span> <span class="dt">DOne</span> ca, | |
| <span class="dt">AllEq</span> a ra) | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[ra, ca]) e | |
| konst (<span class="dt">DScal</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.konst a | |
| (hNat2Integral (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> (<span class="dt">HLength</span> (a <span class="ch">': ra))),</span> | |
| hNat2Integral (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> (<span class="dt">HLength</span> (<span class="dt">DOne</span> <span class="ch">': ca)))))</span> | |
| <span class="co">-- | identity matrix. The size is determined by the type.</span> | |
| <span class="ot">ident ::</span> forall ones e<span class="fu">.</span> | |
| (<span class="dt">H.Field</span> e, <span class="dt">HNat2Integral</span> (<span class="dt">HLength</span> (<span class="dt">DOne</span> <span class="ch">': ones))) =></span> | |
| <span class="dt">D</span> <span class="ch">'(DOne, [ones, ones]) e</span> | |
| ident <span class="fu">=</span> <span class="dt">DMat</span> (H.ident (hNat2Integral (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> (<span class="dt">HLength</span> (<span class="dt">DOne</span> <span class="ch">': ones)))))</span> | |
| <span class="co">-- | zero matrix. The size and dimension is determined by the type.</span> | |
| <span class="ot">zeroes ::</span> forall c a r e<span class="fu">.</span> (<span class="dt">H.Field</span> e, | |
| <span class="dt">HNat2Integral</span> (<span class="dt">HLength</span> (a <span class="ch">': r)),</span> | |
| <span class="dt">HNat2Integral</span> (<span class="dt">HLength</span> (<span class="dt">DOne</span> <span class="ch">': c)))</span> | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[r, c]) e | |
| zeroes <span class="fu">=</span> <span class="dt">DMat</span> (H.konst <span class="dv">0</span> | |
| (hNat2Integral (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> (<span class="dt">HLength</span> (a <span class="ch">': r))),</span> | |
| hNat2Integral (<span class="dt">Proxy</span><span class="ot"> ::</span> <span class="dt">Proxy</span> (<span class="dt">HLength</span> (<span class="dt">DOne</span> <span class="ch">': c)))))</span> | |
| <span class="kw">type</span> family <span class="dt">CanAddConst</span> (<span class="ot">a ::</span> k) (<span class="ot">m ::</span> [[k]])<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">CanAddConst</span> a [as, ones] <span class="fu">=</span> (<span class="dt">AllEq</span> a as, <span class="dt">AllEq</span> <span class="ch">'[] ones)</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">CanAddConst</span> a <span class="ch">'[as] = (AllEq a as)</span> | |
| <span class="ot">addConstant ::</span> (<span class="dt">H.Field</span> e, <span class="dt">CanAddConst</span> a sh) | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[]) e | |
| <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, sh) e</span> | |
| <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, sh) e</span> | |
| addConstant (<span class="dt">DScal</span> a) (<span class="dt">DMat</span> b) <span class="fu">=</span> <span class="dt">DMat</span> (H.addConstant a b) | |
| addConstant (<span class="dt">DScal</span> a) (<span class="dt">DVec</span> b) <span class="fu">=</span> <span class="dt">DVec</span> (H.addConstant a b) | |
| <span class="ot">conj ::</span> <span class="dt">D</span> sh a <span class="ot">-></span> <span class="dt">D</span> sh a | |
| conj (<span class="dt">DMat</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.conj a) | |
| conj (<span class="dt">DVec</span> a) <span class="fu">=</span> <span class="dt">DVec</span> (H.conj a) | |
| <span class="co">-- | conjugate transpose</span> | |
| ctrans x <span class="fu">=</span> conj <span class="fu">.</span> trans <span class="fu">$</span> x | |
| <span class="ot">diag ::</span> (<span class="dt">MapConst</span> <span class="dt">DOne</span> r <span class="fu">~</span> c, <span class="dt">SameLength</span> r c) | |
| <span class="ot">=></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[r]) t <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, '</span>[r,c]) t | |
| diag (<span class="dt">DVec</span> a) <span class="fu">=</span> <span class="dt">DMat</span> (H.diag a) | |
| <span class="st">#if MIN_VERSION_hmatrix(0,15,0)</span> | |
| <span class="co">-- | 'H.blockDiag'. The blocks should be provided as:</span> | |
| <span class="fu">--</span> | |
| <span class="co">-- @blockDiag $ 'hBuild' m1 m2 m3@</span> | |
| <span class="fu">--</span> | |
| <span class="co">-- only available if hmatrix >= 0.15</span> | |
| <span class="ot">diagBlock ::</span> (<span class="dt">HMapOut</span> <span class="dt">UnDimMat</span> (b <span class="ch">': bs) (H.Matrix e),</span> | |
| <span class="dt">Num</span> e, <span class="dt">H.Field</span> e, <span class="dt">AppendShOf</span> b bs (<span class="dt">D</span> <span class="ch">'(a, sh) e),</span> | |
| sh <span class="fu">~</span> <span class="ch">'[r,c])</span> | |
| <span class="ot">=></span> <span class="dt">HList</span> (b <span class="ch">': bs)</span> | |
| <span class="ot">-></span> <span class="dt">D</span> <span class="ch">'(a, sh) e</span> | |
| diagBlock pairs <span class="fu">=</span> <span class="dt">DMat</span> (H.diagBlock (hMapOut <span class="dt">UnDimMat</span> pairs)) | |
| <span class="st">#endif</span> | |
| <span class="kw">data</span> <span class="dt">UnDimMat</span> <span class="fu">=</span> <span class="dt">UnDimMat</span> | |
| <span class="kw">instance</span> (<span class="dt">D</span> sh a <span class="fu">~</span> x, <span class="dt">H.Matrix</span> a <span class="fu">~</span> y) <span class="ot">=></span> <span class="dt">ApplyAB</span> <span class="dt">UnDimMat</span> x y <span class="kw">where</span> | |
| applyAB _ (<span class="dt">DMat</span> x) <span class="fu">=</span> x | |
| <span class="kw">class</span> <span class="dt">DiagBlock</span> (<span class="ot">bs ::</span> [<span class="fu">*</span>]) t | |
| <span class="co">-- | @AppendShOf a [b,c,d] aas@ makes aas have the type of a matrix that</span> | |
| <span class="co">-- has a,b,c,d along the diagonal</span> | |
| <span class="kw">class</span> <span class="dt">AppendShOf</span> a (<span class="ot">as ::</span> [<span class="fu">*</span>]) aas | |
| <span class="kw">instance</span> | |
| (e <span class="fu">~</span> f, f <span class="fu">~</span> g, | |
| <span class="dt">AppendShOf</span> (<span class="dt">D</span> ab e) ds z, | |
| <span class="dt">AppendDims</span> a b ab, | |
| <span class="co">-- constraints to force D in the type</span> | |
| x <span class="fu">~</span> <span class="dt">D</span> a e, | |
| y <span class="fu">~</span> <span class="dt">D</span> b f, | |
| z <span class="fu">~</span> <span class="dt">D</span> c g) <span class="ot">=></span> | |
| <span class="dt">AppendShOf</span> x (y <span class="ch">': ds) z </span> | |
| <span class="kw">instance</span> (x <span class="fu">~</span> z) <span class="ot">=></span> <span class="dt">AppendShOf</span> x <span class="ch">'[] z</span> | |
| <span class="kw">type</span> family <span class="dt">AppendDims</span> (<span class="ot">a ::</span> (<span class="fu">*</span>, [[<span class="fu">*</span>]])) (<span class="ot">b ::</span> (<span class="fu">*</span>, [[<span class="fu">*</span>]])) (<span class="ot">c ::</span> (<span class="fu">*</span>, [[<span class="fu">*</span>]]))<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">AppendDims</span> <span class="ch">'(a, [ra,ca]) '</span>(b, [rb,cb]) <span class="ch">'(c, [rc,cc])</span> | |
| <span class="fu">=</span> (c <span class="fu">~</span> a, <span class="dt">AppendEq</span> ra (b <span class="ch">': rb) rc, AppendEq ca cb cc)</span> | |
| <span class="co">-- how to handle vectors?</span> | |
| <span class="co">--type instance AppendDims '(a, '[ra]) '(b, '[rb]) = '(a, '[HAppendR ra (b ': rb)])</span> | |
| <span class="kw">class</span> <span class="dt">ToHList</span> sh e result <span class="kw">where</span> | |
| <span class="ot"> toHList ::</span> <span class="dt">D</span> sh e <span class="ot">-></span> <span class="dt">HList</span> result | |
| <span class="co">-- | given a vector like @x = DimMat '[units] e@ this does something like</span> | |
| <span class="co">-- @[ (x \@> i) | i <- [1 .. n] ]@, if we had comprehensions for HLists</span> | |
| <span class="kw">instance</span> | |
| (<span class="dt">HListFromList</span> e e1, | |
| <span class="dt">SameLength</span> result e1, | |
| <span class="dt">HMapAux</span> <span class="dt">AddDimensional</span> e1 result, | |
| <span class="dt">ToHListRow</span> (r <span class="ch">': rs) e result) =></span> | |
| <span class="dt">ToHList</span> <span class="ch">'(r, '</span>[rs]) e result <span class="kw">where</span> | |
| toHList (<span class="dt">DVec</span> v) <span class="fu">=</span> <span class="kw">case</span> hListFromList (H.toList v)<span class="ot"> ::</span> <span class="dt">HList</span> e1 <span class="kw">of</span> | |
| e1 <span class="ot">-></span> hMap <span class="dt">AddDimensional</span> e1 | |
| <span class="kw">class</span> <span class="dt">HListFromList</span> e e' <span class="kw">where</span> | |
| <span class="ot"> hListFromList ::</span> [e] <span class="ot">-></span> <span class="dt">HList</span> e' | |
| <span class="kw">instance</span> <span class="dt">HListFromList</span> e <span class="ch">'[] where</span> | |
| hListFromList _ <span class="fu">=</span> <span class="dt">HNil</span> | |
| <span class="kw">instance</span> (e <span class="fu">~</span> e', <span class="dt">HListFromList</span> e es) <span class="ot">=></span> <span class="dt">HListFromList</span> e (e' <span class="ch">': es) where</span> | |
| hListFromList (e <span class="fu">:</span> es) <span class="fu">=</span> e <span class="ot">`HCons`</span> hListFromList es | |
| <span class="kw">type</span> family <span class="dt">ToHListRow</span> (<span class="ot">a ::</span> [<span class="fu">*</span>]) e (<span class="ot">b ::</span> [<span class="fu">*</span>])<span class="ot"> ::</span> <span class="dt">Constraint</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">ToHListRow</span> (a <span class="ch">': as) e (b '</span><span class="fu">:</span> bs) <span class="fu">=</span> (<span class="dt">Quantity</span> a e <span class="fu">~</span> b, <span class="dt">ToHListRow</span> as e bs) | |
| <span class="kw">data</span> <span class="dt">AddDimensional</span> <span class="fu">=</span> <span class="dt">AddDimensional</span> | |
| <span class="kw">instance</span> (<span class="dt">Quantity</span> t x <span class="fu">~</span> y) <span class="ot">=></span> <span class="dt">ApplyAB</span> <span class="dt">AddDimensional</span> x y <span class="kw">where</span> | |
| applyAB _ x <span class="fu">=</span> <span class="dt">Dimensional</span> x | |
| <span class="kw">class</span> <span class="dt">FromHList</span> list sh e <span class="kw">where</span> | |
| <span class="ot"> fromHList ::</span> <span class="dt">HList</span> list <span class="ot">-></span> <span class="dt">D</span> sh e | |
| <span class="kw">instance</span> | |
| (<span class="dt">H.Field</span> e, | |
| <span class="dt">HMapOut</span> <span class="dt">RmDimensional</span> list e, | |
| <span class="dt">ToHListRow</span> (r <span class="ch">': rs) e list) =></span> | |
| <span class="dt">FromHList</span> list <span class="ch">'(r, '</span>[rs]) e <span class="kw">where</span> | |
| fromHList xs <span class="fu">=</span> <span class="dt">DVec</span> (H.fromList (hMapOut <span class="dt">RmDimensional</span> xs)) | |
| <span class="kw">data</span> <span class="dt">RmDimensional</span> <span class="fu">=</span> <span class="dt">RmDimensional</span> | |
| <span class="kw">instance</span> (x <span class="fu">~</span> <span class="dt">Quantity</span> d y) <span class="ot">=></span> <span class="dt">ApplyAB</span> <span class="dt">RmDimensional</span> x y <span class="kw">where</span> | |
| applyAB _ (<span class="dt">Dimensional</span> a) <span class="fu">=</span> a | |
| <span class="kw">class</span> <span class="dt">FromHLists</span> lists sh e <span class="kw">where</span> | |
| <span class="ot"> fromHLists ::</span> <span class="dt">HList</span> lists <span class="ot">-></span> <span class="dt">D</span> sh e | |
| <span class="co">-- | [[Dim e unit]] -> DimMat units e</span> | |
| <span class="kw">instance</span> | |
| (<span class="dt">ToHListRows'</span> (r1 <span class="ch">': r) c e lists,</span> | |
| <span class="dt">HMapOut</span> (<span class="dt">HMapOutWith</span> <span class="dt">RmDimensional</span>) lists [e], | |
| <span class="dt">H.Field</span> e) <span class="ot">=></span> | |
| <span class="dt">FromHLists</span> lists <span class="ch">'(r1, [r,c]) e where</span> | |
| fromHLists xs <span class="fu">=</span> <span class="dt">DMat</span> (H.fromLists (hMapOut (<span class="dt">HMapOutWith</span> <span class="dt">RmDimensional</span>) xs)) | |
| <span class="kw">newtype</span> <span class="dt">HMapOutWith</span> f <span class="fu">=</span> <span class="dt">HMapOutWith</span> f | |
| <span class="kw">instance</span> (<span class="dt">HMapOut</span> f l e, es <span class="fu">~</span> [e], <span class="dt">HList</span> l <span class="fu">~</span> hl) <span class="ot">=></span> <span class="dt">ApplyAB</span> (<span class="dt">HMapOutWith</span> f) hl es <span class="kw">where</span> | |
| applyAB (<span class="dt">HMapOutWith</span> f) <span class="fu">=</span> hMapOut f | |
| <span class="kw">class</span> <span class="dt">ToHListRows'</span> (<span class="ot">r ::</span> [<span class="fu">*</span>]) (<span class="ot">c ::</span> [<span class="fu">*</span>]) (<span class="ot">e ::</span> <span class="fu">*</span>) (<span class="ot">rows ::</span> [<span class="fu">*</span>]) | |
| <span class="kw">instance</span> <span class="dt">ToHListRows'</span> <span class="ch">'[] c e '</span>[] | |
| <span class="kw">instance</span> (<span class="dt">ToHListRows'</span> r c e rows, | |
| <span class="dt">MultEq</span> r c c', | |
| <span class="dt">HMapCxt</span> (<span class="dt">AddQty</span> e) (<span class="dt">HList</span> c') hListRow c' row') | |
| <span class="ot">=></span> <span class="dt">ToHListRows'</span> (r1 <span class="ch">': r) c e (hListRow '</span><span class="fu">:</span> rows) | |
| <span class="kw">data</span> <span class="dt">AddQty</span> u | |
| <span class="kw">instance</span> (qty <span class="fu">~</span> <span class="dt">Quantity</span> u e) <span class="ot">=></span> <span class="dt">ApplyAB</span> (<span class="dt">AddQty</span> u) e qty | |
| <span class="kw">class</span> <span class="dt">ToHLists</span> sh e xs <span class="kw">where</span> | |
| <span class="ot"> toHLists ::</span> <span class="dt">D</span> sh e <span class="ot">-></span> <span class="dt">HList</span> xs | |
| <span class="co">-- | DimMat units e -> [[Dim e unit]]</span> | |
| <span class="kw">instance</span> | |
| (<span class="dt">HListFromList</span> e e1, | |
| <span class="dt">HListFromList</span> (<span class="dt">HList</span> e1) e2, | |
| <span class="dt">HMapAux</span> (<span class="dt">HMap</span> <span class="dt">AddDimensional</span>) e2 xs, | |
| <span class="dt">ToHListRows'</span> ri ci e xs, | |
| <span class="dt">SameLength</span> e2 xs, | |
| (r1 <span class="ch">': r) ~ ri, (DOne '</span><span class="fu">:</span> c) <span class="fu">~</span> ci ) | |
| <span class="ot">=></span> <span class="dt">ToHLists</span> <span class="ch">'(r1, [r,c]) e xs where</span> | |
| toHLists (<span class="dt">DMat</span> m) <span class="fu">=</span> <span class="kw">case</span> hListFromList (map hListFromList (H.toLists m)<span class="ot"> ::</span> [<span class="dt">HList</span> e1])<span class="ot"> ::</span> <span class="dt">HList</span> e2 <span class="kw">of</span> | |
| e2 <span class="ot">-></span> hMap (<span class="dt">HMap</span> <span class="dt">AddDimensional</span>) e2 | |
| <span class="co">{- still bad</span> | |
| <span class="co">class PairsToList a t where</span> | |
| <span class="co"> pairsToList :: a -> [H.Matrix t]</span> | |
| <span class="co">instance PairsToList () t where</span> | |
| <span class="co"> pairsToList _ = []</span> | |
| <span class="co">instance (PairsToList b t, t' ~ t) => PairsToList (DimMat sh t',b) t where</span> | |
| <span class="co"> pairsToList (DimMat a,b) = a : pairsToList b</span> | |
| <span class="co">class EigV (sh :: [[ [DimSpec *] ]])</span> | |
| <span class="co"> (eigenValue :: [[DimSpec *]])</span> | |
| <span class="co"> (eigenVector :: [[[DimSpec *]]])</span> | |
| <span class="co">instance</span> | |
| <span class="co"> ( SameLengths [r,c,r',c',rinv,cinv,eigval,erinv],</span> | |
| <span class="co"> -- ZipWithMul r c eigval,</span> | |
| <span class="co"> MapConst '[] r ~ eigval,</span> | |
| <span class="co"> PInv [r',c'] [rinv,cinv],</span> | |
| <span class="co"> -- AreRecips r' cinv,</span> | |
| <span class="co"> -- AreRecips c' rinv,</span> | |
| <span class="co"> cinv ~ c,</span> | |
| <span class="co"> c ~ ('[] ': _1),</span> | |
| <span class="co"> c' ~ ('[] ': _2),</span> | |
| <span class="co"> ZipWithMul eigval rinv erinv,</span> | |
| <span class="co"> MultiplyCxt [r',c'] erinv r,</span> | |
| <span class="co"> sh ~ [r,c],</span> | |
| <span class="co"> sh' ~ [r',c'])</span> | |
| <span class="co"> => EigV sh eigval sh'</span> | |
| <span class="co">-- | when no eigenvectors are needed</span> | |
| <span class="co">type family EigE (sh :: [[ [DimSpec *] ]]) (eigenValue :: [ [DimSpec *] ]) :: Constraint</span> | |
| <span class="co">type instance EigE [r,c] eigval = ( SameLengths [r,c,eigval], ZipWithMul r c eigval)</span> | |
| <span class="co">{- $eigs</span> | |
| <span class="co">The Hmatrix eig factors A into P and D where A = P D inv(P) and D is diagonal.</span> | |
| <span class="co">The units for eigenvalues can be figured out:</span> | |
| <span class="co">> _____</span> | |
| <span class="co">> -1 | c</span> | |
| <span class="co">> P D P = A = |r</span> | |
| <span class="co">> |</span> | |
| <span class="co">> _______</span> | |
| <span class="co">> | d</span> | |
| <span class="co">> P = |c</span> | |
| <span class="co">> |</span> | |
| <span class="co">> _______</span> | |
| <span class="co">> | -1</span> | |
| <span class="co">> | c</span> | |
| <span class="co">> -1 | </span> | |
| <span class="co">> P = | -1</span> | |
| <span class="co">> |d</span> | |
| <span class="co">So we can see that the dimension labeled `d-1` in P inverse is actually the</span> | |
| <span class="co">same `c` in `A`. The actual units of `d` don't seem to matter because the</span> | |
| <span class="co">`inv(d)` un-does any units that the `d` adds. So `d` can be all DOne. But</span> | |
| <span class="co">another choice, such as 1/c would be more appropriate, since then you can</span> | |
| <span class="co">expm your eigenvectors (not that that seems to be something people do)?</span> | |
| <span class="co">To get the row-units of A to match up, sometimes `D` will have units. </span> | |
| <span class="co">The equation ends up as D/c = r</span> | |
| <span class="co">Please ignore the type signatures on 'eig' 'eigC' etc. instead look at the type of</span> | |
| <span class="co">'wrapEig' 'wrapEigOnly' together with the hmatrix documentation (linked).</span> | |
| <span class="co">Perhaps the convenience definitions `eig m = wrapEig H.eig m` should be in</span> | |
| <span class="co">another module.</span> | |
| <span class="co">-}</span> | |
| <span class="co">{-</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eig'</span> | |
| <span class="co">eig m = wrapEig H.eig m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigC'</span> | |
| <span class="co">eigC m = wrapEig H.eigC m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigH'</span> | |
| <span class="co">eigH m = wrapEig H.eigH m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigH''</span> | |
| <span class="co">eigH' m = wrapEig H.eigH' m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigR'</span> | |
| <span class="co">eigR m = wrapEig H.eigR m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigS'</span> | |
| <span class="co">eigS m = wrapEig H.eigS m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigS''</span> | |
| <span class="co">eigS' m = wrapEig H.eigS' m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigSH'</span> | |
| <span class="co">eigSH m = wrapEig H.eigSH m</span> | |
| <span class="co">-- | 'wrapEig' H.'H.eigSH''</span> | |
| <span class="co">eigSH' m = wrapEig H.eigSH' m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigOnlyC'</span> | |
| <span class="co">eigOnlyC m = wrapEigOnly H.eigOnlyC m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigOnlyH'</span> | |
| <span class="co">eigOnlyH m = wrapEigOnly H.eigOnlyH m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigOnlyR'</span> | |
| <span class="co">eigOnlyR m = wrapEigOnly H.eigOnlyR m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigOnlyS'</span> | |
| <span class="co">eigOnlyS m = wrapEigOnly H.eigOnlyS m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigenvalues'</span> | |
| <span class="co">eigenvalues m = wrapEigOnly H.eigenvalues m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigenvaluesSH'</span> | |
| <span class="co">eigenvaluesSH m = wrapEigOnly H.eigenvaluesSH m</span> | |
| <span class="co">-- | 'wrapEigOnly' H.'H.eigenvaluesSH''</span> | |
| <span class="co">eigenvaluesSH' m = wrapEigOnly H.eigenvaluesSH' m</span> | |
| <span class="co">-}</span> | |
| <span class="ot">wrapEig ::</span> (c' <span class="fu">~</span> (<span class="ch">'[] '</span><span class="fu">:</span> _1), | |
| <span class="dt">EigV</span> [r,c] eigVal [r',c'], | |
| <span class="dt">H.Field</span> y, <span class="dt">H.Field</span> z) | |
| <span class="ot">=></span> (<span class="dt">H.Matrix</span> x <span class="ot">-></span> (<span class="dt">H.Vector</span> y, <span class="dt">H.Matrix</span> z)) <span class="ot">-></span> | |
| <span class="dt">DimMat</span> [r,c] x <span class="ot">-></span> | |
| (<span class="dt">DimMat</span> <span class="ch">'[eigVal] y, DimMat [r'</span>,c'] z) | |
| wrapEig hmatrixFun (<span class="dt">DimMat</span> a) <span class="fu">=</span> <span class="kw">case</span> hmatrixFun a <span class="kw">of</span> | |
| (e,v) <span class="ot">-></span> (<span class="dt">DimVec</span> e, <span class="dt">DimMat</span> v) | |
| <span class="ot">wrapEigOnly ::</span> (<span class="dt">EigE</span> [r,c] eigVal, <span class="dt">H.Field</span> y) | |
| <span class="ot">=></span> (<span class="dt">H.Matrix</span> x <span class="ot">-></span> <span class="dt">H.Vector</span> y) <span class="ot">-></span> | |
| <span class="dt">DimMat</span> [r,c] x <span class="ot">-></span> <span class="dt">DimMat</span> <span class="ch">'[eigVal] y</span> | |
| wrapEigOnly hmatrixFun (<span class="dt">DimMat</span> a) <span class="fu">=</span> <span class="kw">case</span> hmatrixFun a <span class="kw">of</span> | |
| (e) <span class="ot">-></span> <span class="dt">DimVec</span> e | |
| <span class="fu">-</span>} | |
| <span class="co">-- | @\\a xs -> map (map (const a)) xs@</span> | |
| <span class="kw">type</span> family <span class="dt">MapMapConst</span> (<span class="ot">a::</span>k) (<span class="ot">xs ::</span> [[l]])<span class="ot"> ::</span> [[k]] | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">MapMapConst</span> a (x <span class="ch">': xs) = MapConst a x '</span><span class="fu">:</span> <span class="dt">MapMapConst</span> a xs | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">MapMapConst</span> a <span class="ch">'[] = '</span>[] | |
| <span class="co">-- | @\\a xs -> map (const a) xs@</span> | |
| <span class="kw">type</span> family <span class="dt">MapConst</span> (<span class="ot">a ::</span> k) (<span class="ot">xs ::</span> [l])<span class="ot"> ::</span> [k] | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">MapConst</span> a (x <span class="ch">': xs) = a '</span><span class="fu">:</span> <span class="dt">MapConst</span> a xs | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">MapConst</span> a <span class="ch">'[] = '</span>[] | |
| <span class="co">-- | convert from (a,(b,(c,(d,())))) to '[a,b,c,d]</span> | |
| <span class="kw">type</span> family <span class="dt">FromPairs</span> (<span class="ot">a ::</span> <span class="fu">*</span>)<span class="ot"> ::</span> [<span class="fu">*</span>] | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">FromPairs</span> (a,b) <span class="fu">=</span> a <span class="ch">': FromPairs b</span> | |
| <span class="kw">type</span> <span class="kw">instance</span> <span class="dt">FromPairs</span> () <span class="fu">=</span> <span class="ch">'[]</span> | |
| <span class="co">{-</span> | |
| <span class="co">-- | @map fst@</span> | |
| <span class="co">type family MapFst (a :: *) :: [*]</span> | |
| <span class="co">type instance MapFst ((a,_t) , as) = a ': MapFst as</span> | |
| <span class="co">type instance MapFst () = '[]</span> | |
| <span class="co">-- | @\\a xs -> map (/a) xs@</span> | |
| <span class="co">type family MapDiv (a :: k) (xs :: [k]) :: [k]</span> | |
| <span class="co">type instance MapDiv a (x ': xs) = (x @- a) ': MapDiv a xs</span> | |
| <span class="co">type instance MapDiv a '[] = '[]</span> | |
| <span class="co">type family UnDQuantity (a :: [*]) :: [ [*] ]</span> | |
| <span class="co">type instance UnDQuantity (x ': xs) = UnDQuantity1 x ': UnDQuantity xs</span> | |
| <span class="co">type instance UnDQuantity '[] = '[]</span> | |
| <span class="co">type family UnDQuantity1 (a :: *) :: [*] </span> | |
| <span class="co">type instance UnDQuantity1 (Unit t x) = x</span> | |
| <span class="co">type family DimMatFromTuple ijs :: * -> *</span> | |
| <span class="co">type instance DimMatFromTuple ijs =</span> | |
| <span class="co"> DimMat [UnDQuantity (MapFst ijs),</span> | |
| <span class="co"> '[] ': MapDiv (UnDQuantity1 (Fst (Fst ijs)))</span> | |
| <span class="co"> (UnDQuantity (FromPairs (Snd (Fst ijs))))]</span> | |
| <span class="co">type family Append (a :: [k]) (b :: [k]) :: [k]</span> | |
| <span class="co">type instance Append (a ': as) b = a ': Append as b</span> | |
| <span class="co">type instance Append '[] b = b</span> | |
| <span class="co">-}</span></code></pre> | |
| </body> | |
| </html> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment