diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,22 @@ +Changelog +========= + +Version 0.1.0.1 +--------------- + +*Aug 17, 2017* + + + +* Removed `Num` instance in the examples file, to account for + *vector-sized*'s new `Num` instances. +* COMPLETE pragmas for examples file. + +Version 0.1.0.0 +--------------- + +*Nov 27, 2016* + + + +* Initial release. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,11 @@ Hamilton ======== +[![Build Status](https://travis-ci.org/mstksg/hamilton.svg?branch=master)](https://travis-ci.org/mstksg/hamilton) + Simulate physics on arbitrary coordinate systems using [automatic -differentiation][ad] and [Hamiltonian mechanics][]. +differentiation][ad] and [Hamiltonian mechanics][]. State only an arbitrary +parameterization of your system and a potential energy function! [ad]: http://hackage.haskell.org/package/ad [Hamiltonian mechanics]: https://en.wikipedia.org/wiki/Hamiltonian_mechanics @@ -62,10 +65,13 @@ [WRH]: https://www.youtube.com/watch?v=SZXHoWwBcDc -See [documentation][] and [example runner][]. +See a [blog post][] I wrote on this, and also the [hackage documentation][] and the +[example runner user guide][user guide] (and its [source][example runner]). -[documentation]: https://mstksg.github.io/hamilton/ +[blog post]: https://blog.jle.im/entry/introducing-the-hamilton-library.html +[hackage documentation]: http://hackage.haskell.org/package/hamilton [example runner]: https://github.com/mstksg/hamilton/blob/master/app/Examples.hs +[user guide]: https://github.com/mstksg/hamilton#example-app-runner ### Full Exmaple @@ -95,6 +101,18 @@ => V.Vector 4 a -> a potential (V4 _ y1 _ y2) = (y1 + 2 * y2) * 5 + + +-- some helper patterns to pattern match on sized vectors +pattern V2 :: a -> a -> V.Vector 2 a +pattern V2 x y <- (V.toList->[x,y]) + where + V2 x y = fromJust (V.fromList [x,y]) + +pattern V4 :: a -> a -> a -> a -> V.Vector 4 a +pattern V4 x y z a <- (V.toList->[x,y,z,a]) + where + V4 x y z a = fromJust (V.fromList [x,y,z,a]) ~~~ Neat! Easy, right? @@ -136,12 +154,12 @@ ~~~haskell positions :: [R 2] -positions = phsPos <$> evolution +positions = phsPositions <$> evolution ~~~ And the position in the underlying cartesian space as: -~~~hakell +~~~haskell positions' :: [R 4] positions' = underlyingPos doublePendulum <$> positions ~~~ @@ -149,6 +167,8 @@ Example App runner ------------------ +*([Source][example runner])* + Installation: ~~~bash @@ -212,16 +232,61 @@ And...that's all you need! -Here is the actual code for the two-body system: +Here is the actual code for the two-body system, assuming `m1` is `100` and +`m2` is `1`: ~~~haskell twoBody :: System 4 2 -twoBody = - mkSystem (vec4 m1 m1 m2 m2) -- masses - (\(V2 r θ) -> let r1 = r * m2 / (m1 + m2) - r2 = - r * m1 / (m1 + m2) - in V4 (r1 * cos θ) (r1 * sin θ) - (r2 * cos θ) (r2 * sin θ) - ) -- coordinates - (\(V2 r _) -> - m1 * m2 / r) -- potential +twoBody = mkSystem masses coordinates potential + where + masses :: R 4 + masses = vec4 100 100 1 1 + coordinates + :: Floating a + => V.Vector 2 a + -> V.Vector 4 a + coordinates (V2 r θ) = V4 (r1 * cos θ) (r1 * sin θ) + (r2 * cos θ) (r2 * sin θ) + where + r1 = r * 1 / 101 + r2 = - r * 100 / 101 + potential + :: Num a + => V.Vector 4 a + -> a + potential (V2 r _) = - 100 / r ~~~ + +Potential improvements +---------------------- + +* **Time-dependent systems**: Shouldn't be an problem in theory/math; just + add a time parameter before all of the functions. This opens a lot of + doors, like deriving inertial forces for free (like the famous Coriolis + force and centrifugal force). + + The only thing is that it makes the API pretty inconvenient, because it'd + require all of the functions to also take a time parameter. Of course, the + easy way out/ugly solution would be to just offer two versions of the same + function (one for time-independent systems and one for time-dependent + systems. But this is un-ideal. + +* Velocity-dependent potentials: Would give us the ability to model systems + with velocity-dependent Lagrangians like a charged particle in an + electromagnetic field, and also dissipative systems, like systems with + friction (dependent on `signum v`) and linear & quadratic wind resistance. + + This issue is much harder, theoretically. It involves inverting arbitrary + functions `forall a. RealFloat a => V.Vector n a -> V.Vector m a`. It + might be possible with the help of some + [bidirectionalization techniques][bff-pearl], but I can't get the [bff][] + package to compile, and I'm not sure how to get [bff-mono][] to work with + numeric functions. + + If anyone is familiar with bidirectionalization techniques and is willing + to help out, please send me a message or open an issue! :) + +[bff-pearl]: https://pdfs.semanticscholar.org/5f0d/ef02dbd96e102be9104d2ceb728d2a2a5beb.pdf +[bff]: http://hackage.haskell.org/package/bff +[bff-mono]: http://hackage.haskell.org/package/bff-mono + diff --git a/app/Examples.hs b/app/Examples.hs --- a/app/Examples.hs +++ b/app/Examples.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} @@ -146,7 +147,7 @@ bezier :: forall n. KnownNat n - => V.Vector (n + 1) (V2 Double) + => V.Vector (1 + n) (V2 Double) -> SysExample bezier ps = SE "Bezier" (V1 "t") s f (toPhase s c0) where @@ -444,11 +445,11 @@ where x = round $ (pX - xmin) * (wd' / xrange) y = round $ (pY - ymin) * (ht' / yrange) - place aX aY (scale->(V2 pX pY)) i - = translate (fAlign aX (imageWidth i)) - (fAlign aY (imageHeight i)) - . translate pX pY - $ i + place aX aY p i = case scale p of + V2 pX pY -> translate (fAlign aX (imageWidth i)) + (fAlign aY (imageHeight i)) + . translate pX pY + $ i labels = [ place LT EQ (V2 xmin 0) . string defAttr $ printf "%.2f" xmin , place GT EQ (V2 xmax 0) . string defAttr $ printf "%.2f" xmax , place EQ LT (V2 0 ymin) . string defAttr $ printf "%.2f" ymin @@ -479,22 +480,34 @@ pattern V1 x <- (V.head->x) where V1 x = V.singleton x +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE V1 #-} +#endif type V2 = V.Vector 2 pattern V2 :: a -> a -> V2 a pattern V2 x y <- (V.toList->[x,y]) where V2 x y = fromJust (V.fromList [x,y]) +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE V2 #-} +#endif pattern V3 :: a -> a -> a -> V.Vector 3 a pattern V3 x y z <- (V.toList->[x,y,z]) where V3 x y z = fromJust (V.fromList [x,y,z]) +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE V3 #-} +#endif pattern V4 :: a -> a -> a -> a -> V.Vector 4 a pattern V4 x y z a <- (V.toList->[x,y,z,a]) where V4 x y z a = fromJust (V.fromList [x,y,z,a]) +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE V4 #-} +#endif r2list :: KnownNat n @@ -517,7 +530,7 @@ bezierCurve :: forall n f a. (KnownNat n, Applicative f, Num a) - => V.Vector (n + 1) (f a) + => V.Vector (1 + n) (f a) -> a -> f a bezierCurve ps t = @@ -531,20 +544,6 @@ n `choose` k = factorial n `div` (factorial (n - k) * factorial k) factorial :: Int -> Int factorial m = product [1..m] - -instance (KnownNat n, Num a) => Num (V.Vector n a) where - (+) = liftA2 (+) - (-) = liftA2 (-) - (*) = liftA2 (*) - negate = fmap negate - abs = fmap abs - signum = fmap signum - fromInteger = pure . fromInteger - -instance (KnownNat n, Fractional a) => Fractional (V.Vector n a) where - (/) = liftA2 (/) - recip = fmap recip - fromRational = pure . fromRational deriving instance Ord Color diff --git a/hamilton.cabal b/hamilton.cabal --- a/hamilton.cabal +++ b/hamilton.cabal @@ -1,5 +1,5 @@ name: hamilton -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Physics on generalized coordinate systems using Hamiltonian Mechanics and AD description: See README.md (or read online at ) homepage: https://github.com/mstksg/hamilton @@ -10,35 +10,37 @@ copyright: (c) Justin Le 2016 category: Physics build-type: Simple -extra-source-files: README.md +extra-source-files: README.md, CHANGELOG.md cabal-version: >=1.10 +tested-with: GHC == 8.0.2 + , GHC == 8.2.1 library hs-source-dirs: src exposed-modules: Numeric.Hamilton - build-depends: base >= 4.7 && < 5 + build-depends: base >= 4.9 && < 5 , ad , comonad , free , hmatrix >= 0.18 , hmatrix-gsl >= 0.18 , typelits-witnesses - , vector-sized >= 0.4.1 - ghc-options: -Wall + , vector-sized >= 0.6 + ghc-options: -Wall -O2 default-language: Haskell2010 executable hamilton-examples hs-source-dirs: app main-is: Examples.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - build-depends: base + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2 + build-depends: base >= 4.9 , ansi-wl-pprint , containers , hamilton - , hmatrix + , hmatrix >= 0.18 , optparse-applicative >= 0.13 , vector - , vector-sized + , vector-sized >= 0.6 , vty default-language: Haskell2010