mini 1.6.3.0 → 1.6.4.0

raw patch · 10 files changed

+1599/−5 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• mini.cabal +11/−4
• src/Mini/Linear/Approx.hs +36/−0
• src/Mini/Linear/Matrix.hs +248/−0
• src/Mini/Linear/Quaternion.hs +271/−0
• src/Mini/Linear/Space.hs +680/−0
• src/Mini/Linear/Transform2D.hs +73/−0
• src/Mini/Linear/Transform3D.hs +117/−0
• src/Mini/Linear/Vector.hs +151/−0
• src/Mini/Optics/Lens.hs +1/−1

@@ -1,3 +1,14 @@+1.6.4.0 [2026-07-08]+--------------------+* Create Mini.Linear: Linear algebra+  * .Approx: Checking for approximate equality+  * .Matrix: Matrix operations+  * .Quaternion: Quaternion transforms+  * .Space: Vector spaces+  * .Transform2D: Two-dimensional affine transforms+  * .Transform3D: Three-dimensional affine transforms+  * .Vector: Vector operations+ 1.6.3.0 [2026-05-02] -------------------- * Create Mini.Random.SplitMix: An implementation of SplitMix, based on

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               mini-version:            1.6.3.0+version:            1.6.4.0 license:            MIT license-file:       LICENSE author:             Victor Wallsten <victor.wallsten@protonmail.com>@@ -9,14 +9,14 @@ bug-reports:        https://gitlab.com/vicwall/mini/issues synopsis:           Minimal essentials description:-  Everyday essentials: data structures, primitive recursion, hashing, lenses,-  randomness, transformers, and parsing.+  Everyday essentials: data structures, primitive recursion, hashing, linear+  algebra, lenses, randomness, transformers, and parsing.    Uncompromisingly light on dependencies.    Easily navigable code base, keeping indirection and clutter to a minimum. category:           library-tested-with:        GHC == 9.8.2+tested-with:        GHC == 9.10.3 extra-doc-files:    CHANGELOG.md extra-source-files: .editorconfig                     .hlint.yaml@@ -37,6 +37,13 @@     Mini.Data.Set     Mini.Hash.Class     Mini.Hash.Murmur32+    Mini.Linear.Approx+    Mini.Linear.Matrix+    Mini.Linear.Quaternion+    Mini.Linear.Space+    Mini.Linear.Transform2D+    Mini.Linear.Transform3D+    Mini.Linear.Vector     Mini.Optics.Lens     Mini.Random.Class     Mini.Random.SplitMix

@@ -0,0 +1,36 @@+-- | Checking for approximate equality+module Mini.Linear.Approx (+  Approx (+    (~=)+  ),+) where++import Prelude (+  Bool,+  Double,+  Float,+  abs,+  and,+  zipWith,+  ($),+  (-),+  (<=),+ )++-- | The class of approximative types+class Approx a where+  infix 4 ~=++  -- | Approximately equal to+  (~=) :: a -> a -> Bool++-- | Absolute difference maximum of @1e-6@+instance Approx Float where+  a ~= b = abs (a - b) <= 1e-6++-- | Absolute difference maximum of @1e-12@+instance Approx Double where+  a ~= b = abs (a - b) <= 1e-12++instance (Approx a) => Approx [a] where+  a ~= b = and $ zipWith (~=) a b

