linear 1.20.9 → 1.23.3
raw patch · 40 files changed
Files
- .hlint.yaml +7/−0
- .travis.yml +0/−172
- CHANGELOG.markdown +101/−0
- README.markdown +1/−1
- Setup.lhs +5/−32
- Warning.hs +0/−5
- linear.cabal +54/−61
- src/Linear.hs +0/−2
- src/Linear/Affine.hs +20/−61
- src/Linear/Algebra.hs +0/−3
- src/Linear/Binary.hs +0/−9
- src/Linear/Conjugate.hs +4/−3
- src/Linear/Covector.hs +3/−1
- src/Linear/Instances.hs +2/−16
- src/Linear/Matrix.hs +329/−18
- src/Linear/Metric.hs +15/−3
- src/Linear/Plucker.hs +96/−64
- src/Linear/Projection.hs +4/−3
- src/Linear/Quaternion.hs +65/−57
- src/Linear/Trace.hs +9/−11
- src/Linear/V.hs +68/−107
- src/Linear/V0.hs +46/−65
- src/Linear/V1.hs +54/−66
- src/Linear/V2.hs +62/−61
- src/Linear/V3.hs +59/−61
- src/Linear/V4.hs +62/−60
- src/Linear/Vector.hs +42/−28
- tests/Binary.hs +0/−23
- tests/Plucker.hs +0/−35
- tests/Prop/Quaternion.hs +28/−0
- tests/Prop/V3.hs +8/−0
- tests/Test.hs +24/−0
- tests/Unit/Binary.hs +20/−0
- tests/Unit/Plucker.hs +36/−0
- tests/Unit/V.hs +14/−0
- tests/UnitTests.hs +0/−20
- tests/V.hs +0/−13
- tests/doctests.hs +5/−11
- travis/cabal-apt-install +0/−27
- travis/config +0/−16
+ .hlint.yaml view
@@ -0,0 +1,7 @@+- arguments: [-XCPP]++- ignore: {name: Use fmap}+- ignore: {name: Avoid lambda}+- ignore: {name: Redundant lambda}+- ignore: {name: Unused LANGUAGE pragma}+- ignore: {name: Eta reduce, within: [Linear.Plucker, Linear.Quaternion, Linear.V, Linear.V0, Linear.V1, Linear.V2, Linear.V3, Linear.V4]}
− .travis.yml
@@ -1,172 +0,0 @@-# This Travis job script has been generated by a script via-#-# haskell-ci '--output=.travis.yml' '--config=cabal.haskell-ci' 'cabal.project'-#-# For more information, see https://github.com/haskell-CI/haskell-ci-#-# version: 0.3.20190425-#-language: c-dist: xenial-git:- # whether to recursively clone submodules- submodules: false-notifications:- irc:- channels:- - irc.freenode.org#haskell-lens- skip_join: true- template:- - "\"\\x0313linear\\x03/\\x0306%{branch}\\x03 \\x0314%{commit}\\x03 %{build_url} %{message}\""-cache:- directories:- - $HOME/.cabal/packages- - $HOME/.cabal/store-before_cache:- - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log- # remove files that are regenerated by 'cabal update'- - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*- - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json- - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache- - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar- - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx- - rm -rfv $CABALHOME/packages/head.hackage-matrix:- include:- - compiler: ghc-8.8.1- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}- env: GHCHEAD=true- - compiler: ghc-8.6.5- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}- - compiler: ghc-8.4.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}- - compiler: ghc-8.2.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}- - compiler: ghc-8.0.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}- - compiler: ghc-7.10.3- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}- - compiler: ghc-7.8.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}- - compiler: ghc-7.6.3- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-2.4"]}}- - compiler: ghc-7.4.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-2.4"]}}- - compiler: ghc-head- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}}- env: GHCHEAD=true- allow_failures:- - compiler: ghc-head- - compiler: ghc-8.8.1-before_install:- - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')- - HCPKG="$HC-pkg"- - unset CC- - CABAL=/opt/ghc/bin/cabal- - CABALHOME=$HOME/.cabal- - export PATH="$CABALHOME/bin:$PATH"- - TOP=$(pwd)- - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))- - echo $HCNUMVER- - CABAL="$CABAL -vnormal+nowrap+markoutput"- - set -o pipefail- - |- echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk- echo 'BEGIN { state = "output"; }' >> .colorful.awk- echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk- echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk- echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk- echo ' if (state == "cabal") {' >> .colorful.awk- echo ' print blue($0)' >> .colorful.awk- echo ' } else {' >> .colorful.awk- echo ' print $0' >> .colorful.awk- echo ' }' >> .colorful.awk- echo '}' >> .colorful.awk- - cat .colorful.awk- - |- color_cabal_output () {- awk -f $TOP/.colorful.awk- }- - echo text | color_cabal_output-install:- - ${CABAL} --version- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"- - TEST=--enable-tests- - BENCH=--enable-benchmarks- - GHCHEAD=${GHCHEAD-false}- - rm -f $CABALHOME/config- - |- echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config- echo "remote-build-reporting: anonymous" >> $CABALHOME/config- echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config- echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config- echo "world-file: $CABALHOME/world" >> $CABALHOME/config- echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config- echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config- echo "installdir: $CABALHOME/bin" >> $CABALHOME/config- echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config- echo "store-dir: $CABALHOME/store" >> $CABALHOME/config- echo "install-dirs user" >> $CABALHOME/config- echo " prefix: $CABALHOME" >> $CABALHOME/config- echo "repository hackage.haskell.org" >> $CABALHOME/config- echo " url: http://hackage.haskell.org/" >> $CABALHOME/config- - |- if $GHCHEAD; then- echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config- - echo "repository head.hackage" >> $CABALHOME/config- echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config- echo " secure: True" >> $CABALHOME/config- echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config- echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config- echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config- echo " key-threshold: 3" >> $CABALHOME/config- fi- - cat $CABALHOME/config- - rm -fv cabal.project cabal.project.local cabal.project.freeze- - travis_retry ${CABAL} v2-update -v- # Generate cabal.project- - rm -rf cabal.project cabal.project.local cabal.project.freeze- - touch cabal.project- - |- echo 'packages: "."' >> cabal.project- - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(linear)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"- - cat cabal.project || true- - cat cabal.project.local || true- - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi- - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output- - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"- - rm cabal.project.freeze- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output-script:- - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)- # Packaging...- - ${CABAL} v2-sdist all | color_cabal_output- # Unpacking...- - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/- - cd ${DISTDIR} || false- - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;- # Generate cabal.project- - rm -rf cabal.project cabal.project.local cabal.project.freeze- - touch cabal.project- - |- echo 'packages: "linear-*/*.cabal"' >> cabal.project- - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(linear)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"- - cat cabal.project || true- - cat cabal.project.local || true- # Building with tests and benchmarks...- # build & run tests, build benchmarks- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output- # Testing...- - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output- # cabal check...- - (cd linear-* && ${CABAL} -vnormal check)- # haddock...- - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output--# REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"]-# EOF
CHANGELOG.markdown view
@@ -1,3 +1,104 @@+1.23.3 [2026.01.10]+-------------------+* Remove unused `ghc-prim`, `tagged, `transformers-compat`, and `void`+ dependencies.++1.23.2 [2025.06.17]+-------------------+* Replace `test-framework` with `tasty` in the test suite.++1.23.1 [2025.03.03]+-------------------+* Add `Uniform` and `UniformRange` instances for `Plucker`, `Quaternion`, `V`,+ and `V{0,1,2,3,4}`.++1.23 [2024.04.15]+-----------------+* The direction of interpolation of `lerp` has been reversed;+ now `lerp 0 a b == a` and `lerp 1 a b == b`.+ This brings `lerp` in line not only with its implementation+ in other languages and frameworks, but also with `slerp` in this package.++1.22 [2022.11.30]+-----------------+* The types of `_Point` and `lensP` have been generalized:++ ```diff+ -_Point :: Iso' (Point f a) (f a)+ +_Point :: Iso (Point f a) (Point g b) (f a) (g b)++ -lensP :: Lens' (Point g a) (g a)+ +lensP :: Lens (Point f a) (Point g b) (f a) (g b)+ ```++ There is a chance that existing uses of `_Point` or `lensP` will fail to+ typecheck due to their more general types. You can use `_Point.simple` or+ `lensP.simple` to restore their old, more restricted types (where `simple`+ comes from `Control.Lens` in the `lens` library).++1.21.10 [2022.06.21]+--------------------+* Allow building with `vector-0.13.*`.++1.21.9 [2022.05.18]+-------------------+* Allow building with `transformers-0.6.*`.++1.21.8 [2021.11.15]+-------------------+* Allow building with `hashable-1.4.*`.+* Drop support for pre-8.0 versions of GHC.++1.21.7 [2021.09.20]+-------------------+* Fix a build error when using `random-1.2.1` or later.++1.21.6 [2021.07.05]+-------------------+* Fix a build error when configured with `-template-haskell`.++1.21.5 [2021.02.18]+-------------------+* Allow building with `lens-5.*`.++1.21.4 [2021.01.29]+-------------------+* Allow building with `vector-0.12.2` or later.+* The build-type has been changed from `Custom` to `Simple`.+ To achieve this, the `doctests` test suite has been removed in favor of using+ [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec)+ to run the doctests.++1.21.3 [2020.10.03]+-------------------+* Allow building with GHC 9.0.++1.21.2 [2020.09.30]+-------------------+* Use `base-orphans-0.8.3` or later. This means that the `Linear.Instances`+ module no longer defines any orphan instances of its own, and the module is+ now a simple shim on top of `Data.Orphans` from `base-orphans`.++1.21.1 [2020.06.25]+-------------------+* Allow building with `random-1.2.*`.++1.21 [2020.02.03]+-----------------+* Add instances for direct sums (`Product`) and tensor products (`Compose`) of+ other vector spaces. This makes is much more convenient to do things like treat+ a matrix temporarily as a vector through Compose, or to consider things like+ Gauss-Jordan elimination, which wants augmented structures.+* Add `frobenius` for computing the Frobenius norm of a matrix.+* Added `Random` instances for `System.Random`. We had an indirect dependency+ through `vector` anyways.+* Add "obvious" zipping `Semigroup` and `Monoid` instances to all the+ representable vector spaces.+* Add `R1`..`R4` instances to `Quaternion`. `_w` is the scalar component so that+ `_x`,`_y`,`_z` can be directional.+* Add more solvers to `Linear.Matrix`, available with `base-4.8` or later.+* Add `unangle` function to `Linear.V2`.+ 1.20.9 [2019.05.02] ------------------- * Derive `Lift` instances for `Plucker`, `Quaternion`, and `V{0,1,2,3,4}`.
README.markdown view
@@ -1,7 +1,7 @@ linear ====== -[](https://hackage.haskell.org/package/linear) [](http://travis-ci.org/ekmett/linear)+[](https://hackage.haskell.org/package/linear) [](https://github.com/ekmett/linear/actions?query=workflow%3AHaskell-CI) Highly polymorphic vector space operations on sparse and free vector spaces.
Setup.lhs view
@@ -1,34 +1,7 @@-\begin{code}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--#ifndef MIN_VERSION_cabal_doctest-#define MIN_VERSION_cabal_doctest(x,y,z) 0-#endif--#if MIN_VERSION_cabal_doctest(1,0,0)--import Distribution.Extra.Doctest ( defaultMainWithDoctests )-main :: IO ()-main = defaultMainWithDoctests "doctests"--#else--#ifdef MIN_VERSION_Cabal--- If the macro is defined, we have new cabal-install,--- but for some reason we don't have cabal-doctest in package-db------ Probably we are running cabal sdist, when otherwise using new-build--- workflow-import Warning ()-#endif--import Distribution.Simple--main :: IO ()-main = defaultMain+#!/usr/bin/runhaskell+> module Main (main) where -#endif+> import Distribution.Simple -\end{code}+> main :: IO ()+> main = defaultMain
− Warning.hs
@@ -1,5 +0,0 @@-module Warning- {-# WARNING ["You are configuring this package without cabal-doctest installed.",- "The doctests test-suite will not work as a result.",- "To fix this, install cabal-doctest before configuring."] #-}- () where
linear.cabal view
@@ -1,8 +1,8 @@ name: linear category: Math, Algebra-version: 1.20.9+version: 1.23.3 license: BSD3-cabal-version: >= 1.8+cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett <ekmett@gmail.com>@@ -12,25 +12,27 @@ copyright: Copyright (C) 2012-2015 Edward A. Kmett synopsis: Linear Algebra description: Types and combinators for linear algebra on free vector spaces-build-type: Custom-tested-with: GHC == 7.4.2- , GHC == 7.6.3- , GHC == 7.8.4- , GHC == 7.10.3- , GHC == 8.0.2+build-type: Simple+tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5- , GHC == 8.8.1+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.8+ , GHC == 9.4.8+ , GHC == 9.6.7+ , GHC == 9.8.4+ , GHC == 9.10.3+ , GHC == 9.12.2+ , GHC == 9.14.1 extra-source-files: .gitignore- .travis.yml+ .hlint.yaml .vim.custom- travis/cabal-apt-install- travis/config CHANGELOG.markdown README.markdown- Warning.hs flag template-haskell description:@@ -49,38 +51,29 @@ type: git location: https://github.com/ekmett/linear -custom-setup- setup-depends:- base >= 4 && < 5,- Cabal,- cabal-doctest >= 1 && < 1.1- library build-depends: adjunctions >= 4 && < 5,- base >= 4.5 && < 5,- base-orphans >= 0.5 && < 1,+ base >= 4.9 && < 5,+ base-orphans >= 0.8.3 && < 1, binary >= 0.5 && < 0.9, bytes >= 0.15 && < 1, cereal >= 0.4.1.1 && < 0.6,- containers >= 0.4 && < 0.7,- deepseq >= 1.1 && < 1.5,- distributive >= 0.2.2 && < 1,- ghc-prim,- hashable >= 1.1 && < 1.3,- lens >= 4.15.2 && < 5,- reflection >= 1.3.2 && < 3,- semigroups >= 0.9 && < 1,- semigroupoids >= 5.2.1 && < 6,- tagged >= 0.4.4 && < 1,- transformers >= 0.2 && < 0.6,- transformers-compat >= 0.4 && < 1,+ containers >= 0.4 && < 0.9,+ deepseq >= 1.1 && < 1.6,+ distributive >= 0.5.1 && < 1,+ hashable >= 1.2.7.0 && < 1.6,+ indexed-traversable >= 0.1.1 && < 0.2,+ lens >= 4.15.2 && < 6,+ random >= 1.2 && < 1.4,+ reflection >= 2 && < 3,+ semigroupoids >= 5.2.1 && < 7,+ transformers >= 0.5 && < 0.7, unordered-containers >= 0.2.3 && < 0.3,- vector >= 0.10 && < 0.13,- void >= 0.6 && < 1+ vector >= 0.12.1.2 && < 0.14 if flag(template-haskell) && impl(ghc)- build-depends: template-haskell >= 2.7 && < 3.0+ build-depends: template-haskell >= 2.11.1.0 && < 3.0 if flag(herbie) build-depends: HerbiePlugin >= 0.1 && < 0.2@@ -111,35 +104,33 @@ Linear.V4 Linear.Vector - ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields+ ghc-options: -Wall -Wtabs -O2 -fdicts-cheap -funbox-strict-fields -Wno-trustworthy-safe hs-source-dirs: src - if impl(ghc >= 7.10)- ghc-options: -fno-warn-trustworthy-safe+ default-language: Haskell2010 - -- hack around the buggy unused matches check for class associated types in ghc 8 rc1- if impl(ghc >= 8)- ghc-options: -fno-warn-unused-matches+ x-docspec-extra-packages: simple-reflect --- Verify the results of the examples+-- We need this dummy test-suite to add simple-reflect to the install plan+--+-- When cabal-install's extra-packages support becomes widely available+-- (i.e. after 3.4 release), we can remove this test-suite. test-suite doctests- type: exitcode-stdio-1.0- main-is: doctests.hs- ghc-options: -Wall -threaded- hs-source-dirs: tests- build-depends:- base,- doctest >= 0.11.1 && < 0.17,- lens,- linear,- simple-reflect >= 0.3.1+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ hs-source-dirs: tests+ default-language: Haskell2010 -test-suite UnitTests+ build-depends: base < 5, simple-reflect >= 0.3.1++test-suite test type: exitcode-stdio-1.0- main-is: UnitTests.hs- other-modules: Plucker, Binary- if impl(ghc >= 7.7)- other-modules: V+ main-is: Test.hs+ other-modules: Prop.Quaternion+ Prop.V3+ Unit.Binary+ Unit.Plucker+ Unit.V ghc-options: -Wall -threaded hs-source-dirs: tests build-depends:@@ -147,10 +138,12 @@ binary, bytestring, deepseq,- test-framework >= 0.8,- test-framework-hunit >= 0.3,- HUnit >= 1.2.5,+ tasty >= 1.4 && < 1.6,+ tasty-hunit >= 0.10 && < 0.11,+ tasty-quickcheck >= 0.10 && < 0.12, linear,+ QuickCheck >= 2.5, reflection, vector+ default-language: Haskell2010
src/Linear.hs view
@@ -46,5 +46,3 @@ import Linear.V3 import Linear.V4 import Linear.Vector--{-# ANN module "Hlint: ignore Use import/export shortcut" #-}
src/Linear/Affine.hs view
@@ -6,21 +6,14 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif {-# LANGUAGE DeriveDataTypeable #-}-#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif- ----------------------------------------------------------------------------- -- | -- License : BSD-style (see the file LICENSE)@@ -38,36 +31,32 @@ import Control.Lens import Data.Binary as Binary import Data.Bytes.Serial-#if __GLASGOW_HASKELL__ >= 708 import Data.Coerce-#endif import Data.Complex (Complex) import Data.Data import Data.Distributive import Data.Foldable as Foldable import Data.Functor.Bind import Data.Functor.Classes+import Data.Functor.Product import Data.Functor.Rep as Rep import Data.HashMap.Lazy (HashMap) import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif import Data.IntMap (IntMap) import Data.Ix+import Data.Kind import Data.Map (Map)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup)+#endif import Data.Serialize as Cereal import Data.Vector (Vector) import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Foreign.Storable-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif+import GHC.Generics (Generic, Generic1) import Linear.Epsilon import Linear.Metric import Linear.Plucker@@ -79,10 +68,7 @@ import Linear.V3 import Linear.V4 import Linear.Vector--#ifdef HLINT-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}-#endif+import System.Random (Random(..)) -- | An affine space is roughly a vector space in which we have -- forgotten or at least pretend to have forgotten the origin.@@ -91,7 +77,7 @@ -- > (a .+^ u) .+^ v = a .+^ (u ^+^ v)@ -- > (a .-. b) ^+^ v = (a .+^ v) .-. q@ class Additive (Diff p) => Affine p where- type Diff p :: * -> *+ type Diff p :: Type -> Type infixl 6 .-. -- | Get the difference between two points as a vector offset.@@ -107,6 +93,12 @@ p .-^ v = p .+^ negated v {-# INLINE (.-^) #-} +instance (Affine f, Affine g) => Affine (Product f g) where+ type Diff (Product f g) = Product (Diff f) (Diff g)+ Pair a b .-. Pair c d = Pair (a .-. c) (b .-. d)+ Pair a b .+^ Pair c d = Pair (a .+^ c) (b .+^ d)+ Pair a b .-^ Pair c d = Pair (a .+^ c) (b .+^ d)+ -- | Compute the quadrance of the difference (the square of the distance) qdA :: (Affine p, Foldable (Diff p), Num a) => p a -> p a -> a qdA a b = Foldable.sum (fmap (join (*)) (a .-. b))@@ -148,24 +140,15 @@ , Eq1, Ord1, Show1, Read1 , Traversable, Apply, Additive, Metric , Fractional , Num, Ix, Storable, Epsilon- , Hashable-#if __GLASGOW_HASKELL__ >= 702- , Generic-#endif-#if __GLASGOW_HASKELL__ >= 706- , Generic1-#endif-#if __GLASGOW_HASKELL__ >= 708- , Typeable, Data-#endif+ , Semigroup, Monoid+ , Random, Hashable+ , Generic, Generic1, Data ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite f => Finite (Point f) where type Size (Point f) = Size f toV (P v) = toV v fromV v = P (fromV v)-#endif instance NFData (f a) => NFData (Point f a) where rnf (P x) = rnf x@@ -186,25 +169,15 @@ put (P p) = Cereal.put p get = P `liftM` Cereal.get -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 f => Hashable1 (Point f) where liftHashWithSalt h s (P f) = liftHashWithSalt h s f {-# INLINE liftHashWithSalt #-}-#endif -#if __GLASGOW_HASKELL__ < 708-instance forall f. Typeable1 f => Typeable1 (Point f) where- typeOf1 _ = mkTyConApp (mkTyCon3 "linear" "Linear.Affine" "Point") [] `mkAppTy`- typeOf1 (undefined :: f a)--deriving instance (Data (f a), Typeable1 f, Typeable a) => Data (Point f a)-#endif--lensP :: Lens' (Point g a) (g a)+lensP :: Lens (Point f a) (Point g b) (f a) (g b) lensP afb (P a) = P <$> afb a {-# INLINE lensP #-} -_Point :: Iso' (Point f a) (f a)+_Point :: Iso (Point f a) (Point g b) (f a) (g b) _Point = iso (\(P a) -> a) P {-# INLINE _Point #-} @@ -214,7 +187,6 @@ _Wrapped' = _Point {-# INLINE _Wrapped' #-} -#if __GLASGOW_HASKELL__ >= 708 -- These are stolen from Data.Profunctor.Unsafe (.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c f .# _ = coerce f@@ -223,13 +195,6 @@ (#.) :: Coercible c b => (b -> c) -> (a -> b) -> a -> c (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b {-# INLINE (#.) #-}-#else-(.#), (#.) :: (b -> c) -> (a -> b) -> a -> c-(.#) = (.)-{-# INLINE (.#) #-}-(#.) = (.)-{-# INLINE (#.) #-}-#endif unP :: Point f a -> f a unP (P x) = x@@ -239,11 +204,7 @@ -- role troubles. However, GHC 7.8 and above let us use -- explicit coercions for (>>-). instance Bind f => Bind (Point f) where-#if __GLASGOW_HASKELL__ >= 708 (>>-) = ((P .) . (. (unP .))) #. (>>-) .# unP-#else- P m >>- f = P $ m >>- unP . f-#endif join (P m) = P $ m >>- \(P m') -> m' instance Distributive f => Distributive (Point f) where@@ -326,10 +287,8 @@ basicUnsafeNew n = MV_P `liftM` M.basicUnsafeNew n basicUnsafeRead (MV_P v) i = P `liftM` M.basicUnsafeRead v i basicUnsafeWrite (MV_P v) i (P x) = M.basicUnsafeWrite v i x-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_P v) = M.basicInitialize v {-# INLINE basicInitialize #-}-#endif instance U.Unbox (f a) => G.Vector U.Vector (Point f a) where {-# INLINE basicUnsafeFreeze #-}
src/Linear/Algebra.hs view
@@ -2,9 +2,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- they are mathematically required, not redundant, damn it.-#endif ----------------------------------------------------------------------------- -- | -- License : BSD-style (see the file LICENSE)
src/Linear/Binary.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2013-2015 Edward Kmett and Anthony Cowley@@ -16,16 +15,8 @@ , getLinear ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif import Data.Binary-#if __GLASGOW_HASKELL__ < 710-import Data.Foldable (Foldable, traverse_)-import Data.Traversable (Traversable, sequenceA)-#else import Data.Foldable (traverse_)-#endif -- | Serialize a linear type. putLinear :: (Binary a, Foldable t) => t a -> Put
src/Linear/Conjugate.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}-#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif ----------------------------------------------------------------------------- -- |@@ -24,6 +21,10 @@ import Data.Int import Data.Word import Foreign.C.Types (CFloat, CDouble)++-- $setup+-- >>> import Data.Complex (Complex (..))+ -- | An involutive ring class Num a => Conjugate a where
src/Linear/Covector.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- License : BSD-style (see the file LICENSE)@@ -44,7 +44,9 @@ Covector m >>- f = Covector $ \k -> m $ \a -> runCovector (f a) k instance Monad (Covector r) where+#if !(MIN_VERSION_base(4,11,0)) return a = Covector $ \k -> k a+#endif Covector m >>= f = Covector $ \k -> m $ \a -> runCovector (f a) k instance Num r => Alt (Covector r) where
src/Linear/Instances.hs view
@@ -1,8 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -11,18 +7,8 @@ -- Stability : provisional -- Portability : portable ----- Orphans+-- Re-exports orphan instances for @Complex@ from the @base-orphans@ package. ----------------------------------------------------------------------------- module Linear.Instances () where -import Control.Applicative-import Control.Monad.Fix-import Control.Monad.Zip-import Data.Complex import Data.Orphans ()--instance MonadZip Complex where- mzipWith = liftA2--instance MonadFix Complex where- mfix f = (let a :+ _ = f a in a) :+ (let _ :+ a = f a in a)
src/Linear/Matrix.hs view
@@ -1,9 +1,10 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} --------------------------------------------------------------------------- -- |@@ -33,17 +34,28 @@ , _m22, _m23, _m24 , _m32, _m33, _m34 , _m42, _m43, _m44+ , lu+ , luFinite+ , forwardSub+ , forwardSubFinite+ , backwardSub+ , backwardSubFinite+ , luSolve+ , luSolveFinite+ , luInv+ , luInvFinite+ , luDet+ , luDetFinite ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif import Control.Lens hiding (index) import Control.Lens.Internal.Context import Data.Distributive import Data.Foldable as Foldable import Data.Functor.Rep+import GHC.TypeLits import Linear.Quaternion+import Linear.V import Linear.V2 import Linear.V3 import Linear.V4@@ -51,9 +63,14 @@ import Linear.Conjugate import Linear.Trace -#ifdef HLINT-{-# ANN module "HLint: ignore Reduce duplication" #-}-#endif+-- $setup+-- >>> import Control.Lens hiding (index)+-- >>> import Data.Complex (Complex (..))+-- >>> import Linear.V2+-- >>> import Linear.V3+-- >>> import Linear.V+-- >>> import qualified Data.IntMap as IntMap+-- >>> import Debug.SimpleReflect.Vars -- | This is a generalization of 'Control.Lens.inside' to work over any corepresentable 'Functor'. --@@ -74,19 +91,13 @@ i = tabulate $ \ e -> ipos $ go (index es e) o eb = tabulate $ \ e -> ipeek (index eb e) (go (index es e)) --- $setup--- >>> import Data.Complex--- >>> import Data.IntMap--- >>> import Debug.SimpleReflect.Vars--- >>> import Linear.V- infixl 7 !*! -- | Matrix product. This can compute any combination of sparse and dense multiplication. -- -- >>> V2 (V3 1 2 3) (V3 4 5 6) !*! V3 (V2 1 2) (V2 3 4) (V2 4 5) -- V2 (V2 19 25) (V2 43 58) ----- >>> V2 (fromList [(1,2)]) (fromList [(2,3)]) !*! fromList [(1,V3 0 0 1), (2, V3 0 0 5)]+-- >>> V2 (IntMap.fromList [(1,2)]) (IntMap.fromList [(2,3)]) !*! IntMap.fromList [(1,V3 0 0 1), (2, V3 0 0 5)] -- V2 (V3 0 0 2) (V3 0 0 15) (!*!) :: (Functor m, Foldable t, Additive t, Additive n, Num a) => m (t a) -> t (n a) -> m (n a) f !*! g = fmap (\ f' -> Foldable.foldl' (^+^) zero $ liftI2 (*^) f' g) f@@ -224,12 +235,10 @@ (V4 d e f 0) (V4 g h i 0) (V4 j k l 1)-{-# ANN m43_to_m44 "HLint: ignore Use camelCase" #-} -- | Convert a 3x3 matrix to a 4x4 matrix extending it with 0's in the new row and column. m33_to_m44 :: Num a => M33 a -> M44 a m33_to_m44 (V3 r1 r2 r3) = V4 (vector r1) (vector r2) (vector r3) (point 0)-{-# ANN m33_to_m44 "HLint: ignore Use camelCase" #-} -- |The identity matrix for any dimension vector. --@@ -418,3 +427,305 @@ (-i30 * s3 + i31 * s1 - i32 * s0) (i20 * s3 - i21 * s1 + i22 * s0)) {-# INLINE inv44 #-}++-- | Compute the (L, U) decomposition of a square matrix using Crout's+-- algorithm. The 'Index' of the vectors must be 'Integral'.+lu :: ( Num a+ , Fractional a+ , Foldable m+ , Traversable m+ , Applicative m+ , Additive m+ , Ixed (m a)+ , Ixed (m (m a))+ , i ~ Index (m a)+ , i ~ Index (m (m a))+ , Eq i+ , Integral i+ , a ~ IxValue (m a)+ , m a ~ IxValue (m (m a))+ , Num (m a)+ )+ => m (m a)+ -> (m (m a), m (m a))+lu a =+ let n = fromIntegral (length a)+ initU = identity+ initL = zero+ buildLVal !i !j !l !u =+ let go !k !s+ | k == j = s+ | otherwise = go (k+1)+ ( s+ + ( (l ^?! ix i ^?! ix k)+ * (u ^?! ix k ^?! ix j)+ )+ )+ s' = go 0 0+ in l & (ix i . ix j) .~ ((a ^?! ix i ^?! ix j) - s')+ buildL !i !j !l !u+ | i == n = l+ | otherwise = buildL (i+1) j (buildLVal i j l u) u+ buildUVal !i !j !l !u =+ let go !k !s+ | k == j = s+ | otherwise = go (k+1)+ ( s+ + ( (l ^?! ix j ^?! ix k)+ * (u ^?! ix k ^?! ix i)+ )+ )+ s' = go 0 0+ in u & (ix j . ix i) .~ ( ((a ^?! ix j ^?! ix i) - s')+ / (l ^?! ix j ^?! ix j)+ )+ buildU !i !j !l !u+ | i == n = u+ | otherwise = buildU (i+1) j l (buildUVal i j l u)+ buildLU !j !l !u+ | j == n = (l, u)+ | otherwise =+ let l' = buildL j j l u+ u' = buildU j j l' u+ in buildLU (j+1) l' u'+ in buildLU 0 initL initU++-- | Compute the (L, U) decomposition of a square matrix using Crout's+-- algorithm, using the vector's 'Finite' instance to provide an index.+luFinite :: ( Num a+ , Fractional a+ , Functor m+ , Finite m+ , n ~ Size m+ , KnownNat n+ , Num (m a)+ )+ => m (m a)+ -> (m (m a), m (m a))+luFinite a =+ bimap (fmap fromV . fromV)+ (fmap fromV . fromV)+ (lu (fmap toV (toV a)))++-- | Solve a linear system with a lower-triangular matrix of coefficients with+-- forwards substitution.+forwardSub :: ( Num a+ , Fractional a+ , Foldable m+ , Additive m+ , Ixed (m a)+ , Ixed (m (m a))+ , i ~ Index (m a)+ , i ~ Index (m (m a))+ , Eq i+ , Ord i+ , Integral i+ , a ~ IxValue (m a)+ , m a ~ IxValue (m (m a))+ )+ => m (m a)+ -> m a+ -> m a+forwardSub a b =+ let n = fromIntegral (length b)+ initX = zero+ coeff !i !j !s !x+ | j == i = s+ | otherwise = coeff i (j+1) (s + ((a ^?! ix i ^?! ix j) * (x ^?! ix j))) x+ go !i !x+ | i == n = x+ | otherwise = go (i + 1) (x & ix i .~ ( ((b ^?! ix i) - coeff i 0 0 x)+ / (a ^?! ix i ^?! ix i)+ ))+ in go 0 initX++-- | Solve a linear system with a lower-triangular matrix of coefficients with+-- forwards substitution, using the vector's 'Finite' instance to provide an+-- index.+forwardSubFinite :: ( Num a+ , Fractional a+ , Foldable m+ , n ~ Size m+ , KnownNat n+ , Additive m+ , Finite m+ )+ => m (m a)+ -> m a+ -> m a+forwardSubFinite a b = fromV (forwardSub (fmap toV (toV a)) (toV b))++-- | Solve a linear system with an upper-triangular matrix of coefficients with+-- backwards substitution.+backwardSub :: ( Num a+ , Fractional a+ , Foldable m+ , Additive m+ , Ixed (m a)+ , Ixed (m (m a))+ , i ~ Index (m a)+ , i ~ Index (m (m a))+ , Eq i+ , Ord i+ , Integral i+ , a ~ IxValue (m a)+ , m a ~ IxValue (m (m a))+ )+ => m (m a)+ -> m a+ -> m a+backwardSub a b =+ let n = fromIntegral (length b)+ initX = zero+ coeff !i !j !s !x+ | j == n = s+ | otherwise = coeff i+ (j+1)+ (s + ((a ^?! ix i ^?! ix j) * (x ^?! ix j)))+ x+ go !i !x+ | i < 0 = x+ | otherwise = go (i-1)+ (x & ix i .~ ( ((b ^?! ix i) - coeff i (i+1) 0 x)+ / (a ^?! ix i ^?! ix i)+ ))+ in go (n-1) initX++-- | Solve a linear system with an upper-triangular matrix of coefficients with+-- backwards substitution, using the vector's 'Finite' instance to provide an+-- index.+backwardSubFinite :: ( Num a+ , Fractional a+ , Foldable m+ , n ~ Size m+ , KnownNat n+ , Additive m+ , Finite m+ )+ => m (m a)+ -> m a+ -> m a+backwardSubFinite a b = fromV (backwardSub (fmap toV (toV a)) (toV b))++-- | Solve a linear system with LU decomposition.+luSolve :: ( Num a+ , Fractional a+ , Foldable m+ , Traversable m+ , Applicative m+ , Additive m+ , Ixed (m a)+ , Ixed (m (m a))+ , i ~ Index (m a)+ , i ~ Index (m (m a))+ , Eq i+ , Integral i+ , a ~ IxValue (m a)+ , m a ~ IxValue (m (m a))+ , Num (m a)+ )+ => m (m a)+ -> m a+ -> m a+luSolve a b =+ let (l, u) = lu a+ in backwardSub u (forwardSub l b)++-- | Solve a linear system with LU decomposition, using the vector's 'Finite'+-- instance to provide an index.+luSolveFinite :: ( Num a+ , Fractional a+ , Functor m+ , Finite m+ , n ~ Size m+ , KnownNat n+ , Num (m a)+ )+ => m (m a)+ -> m a+ -> m a+luSolveFinite a b = fromV (luSolve (fmap toV (toV a)) (toV b))++-- | Invert a matrix with LU decomposition.+luInv :: ( Num a+ , Fractional a+ , Foldable m+ , Traversable m+ , Applicative m+ , Additive m+ , Distributive m+ , Ixed (m a)+ , Ixed (m (m a))+ , i ~ Index (m a)+ , i ~ Index (m (m a))+ , Eq i+ , Integral i+ , a ~ IxValue (m a)+ , m a ~ IxValue (m (m a))+ , Num (m a)+ )+ => m (m a)+ -> m (m a)+luInv a =+ let n = fromIntegral (length a)+ initA' = zero+ (l, u) = lu a+ go !i !a'+ | i == n = a'+ | otherwise = let e = zero & ix i .~ 1+ a'r = backwardSub u (forwardSub l e)+ in go (i+1) (a' & ix i .~ a'r)+ in transpose (go 0 initA')++-- | Invert a matrix with LU decomposition, using the vector's 'Finite' instance+-- to provide an index.+luInvFinite :: ( Num a+ , Fractional a+ , Functor m+ , Finite m+ , n ~ Size m+ , KnownNat n+ , Num (m a)+ )+ => m (m a)+ -> m (m a)+luInvFinite a = fmap fromV (fromV (luInv (fmap toV (toV a))))++-- | Compute the determinant of a matrix using LU decomposition.+luDet :: ( Num a+ , Fractional a+ , Foldable m+ , Traversable m+ , Applicative m+ , Additive m+ , Trace m+ , Ixed (m a)+ , Ixed (m (m a))+ , i ~ Index (m a)+ , i ~ Index (m (m a))+ , Eq i+ , Integral i+ , a ~ IxValue (m a)+ , m a ~ IxValue (m (m a))+ , Num (m a)+ )+ => m (m a)+ -> a+luDet a =+ let (l, u) = lu a+ p = Foldable.foldl (*) 1+ in p (diagonal l) * p (diagonal u)++-- | Compute the determinant of a matrix using LU decomposition, using the+-- vector's 'Finite' instance to provide an index.+luDetFinite :: ( Num a+ , Fractional a+ , Functor m+ , Finite m+ , n ~ Size m+ , KnownNat n+ , Num (m a)+ )+ => m (m a)+ -> a+luDetFinite = luDet . fmap toV . toV
src/Linear/Metric.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -20,7 +18,9 @@ import Control.Applicative import Data.Foldable as Foldable+import Data.Functor.Compose import Data.Functor.Identity+import Data.Functor.Product import Data.Vector (Vector) import Data.IntMap (IntMap) import Data.Map (Map)@@ -31,6 +31,7 @@ -- $setup -- >>> import Linear+-- -- | Free and sparse inner product/metric spaces. class Additive f => Metric f where@@ -67,6 +68,18 @@ signorm v = fmap (/m) v where m = norm v +instance (Metric f, Metric g) => Metric (Product f g) where+ dot (Pair a b) (Pair c d) = dot a c + dot b d+ quadrance (Pair a b) = quadrance a + quadrance b+ qd (Pair a b) (Pair c d) = qd a c + qd b d+ distance p q = sqrt (qd p q)++instance (Metric f, Metric g) => Metric (Compose f g) where+ dot (Compose a) (Compose b) = quadrance (liftI2 dot a b)+ quadrance = quadrance . fmap quadrance . getCompose+ qd (Compose a) (Compose b) = quadrance (liftI2 qd a b)+ distance (Compose a) (Compose b) = norm (liftI2 qd a b)+ instance Metric Identity where dot (Identity x) (Identity y) = x * y @@ -95,4 +108,3 @@ -- | @project u v@ computes the projection of @v@ onto @u@. project :: (Metric v, Fractional a) => v a -> v a -> v a project u v = ((v `dot` u) / quadrance u) *^ u-
src/Linear/Plucker.hs view
@@ -4,25 +4,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GADTs #-}-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -60,73 +46,89 @@ , e01, e02, e03, e12, e31, e23 ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative+#endif import Control.DeepSeq (NFData(rnf)) import Control.Monad (liftM) import Control.Monad.Fix import Control.Monad.Zip-import Control.Lens hiding (index, (<.>))+import Control.Lens as Lens hiding (index, (<.>)) import Data.Binary as Binary import Data.Bytes.Serial import Data.Distributive import Data.Foldable as Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable import Data.Semigroup import Data.Semigroup.Foldable import Data.Serialize as Cereal-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V-#endif import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import Linear.Epsilon import Linear.Metric-#if __GLASGOW_HASKELL__ >= 707 import Linear.V-#endif import Linear.V2 import Linear.V3 import Linear.V4 import Linear.Vector--{-# ANN module "HLint: ignore Reduce duplication" #-}+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..)) -- | Plücker coordinates for lines in a 3-dimensional space. data Plucker a = Plucker !a !a !a !a !a !a deriving (Eq,Ord,Show,Read-#if __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite Plucker where type Size Plucker = 6 toV (Plucker a b c d e f) = V (V.fromListN 6 [a,b,c,d,e,f]) fromV (V v) = Plucker (v V.! 0) (v V.! 1) (v V.! 2) (v V.! 3) (v V.! 4) (v V.! 5)-#endif +instance Random a => Random (Plucker a) where+ random g = case random g of+ (a, g1) -> case random g1 of+ (b, g2) -> case random g2 of+ (c, g3) -> case random g3 of+ (d, g4) -> case random g4 of+ (e, g5) -> case random g5 of+ (f, g6) -> (Plucker a b c d e f, g6)+ randomR (Plucker a b c d e f, Plucker a' b' c' d' e' f') g = case randomR (a,a') g of+ (a'', g1) -> case randomR (b,b') g1 of+ (b'', g2) -> case randomR (c,c') g2 of+ (c'', g3) -> case randomR (d,d') g3 of+ (d'', g4) -> case randomR (e,e') g4 of+ (e'', g5) -> case randomR (f,f') g5 of+ (f'', g6) -> (Plucker a'' b'' c'' d'' e'' f'', g6)++instance Uniform a => Uniform (Plucker a) where++instance UniformRange a => UniformRange (Plucker a) where+ uniformRM (Plucker a b c d e f, Plucker a' b' c' d' e' f') g = Plucker+ <$> uniformRM (a, a') g+ <*> uniformRM (b, b') g+ <*> uniformRM (c, c') g+ <*> uniformRM (d, d') g+ <*> uniformRM (e, e') g+ <*> uniformRM (f, f') g+ instance Functor Plucker where fmap g (Plucker a b c d e f) = Plucker (g a) (g b) (g c) (g d) (g e) (g f) {-# INLINE fmap #-}@@ -162,8 +164,10 @@ {-# INLINE (>>-) #-} instance Monad Plucker where+#if !(MIN_VERSION_base(4,11,0)) return a = Plucker a a a a a a {-# INLINE return #-}+#endif Plucker a b c d e f >>= g = Plucker a' b' c' d' e' f' where Plucker a' _ _ _ _ _ = g a Plucker _ b' _ _ _ _ = g b@@ -193,10 +197,8 @@ foldMap g (Plucker a b c d e f) = g a `mappend` g b `mappend` g c `mappend` g d `mappend` g e `mappend` g f {-# INLINE foldMap #-}-#if __GLASGOW_HASKELL__ >= 710 null _ = False length _ = 6-#endif instance Traversable Plucker where traverse g (Plucker a b c d e f) =@@ -416,25 +418,31 @@ e31 = E p31 e12 = E p12 -instance FunctorWithIndex (E Plucker) Plucker where+instance WithIndex.FunctorWithIndex (E Plucker) Plucker where imap f (Plucker a b c d e g) = Plucker (f e01 a) (f e02 b) (f e03 c) (f e23 d) (f e31 e) (f e12 g) {-# INLINE imap #-} -instance FoldableWithIndex (E Plucker) Plucker where+instance WithIndex.FoldableWithIndex (E Plucker) Plucker where ifoldMap f (Plucker a b c d e g) = f e01 a `mappend` f e02 b `mappend` f e03 c `mappend` f e23 d `mappend` f e31 e `mappend` f e12 g {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E Plucker) Plucker where+instance WithIndex.TraversableWithIndex (E Plucker) Plucker where itraverse f (Plucker a b c d e g) = Plucker <$> f e01 a <*> f e02 b <*> f e03 c <*> f e23 d <*> f e31 e <*> f e12 g {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E Plucker) Plucker where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E Plucker) Plucker where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E Plucker) Plucker where itraverse = WithIndex.itraverse+#endif+ type instance Index (Plucker a) = E Plucker type instance IxValue (Plucker a) = a instance Ixed (Plucker a) where- ix = el+ ix i = el i {-# INLINE ix #-} instance Each (Plucker a) (Plucker b) a b where@@ -477,11 +485,7 @@ | Counterclockwise -- ^ The lines pass each other counterclockwise -- (left-handed screw).- deriving (Eq, Show-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702- ,Generic-#endif- )+ deriving (Eq, Show,Generic) -- | Check how two lines pass each other. @passes l1 l2@ describes -- @l2@ when looking down @l1@.@@ -510,20 +514,49 @@ -- | Checks if two lines coincide in space. In other words, undirected equality. coincides :: (Epsilon a, Fractional a) => Plucker a -> Plucker a -> Bool coincides p1 p2 = Foldable.all nearZero $ (s *^ p2) - p1- where s = maybe 1 getFirst . getOption . fold $ saveDiv <$> p1 <*> p2- saveDiv x y | nearZero y = Option Nothing- | otherwise = Option . Just $ First (x / y)+ where s = maybe 1 getFirst . getOptionCompat . fold $ saveDiv <$> p1 <*> p2+ saveDiv x y | nearZero y = optionCompat Nothing+ | otherwise = optionCompat . Just $ First (x / y) {-# INLINABLE coincides #-} -- | Checks if two lines coincide in space, and have the same -- orientation. coincides' :: (Epsilon a, Fractional a, Ord a) => Plucker a -> Plucker a -> Bool coincides' p1 p2 = Foldable.all nearZero ((s *^ p2) - p1) && s > 0- where s = maybe 1 getFirst . getOption . fold $ saveDiv <$> p1 <*> p2- saveDiv x y | nearZero y = Option Nothing- | otherwise = Option . Just $ First (x / y)+ where s = maybe 1 getFirst . getOptionCompat . fold $ saveDiv <$> p1 <*> p2+ saveDiv x y | nearZero y = optionCompat Nothing+ | otherwise = optionCompat . Just $ First (x / y) {-# INLINABLE coincides' #-} +-- The coincides and coincides' functions above require the use of a Maybe type+-- with the following Monoid instance:+--+-- instance Semigroup a => Monoid (Maybe a) where ...+--+-- Unfortunately, Maybe has only had such an instance since base-4.11. Prior+-- to that, its Monoid instance had an instance context of Monoid a, which is+-- too strong. To compensate, we use CPP to define an OptionCompat type+-- synonym, which is an alias for Maybe on recent versions of base and an alias+-- for Data.Semigroup.Option on older versions of base. We don't want to use+-- Option on recent versions of base, as it is deprecated.+#if MIN_VERSION_base(4,11,0)+type OptionCompat = Maybe++optionCompat :: Maybe a -> OptionCompat a+optionCompat = id++getOptionCompat :: OptionCompat a -> Maybe a+getOptionCompat = id+#else+type OptionCompat = Option++optionCompat :: Maybe a -> OptionCompat a+optionCompat = Option++getOptionCompat :: OptionCompat a -> Maybe a+getOptionCompat = getOption+#endif+ -- | The minimum squared distance of a line from the origin. quadranceToOrigin :: Fractional a => Plucker a -> a quadranceToOrigin p = (v `dot` v) / (u `dot` u)@@ -573,9 +606,7 @@ M.basicUnsafeWrite a (o+3) w M.basicUnsafeWrite a (o+4) v M.basicUnsafeWrite a (o+5) u-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_Plucker _ v) = M.basicInitialize v-#endif instance U.Unbox a => G.Vector U.Vector (Plucker a) where basicUnsafeFreeze (MV_Plucker n v) = liftM ( V_Plucker n) (G.basicUnsafeFreeze v)@@ -623,8 +654,6 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get --#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 Plucker where liftEq k (Plucker a1 b1 c1 d1 e1 f1) (Plucker a2 b2 c2 d2 e2 f2)@@ -647,12 +676,6 @@ instance Show1 Plucker where liftShowsPrec k _ z (Plucker a b c d e f) = showParen (z > 10) $ showString "Plucker " . k 11 a . showChar ' ' . k 11 b . showChar ' ' . k 11 c . showChar ' ' . k 11 d . showChar ' ' . k 11 e . showChar ' ' . k 11 f-#else-instance Eq1 Plucker where eq1 = (==)-instance Ord1 Plucker where compare1 = compare-instance Show1 Plucker where showsPrec1 = showsPrec-instance Read1 Plucker where readsPrec1 = readsPrec-#endif instance Field1 (Plucker a) (Plucker a) a a where _1 f (Plucker x y z u v w) = f x <&> \x' -> Plucker x' y z u v w@@ -671,3 +694,12 @@ instance Field6 (Plucker a) (Plucker a) a a where _6 f (Plucker x y z u v w) = f w <&> \w' -> Plucker x y z u v w'++instance Semigroup a => Semigroup (Plucker a) where+ (<>) = liftA2 (<>)++instance Monoid a => Monoid (Plucker a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif
src/Linear/Projection.hs view
@@ -30,9 +30,10 @@ import Linear.Epsilon import Linear.Metric -#ifdef HLINT-{-# ANN module "HLint: ignore Reduce duplication" #-}-#endif+-- $setup+-- >>> import Linear.Matrix+-- >>> import Linear.V2+-- >>> import Linear.V4 -- | Build a look at view matrix lookAt
src/Linear/Quaternion.hs view
@@ -5,25 +5,11 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-}-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -58,74 +44,78 @@ import Control.Monad (liftM) import Control.Monad.Fix import Control.Monad.Zip-import Control.Lens hiding ((<.>))+import Control.Lens as Lens hiding ((<.>)) import Data.Binary as Binary import Data.Bytes.Serial import Data.Complex (Complex((:+))) import Data.Data import Data.Distributive import Data.Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..)) #endif import Data.Serialize as Cereal import GHC.Arr (Ix(..)) import qualified Data.Foldable as F-import Data.Monoid-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V-#endif import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Foreign.Ptr (castPtr, plusPtr) import Foreign.Storable (Storable(..))-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import Linear.Epsilon import Linear.Conjugate import Linear.Metric-#if __GLASGOW_HASKELL__ >= 707 import Linear.V-#endif+import Linear.V2 import Linear.V3+import Linear.V4 import Linear.Vector import Prelude hiding (any)--{-# ANN module "HLint: ignore Reduce duplication" #-}+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..)) -- | Quaternions data Quaternion a = Quaternion !a {-# UNPACK #-}!(V3 a)- deriving (Eq,Ord,Read,Show,Data,Typeable-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+ deriving (Eq,Ord,Read,Show,Data+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite Quaternion where type Size Quaternion = 4 toV (Quaternion a (V3 b c d)) = V (V.fromListN 4 [a, b, c, d]) fromV (V v) = Quaternion (v V.! 0) (V3 (v V.! 1) (v V.! 2) (v V.! 3))-#endif +instance Random a => Random (Quaternion a) where+ random g = case random g of+ (a, g') -> case random g' of+ (b, g'') -> (Quaternion a b, g'')+ randomR (Quaternion a b, Quaternion c d) g = case randomR (a,c) g of+ (e, g') -> case randomR (b,d) g' of+ (f, g'') -> (Quaternion e f, g'')++instance Uniform a => Uniform (Quaternion a) where++instance UniformRange a => UniformRange (Quaternion a) where+ uniformRM (Quaternion a b, Quaternion c d) g = Quaternion+ <$> uniformRM (a, c) g+ <*> uniformRM (b, d) g+ instance Functor Quaternion where fmap f (Quaternion e v) = Quaternion (f e) (fmap f v) {-# INLINE fmap #-}@@ -191,23 +181,29 @@ index xs (E l) = view l xs {-# INLINE index #-} -instance FunctorWithIndex (E Quaternion) Quaternion where+instance WithIndex.FunctorWithIndex (E Quaternion) Quaternion where imap f (Quaternion a (V3 b c d)) = Quaternion (f ee a) $ V3 (f ei b) (f ej c) (f ek d) {-# INLINE imap #-} -instance FoldableWithIndex (E Quaternion) Quaternion where+instance WithIndex.FoldableWithIndex (E Quaternion) Quaternion where ifoldMap f (Quaternion a (V3 b c d)) = f ee a `mappend` f ei b `mappend` f ej c `mappend` f ek d {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E Quaternion) Quaternion where+instance WithIndex.TraversableWithIndex (E Quaternion) Quaternion where itraverse f (Quaternion a (V3 b c d)) = Quaternion <$> f ee a <*> (V3 <$> f ei b <*> f ej c <*> f ek d) {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E Quaternion) Quaternion where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E Quaternion) Quaternion where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E Quaternion) Quaternion where itraverse = WithIndex.itraverse+#endif+ type instance Index (Quaternion a) = E Quaternion type instance IxValue (Quaternion a) = a instance Ixed (Quaternion a) where- ix = el+ ix i = el i {-# INLINE ix #-} instance Each (Quaternion a) (Quaternion b) a b where@@ -219,10 +215,8 @@ {-# INLINE foldMap #-} foldr f z (Quaternion e v) = f e (F.foldr f z v) {-# INLINE foldr #-}-#if __GLASGOW_HASKELL__ >= 710 null _ = False length _ = 4-#endif instance Traversable Quaternion where traverse f (Quaternion e v) = Quaternion <$> f e <*> traverse f v@@ -279,11 +273,9 @@ hashWithSalt s (Quaternion a b) = s `hashWithSalt` a `hashWithSalt` b {-# INLINE hashWithSalt #-} -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 Quaternion where liftHashWithSalt h s (Quaternion a b) = liftHashWithSalt h (h s a) b {-# INLINE liftHashWithSalt #-}-#endif qNaN :: RealFloat a => Quaternion a qNaN = Quaternion fNaN (V3 fNaN fNaN fNaN) where fNaN = 0/0@@ -621,9 +613,7 @@ M.basicUnsafeWrite v (o+1) y M.basicUnsafeWrite v (o+2) z M.basicUnsafeWrite v (o+3) w-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_Quaternion _ v) = M.basicInitialize v-#endif instance U.Unbox a => G.Vector U.Vector (Quaternion a) where basicUnsafeFreeze (MV_Quaternion n v) = liftM ( V_Quaternion n) (G.basicUnsafeFreeze v)@@ -666,7 +656,6 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 Quaternion where liftEq f (Quaternion a b) (Quaternion c d) = f a c && liftEq f b d instance Ord1 Quaternion where@@ -675,12 +664,6 @@ liftShowsPrec f g d (Quaternion a b) = showsBinaryWith f (liftShowsPrec f g) "Quaternion" d a b instance Read1 Quaternion where liftReadsPrec f g = readsData $ readsBinaryWith f (liftReadsPrec f g) "Quaternion" Quaternion-#else-instance Eq1 Quaternion where eq1 = (==)-instance Ord1 Quaternion where compare1 = compare-instance Show1 Quaternion where showsPrec1 = showsPrec-instance Read1 Quaternion where readsPrec1 = readsPrec-#endif instance Field1 (Quaternion a) (Quaternion a) a a where _1 f (Quaternion w xyz) = f w <&> \w' -> Quaternion w' xyz@@ -693,3 +676,28 @@ instance Field4 (Quaternion a) (Quaternion a) a a where _4 f (Quaternion w (V3 x y z)) = f z <&> \z' -> Quaternion w (V3 x y z')++instance Semigroup a => Semigroup (Quaternion a) where+ (<>) = liftA2 (<>)++instance Monoid a => Monoid (Quaternion a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif++instance R1 Quaternion where+ _x f (Quaternion w (V3 x y z)) = f x <&> \x' -> Quaternion w (V3 x' y z)++instance R2 Quaternion where+ _y f (Quaternion w (V3 x y z)) = f y <&> \y' -> Quaternion w (V3 x y' z)+ _xy f (Quaternion w (V3 x y z)) = f (V2 x y) <&> \(V2 x' y') -> Quaternion w (V3 x' y' z)++instance R3 Quaternion where+ _z f (Quaternion w (V3 x y z)) = f z <&> \z' -> Quaternion w (V3 x y z')+ _xyz f (Quaternion w xyz) = Quaternion w <$> f xyz++instance R4 Quaternion where+ _w f (Quaternion w xyz) = f w <&> \w' -> Quaternion w' xyz+ _xyzw f (Quaternion w (V3 x y z)) = f (V4 x y z w) <&> \(V4 x' y' z' w') -> Quaternion w' (V3 x' y' z')+
src/Linear/Trace.hs view
@@ -1,12 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DefaultSignatures #-}-#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 {-# LANGUAGE Trustworthy #-}-#endif --------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -20,6 +16,7 @@ --------------------------------------------------------------------------- module Linear.Trace ( Trace(..)+ , frobenius ) where import Control.Monad as Monad@@ -31,9 +28,8 @@ import Linear.Plucker import Linear.Quaternion import Linear.V-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 704+import Linear.Vector import Data.Complex-#endif import Data.Distributive import Data.Foldable as Foldable import Data.Functor.Bind as Bind@@ -41,13 +37,13 @@ import Data.Functor.Product import Data.Hashable import Data.HashMap.Lazy-import Data.IntMap-import Data.Map+import Data.IntMap (IntMap)+import Data.Map (Map) -- $setup -- >>> import Data.Complex--- >>> import Data.IntMap -- >>> import Debug.SimpleReflect.Vars+-- >>> import Linear.V2 class Functor m => Trace m where -- | Compute the trace of a matrix@@ -93,13 +89,11 @@ instance Trace Plucker instance Trace Quaternion -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 704 instance Trace Complex where trace ((a :+ _) :+ (_ :+ b)) = a + b {-# INLINE trace #-} diagonal ((a :+ _) :+ (_ :+ b)) = a :+ b {-# INLINE diagonal #-}-#endif instance (Trace f, Trace g) => Trace (Product f g) where trace (Pair xx yy) = trace (pfst <$> xx) + trace (psnd <$> yy) where@@ -116,3 +110,7 @@ {-# INLINE trace #-} diagonal = Compose . fmap diagonal . diagonal . fmap distribute . getCompose . fmap getCompose {-# INLINE diagonal #-}++-- | Compute the <http://mathworld.wolfram.com/FrobeniusNorm.html Frobenius norm> of a matrix.+frobenius :: (Num a, Foldable f, Additive f, Additive g, Distributive g, Trace g) => f (g a) -> a+frobenius m = trace $ fmap (\ f' -> Foldable.foldl' (^+^) zero $ liftI2 (*^) f' m) (distribute m)
src/Linear/V.hs view
@@ -9,29 +9,12 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE RoleAnnotations #-}-#define USE_TYPE_LITS 1-#endif {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-} -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_reflection-#define MIN_VERSION_reflection(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif- ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -53,89 +36,67 @@ , Dim(..) , reifyDim , reifyVector-#if (MIN_VERSION_reflection(2,0,0)) && __GLASGOW_HASKELL__ >= 708 , reifyDimNat , reifyVectorNat-#endif , fromVector-#if __GLASGOW_HASKELL__ >= 707 , Finite(..) , _V, _V'-#endif ) where -#if __GLASGOW_HASKELL__ < 710 import Control.Applicative-#endif import Control.DeepSeq (NFData) import Control.Monad import Control.Monad.Fix+import Control.Monad.Trans.State import Control.Monad.Zip import Control.Lens as Lens import Data.Binary as Binary import Data.Bytes.Serial-#if __GLASGOW_HASKELL__ >= 707 import Data.Complex-#endif import Data.Data import Data.Distributive import Data.Foldable as Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep as Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif-#if __GLASGOW_HASKELL__ < 708-import Data.Proxy-#endif+import Data.Kind import Data.Reflection as R import Data.Serialize as Cereal-#if __GLASGOW_HASKELL__ < 710-import Data.Traversable (sequenceA)-#endif-import Data.Vector as V+import qualified Data.Traversable.WithIndex as WithIndex+import qualified Data.Vector as V+import Data.Vector (Vector)+import Data.Vector.Fusion.Util (Box(..)) import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Generic.Mutable as M import Foreign.Ptr import Foreign.Storable-#ifdef USE_TYPE_LITS import GHC.TypeLits-#endif-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 707-import GHC.Generics (Generic1)-#endif+import GHC.Generics (Generic, Generic1) #if !(MIN_VERSION_reflection(1,3,0)) && defined(MIN_VERSION_template_haskell) import Language.Haskell.TH #endif import Linear.Epsilon import Linear.Metric import Linear.Vector-#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) import Prelude as P-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif-#endif---#ifdef HLINT-{-# ANN module "hlint: ignore Eta reduce" #-}+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup #endif+import System.Random (Random(..))+import System.Random.Stateful (Uniform(..), UniformRange(..)) class Dim n where reflectDim :: p n -> Int -#if __GLASGOW_HASKELL__ >= 707 type role V nominal representational class Finite v where- type Size (v :: * -> *) :: Nat -- this should allow kind k, for Reifies k Int+ type Size (v :: Type -> Type) :: Nat -- this should allow kind k, for Reifies k Int toV :: v a -> V (Size v) a default toV :: Foldable v => v a -> V (Size v) a toV = V . V.fromList . Foldable.toList@@ -156,27 +117,33 @@ type Size (V n) = n toV = id fromV = id-#endif -newtype V n a = V { toVector :: V.Vector a } deriving (Eq,Ord,Show,Read,Typeable,NFData- , Generic--- GHC bug: https://ghc.haskell.org/trac/ghc/ticket/8468-#if __GLASGOW_HASKELL__ >= 707- ,Generic1-#endif+newtype V n a = V { toVector :: V.Vector a } deriving (Eq,Ord,Show,Read,NFData+ ,Generic,Generic1 ) dim :: forall n a. Dim n => V n a -> Int dim _ = reflectDim (Proxy :: Proxy n) {-# INLINE dim #-} -#ifdef USE_TYPE_LITS instance KnownNat n => Dim (n :: Nat) where reflectDim = fromInteger . natVal {-# INLINE reflectDim #-}++instance (Dim n, Random a) => Random (V n a) where+ random = runState (V <$> V.replicateM (reflectDim (Proxy :: Proxy n)) (state random))+ randomR (V ls,V hs) = runState (V <$> V.zipWithM (\l h -> state $ randomR (l,h)) ls hs)++instance (Dim n, Uniform a) => Uniform (V n a) where+ uniformM g = V <$> V.replicateM (reflectDim (Proxy :: Proxy n)) (uniformM g)++instance (Dim n, UniformRange a) => UniformRange (V n a) where+ uniformRM (V ls, V hs) g = V <$> V.zipWithM (\l h -> uniformRM (l, h) g) ls hs+#if (MIN_VERSION_random(1,3,0))+ isInRange (V ls, V hs) (V xs) = V.and $ V.zipWith3 (\l h x -> isInRange (l, h) x) ls hs xs #endif -data ReifiedDim (s :: *)+data ReifiedDim (s :: Type) retagDim :: (Proxy s -> a) -> proxy (ReifiedDim s) -> a retagDim f _ = f Proxy@@ -186,8 +153,6 @@ reflectDim = retagDim reflect {-# INLINE reflectDim #-} -#if (MIN_VERSION_reflection(2,0,0)) && __GLASGOW_HASKELL__ >= 708- reifyDimNat :: Int -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r reifyDimNat i f = R.reifyNat (fromIntegral i) f {-# INLINE reifyDimNat #-}@@ -196,15 +161,13 @@ reifyVectorNat v f = reifyNat (fromIntegral $ V.length v) $ \(Proxy :: Proxy n) -> f (V v :: V n a) {-# INLINE reifyVectorNat #-} -#endif--reifyDim :: Int -> (forall (n :: *). Dim n => Proxy n -> r) -> r+reifyDim :: Int -> (forall (n :: Type). Dim n => Proxy n -> r) -> r reifyDim i f = R.reify i (go f) where go :: (Proxy (ReifiedDim n) -> a) -> proxy n -> a go g _ = g Proxy {-# INLINE reifyDim #-} -reifyVector :: forall a r. Vector a -> (forall (n :: *). Dim n => V n a -> r) -> r+reifyVector :: forall a r. Vector a -> (forall (n :: Type). Dim n => V n a -> r) -> r reifyVector v f = reifyDim (V.length v) $ \(Proxy :: Proxy n) -> f (V v :: V n a) {-# INLINE reifyVector #-} @@ -212,35 +175,40 @@ reflectDim _ = reflectDim (Proxy :: Proxy n) {-# INLINE reflectDim #-} +instance (Dim n, Semigroup a) => Semigroup (V n a) where+ (<>) = liftA2 (<>)++instance (Dim n, Monoid a) => Monoid (V n a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif+ instance Functor (V n) where fmap f (V as) = V (fmap f as) {-# INLINE fmap #-} -instance FunctorWithIndex Int (V n) where+instance WithIndex.FunctorWithIndex Int (V n) where imap f (V as) = V (Lens.imap f as) {-# INLINE imap #-} instance Foldable (V n) where fold (V as) = fold as {-# INLINE fold #-}- foldMap f (V as) = foldMap f as+ foldMap f (V as) = Foldable.foldMap f as {-# INLINE foldMap #-} foldr f z (V as) = V.foldr f z as {-# INLINE foldr #-} foldl f z (V as) = V.foldl f z as {-# INLINE foldl #-}-#if __GLASGOW_HASKELL__ >= 706 foldr' f z (V as) = V.foldr' f z as {-# INLINE foldr' #-} foldl' f z (V as) = V.foldl' f z as {-# INLINE foldl' #-}-#endif foldr1 f (V as) = V.foldr1 f as {-# INLINE foldr1 #-} foldl1 f (V as) = V.foldl1 f as {-# INLINE foldl1 #-}--#if __GLASGOW_HASKELL__ >= 710 length (V as) = V.length as {-# INLINE length #-} null (V as) = V.null as@@ -257,9 +225,8 @@ {-# INLINE sum #-} product (V as) = V.product as {-# INLINE product #-}-#endif -instance FoldableWithIndex Int (V n) where+instance WithIndex.FoldableWithIndex Int (V n) where ifoldMap f (V as) = ifoldMap f as {-# INLINE ifoldMap #-} @@ -267,10 +234,16 @@ traverse f (V as) = V <$> traverse f as {-# INLINE traverse #-} -instance TraversableWithIndex Int (V n) where+instance WithIndex.TraversableWithIndex Int (V n) where itraverse f (V as) = V <$> itraverse f as {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex Int (V n) where imap = WithIndex.imap+instance Lens.FoldableWithIndex Int (V n) where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex Int (V n) where itraverse = WithIndex.itraverse+#endif+ instance Apply (V n) where V as <.> V bs = V (V.zipWith id as bs) {-# INLINE (<.>) #-}@@ -283,15 +256,17 @@ {-# INLINE (<*>) #-} instance Bind (V n) where- V as >>- f = V $ generate (V.length as) $ \i ->- toVector (f (as `unsafeIndex` i)) `unsafeIndex` i+ V as >>- f = V $ V.generate (V.length as) $ \i ->+ toVector (f (as `V.unsafeIndex` i)) `V.unsafeIndex` i {-# INLINE (>>-) #-} instance Dim n => Monad (V n) where+#if !(MIN_VERSION_base(4,11,0)) return = V . V.replicate (reflectDim (Proxy :: Proxy n)) {-# INLINE return #-}- V as >>= f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i ->- toVector (f (as `unsafeIndex` i)) `unsafeIndex` i+#endif+ V as >>= f = V $ V.generate (reflectDim (Proxy :: Proxy n)) $ \i ->+ toVector (f (as `V.unsafeIndex` i)) `V.unsafeIndex` i {-# INLINE (>>=) #-} instance Dim n => Additive (V n) where@@ -365,7 +340,7 @@ {-# INLINE acosh #-} instance Dim n => Distributive (V n) where- distribute f = V $ V.generate (reflectDim (Proxy :: Proxy n)) $ \i -> fmap (\(V v) -> unsafeIndex v i) f+ distribute f = V $ V.generate (reflectDim (Proxy :: Proxy n)) $ \i -> fmap (\(V v) -> V.unsafeIndex v i) f {-# INLINE distribute #-} instance Hashable a => Hashable (V n a) where@@ -373,13 +348,11 @@ V.foldl' (\s a -> s `hashWithSalt` a) s0 v `hashWithSalt` V.length v -#if (MIN_VERSION_hashable(1,2,5)) instance Dim n => Hashable1 (V n) where liftHashWithSalt h s0 (V v) = V.foldl' (\s a -> h s a) s0 v `hashWithSalt` V.length v {-# INLINE liftHashWithSalt #-}-#endif instance (Dim n, Storable a) => Storable (V n a) where sizeOf _ = reflectDim (Proxy :: Proxy n) * sizeOf (undefined:: a)@@ -387,10 +360,10 @@ alignment _ = alignment (undefined :: a) {-# INLINE alignment #-} poke ptr (V xs) = Foldable.forM_ [0..reflectDim (Proxy :: Proxy n)-1] $ \i ->- pokeElemOff ptr' i (unsafeIndex xs i)+ pokeElemOff ptr' i (V.unsafeIndex xs i) where ptr' = castPtr ptr {-# INLINE poke #-}- peek ptr = V <$> generateM (reflectDim (Proxy :: Proxy n)) (peekElemOff ptr')+ peek ptr = V <$> V.generateM (reflectDim (Proxy :: Proxy n)) (peekElemOff ptr') where ptr' = castPtr ptr {-# INLINE peek #-} @@ -458,7 +431,7 @@ instance Dim n => Representable (V n) where type Rep (V n) = Int- tabulate = V . generate (reflectDim (Proxy :: Proxy n))+ tabulate = V . V.generate (reflectDim (Proxy :: Proxy n)) {-# INLINE tabulate #-} index (V xs) i = xs V.! i {-# INLINE index #-}@@ -497,15 +470,11 @@ vDataType = mkDataType "Linear.V.V" [vConstr] {-# NOINLINE vDataType #-} -#if __GLASGOW_HASKELL__ >= 708-#define Typeable1 Typeable-#endif--instance (Typeable1 (V n), Typeable (V n a), Dim n, Data a) => Data (V n a) where- gfoldl f z (V as) = z (V . fromList) `f` V.toList as+instance (Typeable (V n), Typeable (V n a), Dim n, Data a) => Data (V n a) where+ gfoldl f z (V as) = z (V . V.fromList) `f` V.toList as toConstr _ = vConstr gunfold k z c = case constrIndex c of- 1 -> k (z (V . fromList))+ 1 -> k (z (V . V.fromList)) _ -> error "gunfold" dataTypeOf _ = vDataType dataCast1 f = gcast1 f@@ -526,7 +495,6 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 (V n) where liftEq f0 (V as0) (V bs0) = go f0 (V.toList as0) (V.toList bs0) where go _ [] [] = True@@ -550,14 +518,7 @@ , (as, r2) <- g r1 , P.length as == reflectDim (Proxy :: Proxy n) ]-#else-instance Dim n => Eq1 (V n) where eq1 = (==)-instance Dim n => Ord1 (V n) where compare1 = compare-instance Dim n => Show1 (V n) where showsPrec1 = showsPrec-instance Dim n => Read1 (V n) where readsPrec1 = readsPrec-#endif - data instance U.Vector (V n a) = V_VN {-# UNPACK #-} !Int !(U.Vector a) data instance U.MVector s (V n a) = MV_VN {-# UNPACK #-} !Int !(U.MVector s a) instance (Dim n, U.Unbox a) => U.Unbox (V n a)@@ -583,14 +544,16 @@ go v vn d o j | j >= d = return () | otherwise = do- a <- G.basicUnsafeIndexM vn j+ a <- liftBox $ G.basicUnsafeIndexM vn j M.basicUnsafeWrite v o a go v vn d (o+1) (j+1)-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_VN _ v) = M.basicInitialize v {-# INLINE basicInitialize #-}-#endif +liftBox :: Monad m => Box a -> m a+liftBox (Box a) = return a+{-# INLINE liftBox #-}+ instance (Dim n, U.Unbox a) => G.Vector U.Vector (V n a) where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-}@@ -610,7 +573,6 @@ vLens i = \f (V v) -> f (v V.! i) <&> \a -> V (v V.// [(i, a)]) {-# INLINE vLens #-} -#ifdef USE_TYPE_LITS instance ( 1 <= n) => Field1 (V n a) (V n a) a a where _1 = vLens 0 instance ( 2 <= n) => Field2 (V n a) (V n a) a a where _2 = vLens 1 instance ( 3 <= n) => Field3 (V n a) (V n a) a a where _3 = vLens 2@@ -630,4 +592,3 @@ instance (17 <= n) => Field17 (V n a) (V n a) a a where _17 = vLens 16 instance (18 <= n) => Field18 (V n a) (V n a) a a where _18 = vLens 17 instance (19 <= n) => Field19 (V n a) (V n a) a a where _19 = vLens 18-#endif
src/Linear/V0.hs view
@@ -4,33 +4,11 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}--#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Trustworthy #-}-#endif--#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif-- ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -48,7 +26,7 @@ import Control.Applicative import Control.DeepSeq (NFData(rnf))-import Control.Lens+import Control.Lens as Lens import Control.Monad.Fix import Control.Monad.Zip import Data.Binary -- binary@@ -56,29 +34,23 @@ import Data.Data import Data.Distributive import Data.Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif import Data.Ix #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif import Data.Serialize -- cereal-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V-#endif import Foreign.Storable (Storable(..))-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import qualified Data.Vector.Generic.Mutable as M@@ -87,13 +59,16 @@ import Linear.Metric import Linear.Epsilon import Linear.Vector-#if __GLASGOW_HASKELL__ >= 707 import Linear.V-#endif+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..)) import Prelude hiding (sum) -- $setup+-- >>> import Control.Applicative -- >>> import Control.Lens+-- >>> import qualified Data.Foldable as F+-- >>> let sum xs = F.sum xs -- | A 0-dimensional vector --@@ -103,25 +78,29 @@ -- >>> V0 + V0 -- V0 ---data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite V0 where type Size V0 = 0 toV _ = V V.empty fromV _ = V0-#endif +instance Random (V0 a) where+ random g = (V0, g)+ randomR _ g = (V0, g)+ randomRs _ _ = repeat V0+ randoms _ = repeat V0++instance Uniform (V0 a) where++instance UniformRange (V0 a) where+ uniformRM (_, _) _ = pure V0+ instance Serial1 V0 where serializeWith _ = serialize deserializeWith _ = deserialize@@ -147,10 +126,8 @@ instance Foldable V0 where foldMap _ V0 = mempty {-# INLINE foldMap #-}-#if __GLASGOW_HASKELL__ >= 710 null _ = True length _ = 0-#endif instance Traversable V0 where traverse _ V0 = pure V0@@ -166,6 +143,15 @@ V0 <*> V0 = V0 {-# INLINE (<*>) #-} +instance Semigroup (V0 a) where+ _ <> _ = V0++instance Monoid (V0 a) where+ mempty = V0+#if !(MIN_VERSION_base(4,11,0))+ mappend _ _ = V0+#endif+ instance Additive V0 where zero = V0 {-# INLINE zero #-}@@ -179,8 +165,10 @@ {-# INLINE (>>-) #-} instance Monad V0 where+#if !(MIN_VERSION_base(4,11,0)) return _ = V0 {-# INLINE return #-}+#endif V0 >>= _ = V0 {-# INLINE (>>=) #-} @@ -255,18 +243,14 @@ {-# INLINE distribute #-} instance Hashable (V0 a) where-#if (MIN_VERSION_hashable(1,2,1)) || !(MIN_VERSION_hashable(1,2,0)) hash V0 = 0 {-# INLINE hash #-}-#endif hashWithSalt s V0 = s {-# INLINE hashWithSalt #-} -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 V0 where liftHashWithSalt _ s V0 = s {-# INLINE liftHashWithSalt #-}-#endif instance Epsilon (V0 a) where nearZero _ = True@@ -282,18 +266,24 @@ peek _ = return V0 {-# INLINE peek #-} -instance FunctorWithIndex (E V0) V0 where+instance WithIndex.FunctorWithIndex (E V0) V0 where imap _ V0 = V0 {-# INLINE imap #-} -instance FoldableWithIndex (E V0) V0 where+instance WithIndex.FoldableWithIndex (E V0) V0 where ifoldMap _ V0 = mempty {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E V0) V0 where+instance WithIndex.TraversableWithIndex (E V0) V0 where itraverse _ V0 = pure V0 {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E V0) V0 where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E V0) V0 where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E V0) V0 where itraverse = WithIndex.itraverse+#endif+ instance Representable V0 where type Rep V0 = E V0 tabulate _ = V0@@ -305,7 +295,7 @@ type instance IxValue (V0 a) = a instance Ixed (V0 a) where- ix = el+ ix i = el i {-# INLINE ix #-} instance Each (V0 a) (V0 b) a b where@@ -329,10 +319,8 @@ basicUnsafeNew n = return (MV_V0 n) basicUnsafeRead _ _ = return V0 basicUnsafeWrite _ _ _ = return ()-#if MIN_VERSION_vector(0,11,0) basicInitialize _ = return () {-# INLINE basicInitialize #-}-#endif instance G.Vector U.Vector (V0 a) where {-# INLINE basicUnsafeFreeze #-}@@ -363,7 +351,6 @@ instance NFData (V0 a) where rnf V0 = () -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 V0 where liftEq _ _ _ = True instance Ord1 V0 where@@ -372,9 +359,3 @@ liftShowsPrec _ _ = showsPrec instance Read1 V0 where liftReadsPrec _ _ = readsPrec-#else-instance Eq1 V0 where eq1 = (==)-instance Ord1 V0 where compare1 = compare-instance Show1 V0 where showsPrec1 = showsPrec-instance Read1 V0 where readsPrec1 = readsPrec-#endif
src/Linear/V1.hs view
@@ -8,30 +8,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif- ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -54,52 +35,49 @@ import Control.Monad (liftM) import Control.Monad.Fix import Control.Monad.Zip-import Control.Lens+import Control.Lens as Lens import Data.Binary as Binary import Data.Bytes.Serial import Data.Serialize as Cereal import Data.Data import Data.Distributive import Data.Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif import Data.Semigroup.Foldable-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V import Linear.V-#endif import Foreign.Storable (Storable) import GHC.Arr (Ix(..))-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import Linear.Metric import Linear.Epsilon import Linear.Vector import Prelude hiding (sum)+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..))+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup+#endif import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U -#ifdef HLINT--- HLint is delusional-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}-#endif- -- $setup+-- >>> import Control.Applicative -- >>> import Control.Lens+-- >>> import qualified Data.Foldable as F+-- >>> let sum xs = F.sum xs -- | A 1-dimensional vector --@@ -115,35 +93,29 @@ -- >>> sum (V1 2) -- 2 ---data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Data,Typeable)+--data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Data) newtype V1 a = V1 a- deriving (Eq,Ord,Show,Read,Data,Typeable,+ deriving (Eq,Ord,Show,Read,Data, Functor,Traversable, Epsilon,Storable,NFData-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) instance Foldable V1 where foldMap f (V1 a) = f a-#if __GLASGOW_HASKELL__ >= 710+#if MIN_VERSION_base(4,13,0)+ foldMap' f (V1 a) = f a+#endif null _ = False length _ = 1-#endif -#if __GLASGOW_HASKELL__ >= 707 instance Finite V1 where type Size V1 = 1 toV (V1 a) = V (V.singleton a) fromV (V v) = V1 (v V.! 0)-#endif instance Foldable1 V1 where foldMap1 f (V1 a) = f a@@ -176,8 +148,10 @@ {-# INLINE (>>-) #-} instance Monad V1 where+#if !(MIN_VERSION_base(4,11,0)) return = V1 {-# INLINE return #-}+#endif V1 a >>= f = f a {-# INLINE (>>=) #-} @@ -244,16 +218,12 @@ {-# INLINE acosh #-} instance Hashable a => Hashable (V1 a) where-#if (MIN_VERSION_hashable(1,2,1)) || !(MIN_VERSION_hashable(1,2,0)) hash (V1 a) = hash a-#endif hashWithSalt s (V1 a) = s `hashWithSalt` a -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 V1 where liftHashWithSalt h s (V1 a) = h s a {-# INLINE liftHashWithSalt #-}-#endif instance Metric V1 where dot (V1 a) (V1 b) = a * b@@ -305,23 +275,29 @@ index xs (E l) = view l xs {-# INLINE index #-} -instance FunctorWithIndex (E V1) V1 where+instance WithIndex.FunctorWithIndex (E V1) V1 where imap f (V1 a) = V1 (f ex a) {-# INLINE imap #-} -instance FoldableWithIndex (E V1) V1 where+instance WithIndex.FoldableWithIndex (E V1) V1 where ifoldMap f (V1 a) = f ex a {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E V1) V1 where+instance WithIndex.TraversableWithIndex (E V1) V1 where itraverse f (V1 a) = V1 <$> f ex a {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E V1) V1 where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E V1) V1 where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E V1) V1 where itraverse = WithIndex.itraverse+#endif+ type instance Index (V1 a) = E V1 type instance IxValue (V1 a) = a instance Ixed (V1 a) where- ix = el+ ix i = el i {-# INLINE ix #-} instance Each (V1 a) (V1 b) a b where@@ -345,10 +321,8 @@ basicUnsafeNew n = liftM MV_V1 (M.basicUnsafeNew n) basicUnsafeRead (MV_V1 v) i = liftM V1 (M.basicUnsafeRead v i) basicUnsafeWrite (MV_V1 v) i (V1 x) = M.basicUnsafeWrite v i x-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_V1 v) = M.basicInitialize v {-# INLINE basicInitialize #-}-#endif instance U.Unbox a => G.Vector U.Vector (V1 a) where {-# INLINE basicUnsafeFreeze #-}@@ -392,7 +366,17 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0))+instance Random a => Random (V1 a) where+ random g = case random g of (a, g') -> (V1 a, g')+ randoms g = V1 <$> randoms g+ randomR (V1 a, V1 b) g = case randomR (a, b) g of (a', g') -> (V1 a', g')+ randomRs (V1 a, V1 b) g = V1 <$> randomRs (a, b) g++instance Uniform a => Uniform (V1 a) where++instance UniformRange a => UniformRange (V1 a) where+ uniformRM (V1 a, V1 b) g = V1 <$> uniformRM (a, b) g+ instance Eq1 V1 where liftEq f (V1 a) (V1 b) = f a b instance Ord1 V1 where@@ -401,12 +385,16 @@ liftShowsPrec f _ d (V1 a) = showParen (d >= 10) $ showString "V1 " . f d a instance Read1 V1 where liftReadsPrec f _ = readsData $ readsUnaryWith f "V1" V1-#else-instance Eq1 V1 where eq1 = (==)-instance Ord1 V1 where compare1 = compare-instance Show1 V1 where showsPrec1 = showsPrec-instance Read1 V1 where readsPrec1 = readsPrec-#endif instance Field1 (V1 a) (V1 b) a b where _1 f (V1 x) = V1 <$> f x++instance Semigroup a => Semigroup (V1 a) where+ (<>) = liftA2 (<>)++instance Monoid a => Monoid (V1 a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif+
src/Linear/V2.hs view
@@ -5,31 +5,11 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif-- ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -49,6 +29,7 @@ , ex, ey , perp , angle+ , unangle , crossZ ) where @@ -57,35 +38,29 @@ import Control.Monad (liftM) import Control.Monad.Fix import Control.Monad.Zip-import Control.Lens hiding ((<.>))+import Control.Lens as Lens hiding ((<.>)) import Data.Binary as Binary import Data.Bytes.Serial import Data.Data import Data.Distributive import Data.Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif import Data.Semigroup import Data.Semigroup.Foldable import Data.Serialize as Cereal-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V-#endif import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import qualified Data.Vector.Generic.Mutable as M@@ -93,15 +68,18 @@ import qualified Data.Vector.Unboxed.Base as U import Linear.Metric import Linear.Epsilon-#if __GLASGOW_HASKELL__ >= 707 import Linear.V-#endif import Linear.Vector import Linear.V1 (R1(..),ex) import Prelude hiding (sum)+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..)) -- $setup+-- >>> import Control.Applicative -- >>> import Control.Lens+-- >>> import qualified Data.Foldable as F+-- >>> let sum xs = F.sum xs -- | A 2-dimensional vector --@@ -118,25 +96,33 @@ -- 3 data V2 a = V2 !a !a deriving- (Eq,Ord,Show,Read,Data,Typeable-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+ (Eq,Ord,Show,Read,Data+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite V2 where type Size V2 = 2 toV (V2 a b) = V (V.fromListN 2 [a,b]) fromV (V v) = V2 (v V.! 0) (v V.! 1)-#endif +instance Random a => Random (V2 a) where+ random g = case random g of+ (a, g') -> case random g' of+ (b, g'') -> (V2 a b, g'')+ {-# inline random #-}+ randomR (V2 a b, V2 c d) g = case randomR (a, c) g of+ (x, g') -> case randomR (b, d) g' of+ (y, g'') -> (V2 x y, g'')+ {-# inline randomR #-}++instance Uniform a => Uniform (V2 a) where++instance UniformRange a => UniformRange (V2 a) where+ uniformRM (V2 a b, V2 c d) g = V2 <$> uniformRM (a, c) g <*> uniformRM (b, d) g+ instance Functor V2 where fmap f (V2 a b) = V2 (f a) (f b) {-# INLINE fmap #-}@@ -146,10 +132,12 @@ instance Foldable V2 where foldMap f (V2 a b) = f a `mappend` f b {-# INLINE foldMap #-}-#if __GLASGOW_HASKELL__ >= 710+#if MIN_VERSION_base(4,13,0)+ foldMap' f (V2 a b) = f a `mappend` f b+ {-# INLINE foldMap' #-}+#endif null _ = False length _ = 2-#endif instance Traversable V2 where traverse f (V2 a b) = V2 <$> f a <*> f b@@ -177,11 +165,9 @@ hashWithSalt s (V2 a b) = s `hashWithSalt` a `hashWithSalt` b {-# INLINE hashWithSalt #-} -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 V2 where liftHashWithSalt h s (V2 a b) = s `h` a `h` b {-# INLINE liftHashWithSalt #-}-#endif instance Additive V2 where zero = pure 0@@ -198,8 +184,10 @@ {-# INLINE (>>-) #-} instance Monad V2 where+#if !(MIN_VERSION_base(4,11,0)) return a = V2 a a {-# INLINE return #-}+#endif V2 a b >>= f = V2 a' b' where V2 a' _ = f a V2 _ b' = f b@@ -356,23 +344,29 @@ index xs (E l) = view l xs {-# INLINE index #-} -instance FunctorWithIndex (E V2) V2 where+instance WithIndex.FunctorWithIndex (E V2) V2 where imap f (V2 a b) = V2 (f ex a) (f ey b) {-# INLINE imap #-} -instance FoldableWithIndex (E V2) V2 where+instance WithIndex.FoldableWithIndex (E V2) V2 where ifoldMap f (V2 a b) = f ex a `mappend` f ey b {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E V2) V2 where+instance WithIndex.TraversableWithIndex (E V2) V2 where itraverse f (V2 a b) = V2 <$> f ex a <*> f ey b {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E V2) V2 where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E V2) V2 where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E V2) V2 where itraverse = WithIndex.itraverse+#endif+ type instance Index (V2 a) = E V2 type instance IxValue (V2 a) = a instance Ixed (V2 a) where- ix = el+ ix i = el i {-# INLINE ix #-} instance Each (V2 a) (V2 b) a b where@@ -403,10 +397,8 @@ do let o = 2*i M.basicUnsafeWrite v o x M.basicUnsafeWrite v (o+1) y-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_V2 _ v) = M.basicInitialize v {-# INLINE basicInitialize #-}-#endif instance U.Unbox a => G.Vector U.Vector (V2 a) where {-# INLINE basicUnsafeFreeze #-}@@ -434,6 +426,13 @@ angle :: Floating a => a -> V2 a angle a = V2 (cos a) (sin a) +unangle :: (Floating a, Ord a) => V2 a -> a+unangle a@(V2 ax ay) =+ let alpha = asin $ ay / norm a+ in if ax < 0+ then pi - alpha+ else alpha+ -- | The Z-component of the cross product of two vectors in the XY-plane. -- -- >>> crossZ (V2 1 0) (V2 0 1)@@ -467,7 +466,6 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 V2 where liftEq f (V2 a b) (V2 c d) = f a c && f b d instance Ord1 V2 where@@ -476,15 +474,18 @@ liftReadsPrec f _ = readsData $ readsBinaryWith f f "V2" V2 instance Show1 V2 where liftShowsPrec f _ d (V2 a b) = showsBinaryWith f f "V2" d a b-#else-instance Eq1 V2 where eq1 = (==)-instance Ord1 V2 where compare1 = compare-instance Show1 V2 where showsPrec1 = showsPrec-instance Read1 V2 where readsPrec1 = readsPrec-#endif instance Field1 (V2 a) (V2 a) a a where _1 f (V2 x y) = f x <&> \x' -> V2 x' y instance Field2 (V2 a) (V2 a) a a where _2 f (V2 x y) = f y <&> \y' -> V2 x y'++instance Semigroup a => Semigroup (V2 a) where+ (<>) = liftA2 (<>)++instance Monoid a => Monoid (V2 a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif
src/Linear/V3.hs view
@@ -5,30 +5,11 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif- ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -52,76 +33,66 @@ , ex, ey, ez ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative+#endif import Control.DeepSeq (NFData(rnf)) import Control.Monad (liftM) import Control.Monad.Fix import Control.Monad.Zip-import Control.Lens hiding ((<.>))+import Control.Lens as Lens hiding ((<.>)) import Data.Binary as Binary -- binary import Data.Bytes.Serial -- bytes import Data.Data import Data.Distributive import Data.Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif import Data.Semigroup.Foldable import Data.Serialize as Cereal -- cereal-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V-#endif import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import Linear.Epsilon import Linear.Metric-#if __GLASGOW_HASKELL__ >= 707 import Linear.V-#endif import Linear.V2 import Linear.Vector+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..)) -{-# ANN module "HLint: ignore Reduce duplication" #-}+-- $setup+-- >>> import Control.Lens hiding (index) -- | A 3-dimensional vector-data V3 a = V3 !a !a !a deriving (Eq,Ord,Show,Read,Data,Typeable-#if __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+data V3 a = V3 !a !a !a deriving (Eq,Ord,Show,Read,Data+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite V3 where type Size V3 = 3 toV (V3 a b c) = V (V.fromListN 3 [a,b,c]) fromV (V v) = V3 (v V.! 0) (v V.! 1) (v V.! 2)-#endif instance Functor V3 where fmap f (V3 a b c) = V3 (f a) (f b) (f c)@@ -132,11 +103,31 @@ instance Foldable V3 where foldMap f (V3 a b c) = f a `mappend` f b `mappend` f c {-# INLINE foldMap #-}-#if __GLASGOW_HASKELL__ >= 710+#if MIN_VERSION_base(4,13,0)+ foldMap' f (V3 a b c) = (f a `mappend` f b) `mappend` f c+ {-# INLINE foldMap' #-}+#endif null _ = False length _ = 3-#endif +instance Random a => Random (V3 a) where+ random g = case random g of+ (a, g') -> case random g' of+ (b, g'') -> case random g'' of+ (c, g''') -> (V3 a b c, g''')+ randomR (V3 a b c, V3 a' b' c') g = case randomR (a,a') g of+ (a'', g') -> case randomR (b,b') g' of+ (b'', g'') -> case randomR (c,c') g'' of+ (c'', g''') -> (V3 a'' b'' c'', g''')++instance Uniform a => Uniform (V3 a) where++instance UniformRange a => UniformRange (V3 a) where+ uniformRM (V3 a b c, V3 a' b' c') g = V3+ <$> uniformRM (a, a') g+ <*> uniformRM (b, b') g+ <*> uniformRM (c, c') g+ instance Traversable V3 where traverse f (V3 a b c) = V3 <$> f a <*> f b <*> f c {-# INLINE traverse #-}@@ -175,8 +166,10 @@ {-# INLINE (>>-) #-} instance Monad V3 where+#if !(MIN_VERSION_base(4,11,0)) return a = V3 a a a {-# INLINE return #-}+#endif V3 a b c >>= f = V3 a' b' c' where V3 a' _ _ = f a V3 _ b' _ = f b@@ -249,11 +242,9 @@ hashWithSalt s (V3 a b c) = s `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c {-# INLINE hashWithSalt #-} -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 V3 where liftHashWithSalt h s (V3 a b c) = s `h` a `h` b `h` c {-# INLINE liftHashWithSalt #-}-#endif instance Metric V3 where dot (V3 a b c) (V3 d e f) = a * d + b * e + c * f@@ -378,23 +369,29 @@ index xs (E l) = view l xs {-# INLINE index #-} -instance FunctorWithIndex (E V3) V3 where+instance WithIndex.FunctorWithIndex (E V3) V3 where imap f (V3 a b c) = V3 (f ex a) (f ey b) (f ez c) {-# INLINE imap #-} -instance FoldableWithIndex (E V3) V3 where+instance WithIndex.FoldableWithIndex (E V3) V3 where ifoldMap f (V3 a b c) = f ex a `mappend` f ey b `mappend` f ez c {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E V3) V3 where+instance WithIndex.TraversableWithIndex (E V3) V3 where itraverse f (V3 a b c) = V3 <$> f ex a <*> f ey b <*> f ez c {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E V3) V3 where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E V3) V3 where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E V3) V3 where itraverse = WithIndex.itraverse+#endif+ type instance Index (V3 a) = E V3 type instance IxValue (V3 a) = a instance Ixed (V3 a) where- ix = el+ ix i = el i {-# INLINE ix #-} instance Each (V3 a) (V3 b) a b where@@ -427,10 +424,8 @@ M.basicUnsafeWrite v o x M.basicUnsafeWrite v (o+1) y M.basicUnsafeWrite v (o+2) z-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_V3 _ v) = M.basicInitialize v {-# INLINE basicInitialize #-}-#endif instance U.Unbox a => G.Vector U.Vector (V3 a) where {-# INLINE basicUnsafeFreeze #-}@@ -482,7 +477,6 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 V3 where liftEq k (V3 a b c) (V3 d e f) = k a d && k b e && k c f instance Ord1 V3 where@@ -498,12 +492,6 @@ instance Show1 V3 where liftShowsPrec f _ d (V3 a b c) = showParen (d > 10) $ showString "V3 " . f 11 a . showChar ' ' . f 11 b . showChar ' ' . f 11 c-#else-instance Eq1 V3 where eq1 = (==)-instance Ord1 V3 where compare1 = compare-instance Show1 V3 where showsPrec1 = showsPrec-instance Read1 V3 where readsPrec1 = readsPrec-#endif instance Field1 (V3 a) (V3 a) a a where _1 f (V3 x y z) = f x <&> \x' -> V3 x' y z@@ -513,3 +501,13 @@ instance Field3 (V3 a) (V3 a) a a where _3 f (V3 x y z) = f z <&> \z' -> V3 x y z'++instance Semigroup a => Semigroup (V3 a) where+ (<>) = liftA2 (<>)++instance Monoid a => Monoid (V3 a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif+
src/Linear/V4.hs view
@@ -5,29 +5,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DataKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif -#ifndef MIN_VERSION_hashable-#define MIN_VERSION_hashable(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1-#endif--#ifndef MIN_VERSION_transformers-#define MIN_VERSION_transformers(x,y,z) 1-#endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -58,77 +40,67 @@ , ex, ey, ez, ew ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative+#endif import Control.DeepSeq (NFData(rnf)) import Control.Monad (liftM) import Control.Monad.Fix import Control.Monad.Zip-import Control.Lens hiding ((<.>))+import Control.Lens as Lens hiding ((<.>)) import Data.Binary as Binary import Data.Bytes.Serial import Data.Data import Data.Distributive import Data.Foldable+import qualified Data.Foldable.WithIndex as WithIndex import Data.Functor.Bind import Data.Functor.Classes import Data.Functor.Rep+import qualified Data.Functor.WithIndex as WithIndex import Data.Hashable-#if (MIN_VERSION_hashable(1,2,5)) import Data.Hashable.Lifted-#endif #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif import Data.Semigroup.Foldable import Data.Serialize as Cereal-#if __GLASGOW_HASKELL__ >= 707+import qualified Data.Traversable.WithIndex as WithIndex import qualified Data.Vector as V-#endif import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif-#if __GLASGOW_HASKELL__ >= 800+import GHC.Generics (Generic, Generic1)+#if defined(MIN_VERSION_template_haskell) import Language.Haskell.TH.Syntax (Lift) #endif import Linear.Epsilon import Linear.Metric-#if __GLASGOW_HASKELL__ >= 707 import Linear.V-#endif import Linear.V2 import Linear.V3 import Linear.Vector+import System.Random (Random(..), Uniform)+import System.Random.Stateful (UniformRange(..)) -{-# ANN module "HLint: ignore Reduce duplication" #-}+-- $setup+-- >>> import Control.Lens hiding (index) -- | A 4-dimensional vector.-data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show,Read,Data,Typeable-#if __GLASGOW_HASKELL__ >= 702- ,Generic-#endif-#if __GLASGOW_HASKELL__ >= 706- ,Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800+data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show,Read,Data+ ,Generic,Generic1+#if defined(MIN_VERSION_template_haskell) ,Lift #endif ) -#if __GLASGOW_HASKELL__ >= 707 instance Finite V4 where type Size V4 = 4 toV (V4 a b c d) = V (V.fromListN 4 [a,b,c,d]) fromV (V v) = V4 (v V.! 0) (v V.! 1) (v V.! 2) (v V.! 3)-#endif instance Functor V4 where fmap f (V4 a b c d) = V4 (f a) (f b) (f c) (f d)@@ -139,11 +111,34 @@ instance Foldable V4 where foldMap f (V4 a b c d) = f a `mappend` f b `mappend` f c `mappend` f d {-# INLINE foldMap #-}-#if __GLASGOW_HASKELL__ >= 710+#if MIN_VERSION_base(4,13,0)+ foldMap' f (V4 a b c d) = ((f a `mappend` f b) `mappend` f c) `mappend` f d+ {-# INLINE foldMap' #-}+#endif null _ = False length _ = 4-#endif +instance Random a => Random (V4 a) where+ random g = case random g of+ (a, g') -> case random g' of+ (b, g'') -> case random g'' of+ (c, g''') -> case random g''' of+ (d, g'''') -> (V4 a b c d, g'''')+ randomR (V4 a b c d, V4 a' b' c' d') g = case randomR (a,a') g of+ (a'', g') -> case randomR (b,b') g' of+ (b'', g'') -> case randomR (c,c') g'' of+ (c'', g''') -> case randomR (d,d') g''' of+ (d'', g'''') -> (V4 a'' b'' c'' d'', g'''')++instance Uniform a => Uniform (V4 a) where++instance UniformRange a => UniformRange (V4 a) where+ uniformRM (V4 a b c d, V4 a' b' c' d') g = V4+ <$> uniformRM (a, a') g+ <*> uniformRM (b, b') g+ <*> uniformRM (c, c') g+ <*> uniformRM (d, d') g+ instance Traversable V4 where traverse f (V4 a b c d) = V4 <$> f a <*> f b <*> f c <*> f d {-# INLINE traverse #-}@@ -183,8 +178,10 @@ {-# INLINE (>>-) #-} instance Monad V4 where+#if !(MIN_VERSION_base(4,11,0)) return a = V4 a a a a {-# INLINE return #-}+#endif V4 a b c d >>= f = V4 a' b' c' d' where V4 a' _ _ _ = f a V4 _ b' _ _ = f b@@ -269,11 +266,9 @@ hashWithSalt s (V4 a b c d) = s `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d {-# INLINE hashWithSalt #-} -#if (MIN_VERSION_hashable(1,2,5)) instance Hashable1 V4 where liftHashWithSalt h s (V4 a b c d) = s `h` a `h` b `h` c `h` d {-# INLINE liftHashWithSalt #-}-#endif -- | A space that distinguishes orthogonal basis vectors '_x', '_y', '_z', '_w'. (It may have more.) class R3 t => R4 t where@@ -525,23 +520,29 @@ index xs (E l) = view l xs {-# INLINE index #-} -instance FunctorWithIndex (E V4) V4 where+instance WithIndex.FunctorWithIndex (E V4) V4 where imap f (V4 a b c d) = V4 (f ex a) (f ey b) (f ez c) (f ew d) {-# INLINE imap #-} -instance FoldableWithIndex (E V4) V4 where+instance WithIndex.FoldableWithIndex (E V4) V4 where ifoldMap f (V4 a b c d) = f ex a `mappend` f ey b `mappend` f ez c `mappend` f ew d {-# INLINE ifoldMap #-} -instance TraversableWithIndex (E V4) V4 where+instance WithIndex.TraversableWithIndex (E V4) V4 where itraverse f (V4 a b c d) = V4 <$> f ex a <*> f ey b <*> f ez c <*> f ew d {-# INLINE itraverse #-} +#if !MIN_VERSION_lens(5,0,0)+instance Lens.FunctorWithIndex (E V4) V4 where imap = WithIndex.imap+instance Lens.FoldableWithIndex (E V4) V4 where ifoldMap = WithIndex.ifoldMap+instance Lens.TraversableWithIndex (E V4) V4 where itraverse = WithIndex.itraverse+#endif+ type instance Index (V4 a) = E V4 type instance IxValue (V4 a) = a instance Ixed (V4 a) where- ix = el+ ix i = el i instance Each (V4 a) (V4 b) a b where each = traverse@@ -568,9 +569,7 @@ M.basicUnsafeWrite v (o+1) y M.basicUnsafeWrite v (o+2) z M.basicUnsafeWrite v (o+3) w-#if MIN_VERSION_vector(0,11,0) basicInitialize (MV_V4 _ v) = M.basicInitialize v-#endif instance U.Unbox a => G.Vector U.Vector (V4 a) where basicUnsafeFreeze (MV_V4 n v) = liftM ( V_V4 n) (G.basicUnsafeFreeze v)@@ -619,7 +618,6 @@ put = serializeWith Cereal.put get = deserializeWith Cereal.get -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq1 V4 where liftEq k (V4 a b c d) (V4 e f g h) = k a e && k b f && k c g && k d h instance Ord1 V4 where@@ -636,12 +634,6 @@ instance Show1 V4 where liftShowsPrec f _ z (V4 a b c d) = showParen (z > 10) $ showString "V4 " . f 11 a . showChar ' ' . f 11 b . showChar ' ' . f 11 c . showChar ' ' . f 11 d-#else-instance Eq1 V4 where eq1 = (==)-instance Ord1 V4 where compare1 = compare-instance Show1 V4 where showsPrec1 = showsPrec-instance Read1 V4 where readsPrec1 = readsPrec-#endif instance Field1 (V4 a) (V4 a) a a where _1 f (V4 x y z w) = f x <&> \x' -> V4 x' y z w@@ -654,3 +646,13 @@ instance Field4 (V4 a) (V4 a) a a where _4 f (V4 x y z w) = f w <&> \w' -> V4 x y z w'++instance Semigroup a => Semigroup (V4 a) where+ (<>) = liftA2 (<>)++instance Monoid a => Monoid (V4 a) where+ mempty = pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = liftA2 mappend+#endif+
src/Linear/Vector.hs view
@@ -2,12 +2,10 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DefaultSignatures #-}-#define USE_GHC_GENERICS-#endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -36,27 +34,19 @@ import Control.Applicative import Control.Lens import Data.Complex-#if __GLASGOW_HASKELL__ < 710-import Data.Foldable as Foldable (Foldable, forM_, foldl')-#else import Data.Foldable as Foldable (forM_, foldl')-#endif+import Data.Functor.Compose+import Data.Functor.Product import Data.HashMap.Lazy as HashMap import Data.Hashable import Data.IntMap as IntMap import Data.Map as Map-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (mempty)-#endif-import Data.Vector as Vector-import Data.Vector.Mutable as Mutable-#ifdef USE_GHC_GENERICS+import qualified Data.Vector as Vector+import Data.Vector (Vector)+import qualified Data.Vector.Mutable as Mutable import GHC.Generics-#endif import Linear.Instances () -{-# ANN module "HLint: ignore Redundant lambda" #-}- -- $setup -- >>> import Linear.V2 @@ -66,7 +56,6 @@ infixl 6 ^+^, ^-^ infixl 7 ^*, *^, ^/ -#ifdef USE_GHC_GENERICS class GAdditive f where gzero :: Num a => f a gliftU2 :: (a -> a -> a) -> f a -> f a -> f a@@ -88,6 +77,14 @@ gliftI2 f (a :*: b) (c :*: d) = gliftI2 f a c :*: gliftI2 f b d {-# INLINE gliftI2 #-} +instance (Additive f, GAdditive g) => GAdditive (f :.: g) where+ gzero = Comp1 $ gzero <$ (zero :: f Int)+ {-# INLINE gzero #-}+ gliftU2 f (Comp1 a) (Comp1 b) = Comp1 $ liftU2 (gliftU2 f) a b+ {-# INLINE gliftU2 #-}+ gliftI2 f (Comp1 a) (Comp1 b) = Comp1 $ liftI2 (gliftI2 f) a b+ {-# INLINE gliftI2 #-}+ instance Additive f => GAdditive (Rec1 f) where gzero = Rec1 zero {-# INLINE gzero #-}@@ -110,19 +107,15 @@ {-# INLINE gliftU2 #-} gliftI2 f (Par1 a) (Par1 b) = Par1 (f a b) {-# INLINE gliftI2 #-}-#endif - -- | A vector is an additive group with additional structure. class Functor f => Additive f where -- | The zero vector zero :: Num a => f a-#ifdef USE_GHC_GENERICS #ifndef HLINT default zero :: (GAdditive (Rep1 f), Generic1 f, Num a) => f a zero = to1 gzero #endif-#endif -- | Compute the sum of two vectors --@@ -140,8 +133,13 @@ x ^-^ y = x ^+^ negated y -- | Linearly interpolate between two vectors.+ --+ -- /Since linear version 1.23, interpolation direction has been reversed; now/+ --+ -- > lerp 0 a b == a+ -- > lerp 1 a b == b lerp :: Num a => a -> f a -> f a -> f a- lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v+ lerp alpha u v = (1 - alpha) *^ u ^+^ alpha *^ v {-# INLINE lerp #-} -- | Apply a function to merge the 'non-zero' components of two vectors, unioning the rest of the values.@@ -150,13 +148,11 @@ -- -- * For a sparse vector this is equivalent to 'unionWith'. liftU2 :: (a -> a -> a) -> f a -> f a -> f a-#ifdef USE_GHC_GENERICS #ifndef HLINT default liftU2 :: Applicative f => (a -> a -> a) -> f a -> f a -> f a liftU2 = liftA2 {-# INLINE liftU2 #-} #endif-#endif -- | Apply a function to the components of two vectors. --@@ -164,14 +160,32 @@ -- -- * For a sparse vector this is equivalent to 'intersectionWith'. liftI2 :: (a -> b -> c) -> f a -> f b -> f c-#ifdef USE_GHC_GENERICS #ifndef HLINT default liftI2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c liftI2 = liftA2 {-# INLINE liftI2 #-} #endif-#endif +instance (Additive f, Additive g) => Additive (Product f g) where+ zero = Pair zero zero+ liftU2 f (Pair a b) (Pair c d) = Pair (liftU2 f a c) (liftU2 f b d)+ liftI2 f (Pair a b) (Pair c d) = Pair (liftI2 f a c) (liftI2 f b d)+ Pair a b ^+^ Pair c d = Pair (a ^+^ c) (b ^+^ d)+ Pair a b ^-^ Pair c d = Pair (a ^-^ c) (b ^-^ d)+ lerp alpha (Pair a b) (Pair c d) = Pair (lerp alpha a c) (lerp alpha b d)++instance (Additive f, Additive g) => Additive (Compose f g) where+ zero = Compose $ zero <$ (zero :: f Int)+ {-# INLINE zero #-}+ Compose a ^+^ Compose b = Compose $ liftU2 (^+^) a b+ {-# INLINE (^+^) #-}+ Compose a ^-^ Compose b = Compose $ liftU2 (^-^) a b+ {-# INLINE (^-^) #-}+ liftU2 f (Compose a) (Compose b) = Compose $ liftU2 (liftU2 f) a b+ {-# INLINE liftU2 #-}+ liftI2 f (Compose a) (Compose b) = Compose $ liftI2 (liftI2 f) a b+ {-# INLINE liftI2 #-}+ instance Additive ZipList where zero = ZipList [] {-# INLINE zero #-}@@ -185,10 +199,10 @@ {-# INLINE zero #-} liftU2 f u v = case compare lu lv of LT | lu == 0 -> v- | otherwise -> Vector.modify (\ w -> Foldable.forM_ [0..lu-1] $ \i -> unsafeWrite w i $ f (unsafeIndex u i) (unsafeIndex v i)) v+ | otherwise -> Vector.modify (\ w -> Foldable.forM_ [0..lu-1] $ \i -> Mutable.unsafeWrite w i $ f (Vector.unsafeIndex u i) (Vector.unsafeIndex v i)) v EQ -> Vector.zipWith f u v GT | lv == 0 -> u- | otherwise -> Vector.modify (\ w -> Foldable.forM_ [0..lv-1] $ \i -> unsafeWrite w i $ f (unsafeIndex u i) (unsafeIndex v i)) u+ | otherwise -> Vector.modify (\ w -> Foldable.forM_ [0..lv-1] $ \i -> Mutable.unsafeWrite w i $ f (Vector.unsafeIndex u i) (Vector.unsafeIndex v i)) u where lu = Vector.length u lv = Vector.length v
− tests/Binary.hs
@@ -1,23 +0,0 @@-{-# LANGUAGE CPP #-}-module Binary (tests) where--#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-#endif-import Data.Binary.Put-import Data.Binary.Get-import Linear-import qualified Data.ByteString.Lazy as BS-import Test.HUnit--originalVecs :: (V3 Float, V2 Char)-originalVecs = (V3 1 2 3, V2 'a' 'b')--bytes :: BS.ByteString-bytes = runPut $ do putLinear $ fst originalVecs- putLinear $ snd originalVecs--tests :: Test-tests = test [ "Serialized length" ~: BS.length bytes ~?= 3*13+2- , "Deserialization" ~: deserialized ~?= originalVecs ]- where deserialized = runGet ((,) <$> getLinear <*> getLinear) bytes
− tests/Plucker.hs
@@ -1,35 +0,0 @@-module Plucker (tests) where-import Linear-import Linear.Plucker-import Linear.Plucker.Coincides-import Test.HUnit--ln2,ln3,ln4,ln5,ln6,ln7,ln8,ln9 :: Plucker Float-ln2 = plucker3D (V3 1 3 0) (V3 1 3 (-2)) -- starting line-ln3 = plucker3D (V3 2 3 0) (V3 2 3 (-2)) -- parallel-ln4 = plucker3D (V3 2 4 0) (V3 1 4 (-2)) -- ccw-ln5 = plucker3D (V3 (-2) 4 0) (V3 2 4 (-2)) -- cw-ln6 = plucker3D (V3 2 3 0) (V3 1 3 (-2)) -- intersect-ln7 = plucker3D (V3 1 3 0) (V3 1 3 2) -- reversed-ln8 = plucker3D (V3 0 4 4) (V3 0 (-4) (-4)) -- through origin-ln9 = Plucker 1 2 3 4 5 6 -- not a 3D line--tests :: Test-tests = test [ "parallel" ~: parallel ln2 ln3 ~?= True- , "CCW" ~: passes ln2 ln4 ~?= Counterclockwise - , "CW" ~: passes ln2 ln5 ~?= Clockwise- , "intersect1" ~: intersects ln2 ln6 ~?= True - , "intersect2" ~: intersects ln2 ln3 ~?= False- , "line equality 1" ~: Line ln2 == Line ln2 ~?= True - , "line equality 2" ~: Line ln2 == Line ln7 ~?= True - , "line equality 3" ~: Line ln2 == Ray ln7 ~?= True- , "line equality 4" ~: Ray ln2 == Line ln7 ~?= True- , "ray equality 1" ~: Ray ln2 == Ray ln7 ~?= False- , "ray equality 2" ~: Ray ln2 == Ray (3 *^ ln2) ~?= True- , "ray equality 3" ~: Ray ln2 == Ray (negate ln7) ~?= True- , "quadrance" ~: nearZero (quadranceToOrigin ln2 - 10) ~?= True- , "closest 1" ~: - nearZero (qd (V3 1 3 0) $ closestToOrigin ln2) ~?= True- , "closest 2" ~: nearZero (qd 0 $ closestToOrigin ln8) ~?= True- , "isLine 1" ~: isLine ln2 ~?= True- , "isLine 2" ~: isLine ln9 ~?= False ]
+ tests/Prop/Quaternion.hs view
@@ -0,0 +1,28 @@+{-# OPTIONS_GHC -Wno-orphans #-}+module Prop.Quaternion (tests) where++import Linear.Quaternion (Quaternion(..))+import Linear.Epsilon (nearZero)+import Linear.Vector (lerp)+import Test.QuickCheck (Arbitrary(..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import Prop.V3 ()++instance Arbitrary a => Arbitrary (Quaternion a) where+ arbitrary = Quaternion <$> arbitrary <*> arbitrary++prop_lerp0 :: Quaternion Double -> Quaternion Double -> Bool+prop_lerp0 a b = nearZero (lerp 0 a b - a)++prop_lerp1 :: Quaternion Double -> Quaternion Double -> Bool+prop_lerp1 a b = nearZero (lerp 1 a b - b)++tests :: [TestTree]+tests =+ [ testGroup "lerp"+ [ testProperty "lerp 0 a b == a" prop_lerp0+ , testProperty "lerp 1 a b == b" prop_lerp1+ ]+ ]
+ tests/Prop/V3.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -Wno-orphans #-}+module Prop.V3 () where++import Linear.V3 (V3(..))+import Test.QuickCheck (Arbitrary(..))++instance Arbitrary a => Arbitrary (V3 a) where+ arbitrary = V3 <$> arbitrary <*> arbitrary <*> arbitrary
+ tests/Test.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+module Main (main) where++import Test.Tasty (defaultMain, testGroup, TestTree)++import qualified Prop.Quaternion+import qualified Unit.Binary+import qualified Unit.Plucker+import qualified Unit.V++tests :: [TestTree]+tests =+ [ testGroup "Property tests"+ [ testGroup "Quaternion" Prop.Quaternion.tests+ ]+ , testGroup "Unit tests"+ [ testGroup "Binary" Unit.Binary.tests+ , testGroup "Plucker" Unit.Plucker.tests+ , testGroup "V" Unit.V.tests+ ]+ ]++main :: IO ()+main = defaultMain $ testGroup "linear" tests
+ tests/Unit/Binary.hs view
@@ -0,0 +1,20 @@+module Unit.Binary (tests) where++import Data.Binary.Put+import Data.Binary.Get+import Linear+import qualified Data.ByteString.Lazy as BS+import Test.Tasty (TestTree)+import Test.Tasty.HUnit ((@?=), testCase)++originalVecs :: (V3 Float, V2 Char)+originalVecs = (V3 1 2 3, V2 'a' 'b')++bytes :: BS.ByteString+bytes = runPut $ do putLinear $ fst originalVecs+ putLinear $ snd originalVecs++tests :: [TestTree]+tests = [ testCase "Serialized length" $ BS.length bytes @?= 3*13+2+ , testCase "Deserialization" $ deserialized @?= originalVecs ]+ where deserialized = runGet ((,) <$> getLinear <*> getLinear) bytes
+ tests/Unit/Plucker.hs view
@@ -0,0 +1,36 @@+module Unit.Plucker (tests) where+import Linear+import Linear.Plucker+import Linear.Plucker.Coincides+import Test.Tasty (TestTree)+import Test.Tasty.HUnit ((@?=), testCase)++ln2,ln3,ln4,ln5,ln6,ln7,ln8,ln9 :: Plucker Float+ln2 = plucker3D (V3 1 3 0) (V3 1 3 (-2)) -- starting line+ln3 = plucker3D (V3 2 3 0) (V3 2 3 (-2)) -- parallel+ln4 = plucker3D (V3 2 4 0) (V3 1 4 (-2)) -- ccw+ln5 = plucker3D (V3 (-2) 4 0) (V3 2 4 (-2)) -- cw+ln6 = plucker3D (V3 2 3 0) (V3 1 3 (-2)) -- intersect+ln7 = plucker3D (V3 1 3 0) (V3 1 3 2) -- reversed+ln8 = plucker3D (V3 0 4 4) (V3 0 (-4) (-4)) -- through origin+ln9 = Plucker 1 2 3 4 5 6 -- not a 3D line++tests :: [TestTree]+tests = [ testCase "parallel" $ parallel ln2 ln3 @?= True+ , testCase "CCW" $ passes ln2 ln4 @?= Counterclockwise+ , testCase "CW" $ passes ln2 ln5 @?= Clockwise+ , testCase "intersect1" $ intersects ln2 ln6 @?= True+ , testCase "intersect2" $ intersects ln2 ln3 @?= False+ , testCase "line equality 1" $ Line ln2 == Line ln2 @?= True+ , testCase "line equality 2" $ Line ln2 == Line ln7 @?= True+ , testCase "line equality 3" $ Line ln2 == Ray ln7 @?= True+ , testCase "line equality 4" $ Ray ln2 == Line ln7 @?= True+ , testCase "ray equality 1" $ Ray ln2 == Ray ln7 @?= False+ , testCase "ray equality 2" $ Ray ln2 == Ray (3 *^ ln2) @?= True+ , testCase "ray equality 3" $ Ray ln2 == Ray (negate ln7) @?= True+ , testCase "quadrance" $ nearZero (quadranceToOrigin ln2 - 10) @?= True+ , testCase "closest 1" $+ nearZero (qd (V3 1 3 0) $ closestToOrigin ln2) @?= True+ , testCase "closest 2" $ nearZero (qd 0 $ closestToOrigin ln8) @?= True+ , testCase "isLine 1" $ isLine ln2 @?= True+ , testCase "isLine 2" $ isLine ln9 @?= False ]
+ tests/Unit/V.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DataKinds #-}+module Unit.V (tests) where++import Control.DeepSeq (rnf)+import qualified Data.Vector.Unboxed as U (fromList)+import Linear.V (V)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit ((@?=), testCase)++v10 :: V 10 Int+v10 = return 5++tests :: [TestTree]+tests = [ testCase "GH124" $ rnf (U.fromList [v10]) @?= () ]
− tests/UnitTests.hs
@@ -1,20 +0,0 @@-{-# LANGUAGE CPP #-}-module Main (main) where-import Test.Framework (defaultMain, testGroup, Test)-import Test.Framework.Providers.HUnit-import qualified Plucker-import qualified Binary-#if __GLASGOW_HASKELL__ >= 707-import qualified V-#endif--tests :: [Test]-tests = [ testGroup "Plucker" $ hUnitTestToTests Plucker.tests- , testGroup "Binary" $ hUnitTestToTests Binary.tests-#if __GLASGOW_HASKELL__ >= 707- , testGroup "V" $ hUnitTestToTests V.tests-#endif- ]--main :: IO ()-main = defaultMain tests
− tests/V.hs
@@ -1,13 +0,0 @@-{-# LANGUAGE DataKinds #-}-module V (tests) where--import Control.DeepSeq (rnf)-import qualified Data.Vector.Unboxed as U (fromList)-import Linear.V (V)-import Test.HUnit--v10 :: V 10 Int-v10 = return 5--tests :: Test-tests = test [ "GH124" ~: rnf (U.fromList [v10]) ~?= () ]
tests/doctests.hs view
@@ -7,19 +7,13 @@ -- Stability : provisional -- Portability : portable ----- This module provides doctests for a project based on the actual versions--- of the packages it was built with. It requires a corresponding Setup.lhs--- to be added to the project+-- This module exists to add dependencies ----------------------------------------------------------------------------- module Main where -import Build_doctests (flags, pkgs, module_sources)-import Data.Foldable (traverse_)-import Test.DocTest- main :: IO () main = do- traverse_ putStrLn args- doctest args- where- args = flags ++ pkgs ++ module_sources+ putStrLn "This test-suite exists only to add dependencies"+ putStrLn "To run doctests: "+ putStrLn " cabal build all --enable-tests"+ putStrLn " cabal-docspec"
− travis/cabal-apt-install
@@ -1,27 +0,0 @@-#! /bin/bash-set -eu--APT="sudo apt-get -q -y"-CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall"--$APT update-$APT install dctrl-tools--# Find potential system packages to satisfy cabal dependencies-deps()-{- local M='^\([^ ]\+\)-[0-9.]\+ (.*$'- local G=' -o ( -FPackage -X libghc-\L\1\E-dev )'- local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \- | sed -ne "s/$M/$G/p" | sort -u)"- grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u-}--$APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special-$CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage--if ! $APT install hlint ; then- $APT install $(deps hlint)- cabal install hlint-fi-
− travis/config
@@ -1,16 +0,0 @@--- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix------ This is particularly useful for travis-ci to get it to stop complaining--- about a broken build when everything is still correct on our end.------ This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead------ To enable this, uncomment the before_script in .travis.yml--remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive-remote-repo-cache: ~/.cabal/packages-world-file: ~/.cabal/world-build-summary: ~/.cabal/logs/build.log-remote-build-reporting: anonymous-install-dirs user-install-dirs global