@@ -0,0 +1,248 @@+{-# LANGUAGE ImpredicativeTypes #-}++-- | Column-major matrix operations+module Mini.Linear.Matrix (+  -- * Class+  Square (+    adj,+    det,+    diagonal+  ),++  -- * Construction+  identity,+  zero,++  -- * Operations+  (#*#),+  (#*^),+  (#+#),+  (#-#),+  (^*#),+  (~*#),+  inverse,+  trace,+  transpose,+) where++import Control.Applicative (+  liftA2,+ )+import Mini.Linear.Space (+  V0 (V0),+  V1,+  V2 (V2),+  V3 (V3),+  V4 (V4),+  w,+  x,+  xy,+  xyw,+  xyz,+  xz,+  xzw,+  y,+  yz,+  yzw,+  z,+ )+import Mini.Linear.Vector (+  Vector,+  axes,+  dot,+  (^+^),+  (^-^),+  (~*^),+ )+import qualified Mini.Linear.Vector as V (+  zero,+ )+import Mini.Optics.Lens (+  Lens,+  set,+  view,+ )+import Prelude (+  Fractional,+  Num,+  fmap,+  foldr,+  id,+  negate,+  pure,+  recip,+  sum,+  ($),+  (*),+  (+),+  (-),+  (.),+  (<$),+  (<$>),+ )++-- Class++-- | The class of square matrices+class (Vector v) => Square v where+  -- | Adjoint of a matrix+  adj :: (Num a) => v (v a) -> v (v a)++  -- | Determinant of a matrix+  det :: (Num a) => v (v a) -> a++  -- | Diagonal lens+  diagonal :: Lens (v (v a)) (v (v a)) (v a) (v a)++instance Square V0 where+  adj = id+  det _ = 1+  diagonal f _ = V0 <$ f V0++instance Square V1 where+  adj = set (x . x) 1+  det = view (x . x)+  diagonal = x++instance Square V2 where+  adj m =+    V2+      (V2 (view (y . y) m) (negate $ view (x . y) m))+      (V2 (negate $ view (y . x) m) (view (x . x) m))+  det m =+    view (x . x) m * view (y . y) m+      - view (y . x) m * view (x . y) m+  diagonal f m =+    ( \v ->+        V2+          (V2 (view x v) (view (x . y) m))+          (V2 (view (y . x) m) (view y v))+    )+      <$> f (V2 (view (x . x) m) (view (y . y) m))++instance Square V3 where+  adj m =+    let d00 = det $ view yz <$> view yz m+        d01 = det $ view yz <$> view xz m+        d02 = det $ view yz <$> view xy m+        d10 = det $ view xz <$> view yz m+        d11 = det $ view xz <$> view xz m+        d12 = det $ view xz <$> view xy m+        d20 = det $ view xy <$> view yz m+        d21 = det $ view xy <$> view xz m+        d22 = det $ view xy <$> view xy m+     in V3+          (V3 d00 (negate d01) d02)+          (V3 (negate d10) d11 (negate d12))+          (V3 d20 (negate d21) d22)+  det m =+    view (x . x) m * det (view yz <$> view yz m)+      - view (y . x) m * det (view yz <$> view xz m)+      + view (z . x) m * det (view yz <$> view xy m)+  diagonal f m =+    ( \v ->+        V3+          (V3 (view x v) (view (x . y) m) (view (x . z) m))+          (V3 (view (y . x) m) (view y v) (view (y . z) m))+          (V3 (view (z . x) m) (view (z . y) m) (view z v))+    )+      <$> f (V3 (view (x . x) m) (view (y . y) m) (view (z . z) m))++instance Square V4 where+  adj m =+    let d00 = det $ view yzw <$> view yzw m+        d01 = det $ view yzw <$> view xzw m+        d02 = det $ view yzw <$> view xyw m+        d03 = det $ view yzw <$> view xyz m+        d10 = det $ view xzw <$> view yzw m+        d11 = det $ view xzw <$> view xzw m+        d12 = det $ view xzw <$> view xyw m+        d13 = det $ view xzw <$> view xyz m+        d20 = det $ view xyw <$> view yzw m+        d21 = det $ view xyw <$> view xzw m+        d22 = det $ view xyw <$> view xyw m+        d23 = det $ view xyw <$> view xyz m+        d30 = det $ view xyz <$> view yzw m+        d31 = det $ view xyz <$> view xzw m+        d32 = det $ view xyz <$> view xyw m+        d33 = det $ view xyz <$> view xyz m+     in V4+          (V4 d00 (negate d01) d02 (negate d03))+          (V4 (negate d10) d11 (negate d12) d13)+          (V4 d20 (negate d21) d22 (negate d23))+          (V4 (negate d30) d31 (negate d32) d33)+  det m =+    view (x . x) m * det (view yzw <$> view yzw m)+      - view (y . x) m * det (view yzw <$> view xzw m)+      + view (z . x) m * det (view yzw <$> view xyw m)+      - view (w . x) m * det (view yzw <$> view xyz m)+  diagonal f m =+    ( \v ->+        V4+          (V4 (view x v) (view (x . y) m) (view (x . z) m) (view (x . w) m))+          (V4 (view (y . x) m) (view y v) (view (y . z) m) (view (y . w) m))+          (V4 (view (z . x) m) (view (z . y) m) (view z v) (view (z . w) m))+          (V4 (view (w . x) m) (view (w . y) m) (view (w . z) m) (view w v))+    )+      <$> f+        (V4 (view (x . x) m) (view (y . y) m) (view (z . z) m) (view (w . w) m))++-- Construction++-- | Multiplicative identity matrix+identity :: (Square v, Num a) => v (v a)+identity = set diagonal (pure 1) zero++-- | Additive identity matrix+zero :: (Vector p, Vector q, Num a) => q (p a)+zero = pure V.zero++-- Operations++infixr 7 #*#++-- | Matrix-matrix multiplication+(#*#) :: (Vector p, Vector q, Vector r, Num a) => q (p a) -> r (q a) -> r (p a)+qp #*# rq = fmap (\q -> foldr (^+^) V.zero $ liftA2 (~*^) q qp) rq++infix 7 #*^++-- | Matrix-vector multiplication+(#*^) :: (Vector p, Vector q, Num a) => q (p a) -> q a -> p a+m #*^ v = foldr (^+^) V.zero $ liftA2 (~*^) v m++infixl 6 #+#++-- | Matrix-matrix addition+(#+#) :: (Vector p, Vector q, Num a) => q (p a) -> q (p a) -> q (p a)+(#+#) = liftA2 (^+^)++infixl 6 #-#++-- | Matrix-matrix subtraction+(#-#) :: (Vector p, Vector q, Num a) => q (p a) -> q (p a) -> q (p a)+(#-#) = liftA2 (^-^)++infix 7 ^*#++-- | Vector-matrix multiplication+(^*#) :: (Vector p, Vector q, Num a) => p a -> q (p a) -> q a+v ^*# m = fmap (`dot` v) m++infixl 7 ~*#++-- | Scalar-matrix multiplication+(~*#) :: (Vector p, Vector q, Num a) => a -> q (p a) -> q (p a)+s ~*# m = fmap (s *) <$> m++-- | Multiplicative inverse of a matrix /m/ (assumes @not $ det m ~= 0@)+inverse :: (Square v, Fractional a) => v (v a) -> v (v a)+inverse m = recip (det m) ~*# m++-- | Diagonal sum of a matrix+trace :: (Square v, Num a) => v (v a) -> a+trace = sum . view diagonal++-- | Transpose of a matrix+transpose :: (Vector p, Vector q) => q (p a) -> p (q a)+transpose qp = fmap (\o -> fmap (view o) qp) axes

@@ -0,0 +1,271 @@+-- | Quaternion transforms for three-dimensional Euclidean space+module Mini.Linear.Quaternion (+  -- * Type+  Quaternion (Quaternion),++  -- * Construction+  axisAngle,+  identity,+  zero,++  -- * Operations+  (%*%),+  (%+%),+  (%-%),+  (~*%),+  conjugate,+  inverse,+  norm,++  -- * Rotation+  rotate,++  -- * Interpolation+  slerp,++  -- * Conversion+  toMatrix,+) where++import Control.Applicative (+  liftA2,+ )+import Control.Monad (+  ap,+  liftM,+ )+import Mini.Hash.Class (+  Hashable,+  toBytes,+ )+import Mini.Linear.Approx (+  Approx,+  (~=),+ )+import qualified Mini.Linear.Matrix as M (+  identity,+ )+import Mini.Linear.Space (+  R1,+  R2,+  R3,+  R4,+  V3,+  V4 (V4),+  w,+  x,+  xy,+  xyz,+  xyzw,+  y,+  z,+ )+import Mini.Linear.Vector (+  cross,+  dot,+  (^+^),+  (~*^),+ )+import qualified Mini.Linear.Vector as V (+  norm,+  zero,+ )+import Mini.Optics.Lens (+  over,+  set,+  view,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Prelude (+  Applicative,+  Eq,+  Floating,+  Foldable,+  Functor,+  Monad,+  Monoid,+  Num,+  Ord,+  Semigroup,+  Show,+  Traversable,+  acos,+  and,+  concatMap,+  cos,+  fmap,+  foldr,+  mempty,+  negate,+  pure,+  recip,+  sin,+  sum,+  traverse,+  ($),+  (*),+  (+),+  (-),+  (.),+  (/),+  (<$>),+  (<*>),+  (<>),+  (>>=),+ )++-- Type++-- | Wrapper whose 'xyz'-components are imaginary and 'w'-component is real+newtype Quaternion a = Quaternion (V4 a)+  deriving (Show, Eq, Ord)++instance R1 Quaternion where+  x f (Quaternion v) =+    (\x' -> Quaternion $ set x x' v) <$> f (view x v)++instance R2 Quaternion where+  xy f (Quaternion v) =+    (\xy' -> Quaternion $ set xy xy' v) <$> f (view xy v)++instance R3 Quaternion where+  xyz f (Quaternion v) =+    (\xyz' -> Quaternion $ set xyz xyz' v) <$> f (view xyz v)++instance R4 Quaternion where+  xyzw f (Quaternion v) = Quaternion <$> f v++instance Functor Quaternion where+  fmap = liftM++instance Applicative Quaternion where+  pure = Quaternion . pure+  (<*>) = ap++instance Monad Quaternion where+  m >>= k =+    Quaternion+      ( V4+          (view x . k $ view x m)+          (view y . k $ view y m)+          (view z . k $ view z m)+          (view w . k $ view w m)+      )++instance Foldable Quaternion where+  foldr f b (Quaternion v) = foldr f b v++instance Traversable Quaternion where+  traverse f (Quaternion v) = Quaternion <$> traverse f v++instance (Semigroup a) => Semigroup (Quaternion a) where+  (<>) = liftA2 (<>)++instance (Monoid a) => Monoid (Quaternion a) where+  mempty = pure mempty++instance (Approx a) => Approx (Quaternion a) where+  p ~= q = and $ liftA2 (~=) p q++instance (Hashable a) => Hashable (Quaternion a) where+  toBytes = concatMap toBytes++instance (Random a) => Random (Quaternion a) where+  random g = let (v, g') = random g in (Quaternion v, g')++-- Construction++-- | Rotation around an axis /v/ a number of radians (assumes @v ~= hat v@)+axisAngle :: (Floating a) => V3 a -> a -> Quaternion a+axisAngle v a =+  let v' = sin (a / 2) ~*^ v+   in Quaternion $ V4 (view x v') (view y v') (view z v') (cos (a / 2))++-- | Multiplicative identity quaternion+identity :: (Num a) => Quaternion a+identity = set w 1 zero++-- | Additive identity quaternion+zero :: (Num a) => Quaternion a+zero = Quaternion V.zero++-- Operations++-- | Quaternion-quaternion multiplication+(%*%) :: (Num a) => Quaternion a -> Quaternion a -> Quaternion a+q %*% r =+  let qv = view xyz q+      qw = view w q+      rv = view xyz r+      rw = view w r+      v' = (qv `cross` rv) ^+^ (rw ~*^ qv) ^+^ (qw ~*^ rv)+      w' = (qw * rw - qv `dot` rv)+   in Quaternion $+        V4+          (view x v')+          (view y v')+          (view z v')+          w'++-- | Quaternion-quaternion addition+(%+%) :: (Num a) => Quaternion a -> Quaternion a -> Quaternion a+(%+%) = liftA2 (+)++-- | Quaternion-quaternion subtraction+(%-%) :: (Num a) => Quaternion a -> Quaternion a -> Quaternion a+(%-%) = liftA2 (-)++-- | Scalar-quaternion multiplication+(~*%) :: (Num a) => a -> Quaternion a -> Quaternion a+s ~*% q = over w (s *) $ over xyz (s ~*^) q++-- | Conjugate of a quaternion+conjugate :: (Num a) => Quaternion a -> Quaternion a+conjugate = over xyz (fmap negate)++-- | Multiplicative inverse of a quaternion /q/ (assumes @not $ q ~= zero@)+inverse :: (Floating a) => Quaternion a -> Quaternion a+inverse q = recip (norm q * norm q) ~*% conjugate q++-- | Norm of a quaternion+norm :: (Floating a) => Quaternion a -> a+norm = V.norm . view xyzw++-- Rotation++-- | Apply a rotation /r/ to a vector (assumes /r/ is a unit quaternion)+rotate :: (Floating a) => Quaternion a -> V3 a -> V3 a+rotate r v =+  view xyz $+    r+      %*% Quaternion (V4 (view x v) (view y v) (view z v) 0)+      %*% conjugate r++-- Interpolation++-- | Spherical linear interpolation s.t. @slerp q r 0 == q && slerp q r 1 == r@+slerp :: (Floating a) => Quaternion a -> Quaternion a -> a -> Quaternion a+slerp q r t =+  let phi = acos . sum $ liftA2 (*) q r+      q' = (sin (phi * (1 - t)) / sin phi) ~*% q+      r' = (sin (phi * t) / sin phi) ~*% r+   in q' %+% r'++-- Conversion++-- | Convert a rotation /r/ to matrix form (assumes /r/ is a unit quaternion)+toMatrix :: (Num a) => Quaternion a -> V4 (V4 a)+toMatrix (Quaternion (V4 qx qy qz qw)) =+  set (x . x) (1 - 2 * (qy * qy + qz * qz))+    . set (x . y) (2 * (qx * qy + qw * qz))+    . set (x . z) (2 * (qx * qz - qw * qy))+    . set (y . x) (2 * (qx * qy - qw * qz))+    . set (y . y) (1 - 2 * (qx * qx + qz * qz))+    . set (y . z) (2 * (qy * qz + qw * qx))+    . set (z . x) (2 * (qx * qz + qw * qy))+    . set (z . y) (2 * (qy * qz - qw * qx))+    . set (z . z) (1 - 2 * (qx * qx + qy * qy))+    $ M.identity

@@ -0,0 +1,680 @@+-- | Vector spaces of up to four dimensions+module Mini.Linear.Space (+  -- * Elements+  V0 (V0),+  V1 (V1),+  V2 (V2),+  V3 (V3),+  V4 (V4),++  -- * Spaces+  R1 (+    x+  ),+  R2 (+    y,+    xy,+    yx+  ),+  R3 (+    z,+    xz,+    yz,+    zx,+    zy,+    xyz,+    xzy,+    yxz,+    yzx,+    zxy,+    zyx+  ),+  R4 (+    w,+    xw,+    yw,+    zw,+    wx,+    wy,+    wz,+    xyw,+    xzw,+    xwy,+    xwz,+    yxw,+    yzw,+    ywx,+    ywz,+    zxw,+    zyw,+    zwx,+    zwy,+    wxy,+    wxz,+    wyx,+    wyz,+    wzx,+    wzy,+    xyzw,+    xywz,+    xzyw,+    xzwy,+    xwyz,+    xwzy,+    yxzw,+    yxwz,+    yzxw,+    yzwx,+    ywxz,+    ywzx,+    zxyw,+    zxwy,+    zyxw,+    zywx,+    zwxy,+    zwyx,+    wxyz,+    wxzy,+    wyxz,+    wyzx,+    wzxy,+    wzyx+  ),+) where++import Control.Applicative (+  liftA2,+ )+import Control.Monad (+  ap,+  liftM,+ )+import Mini.Hash.Class (+  Hashable (+    toBytes+  ),+ )+import Mini.Linear.Approx (+  Approx,+  (~=),+ )+import Mini.Optics.Lens (+  Lens,+  view,+ )+import Mini.Random.Class (+  Random,+  random,+ )+import Prelude (+  Applicative,+  Bool (+    False,+    True+  ),+  Eq,+  Foldable,+  Functor,+  Monad,+  Monoid,+  Ord,+  Semigroup,+  Show,+  Traversable,+  and,+  concatMap,+  fmap,+  foldr,+  id,+  length,+  mempty,+  null,+  pure,+  traverse,+  ($),+  (.),+  (<$>),+  (<*>),+  (<>),+  (>>=),+ )++-- Spaces++-- | Vector space with at least one dimension+class R1 v where+  -- | Basis vector lens of the first dimension+  x :: Lens (v a) (v a) a a++-- | Vector space with at least two dimensions+class (R1 v) => R2 v where+  -- | Basis vector lens of the second dimension+  y :: Lens (v a) (v a) a a+  y f = xy (\(V2 a0 a1) -> V2 a0 <$> f a1)++  xy :: Lens (v a) (v a) (V2 a) (V2 a)+  yx :: Lens (v a) (v a) (V2 a) (V2 a)+  yx f = xy (\v -> f $ V2 (view y v) (view x v))++-- | Vector space with at least three dimensions+class (R2 v) => R3 v where+  -- | Basis vector lens of the third dimension+  z :: Lens (v a) (v a) a a+  z f = xyz (\(V3 a0 a1 a2) -> V3 a0 a1 <$> f a2)++  xz :: Lens (v a) (v a) (V2 a) (V2 a)+  xz f =+    xyz+      ( \v ->+          (\v' -> V3 (view x v') (view y v) (view y v'))+            <$> f (V2 (view x v) (view z v))+      )++  yz :: Lens (v a) (v a) (V2 a) (V2 a)+  yz f =+    xyz+      ( \v ->+          (\v' -> V3 (view x v) (view x v') (view y v'))+            <$> f (V2 (view y v) (view z v))+      )++  zx :: Lens (v a) (v a) (V2 a) (V2 a)+  zx f =+    xyz+      ( \v ->+          (\v' -> V3 (view y v') (view y v) (view x v'))+            <$> f (V2 (view z v) (view x v))+      )++  zy :: Lens (v a) (v a) (V2 a) (V2 a)+  zy f =+    xyz+      ( \v ->+          (\v' -> V3 (view x v) (view y v') (view x v'))+            <$> f (V2 (view z v) (view y v))+      )++  xyz :: Lens (v a) (v a) (V3 a) (V3 a)+  xzy :: Lens (v a) (v a) (V3 a) (V3 a)+  xzy f = xyz (\v -> f $ V3 (view x v) (view z v) (view y v))++  yxz :: Lens (v a) (v a) (V3 a) (V3 a)+  yxz f = xyz (\v -> f $ V3 (view y v) (view x v) (view z v))++  yzx :: Lens (v a) (v a) (V3 a) (V3 a)+  yzx f = xyz (\v -> f $ V3 (view y v) (view z v) (view x v))++  zxy :: Lens (v a) (v a) (V3 a) (V3 a)+  zxy f = xyz (\v -> f $ V3 (view z v) (view x v) (view y v))++  zyx :: Lens (v a) (v a) (V3 a) (V3 a)+  zyx f = xyz (\v -> f $ V3 (view z v) (view y v) (view x v))++-- | Vector space with at least four dimensions+class (R3 v) => R4 v where+  -- | Basis vector lens of the fourth dimension+  w :: Lens (v a) (v a) a a+  w f = xyzw (\(V4 a0 a1 a2 a3) -> V4 a0 a1 a2 <$> f a3)++  xw :: Lens (v a) (v a) (V2 a) (V2 a)+  xw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v') (view y v) (view z v) (view y v'))+            <$> f (V2 (view x v) (view w v))+      )+  yw :: Lens (v a) (v a) (V2 a) (V2 a)+  yw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view x v') (view z v) (view y v'))+            <$> f (V2 (view y v) (view w v))+      )+  zw :: Lens (v a) (v a) (V2 a) (V2 a)+  zw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view y v) (view x v') (view y v'))+            <$> f (V2 (view z v) (view w v))+      )+  wx :: Lens (v a) (v a) (V2 a) (V2 a)+  wx f =+    xyzw+      ( \v ->+          (\v' -> V4 (view y v') (view y v) (view z v) (view x v'))+            <$> f (V2 (view w v) (view x v))+      )+  wy :: Lens (v a) (v a) (V2 a) (V2 a)+  wy f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view y v') (view z v) (view x v'))+            <$> f (V2 (view w v) (view y v))+      )+  wz :: Lens (v a) (v a) (V2 a) (V2 a)+  wz f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view y v) (view y v') (view x v'))+            <$> f (V2 (view w v) (view z v))+      )+  xyw :: Lens (v a) (v a) (V3 a) (V3 a)+  xyw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v') (view y v') (view z v) (view z v'))+            <$> f (V3 (view x v) (view y v) (view w v))+      )+  xzw :: Lens (v a) (v a) (V3 a) (V3 a)+  xzw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v') (view y v) (view y v') (view z v'))+            <$> f (V3 (view x v) (view z v) (view w v))+      )+  xwy :: Lens (v a) (v a) (V3 a) (V3 a)+  xwy f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v') (view y v') (view z v) (view y v'))+            <$> f (V3 (view x v) (view w v) (view y v))+      )+  xwz :: Lens (v a) (v a) (V3 a) (V3 a)+  xwz f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v') (view y v) (view z v') (view y v'))+            <$> f (V3 (view x v) (view w v) (view z v))+      )+  yxw :: Lens (v a) (v a) (V3 a) (V3 a)+  yxw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v') (view x v') (view z v) (view z v'))+            <$> f (V3 (view y v) (view x v) (view w v))+      )+  yzw :: Lens (v a) (v a) (V3 a) (V3 a)+  yzw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view x v') (view y v') (view z v'))+            <$> f (V3 (view y v) (view z v) (view w v))+      )+  ywx :: Lens (v a) (v a) (V3 a) (V3 a)+  ywx f =+    xyzw+      ( \v ->+          (\v' -> V4 (view z v') (view x v') (view z v) (view y v'))+            <$> f (V3 (view y v) (view w v) (view x v))+      )+  ywz :: Lens (v a) (v a) (V3 a) (V3 a)+  ywz f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view x v') (view z v') (view y v'))+            <$> f (V3 (view y v) (view w v) (view z v))+      )+  zxw :: Lens (v a) (v a) (V3 a) (V3 a)+  zxw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view y v') (view y v) (view x v') (view z v'))+            <$> f (V3 (view z v) (view x v) (view w v))+      )+  zyw :: Lens (v a) (v a) (V3 a) (V3 a)+  zyw f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view y v') (view x v') (view z v'))+            <$> f (V3 (view z v) (view y v) (view w v))+      )+  zwx :: Lens (v a) (v a) (V3 a) (V3 a)+  zwx f =+    xyzw+      ( \v ->+          (\v' -> V4 (view z v') (view y v) (view x v') (view y v'))+            <$> f (V3 (view z v) (view w v) (view x v))+      )+  zwy :: Lens (v a) (v a) (V3 a) (V3 a)+  zwy f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view z v') (view x v') (view y v'))+            <$> f (V3 (view z v) (view w v) (view y v))+      )+  wxy :: Lens (v a) (v a) (V3 a) (V3 a)+  wxy f =+    xyzw+      ( \v ->+          (\v' -> V4 (view y v') (view z v') (view z v) (view x v'))+            <$> f (V3 (view w v) (view x v) (view y v))+      )+  wxz :: Lens (v a) (v a) (V3 a) (V3 a)+  wxz f =+    xyzw+      ( \v ->+          (\v' -> V4 (view y v') (view y v) (view z v') (view x v'))+            <$> f (V3 (view w v) (view x v) (view z v))+      )+  wyx :: Lens (v a) (v a) (V3 a) (V3 a)+  wyx f =+    xyzw+      ( \v ->+          (\v' -> V4 (view z v') (view y v') (view z v) (view x v'))+            <$> f (V3 (view w v) (view y v) (view x v))+      )+  wyz :: Lens (v a) (v a) (V3 a) (V3 a)+  wyz f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view y v') (view z v') (view x v'))+            <$> f (V3 (view w v) (view y v) (view z v))+      )+  wzx :: Lens (v a) (v a) (V3 a) (V3 a)+  wzx f =+    xyzw+      ( \v ->+          (\v' -> V4 (view z v') (view y v) (view y v') (view x v'))+            <$> f (V3 (view w v) (view z v) (view x v))+      )+  wzy :: Lens (v a) (v a) (V3 a) (V3 a)+  wzy f =+    xyzw+      ( \v ->+          (\v' -> V4 (view x v) (view z v') (view y v') (view x v'))+            <$> f (V3 (view w v) (view z v) (view y v))+      )+  xyzw :: Lens (v a) (v a) (V4 a) (V4 a)+  xywz :: Lens (v a) (v a) (V4 a) (V4 a)+  xywz f = xyzw (\v -> f $ V4 (view x v) (view y v) (view w v) (view z v))+  xzyw :: Lens (v a) (v a) (V4 a) (V4 a)+  xzyw f = xyzw (\v -> f $ V4 (view x v) (view z v) (view y v) (view w v))+  xzwy :: Lens (v a) (v a) (V4 a) (V4 a)+  xzwy f = xyzw (\v -> f $ V4 (view x v) (view z v) (view w v) (view y v))+  xwyz :: Lens (v a) (v a) (V4 a) (V4 a)+  xwyz f = xyzw (\v -> f $ V4 (view x v) (view w v) (view y v) (view z v))+  xwzy :: Lens (v a) (v a) (V4 a) (V4 a)+  xwzy f = xyzw (\v -> f $ V4 (view x v) (view w v) (view z v) (view y v))+  yxzw :: Lens (v a) (v a) (V4 a) (V4 a)+  yxzw f = xyzw (\v -> f $ V4 (view y v) (view x v) (view z v) (view w v))+  yxwz :: Lens (v a) (v a) (V4 a) (V4 a)+  yxwz f = xyzw (\v -> f $ V4 (view y v) (view x v) (view w v) (view z v))+  yzxw :: Lens (v a) (v a) (V4 a) (V4 a)+  yzxw f = xyzw (\v -> f $ V4 (view y v) (view z v) (view x v) (view w v))+  yzwx :: Lens (v a) (v a) (V4 a) (V4 a)+  yzwx f = xyzw (\v -> f $ V4 (view y v) (view z v) (view w v) (view x v))+  ywxz :: Lens (v a) (v a) (V4 a) (V4 a)+  ywxz f = xyzw (\v -> f $ V4 (view y v) (view w v) (view x v) (view z v))+  ywzx :: Lens (v a) (v a) (V4 a) (V4 a)+  ywzx f = xyzw (\v -> f $ V4 (view y v) (view w v) (view z v) (view x v))+  zxyw :: Lens (v a) (v a) (V4 a) (V4 a)+  zxyw f = xyzw (\v -> f $ V4 (view z v) (view x v) (view y v) (view w v))+  zxwy :: Lens (v a) (v a) (V4 a) (V4 a)+  zxwy f = xyzw (\v -> f $ V4 (view z v) (view x v) (view w v) (view y v))+  zyxw :: Lens (v a) (v a) (V4 a) (V4 a)+  zyxw f = xyzw (\v -> f $ V4 (view z v) (view y v) (view x v) (view w v))+  zywx :: Lens (v a) (v a) (V4 a) (V4 a)+  zywx f = xyzw (\v -> f $ V4 (view z v) (view y v) (view w v) (view x v))+  zwxy :: Lens (v a) (v a) (V4 a) (V4 a)+  zwxy f = xyzw (\v -> f $ V4 (view z v) (view w v) (view x v) (view y v))+  zwyx :: Lens (v a) (v a) (V4 a) (V4 a)+  zwyx f = xyzw (\v -> f $ V4 (view z v) (view w v) (view y v) (view x v))+  wxyz :: Lens (v a) (v a) (V4 a) (V4 a)+  wxyz f = xyzw (\v -> f $ V4 (view w v) (view x v) (view y v) (view z v))+  wxzy :: Lens (v a) (v a) (V4 a) (V4 a)+  wxzy f = xyzw (\v -> f $ V4 (view w v) (view x v) (view z v) (view y v))+  wyxz :: Lens (v a) (v a) (V4 a) (V4 a)+  wyxz f = xyzw (\v -> f $ V4 (view w v) (view y v) (view x v) (view z v))+  wyzx :: Lens (v a) (v a) (V4 a) (V4 a)+  wyzx f = xyzw (\v -> f $ V4 (view w v) (view y v) (view z v) (view x v))+  wzxy :: Lens (v a) (v a) (V4 a) (V4 a)+  wzxy f = xyzw (\v -> f $ V4 (view w v) (view z v) (view x v) (view y v))+  wzyx :: Lens (v a) (v a) (V4 a) (V4 a)+  wzyx f = xyzw (\v -> f $ V4 (view w v) (view z v) (view y v) (view x v))++-- Elements++-- | Zero-dimensional vector+data V0 a = V0+  deriving (Show, Eq, Ord)++instance Functor V0 where+  fmap = liftM++instance Applicative V0 where+  pure _ = V0+  (<*>) = ap++instance Monad V0 where+  _ >>= _ = V0++instance Foldable V0 where+  foldr _ b _ = b+  null _ = True+  length _ = 0++instance Traversable V0 where+  traverse _ _ = pure V0++instance Semigroup (V0 a) where+  _ <> _ = V0++instance Monoid (V0 a) where+  mempty = V0++instance Approx (V0 a) where+  _ ~= _ = True++instance Hashable (V0 a) where+  toBytes _ = []++instance Random (V0 a) where+  random g = (V0, g)++-- | One-dimensional vector+newtype V1 a = V1 a+  deriving (Show, Eq, Ord)++instance R1 V1 where+  x f (V1 a0) = V1 <$> f a0++instance Functor V1 where+  fmap = liftM++instance Applicative V1 where+  pure = V1+  (<*>) = ap++instance Monad V1 where+  m >>= k = k $ view x m++instance Foldable V1 where+  foldr f b v = f (view x v) b+  null _ = False+  length _ = 1++instance Traversable V1 where+  traverse f v = V1 <$> f (view x v)++instance (Semigroup a) => Semigroup (V1 a) where+  (<>) = liftA2 (<>)++instance (Monoid a) => Monoid (V1 a) where+  mempty = pure mempty++instance (Approx a) => Approx (V1 a) where+  u ~= v = view x u ~= view x v++instance (Hashable a) => Hashable (V1 a) where+  toBytes = concatMap toBytes++instance (Random a) => Random (V1 a) where+  random g = let (a, g') = random g in (V1 a, g')++-- | Two-dimensional vector+data V2 a = V2 a a+  deriving (Show, Eq, Ord)++instance R1 V2 where+  x f (V2 a0 a1) = (`V2` a1) <$> f a0++instance R2 V2 where+  xy = id++instance Functor V2 where+  fmap = liftM++instance Applicative V2 where+  pure a = V2 a a+  (<*>) = ap++instance Monad V2 where+  m >>= k = V2 (view x . k $ view x m) (view y . k $ view y m)++instance Foldable V2 where+  foldr f b v = f (view x v) $ f (view y v) b+  null _ = False+  length _ = 2++instance Traversable V2 where+  traverse f v = V2 <$> f (view x v) <*> f (view y v)++instance (Semigroup a) => Semigroup (V2 a) where+  (<>) = liftA2 (<>)++instance (Monoid a) => Monoid (V2 a) where+  mempty = pure mempty++instance (Approx a) => Approx (V2 a) where+  u ~= v = and $ liftA2 (~=) u v++instance (Hashable a) => Hashable (V2 a) where+  toBytes = concatMap toBytes++instance (Random a) => Random (V2 a) where+  random g =+    let (a0, g') = random g+        (a1, g'') = random g'+     in (V2 a0 a1, g'')++-- | Three-dimensional vector+data V3 a = V3 a a a+  deriving (Show, Eq, Ord)++instance R1 V3 where+  x f (V3 a0 a1 a2) = (\a0' -> V3 a0' a1 a2) <$> f a0++instance R2 V3 where+  xy f (V3 a0 a1 a2) =+    (\(V2 a0' a1') -> V3 a0' a1' a2)+      <$> f (V2 a0 a1)++instance R3 V3 where+  xyz = id++instance Functor V3 where+  fmap = liftM++instance Applicative V3 where+  pure a = V3 a a a+  (<*>) = ap++instance Monad V3 where+  m >>= k =+    V3+      (view x . k $ view x m)+      (view y . k $ view y m)+      (view z . k $ view z m)++instance Foldable V3 where+  foldr f b v = f (view x v) . f (view y v) $ f (view z v) b+  null _ = False+  length _ = 3++instance Traversable V3 where+  traverse f v = V3 <$> f (view x v) <*> f (view y v) <*> f (view z v)++instance (Semigroup a) => Semigroup (V3 a) where+  (<>) = liftA2 (<>)++instance (Monoid a) => Monoid (V3 a) where+  mempty = pure mempty++instance (Approx a) => Approx (V3 a) where+  u ~= v = and $ liftA2 (~=) u v++instance (Hashable a) => Hashable (V3 a) where+  toBytes = concatMap toBytes++instance (Random a) => Random (V3 a) where+  random g =+    let (a0, g') = random g+        (a1, g'') = random g'+        (a2, g''') = random g''+     in (V3 a0 a1 a2, g''')++-- | Four-dimensional vector+data V4 a = V4 a a a a+  deriving (Show, Eq, Ord)++instance R1 V4 where+  x f (V4 a0 a1 a2 a3) = (\a0' -> V4 a0' a1 a2 a3) <$> f a0++instance R2 V4 where+  xy f (V4 a0 a1 a2 a3) = (\(V2 a0' a1') -> V4 a0' a1' a2 a3) <$> f (V2 a0 a1)++instance R3 V4 where+  xyz f (V4 a0 a1 a2 a3) =+    (\(V3 a0' a1' a2') -> V4 a0' a1' a2' a3)+      <$> f (V3 a0 a1 a2)++instance R4 V4 where+  xyzw = id++instance Functor V4 where+  fmap = liftM++instance Applicative V4 where+  pure a = V4 a a a a+  (<*>) = ap++instance Monad V4 where+  m >>= k =+    V4+      (view x . k $ view x m)+      (view y . k $ view y m)+      (view z . k $ view z m)+      (view w . k $ view w m)++instance Foldable V4 where+  foldr f b v = f (view x v) . f (view y v) . f (view z v) $ f (view w v) b+  null _ = False+  length _ = 4++instance Traversable V4 where+  traverse f v =+    V4+      <$> f (view x v)+      <*> f (view y v)+      <*> f (view z v)+      <*> f (view w v)++instance (Semigroup a) => Semigroup (V4 a) where+  (<>) = liftA2 (<>)++instance (Monoid a) => Monoid (V4 a) where+  mempty = pure mempty++instance (Approx a) => Approx (V4 a) where+  u ~= v = and $ liftA2 (~=) u v++instance (Hashable a) => Hashable (V4 a) where+  toBytes = concatMap toBytes++instance (Random a) => Random (V4 a) where+  random g =+    let (a0, g') = random g+        (a1, g'') = random g'+        (a2, g''') = random g''+        (a3, g'''') = random g'''+     in (V4 a0 a1 a2 a3, g'''')

@@ -0,0 +1,73 @@+-- | Affine transform matrices for two-dimensional Euclidean space+module Mini.Linear.Transform2D (+  -- * Translation+  translate,++  -- * Scaling+  scale,++  -- * Shearing+  shearByX,+  shearByY,++  -- * Rotation+  rotate,+) where++import Mini.Linear.Matrix (+  diagonal,+  identity,+ )+import Mini.Linear.Space (+  V2,+  V3,+  x,+  xy,+  y,+  z,+ )+import Mini.Optics.Lens (+  set,+ )+import Prelude (+  Floating,+  Num,+  cos,+  negate,+  sin,+  ($),+  (.),+ )++-- Translation++-- | Translate each dimension by the respective components of a vector+translate :: (Num a) => V2 a -> V3 (V3 a)+translate v = set (z . xy) v identity++-- Scaling++-- | Scale each dimension by the respective components of a vector+scale :: (Num a) => V2 a -> V3 (V3 a)+scale v = set (diagonal . xy) v identity++-- Shearing++-- | Shear /y/ w.r.t. /x/ by a factor+shearByX :: (Num a) => a -> V3 (V3 a)+shearByX s = set (x . y) s identity++-- | Shear /x/ w.r.t. /y/ by a factor+shearByY :: (Num a) => a -> V3 (V3 a)+shearByY s = set (y . x) s identity++-- Rotation++-- | Rotate by a number of radians+rotate :: (Floating a) => a -> V3 (V3 a)+rotate phi =+  set (x . x) (cos phi)+    . set (x . y) (sin phi)+    . set (y . x) (negate $ sin phi)+    . set (y . y) (cos phi)+    $ identity

@@ -0,0 +1,117 @@+-- | Affine transform matrices for three-dimensional Euclidean space+module Mini.Linear.Transform3D (+  -- * Translation+  translate,++  -- * Scaling+  scale,++  -- * Shearing+  shearByX,+  shearByY,+  shearByZ,++  -- * Rotation+  yaw,+  pitch,+  roll,+  euler,+) where++import Mini.Linear.Matrix (+  diagonal,+  identity,+ )+import Mini.Linear.Space (+  V3 (V3),+  V4,+  w,+  x,+  xyz,+  y,+  z,+ )+import Mini.Optics.Lens (+  set,+ )+import Prelude (+  Floating,+  Num,+  cos,+  negate,+  sin,+  ($),+  (*),+  (+),+  (-),+  (.),+ )++-- Translation++-- | Translate each dimension by the corresponding components of a vector+translate :: (Num a) => V3 a -> V4 (V4 a)+translate v = set (w . xyz) v identity++-- Scaling++-- | Scale each dimension by the corresponding components of a vector+scale :: (Num a) => V3 a -> V4 (V4 a)+scale v = set (diagonal . xyz) v identity++-- Shearing++-- | Shear each dimension w.r.t. /x/ by the corresponding components of a vector+shearByX :: (Num a) => V3 a -> V4 (V4 a)+shearByX v = set (x . xyz) v identity++-- | Shear each dimension w.r.t. /y/ by the corresponding components of a vector+shearByY :: (Num a) => V3 a -> V4 (V4 a)+shearByY v = set (y . xyz) v identity++-- | Shear each dimension w.r.t. /z/ by the corresponding components of a vector+shearByZ :: (Num a) => V3 a -> V4 (V4 a)+shearByZ v = set (z . xyz) v identity++-- Rotation++-- | Rotate a number of radians around the /y/-axis+yaw :: (Floating a) => a -> V4 (V4 a)+yaw phi =+  set (x . x) (cos phi)+    . set (x . z) (negate $ sin phi)+    . set (z . x) (sin phi)+    . set (z . z) (cos phi)+    $ identity++-- | Rotate a number of radians around the /x/-axis+pitch :: (Floating a) => a -> V4 (V4 a)+pitch phi =+  set (y . y) (cos phi)+    . set (y . z) (sin phi)+    . set (z . y) (negate $ sin phi)+    . set (z . z) (cos phi)+    $ identity++-- | Rotate a number of radians around the /z/-axis+roll :: (Floating a) => a -> V4 (V4 a)+roll phi =+  set (x . x) (cos phi)+    . set (x . y) (sin phi)+    . set (y . x) (negate $ sin phi)+    . set (y . y) (cos phi)+    $ identity++-- | Rotate in order of 'yaw', 'pitch', 'roll' (/y, x, z/)+euler :: (Floating a) => V3 a -> V4 (V4 a)+euler (V3 p h r) =+  set (x . x) (cos r * cos h - sin r * sin p * sin h)+    . set (x . y) (sin r * cos h + cos r * sin p * sin h)+    . set (x . z) (negate $ cos p * sin h)+    . set (y . x) (negate $ sin r * cos p)+    . set (y . y) (cos r * cos p)+    . set (y . z) (sin p)+    . set (z . x) (cos r * sin h + sin r * sin p * cos h)+    . set (z . y) (sin r * sin h - cos r * sin p * cos h)+    . set (z . z) (cos p * cos h)+    $ identity

@@ -0,0 +1,151 @@+{-# LANGUAGE ImpredicativeTypes #-}++-- | Vector operations in orthonormal Euclidean spaces+module Mini.Linear.Vector (+  -- * Class+  Vector (+    axes+  ),++  -- * Construction+  basis,+  e,+  zero,++  -- * Operations+  (^+^),+  (^-^),+  (~*^),+  cross,+  dot,+  hat,+  norm,+  onto,++  -- * Interpolation+  lerp,+) where++import Control.Applicative (+  liftA2,+ )+import Mini.Linear.Space (+  V0 (V0),+  V1 (V1),+  V2 (V2),+  V3 (V3),+  V4 (V4),+  w,+  x,+  y,+  yzx,+  z,+  zxy,+ )+import Mini.Optics.Lens (+  Lens,+  set,+  view,+ )+import Prelude (+  Applicative,+  Floating,+  Foldable,+  Fractional,+  Num,+  fmap,+  pure,+  recip,+  sqrt,+  sum,+  ($),+  (*),+  (+),+  (-),+  (/),+ )++-- Class++-- | The class of vectors+class (Applicative v, Foldable v) => Vector v where+  -- | Basis vector lenses+  axes :: v (Lens (v a) (v a) a a)++instance Vector V0 where+  axes = V0++instance Vector V1 where+  axes = V1 x++instance Vector V2 where+  axes = V2 x y++instance Vector V3 where+  axes = V3 x y z++instance Vector V4 where+  axes = V4 x y z w++-- Construction++-- | Standard basis+basis :: (Vector v, Num a) => v (v a)+basis = fmap e axes++-- | Make a basis vector from a basis vector lens+e :: (Vector v, Num a) => Lens (v a) (v a) a a -> v a+e o = set o 1 zero++-- | Additive identity vector+zero :: (Vector v, Num a) => v a+zero = pure 0++-- Operations++infixl 6 ^+^++-- | Vector-vector addition+(^+^) :: (Vector v, Num a) => v a -> v a -> v a+(^+^) = liftA2 (+)++infixl 6 ^-^++-- | Vector-vector subtraction+(^-^) :: (Vector v, Num a) => v a -> v a -> v a+(^-^) = liftA2 (-)++infixl 7 ~*^++-- | Scalar-vector multiplication+(~*^) :: (Vector v, Num a) => a -> v a -> v a+s ~*^ v = fmap (s *) v++-- | Cross product+cross :: (Num a) => V3 a -> V3 a -> V3 a+cross u v =+  (^-^)+    (liftA2 (*) (view yzx u) (view zxy v))+    (liftA2 (*) (view zxy u) (view yzx v))++-- | Dot product+dot :: (Vector v, Num a) => v a -> v a -> a+dot u v = sum $ liftA2 (*) u v++-- | Adapt a vector /v/ to have unit norm (assumes @not $ v ~= zero@)+hat :: (Vector v, Floating a) => v a -> v a+hat u = recip (norm u) ~*^ u++-- | Norm of a vector+norm :: (Vector v, Floating a) => v a -> a+norm u = sqrt $ u `dot` u++-- | Project a vector onto a vector /v/ (assumes @not $ v ~= zero@)+onto :: (Vector v, Fractional a) => v a -> v a -> v a+onto u v = (u `dot` v) / (v `dot` v) ~*^ v++-- Interpolation++-- | Linear interpolation s.t. @lerp u v 0 == u && lerp u v 1 == v@+lerp :: (Vector v, Num a) => v a -> v a -> a -> v a+lerp u v t = (1 - t) ~*^ u ^+^ t ~*^ v

@@ -43,7 +43,7 @@  -- | Make a lens from a getter and a setter lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b-lens sa sbt ab s = sbt s <$> ab (sa s)+lens sa sbt afb s = sbt s <$> afb (sa s)  -- Operations