cybus (empty) → 0.1.0.0
raw patch · 15 files changed
+5496/−0 lines, 15 filesdep +QuickCheckdep +adjunctionsdep +base
Dependencies added: QuickCheck, adjunctions, base, checkers, cybus, deepseq, distributive, indexed-traversable, lens, mtl, pos, pretty-simple, primus, profunctors, semigroupoids, tasty, tasty-hunit, tasty-quickcheck, these, transformers, vector
Files
- LICENSE +29/−0
- app/Main.hs +42/−0
- cybus.cabal +113/−0
- src/Cybus.hs +39/−0
- src/Cybus/Fin.hs +299/−0
- src/Cybus/FinMat.hs +375/−0
- src/Cybus/Mat.hs +2253/−0
- src/Cybus/NatHelper.hs +376/−0
- test/CheckerHelper.hs +63/−0
- test/Main.hs +33/−0
- test/TestEnum.hs +207/−0
- test/TestFin.hs +256/−0
- test/TestFinMat.hs +449/−0
- test/TestMat.hs +915/−0
- test/TestNatHelper.hs +47/−0
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License + +Copyright (c) 2018, Grant Weyburne +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ app/Main.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}++module Main where+import Data.List.NonEmpty (NonEmpty(..))+--import qualified Data.List.NonEmpty as N+import Cybus++main :: IO ()+main = putStr $ show $ mm' @212++tst1 :: Mat (4 ':| [5,3]) Int+tst1 = gen id++tst2 :: Mat (4 ':| '[]) (Mat (5 ':| '[3]) Int)+tst2 = toVec (gen @(4 ':| [5,3]) id)++tst3 :: Mat (n ':| n1 ': ns) a -> Mat (n ':| '[]) (Mat (n1 ':| ns) a)+tst3 = toVec++tst4 :: Mat2 4 7 Int+tst4 = mat2 @4 @3 [1..] `multMat` mat2 @3 @7 [1..]+{-+>tst3 (mm @234)+Mat@[2]+[Mat@[3,4]+ [+ [1,2,3,4],+ [5,6,7,8],+ [9,10,11,12]+ ]+,Mat@[3,4]+ [+ [13,14,15,16],+ [17,18,19,20],+ [21,22,23,24]+ ]+]++it :: Mat (2 ':| '[]) (Mat (3 ':| '[4]) Int)+-}
+ cybus.cabal view
@@ -0,0 +1,113 @@+cabal-version: 1.12 ++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: cybus+version: 0.1.0.0+synopsis: multi-dimensional arrays+description: A library for typesafe multi-dimensional arrays . Please see the README on GitHub at <https://github.com/gbwey/cybus#readme>+category: Data, Containers+homepage: https://github.com/gbwey/cybus#readme+bug-reports: https://github.com/gbwey/cybus.git/issues+author: Grant Weyburne <gbwey9@gmail.com>+maintainer: Grant Weyburne <gbwey9@gmail.com>+copyright: 2022 Grant Weyburne+license: BSD3+license-file: LICENSE+build-type: Simple++source-repository head+ type: git+ location: https://github.com/gbwey/cybus.git++library+ exposed-modules:+ Cybus+ Cybus.Fin+ Cybus.FinMat+ Cybus.Mat+ Cybus.NatHelper+ other-modules:+ Paths_cybus+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wunused-type-patterns -Wredundant-constraints -Wmonomorphism-restriction -Wmissing-deriving-strategies -Wmissing-local-signatures -Widentities -Wmissing-export-lists+ build-depends:+ adjunctions+ , base >=4.7 && <5+ , deepseq+ , distributive+ , indexed-traversable+ , mtl+ , pos+ , primus+ , profunctors+ , semigroupoids+ , these+ , transformers+ , vector+ default-language: Haskell2010++executable cybus-exe+ main-is: Main.hs+ other-modules:+ Paths_cybus+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wno-missing-export-lists -Wno-missing-local-signatures+ build-depends:+ adjunctions+ , base+ , cybus+ , deepseq+ , distributive+ , indexed-traversable+ , mtl+ , pos+ , primus+ , profunctors+ , semigroupoids+ , these+ , transformers+ , vector+ default-language: Haskell2010++test-suite cybus-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ CheckerHelper+ TestEnum+ TestFin+ TestFinMat+ TestMat+ TestNatHelper+ Paths_cybus+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wunused-type-patterns -Wredundant-constraints -Wmissing-deriving-strategies -Widentities -Wno-missing-export-lists -Wno-missing-local-signatures+ build-depends:+ QuickCheck+ , adjunctions+ , base+ , checkers+ , cybus+ , deepseq+ , distributive+ , indexed-traversable+ , lens+ , mtl+ , pos+ , pretty-simple+ , primus+ , profunctors+ , semigroupoids+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , these+ , transformers+ , vector+ default-language: Haskell2010
+ src/Cybus.hs view
@@ -0,0 +1,39 @@+{- |+Module : Cybus+Description : convenience module with all the modules imported+Copyright : (c) Grant Weyburne, 2022+License : BSD-3+-}+module Cybus (+ module Cybus.Fin,+ module Cybus.FinMat,+ module Cybus.Mat,+ module Cybus.NatHelper,+ module Data.Pos,+ module Primus.AsMaybe,+ module Primus.Bool,+ module Primus.Enum,+ module Primus.Error,+ module Primus.Extra,+ module Primus.Fold,+ module Primus.List,+ module Primus.NonEmpty,+ module Primus.Num1,+ module Primus.Rep,+) where++import Cybus.Fin+import Cybus.FinMat+import Cybus.Mat+import Cybus.NatHelper+import Data.Pos+import Primus.AsMaybe+import Primus.Bool+import Primus.Enum+import Primus.Error+import Primus.Extra+import Primus.Fold+import Primus.List+import Primus.NonEmpty+import Primus.Num1+import Primus.Rep
+ src/Cybus/Fin.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+Module : Cybus.Fin+Description : finite numbers+Copyright : (c) Grant Weyburne, 2022+License : BSD-3++used for single indexes into a 'Cybus.Mat.Mat' or 'Cybus.FinMat.FinMat'+-}+module Cybus.Fin (+ type Fin,+ fnPos,+ fnN,+ pattern Fin,+ pattern FinU,+ FinT,+ FinWithMessageT,+ finC,++ -- * read/show methods+ showFin,+ readFinP,+ readFin,++ -- * constructors++ -- * miscellaneous+ mkFinC,+ mkFin,+ fin,+ finP,++ -- * fin indexes+ _F1,+ _F2,+ _F3,+ _F4,+ _F5,+ _F6,+ _F7,+ _F8,+ _F9,+ _F10,+ _F11,+ _F12,+ _F13,+ _F14,+ _F15,+ _F16,+ _F17,+ _F18,+ _F19,+ _F20,+) where++import Control.DeepSeq+import Control.Monad+import Cybus.NatHelper+import Data.Kind+import Data.Pos+import GHC.Enum+import GHC.Generics (Generic, Generic1)+import GHC.Read (readPrec)+import GHC.Stack+import qualified GHC.TypeLits as GL+import GHC.TypeNats (Nat)+import Primus.Enum+import Primus.Error+import Primus.Extra+import Primus.Num1+import qualified Text.ParserCombinators.ReadP as P+import qualified Text.ParserCombinators.ReadPrec as PC++-- | definition of the Finite type+type Fin :: Nat -> Type+data Fin n = Fin' !Pos !Pos+ deriving stock (Eq, Ord, Generic, Generic1)+ deriving anyclass (NFData)++-- | accessor for the index position within a 'Fin'+fnPos :: Fin n -> Pos+fnPos (Fin' i _) = i++-- | accessor for the maximum size within a 'Fin'+fnN :: Fin n -> Pos+fnN (Fin' _ n) = n++-- | readonly pattern synonym for fin+{-# COMPLETE Fin #-}++pattern Fin ::+ forall (n :: Nat).+ Pos ->+ Pos ->+ Fin n+pattern Fin i n <- Fin' i n++{-# COMPLETE FinU #-}++-- | pattern synonym for validating the fin before construction with a PosT constraint for validating at the typelevel+pattern FinU ::+ forall (n :: Nat).+ (HasCallStack, PosT n) =>+ Pos ->+ Pos ->+ Fin n+pattern FinU i n <-+ Fin' i n+ where+ FinU = frp .@ mkFinC -- dont change this: frp is good else breaking the system++-- | create a 'Fin' value level "i" and "n" values and validate that "i" is in range+mkFin :: Pos -> Pos -> Either String (Fin n)+mkFin p n = lmsg "mkFin" $ do+ if p <= n+ then pure (Fin' p n)+ else Left $ show p ++ " is too large: maximum is " ++ show n++-- | create a 'Fin' value level "i" and "n" values and validate against expected "n"+mkFinC :: forall n. PosT n => Pos -> Pos -> Either String (Fin n)+mkFinC p n = do+ let n' = fromNP @n+ if n == n'+ then mkFin p n+ else Left $ "mkFinC: " ++ show n ++ " /= " ++ show n' ++ " at typelevel"++-- | convenience function for conversion from 'Int' to 'Fin'+fin :: PosT n => Int -> Either String (Fin n)+fin = finP <=< eitherPos++-- | convenience function for conversion from 'Pos' to 'Fin'+finP :: forall n. PosT n => Pos -> Either String (Fin n)+finP = flip mkFinC (fromNP @n)++instance PosT n => Monoid (Fin n) where+ mempty = minBound++instance Semigroup (Fin n) where+ (<>) = max++-- PosT only needed for fromInteger+instance PosT n => Num (Fin n) where+ (+) = forceRight "(+)" .@ withOp2 (+)+ (-) = forceRight "(-)" .@ withOp2 (-)+ (*) = forceRight "(*)" .@ withOp2 (*)+ abs = id+ signum (Fin _ n) = FinU _1P n+ negate = normalError "Num (Fin n):negate is undefined"+ fromInteger i = forceRight "Num (Fin n):fromInteger" $ do+ ii <- integerToIntSafe (i + 1)+ k <- eitherPos ii+ mkFinC k (fromNP @n)++instance PosT n => Num1 (Fin n) where+ signum1 = fmap signum -- have to override as 1 is Fin 2 (there is no zero)++instance PosT n => Enum (Fin n) where+ toEnum i = forceRight "Enum(Fin n):toEnum" $ do+ p <- eitherPos (i + 1)+ mkFinC p (fromNP @n)+ fromEnum = subtract 1 . unP . fnPos -- todo: ok subtract one could be a problem+ enumFrom = boundedEnumFrom+ enumFromThen = boundedEnumFromThen++instance PosT n => Bounded (Fin n) where+ minBound = FinU _1P (fromNP @n)+ maxBound = FinU (fromNP @n) (fromNP @n)++-- | pretty print 'Fin'+showFin :: Fin n -> String+showFin (Fin (Pos i) (Pos n)) = "Fin" ++ show (i, n)++instance PosT n => Read (Fin n) where+ readPrec = PC.readP_to_Prec (const readFinP)++-- | reader for 'Fin'+readFin :: PosT n => ReadS (Fin n)+readFin = P.readP_to_S readFinP++-- | reader for 'showFin'+readFinP :: forall n. PosT n => P.ReadP (Fin n)+readFinP = do+ P.skipSpaces+ (i, n) <- P.between (P.string "Fin(") (P.string ")") ((,) <$> pPosInt <* P.char ',' <*> pPosInt)+ either (const P.pfail) pure (mkFinC i n)++instance Show (Fin n) where+ show = showFin++-- | create a 'Fin' using typelevel "i" and "n" Nat+finC :: forall (i :: Nat) (n :: Nat). FinT i n => Fin n+finC = Fin' (fromNP @i) (fromNP @n)++-- | type constraint for restricting a 'Nat' to positive numbers+type FinT :: Nat -> Nat -> Constraint+type FinT i n = (i <=! n, PosT n)++-- | type constraint for restricting a 'Nat' to positive numbers with a custom error message+type FinWithMessageT :: GL.ErrorMessage -> Nat -> Nat -> Constraint+type FinWithMessageT msg i n = (LTEQT msg i n, PosT n)++-- | type synonym for index 1+_F1 :: FinT 1 n => Fin n+_F1 = finC @1++-- | type synonym for index 2+_F2 :: FinT 2 n => Fin n+_F2 = finC @2++-- | type synonym for index 3+_F3 :: FinT 3 n => Fin n+_F3 = finC @3++-- | type synonym for index 4+_F4 :: FinT 4 n => Fin n+_F4 = finC @4++-- | type synonym for index 5+_F5 :: FinT 5 n => Fin n+_F5 = finC @5++-- | type synonym for index 6+_F6 :: FinT 6 n => Fin n+_F6 = finC @6++-- | type synonym for index 7+_F7 :: FinT 7 n => Fin n+_F7 = finC @7++-- | type synonym for index 8+_F8 :: FinT 8 n => Fin n+_F8 = finC @8++-- | type synonym for index 9+_F9 :: FinT 9 n => Fin n+_F9 = finC @9++-- | type synonym for index 10+_F10 :: FinT 10 n => Fin n+_F10 = finC @10++-- | type synonym for index 11+_F11 :: FinT 11 n => Fin n+_F11 = finC @11++-- | type synonym for index 12+_F12 :: FinT 12 n => Fin n+_F12 = finC @12++-- | type synonym for index 13+_F13 :: FinT 13 n => Fin n+_F13 = finC @13++-- | type synonym for index 14+_F14 :: FinT 14 n => Fin n+_F14 = finC @14++-- | type synonym for index 15+_F15 :: FinT 15 n => Fin n+_F15 = finC @15++-- | type synonym for index 16+_F16 :: FinT 16 n => Fin n+_F16 = finC @16++-- | type synonym for index 17+_F17 :: FinT 17 n => Fin n+_F17 = finC @17++-- | type synonym for index 18+_F18 :: FinT 18 n => Fin n+_F18 = finC @18++-- | type synonym for index 19+_F19 :: FinT 19 n => Fin n+_F19 = finC @19++-- | type synonym for index 20+_F20 :: FinT 20 n => Fin n+_F20 = finC @20
+ src/Cybus/FinMat.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+Module : Cybus.FinMat+Description : fixed-sized indices for a matrix+Copyright : (c) Grant Weyburne, 2022+License : BSD-3+-}+module Cybus.FinMat (+ type FinMat,+ fmPos,+ fmNS,+ pattern FinMat,+ pattern FinMatU,+ mkFinMat,+ mkFinMatC,+ toFinMatFromPos,+ FinMatC (..),+ finMatToNonEmpty,+ nonEmptyToFinMat,+ nonEmptyToFinMat',++ -- * read/show methods+ showFinMat,+ readFinMatP,+ readFinMat,+ showFinMat',++ -- * constructors++ -- * miscellaneous+ NSC (..),+ NSRangeC,+ _finMatFin,+ finMatFinSet,+ finMatFinGet,+ relPos,++ -- * lens into indices of matrix+ _i1,+ _i2,+ _i3,+ _i4,+ _i5,+ _i6,+ _i7,+ _i8,+ _i9,+ _i10,+) where++import Control.DeepSeq+import Cybus.Fin+import Cybus.NatHelper+import Data.Kind+import qualified Data.List as L+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import Data.Pos+import Data.Semigroup.Foldable+import Data.These+import GHC.Enum+import GHC.Generics (Generic, Generic1)+import GHC.Read (readPrec)+import GHC.Stack+import qualified GHC.TypeLits as GL+import GHC.TypeNats (Nat)+import qualified GHC.TypeNats as GN+import Primus.Enum+import Primus.Error+import Primus.Extra+import Primus.Lens+import Primus.NonEmpty+import Primus.Num1+import qualified Primus.TypeLevel as TP (Len1T, pnat)+import qualified Text.ParserCombinators.ReadP as P+import qualified Text.ParserCombinators.ReadPrec as PC++-- | definition of the indices of a matrix+type FinMat :: NonEmpty Nat -> Type+data FinMat ns = FinMatUnsafe !Int !(NonEmpty Pos)+ deriving stock (Eq, Ord, Generic, Generic1)+ deriving anyclass (NFData)++-- | accessor for the relative position within a matrix+fmPos :: FinMat ns -> Int+fmPos (FinMatUnsafe i _) = i++-- | accessor for the indices of a matrix+fmNS :: FinMat ns -> NonEmpty Pos+fmNS (FinMatUnsafe _ ns) = ns++-- | readonly pattern synonym for finmatrix+{-# COMPLETE FinMat #-}++pattern FinMat ::+ forall (ns :: NonEmpty Nat).+ Int ->+ NonEmpty Pos ->+ FinMat ns+pattern FinMat i ps <- FinMatUnsafe i ps++{-# COMPLETE FinMatU #-}++-- | pattern synonym for validating the finmatrix before construction but uses an extra 'NSC' constraint to check "ns"+pattern FinMatU ::+ forall (ns :: NonEmpty Nat).+ (HasCallStack, NSC ns) =>+ Int ->+ NonEmpty Pos ->+ FinMat ns+pattern FinMatU i ps <-+ FinMatUnsafe i ps+ where+ FinMatU = frp .@ mkFinMatC -- dont change this: frp is necessary else breaking the system++-- | create a FinMat value level "i" and "ns" values and validate that "i" is in range+mkFinMat :: Int -> NonEmpty Pos -> Either String (FinMat ns)+mkFinMat i ps = lmsg "mkFinMat" $ do+ let tot = productPInt ps+ if+ | i < 0 -> Left $ "cant be less than 0: i=" ++ show i+ | i >= tot -> Left $ "is too large: maximum is " ++ show (tot - 1) ++ " but found " ++ show i+ | otherwise -> pure (FinMatUnsafe i ps)++-- | create a FinMat value level "i" and "ns" values and validate against expected "ns"+mkFinMatC :: forall ns. NSC ns => Int -> NonEmpty Pos -> Either String (FinMat ns)+mkFinMatC i ps = do+ let ns = fromNSP @ns+ if ns == ps+ then mkFinMat i ps+ else Left $ "mkFinMatC: invalid indices: typelevel " ++ show (fromPositives ns) ++ " /= " ++ show (fromPositives ps)++-- | create a FinMat using a relative type level index+toFinMatFromPos :: forall (i :: Nat) ns. (NSC ns, i <! Product1T ns) => FinMat ns+toFinMatFromPos = FinMatU (TP.pnat @i) (fromNSP @ns)++-- | convert type level indices into a FinMat+class FinMatC is ns where+ finMatC :: FinMat ns++instance (NSC is, NSC ns, FinMatT is ns 1 is ns) => FinMatC is ns where+ finMatC = frp $ nonEmptyToFinMat' (fromNSP @is) (fromNSP @ns)++type FinMatT :: NonEmpty Nat -> NonEmpty Nat -> Nat -> NonEmpty Nat -> NonEmpty Nat -> Constraint+type family FinMatT is0 ns0 ind is ns where+ FinMatT _is0 _ns0 ind (i ':| '[]) (n ':| '[]) =+ FinWithMessageT ( 'GL.Text " at index " 'GL.:<>: 'GL.ShowType ind) i n+ FinMatT is0 ns0 ind (i ':| i' ': is) (n ':| n' ': ns) =+ (FinWithMessageT ( 'GL.Text " at index=" 'GL.:<>: 'GL.ShowType ind) i n, FinMatT is0 ns0 (ind GN.+ 1) (i' ':| is) (n' ':| ns))+ FinMatT is0 ns0 _ind (_ ':| _ ': _) (_ ':| '[]) =+ GL.TypeError+ ( 'GL.Text "too many indices: length is > length ns:"+ 'GL.:<>: 'GL.Text " found "+ 'GL.:<>: 'GL.ShowType (TP.Len1T is0)+ 'GL.:<>: 'GL.Text " expected "+ 'GL.:<>: 'GL.ShowType (TP.Len1T ns0)+ )+ FinMatT is0 ns0 _ind (_ ':| '[]) (_ ':| _ ': _) =+ GL.TypeError+ ( 'GL.Text "not enough indices: length is < length ns: "+ 'GL.:<>: 'GL.Text " found "+ 'GL.:<>: 'GL.ShowType (TP.Len1T is0)+ 'GL.:<>: 'GL.Text " expected "+ 'GL.:<>: 'GL.ShowType (TP.Len1T ns0)+ )++-- | convert a FinMat into a list of indices+finMatToNonEmpty :: forall ns. FinMat ns -> NonEmpty Pos+finMatToNonEmpty (FinMat i ns) = snd $ L.mapAccumR divModNextP i ns++-- | try to convert a list of indices into a FinMat+nonEmptyToFinMat :: forall ns. NSC ns => NonEmpty Pos -> Either String (FinMat ns)+nonEmptyToFinMat is = nonEmptyToFinMat' is (fromNSP @ns)++-- | try to convert a list of indices into a FinMat+nonEmptyToFinMat' :: NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat ns)+nonEmptyToFinMat' is ns =+ lmsg "nonEmptyToFinMat" $+ let (lrs, mlr) = zipWithExtras1 g is ns+ g :: Pos -> Pos -> Either String (Pos, Pos)+ g x y =+ if x <= y+ then Right (x, y)+ else Left $ "outofbounds " ++ show (x, y)+ in case mlr of+ MLREqual -> case partitionEithersNE lrs of+ That xys -> Right $ frp $ mkFinMat (snd $ relPos xys) ns+ This es -> Left $ "This " ++ L.intercalate "\n" (N.toList es)+ These es as -> Left $ "These es=" ++ L.intercalate "\n" (N.toList es) ++ " as=" ++ show as+ MLRLeft{} -> Left $ "too many indices: expected " ++ show (unP (lengthP ns)) ++ " is=" ++ show is ++ " ns=" ++ show ns+ MLRRight{} -> Left $ "not enough indices: expected " ++ show (unP (lengthP ns)) ++ " is=" ++ show is ++ " ns=" ++ show ns++-- | find the relative position in a matrix index+relPos :: Foldable1 t => t (Pos, Pos) -> (Pos, Int)+relPos xys =+ let ret@(Pos a, b) = foldr (\(Pos x, y) (z, tot) -> (z *! y, (x - 1) * unP z + tot)) (_1P, 0) xys+ in if b >= a+ then programmError $ "relPos " ++ show ret+ else ret++instance NSC ns => Monoid (FinMat ns) where+ mempty = minBound++instance Semigroup (FinMat ns) where+ (<>) = max++instance NSC ns => Num (FinMat ns) where+ (+) = forceRight "(+)" .@ withOp2 (+)+ (-) = forceRight "(-)" .@ withOp2 (-)+ (*) = forceRight "(*)" .@ withOp2 (*)+ abs = id+ signum (FinMat i ns) = FinMatU (signum i) ns+ negate = normalError "Num (FinMat ns):negate is undefined"+ fromInteger i = forceRight "Num (FinMat ns):fromInteger" $ do+ if i < 0+ then Left "undefined for negative numbers"+ else do+ ii <- integerToIntSafe i+ mkFinMatC ii (fromNSP @ns)++instance NSC ns => Num1 (FinMat ns) where+ fromInteger1 (FinMat _ ns) i = do+ ii <- integerToIntSafe i+ mkFinMatC ii ns++instance NSC ns => Enum (FinMat ns) where+ toEnum = forceRight "Enum(FinMat ns):toEnum" . flip mkFinMatC (fromNSP @ns)+ fromEnum = fmPos+ enumFrom = boundedEnumFrom+ enumFromThen = boundedEnumFromThen++instance NSC ns => Bounded (FinMat ns) where+ minBound = FinMatU 0 (fromNSP @ns)+ maxBound = FinMatU (unP (fromNSTotalP @ns) - 1) (fromNSP @ns)++instance NSC ns => Read (FinMat ns) where+ readPrec = PC.readP_to_Prec (const readFinMatP)++-- | reader for 'FinMat'+readFinMat :: NSC ns => ReadS (FinMat ns)+readFinMat = P.readP_to_S readFinMatP++-- | reader for 'showFin'+readFinMatP :: forall ns. NSC ns => P.ReadP (FinMat ns)+readFinMatP = do+ P.skipSpaces+ (i, ns) <- (,) <$> pInt <* P.char '@' <*> pPositives '{' '}'+ either (const P.pfail) pure $ mkFinMatC @ns i ns++neToString :: NonEmpty Pos -> String+neToString = L.intercalate "," . map show . fromPositives++-- | pretty print FinMat+showFinMat :: FinMat ns -> String+showFinMat (FinMat i ns) =+ show i ++ "@{" ++ neToString ns ++ "}"++-- | more detailed pretty print FinMat+showFinMat' :: forall ns. FinMat ns -> String+showFinMat' w@(FinMat i ns) =+ show i ++ "@{" ++ neToString (finMatToNonEmpty w) ++ "|" ++ neToString ns ++ "}"++instance Show (FinMat ns) where+ show = showFinMat++-- | constrain i within the size of the indices ie "i >= 1 && i <= Length ns"+type NSRangeC :: Peano -> NonEmpty Nat -> Constraint+class NSRangeC i ns++instance NSRangeC ( 'S 'Z) (n ':| ns)+instance NSRangeC ( 'S i) (m ':| ns) => NSRangeC ( 'S ( 'S i)) (n ':| m ': ns)+instance+ GL.TypeError ( 'GL.Text "NSRangeC: index is larger than the number of matrix indices ns") =>+ NSRangeC ( 'S ( 'S i)) (n ':| '[])++instance+ GL.TypeError ( 'GL.Text "NSRangeC: zero is not a valid index: index must be one or greater") =>+ NSRangeC 'Z (n ':| ns)++-- | a lens for accessing the "i" index in a indices of FinMat+_finMatFin ::+ forall i n ns.+ (PosT i, NSRangeC (NatToPeanoT i) ns) =>+ Lens' (FinMat ns) (Fin n)+_finMatFin = lens (finMatFinGet @i @n @ns) (finMatFinSet @i @n @ns)++-- | set the 'Fin' at index "i" for the FinMat+finMatFinSet ::+ forall i n ns.+ (PosT i, NSRangeC (NatToPeanoT i) ns) =>+ FinMat ns ->+ Fin n ->+ FinMat ns+finMatFinSet fm@(FinMat _ ns) (Fin ind _) =+ let i = fromNP @i+ ps = finMatToNonEmpty fm+ in case setAt1 i ind ps of+ Nothing -> programmError $ "finMatFinSet: index out of bounds: index is " ++ show i+ Just ps1 -> frp $ nonEmptyToFinMat' ps1 ns++{- | get the 'Fin' at index "i" from FinMat+ must rely on FinMat to get "n at index i "which saves us pulling "n" from the typelevel ie we can omit PosT n+-}+finMatFinGet ::+ forall i n ns.+ (PosT i, NSRangeC (NatToPeanoT i) ns) =>+ FinMat ns ->+ Fin n+finMatFinGet fm@(FinMat _ ns) =+ let i = fromNP @i+ ps = finMatToNonEmpty fm+ in case (at1 i ps, at1 i ns) of+ (Nothing, _) -> programmError "finMatFinGet: invalid index!"+ (_, Nothing) -> programmError $ "finMatFinGet: FinMat is corrupt: doesnt have the index at " ++ show i ++ " " ++ show fm+ (Just p, Just n) -> frp $ mkFin p n++-- | lens for index 1+_i1 :: Lens' (FinMat (n ':| ns)) (Fin n)+_i1 = _finMatFin @1++-- | lens for index 2+_i2 :: Lens' (FinMat (n1 ':| n ': ns)) (Fin n)+_i2 = _finMatFin @2++-- | lens for index 3+_i3 :: Lens' (FinMat (n1 ':| n2 ': n ': ns)) (Fin n)+_i3 = _finMatFin @3++-- | lens for index 4+_i4 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n ': ns)) (Fin n)+_i4 = _finMatFin @4++-- | lens for index 5+_i5 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n4 ': n ': ns)) (Fin n)+_i5 = _finMatFin @5++-- | lens for index 6+_i6 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n4 ': n5 ': n ': ns)) (Fin n)+_i6 = _finMatFin @6++-- | lens for index 7+_i7 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n4 ': n5 ': n6 ': n ': ns)) (Fin n)+_i7 = _finMatFin @7++-- | lens for index 8+_i8 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n4 ': n5 ': n6 ': n7 ': n ': ns)) (Fin n)+_i8 = _finMatFin @8++-- | lens for index 9+_i9 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n4 ': n5 ': n6 ': n7 ': n8 ': n ': ns)) (Fin n)+_i9 = _finMatFin @9++-- | lens for index 10+_i10 :: Lens' (FinMat (n1 ':| n2 ': n3 ': n4 ': n5 ': n6 ': n7 ': n8 ': n9 ': n ': ns)) (Fin n)+_i10 = _finMatFin @10
+ src/Cybus/Mat.hs view
@@ -0,0 +1,2253 @@++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++{- |+Module : Cybus.Mat+Description : type level indexed multi-dimensional matrix+Copyright : (c) Grant Weyburne, 2022+License : BSD-3+-}+module Cybus.Mat (+ type Mat,+ mVec,+ mIndices,+ pattern Mat,+ pattern MatU,+ Vec,+ Mat2,+ Mat3,+ Mat4,+ Mat5,+ Mat6,+ MatN,++ -- * cons/snoc lenses+ ConsMatC (..),+ SnocMatC (..),+ Eof1 (..),+ EofN (..),++ -- * tuple conversions+ MatTupleC (..),+ MatTupleT,+ ListTupleCInternal (..),++ -- * converters+ MatConvertersC (..),+ nestedListToMatValidated,+ nestedNonEmptyToMatValidated,+ MatToNestedVecT,++ -- * bulk construct matrix+ mkMat,+ mkMatC,+ mat,+ mat',+ vec,+ vec',+ mat2,+ mat2',+ gen',+ gen,+ mm',+ mm,+ buildMat,++ -- * vector/matrix builders+ (.:),+ se1,+ (.::),+ se2,+ (.|),+ (.||),++ -- * indexing+ ixMat,+ ixMat',+ setMat,+ updateMat,+ indexMat,+ finMatRows,++ -- * reverse+ reverseRows,++ -- * sort+ sortByRows,+ multMat,+ -- dot,+ DotC (..),++ -- * zip+ zipWithMat,+ zipWithMat3,+ zipMat,+ zipWithMatA,+ izipWith,+ izipWithM,++ -- * general+ cartesian,+ pureMat,+ replicateMat,++ -- * row operations+ deleteRow,+ deleteRow',+ insertRow,+ insertRow',+ swapRow,+ swapRow',+ _row,+ _row',+ rows,+ unrows,+ _rows,+ wrapRows1,+ indexRow,++ -- * column operations+ deleteCol,+ deleteCol',+ insertCol,+ insertCol',+ swapCol,+ swapCol',+ _col,+ _col',+ swapMat,+ swapMat',+ appendV,+ appendH,+ permutationsMat,+ findMatElems,++ -- * bulk updates+ bulkMat,+ updatesMat,+ getsMat,+ setsMat,+ nonEmptyMatsToMat,++ -- * reshape+ _transposeMat,+ transposeMat,+ toND,+ MatToNDT,+ toVec,+ toMat2,+ toMat3,+ concatMat,+ redim,+ reverseDim,++ -- * subset and slicing+ SliceC (..),+ SliceT,+ SliceC' (..),+ SliceT',+ slice,+ sliceUpdate,+ sliceToFinMat,+ SliceToFinMatT,+ ixSlice,+ ixSlice',+ subsetRows,+ subsetCols,+ diagonal,+ rowsToMat,++ -- * splitting+ chunkNV,+ chunkNVMat,++ -- * leaf methods+ LeafC (..),+ traverseLeafSimple,+ mapLeafSimple,+ foldMapLeaf,+ foldMapLeafR,+ mapLeaf,+ mapLeafS,+ mapLeafSimpleS,+ foldLeaf,+ toLeaves,+ mapCols,+ mapCols',++ -- * read/show/print methods+ ShowMatC (..),+ ShowOpts (..),+ defShowOpts,+ prtMat,+ showMat,+ readMatP,+ readMat,+ readMat2,+ readVec,++ -- * row lenses+ Row1 (..),+ Row2 (..),+ Row3 (..),+ Row4 (..),+ Row5 (..),+ Row6 (..),+ Row7 (..),+ Row8 (..),+ Row9 (..),+ Row10 (..),++ -- * column lenses+ _c1,+ _c2,+ _c3,+ _c4,+ _c5,+ _c6,+ _c7,+ _c8,+ _c9,+ _c10,++ -- * miscellaneous+ finMatMatrix,+ finMatMatrix',++ -- * scans+ scanlVec,+ scanrVec,+ postscanlMat,+ postscanrMat,++ -- ** coercion methods to set the dimensions of a matrix+ dim1,+ dim2,+ dim3,+ dim4,+ dim5,+ dim6,+ dim7,+ dim8,+ dim9,+ dim10,+) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Arrow+import Control.DeepSeq+import Control.Monad+import qualified Control.Monad.State.Strict as S+import Control.Monad.Zip+import Cybus.Fin+import Cybus.FinMat+import Cybus.NatHelper+import Data.Bool+import Data.Coerce+import Data.Distributive+import Data.Foldable+import Data.Foldable.WithIndex+import qualified Data.Functor.Apply as Apply+import qualified Data.Functor.Bind as Bind+import Data.Functor.Identity+import Data.Functor.Rep+import Data.Functor.WithIndex+import Data.Kind+import qualified Data.List as L+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import Data.Pos+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.String+import Data.Traversable.WithIndex+import Data.Tuple+import Data.Vector (Vector)+import qualified Data.Vector as V+import GHC.Enum+import qualified GHC.Exts as GE (IsList (..))+import GHC.Generics (Generic, Generic1)+import qualified GHC.Read as GR+import GHC.Stack+import qualified GHC.TypeLits as GL+import GHC.TypeNats (Nat)+import qualified GHC.TypeNats as GN+import Primus.Enum+import Primus.Error+import Primus.Extra+import Primus.Fold+import Primus.Lens+import Primus.NonEmpty+import Primus.Num1+import Primus.One+import Primus.Rep+import qualified Primus.TypeLevel as TP (Cons1T, Init1T, Last1T, type (++))+import qualified Text.ParserCombinators.ReadP as P+import qualified Text.ParserCombinators.ReadPrec as PC++-- | definition of a matrix+type Mat :: NonEmpty Nat -> Type -> Type+data Mat ns a = MatUnsafe !(Vector a) !(NonEmpty Pos)+ deriving stock (Functor, Traversable, Foldable, Generic, Generic1, Eq, Ord)+ deriving anyclass (NFData, NFData1)++-- | accessor for the relative position within a matrix+mVec :: Mat ns a -> Vector a+mVec (MatUnsafe v _) = v++-- | accessor for the indices of a matrix+mIndices :: Mat ns a -> NonEmpty Pos+mIndices (MatUnsafe _ ns) = ns++-- | convenient type synonym for a 1d matrix+type Vec :: Nat -> Type -> Type+type Vec n = Mat (n ':| '[])++-- | convenient type synonym for a 2d matrix+type Mat2 :: Nat -> Nat -> Type -> Type+type Mat2 n m = Mat (n ':| '[m])++-- | convenient type synonym for a 3d matrix+type Mat3 :: Nat -> Nat -> Nat -> Type -> Type+type Mat3 n m p = Mat (n ':| '[m, p])++-- | convenient type synonym for a 4d matrix+type Mat4 :: Nat -> Nat -> Nat -> Nat -> Type -> Type+type Mat4 n m p q = Mat (n ':| '[m, p, q])++-- | convenient type synonym for a 5d matrix+type Mat5 :: Nat -> Nat -> Nat -> Nat -> Nat -> Type -> Type+type Mat5 n m p q r = Mat (n ':| '[m, p, q, r])++-- | convenient type synonym for a 6d matrix+type Mat6 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Type -> Type+type Mat6 n m p q r s = Mat (n ':| '[m, p, q, r, s])++-- | convenient type synonym for specifying the dimensions of a matrix using the 'NN' type family+type MatN :: Nat -> Type -> Type+type MatN n = Mat (NN n)++-- | readonly pattern synonym for a matrix+{-# COMPLETE Mat #-}++pattern Mat ::+ forall (ns :: NonEmpty Nat) a.+ Vector a ->+ NonEmpty Pos ->+ Mat ns a+pattern Mat v ps <- MatUnsafe v ps++{-# COMPLETE MatIU #-}++-- | bidirectional pattern synonym for simple validation of a matrix before construction+pattern MatIU ::+ forall (ns :: NonEmpty Nat) a.+ HasCallStack =>+ Vector a ->+ NonEmpty Pos ->+ Mat ns a+pattern MatIU v ps <-+ MatUnsafe v ps+ where+ MatIU = frp .@ mkMat -- dont change this: frp is needed++{-# COMPLETE MatU #-}++-- | bidirectional pattern synonym for validating a matrix before construction with 'NSC' constraint for additional typelevel validation+pattern MatU ::+ forall (ns :: NonEmpty Nat) a.+ (NSC ns, HasCallStack) =>+ Vector a ->+ NonEmpty Pos ->+ Mat ns a+pattern MatU v ps <-+ MatUnsafe v ps+ where+ MatU = frp .@ mkMatC -- dont change this: frp is needed++instance (Bounded a, Enum a) => Num1 (Mat ns a) where+ fromInteger1 = toEnumTraversable+ toInteger1 = fromEnumFoldable1 -- need this as Enum is only Int but containers can be larger ie Integer++instance (Enum a, Bounded a, NSC ns) => Enum (Mat ns a) where+ toEnum = forceRight "Enum Mat:toEnum" . toEnumRep . toInteger+ fromEnum = forceRight "Enum Mat:fromEnum" . integerToIntSafe . fromEnumFoldable1+ enumFrom = boundedEnumFrom+ enumFromThen = boundedEnumFromThen++instance (NSC ns, Bounded a) => Bounded (Mat ns a) where+ minBound = pure minBound+ maxBound = pure maxBound++instance (c ~ Char, NSC ns) => IsString (Mat ns c) where+ fromString = mat++-- | generate a 'Mat' using a list+mat, mat' :: forall ns a. (HasCallStack, NSC ns) => [a] -> Mat ns a+mat = fr . matImpl False+mat' = fr . matImpl True++matImpl :: forall ns a. NSC ns => Bool -> [a] -> Either String (Mat ns a)+matImpl b = \case+ [] -> Left "matImpl: no data"+ x : xs -> do+ let ns = fromNSP @ns+ n = productP ns+ (as, zs) <- splitAt1GE n (x :| xs)+ case (b, zs) of+ (True, _ : _) -> Left "matImpl: found extras"+ _o -> Right $ MatU (V.fromListN (unP n) (N.toList as)) ns++-- | used by 'pure' so dont call pure from here+pureMat :: forall ns a. NSC ns => a -> Mat ns a+pureMat a =+ let ns = fromNSP @ns+ in MatU (V.replicate (productPInt ns) a) ns++-- | creates a matrix of first dimension "n" by replicating the input matrix "n" times+replicateMat :: forall n n1 ns a. PosT n => Mat (n1 ':| ns) a -> Mat (n ':| n1 ': ns) a+replicateMat (Mat v ns) =+ let n = fromNP @n+ in MatIU (V.concat (replicate (unP n) v)) (n N.<| ns)++instance (NSC ns, Num a) => Num (Mat ns a) where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ negate = fmap negate+ signum = fmap signum+ fromInteger = pure . fromInteger+ abs = fmap abs++instance (NSC ns, Fractional a) => Fractional (Mat ns a) where+ (/) = liftA2 (/)+ recip = fmap recip+ fromRational = pure . fromRational++instance NSC ns => Applicative (Mat ns) where+ pure = pureMat+ (<*>) = ap2++ap2 :: Mat ns (a -> b) -> Mat ns a -> Mat ns b+ap2 (Mat vab ps) (Mat va _) = MatIU (V.zipWith id vab va) ps -- ziplist style++ap3 :: NSC ns => (a -> Mat ns b) -> Mat ns a -> Mat ns b+ap3 f = imap (\fn -> indexMat fn . f)++instance Apply.Apply (Mat ns) where+ (<.>) = ap2++instance NSC ns => Monad (Mat ns) where+ (>>=) = flip ap3++instance NSC ns => Bind.Bind (Mat ns) where+ (>>-) = flip ap3++instance NSC ns => MonadZip (Mat ns) where+ mzipWith = zipWithMat++-- | zip two matrices using a combining function+zipWithMat :: (a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c+zipWithMat f (Mat v ps) (Mat w _) = MatIU (V.zipWith f v w) ps++-- | zip three matrices using a combining function+zipWithMat3 :: (a -> b -> c -> d) -> Mat ns a -> Mat ns b -> Mat ns c -> Mat ns d+zipWithMat3 f (Mat v ps) (Mat w _) (Mat x _) = MatIU (V.zipWith3 f v w x) ps++-- | zip two matrices+zipMat :: Mat ns a -> Mat ns b -> Mat ns (a, b)+zipMat = zipWithMat (,)++-- | 'zipWithMat' with an Applicative or use 'Primus.Fold.zipWithT' but that needs a 'NSC' constraint+zipWithMatA ::+ Applicative f =>+ (a -> b -> f c) ->+ Mat ns a ->+ Mat ns b ->+ f (Mat ns c)+zipWithMatA f = traverse (uncurry f) .@ zipMat++-- | 'zipWithMat' with an index or use 'Primus.Rep.izipWithR'+izipWith ::+ NSC ns =>+ (FinMat ns -> a -> b -> c) ->+ Mat ns a ->+ Mat ns b ->+ Mat ns c+izipWith f = zipWithMat3 f finMatMatrix++-- | 'zipWithMatA' with an index or use 'Primus.Rep.izipWithR' if "f" is 'Data.Distributive.Distributive'+izipWithM ::+ (NSC ns, Applicative f) =>+ (FinMat ns -> a -> b -> f c) ->+ Mat ns a ->+ Mat ns b ->+ f (Mat ns c)+izipWithM f = itraverse (uncurry . f) .@ zipMat++instance Foldable1 (Mat ns) where+ foldMap1 f = foldMap1 f . nep . V.toList . mVec -- cant be empty (dont use 'toNonEmpty')++instance Traversable1 (Mat ns) where+ traverse1 f (Mat v ps) =+ case V.toList v of+ [] -> programmError "Mat: traverse1: empty vector"+ a : as -> (\(b :| bs) -> MatIU (V.fromList (b : bs)) ps) <$> traverse1 f (a :| as)++instance Semigroup a => Semigroup (Mat ns a) where+ (<>) = zipWithMat (<>)+instance (Monoid a, NSC ns) => Monoid (Mat ns a) where+ mempty = pure mempty++instance NSC ns => FunctorWithIndex (FinMat ns) (Mat ns) where+ imap f = snd . L.mapAccumL (\i a -> (i + 1, f (FinMatU i (fromNSP @ns)) a)) 0++instance NSC ns => FoldableWithIndex (FinMat ns) (Mat ns) where+ ifoldMap f = fold . imap f++-- todo: write a dedicated version+instance NSC ns => TraversableWithIndex (FinMat ns) (Mat ns) where+ itraverse f = sequenceA . imap f++instance NSC ns => Distributive (Mat ns) where+ collect agb fa =+ let z = agb <$> fa+ in imap (\fm -> const ((V.! fmPos fm) . mVec <$> z)) (pure ())++-- | index into a matrix+indexMat :: FinMat ns -> Mat ns a -> a+indexMat fm = (V.! fmPos fm) . mVec++-- | create a matrix of matrix indices for a given size "ns"+finMatMatrix :: forall ns. NSC ns => Mat ns (FinMat ns)+finMatMatrix = finMatMatrix' (pure ())++-- | fill an existing matrix with indices+finMatMatrix' :: forall ns x. NSC ns => Mat ns x -> Mat ns (FinMat ns)+finMatMatrix' = imap const++instance NSC ns => Representable (Mat ns) where+ type Rep (Mat ns) = FinMat ns+ tabulate f = imap (const . f) (pure ())+ index = flip indexMat++instance NSC ns => GE.IsList (Mat ns a) where+ type Item (Mat ns a) = a+ fromList = snd . fr . fillTraversable (pure ())+ toList = toListMat++-- | validate before creating a matrix+mkMat :: forall ns a. Vector a -> NonEmpty Pos -> Either String (Mat ns a)+mkMat v ps =+ let n1 = productPInt ps+ n2 = V.length v+ ret = n1 == n2+ in if ret+ then Right (MatUnsafe v ps)+ else Left $ "\n\nproduct of " ++ show (fromPositives ps) ++ "=" ++ show n1 ++ "\nvector length=" ++ show n2 ++ "\n"++-- | validate before creating a matrix with extra 'NSC' constraint to check that "ns" and 'mIndices' match+mkMatC :: forall ns a. NSC ns => Vector a -> NonEmpty Pos -> Either String (Mat ns a)+mkMatC v ps = do+ let ps1 = fromNSP @ns+ if ps == ps1+ then mkMat v ps+ else Left $ "\nns mismatch: expected: " ++ show (fromPositives ps1) ++ " but found " ++ show (fromPositives ps)++-- | generate a matrix using indices+gen' :: forall ns a. NSC ns => ([Int] -> a) -> Mat ns a+gen' f = tabulate (f . fromPositives . finMatToNonEmpty @ns)++-- | generate a matrix using relative position+gen :: forall ns a. NSC ns => (Int -> a) -> Mat ns a+gen f = tabulate (f . fmPos)++-- | lens that accesses a value inside a mat given a concrete mat index+ixMat :: forall (ns :: NonEmpty Nat) a. FinMat ns -> Lens' (Mat ns a) a+ixMat i = lens (indexMat i) (\s b -> setMat b i s)++-- | lens that accesses a value inside a mat using a type level index+ixMat' ::+ forall (is :: NonEmpty Nat) (ns :: NonEmpty Nat) a.+ FinMatC is ns =>+ Lens' (Mat ns a) a+ixMat' = ixMat (finMatC @is @ns)++-- | sets a value in a matrix+setMat :: a -> FinMat ns -> Mat ns a -> Mat ns a+setMat a fm (Mat v ps) = MatIU (V.update v (V.singleton (fmPos fm, a))) ps++-- | updates a value in a matrix+updateMat :: (a -> a) -> FinMat ns -> Mat ns a -> Mat ns a+updateMat f (FinMat i _) (Mat v ps) =+ let (v1, v2) = V.splitAt i v+ in case V.uncons v2 of+ Just (a, v2') -> MatIU (v1 <> V.cons (f a) v2') ps+ Nothing -> programmError $ "updateMat: i=" ++ show i++-- | cons a value with a 1d matrix+(.:) :: forall n a a'. a ~ a' => a -> Vec n a' -> Vec (1 GN.+ n) a'+a .: Mat v (p :| ps) = MatIU (V.cons a v) (succP p :| ps)++infixr 4 .:++-- | cons a matrix with a one-higher dimension matrix+(.::) :: forall n m ns a. Mat (m ':| ns) a -> Mat (n ':| m ': ns) a -> Mat (1 GN.+ n ':| m ': ns) a+Mat v (_ :| _) .:: Mat v1 (p1 :| ps1) = MatIU (v <> v1) (succP p1 :| ps1)++infixr 3 .::++-- | combine two values together into 1d matrix+(.|) :: forall a a'. a ~ a' => a -> a' -> Vec 2 a'+a .| a' = MatU (V.cons a (V.singleton a')) (_2P :| [])++infixr 4 .|++-- | combine two matrices+(.||) :: forall m ns a. Mat (m ':| ns) a -> Mat (m ':| ns) a -> Mat (2 ':| m ': ns) a+Mat v (_ :| _) .|| Mat v1 (p1 :| ps1) = MatIU (v <> v1) (_2P :| p1 : ps1)++infixr 3 .||++-- | last element in a 1d matrix+se1 :: forall a. a -> Vec 1 a+se1 a = MatU (V.singleton a) (_1P :| [])++-- | last element in a 2d or greater matrix+se2 :: forall n ns a. Mat (n ':| ns) a -> Mat (1 ':| n ': ns) a+se2 (Mat v ps) = MatIU v (_1P N.<| ps)++-- | create a 1d matrix from a list of values+vec :: forall n a. (HasCallStack, PosT n) => [a] -> Vec n a+vec = mat @(n ':| '[])++-- | create a 1d matrix from a list of values with the exact number of elements+vec' :: forall n a. (HasCallStack, PosT n) => [a] -> Vec n a+vec' = mat' @(n ':| '[])++-- | create a 2d matrix from a list of values+mat2 :: forall n m a. (HasCallStack, PosT n, PosT m) => [a] -> Mat2 n m a+mat2 = mat @(n ':| m ': '[])++-- | create a 2d matrix from a list of values with the exact number of elements+mat2' :: forall n m a. (HasCallStack, PosT n, PosT m) => [a] -> Mat2 n m a+mat2' = mat' @(n ':| m ': '[])++-- | map each column+mapCols ::+ forall n m ns a b.+ (FinMat (m ':| n ': ns) -> Vec (TP.Last1T (n ':| ns)) a -> Vec (TP.Last1T (n ':| ns)) b) ->+ Mat (n ':| m ': ns) a ->+ Mat (n ':| m ': ns) b+mapCols f = transposeMat . mapLeafSimple f . transposeMat++-- | map each column with user state+mapCols' ::+ forall n m ns a b c.+ (FinMat (m ':| n ': ns) -> c -> Vec (TP.Last1T (n ':| ns)) a -> (c, Vec (TP.Last1T (n ':| ns)) b)) ->+ c ->+ Mat (n ':| m ': ns) a ->+ (c, Mat (n ':| m ': ns) b)+mapCols' f c = fmap transposeMat . mapLeafSimpleS f c . transposeMat++-- | traverse over a nested leaf matrix only allowing changes to "a"+traverseLeafSimple ::+ (LeafC ns, Applicative m) =>+ (FinMat ns -> Vec (TP.Last1T ns) a -> m (Vec (TP.Last1T ns) b)) ->+ Mat ns a ->+ m (Mat ns b)+traverseLeafSimple f = fmap fromLeavesInternalC . traverseLeafC f++-- | map over a nested leaf matrix only allowing changes to "a"+mapLeafSimple ::+ LeafC ns =>+ (FinMat ns -> Vec (TP.Last1T ns) a -> Vec (TP.Last1T ns) b) ->+ Mat ns a ->+ Mat ns b+mapLeafSimple f = fromLeavesInternalC . runIdentity . traverseLeafC (Identity .@ f)++-- | foldmap over a nested leaf matrix+foldMapLeaf+ , foldMapLeafR ::+ (Monoid z, LeafC ns) =>+ (FinMat ns -> Vec (TP.Last1T ns) a -> z) ->+ Mat ns a ->+ z+foldMapLeaf f = getConst . traverseLeafC (Const .@ f)+foldMapLeafR f = getConst . forwards . traverseLeafC ((Backwards . Const) .@ f)++-- | map over a nested leaf matrix+mapLeaf ::+ LeafC ns =>+ (FinMat ns -> Vec (TP.Last1T ns) a -> b) ->+ Mat ns a ->+ Mat (TP.Init1T ns) b+mapLeaf f = runIdentity . traverseLeafC (Identity .@ f)++-- | map over a nested leaf matrix with state+mapLeafS ::+ LeafC ns =>+ (FinMat ns -> c -> Vec (TP.Last1T ns) a -> (c, b)) ->+ c ->+ Mat ns a ->+ (c, Mat (TP.Init1T ns) b)+mapLeafS f c0 = swap . flip S.runState c0 . traverseLeafC (\i a -> S.state $ \c -> swap (f i c a))++-- | map over a nested leaf matrix only allowing changes to "a" and access to user state+mapLeafSimpleS ::+ LeafC ns =>+ (FinMat ns -> c -> Vec (TP.Last1T ns) a -> (c, Vec (TP.Last1T ns) b)) ->+ c ->+ Mat ns a ->+ (c, Mat ns b)+mapLeafSimpleS f c0 =+ second fromLeavesInternalC . swap . flip S.runState c0 . traverseLeafC (\i a -> S.state $ \c -> swap (f i c a))++-- | fold over a nested leaf matrix+foldLeaf ::+ LeafC ns =>+ (FinMat ns -> c -> Vec (TP.Last1T ns) a -> c) ->+ c ->+ Mat ns a ->+ c+foldLeaf f = fst .@ mapLeafS g+ where+ g fn c m = (f fn c m, ())++-- | convert to nested matrix with 1d leaves+toLeaves ::+ LeafC ns =>+ Mat ns a ->+ Mat (TP.Init1T ns) (Vec (TP.Last1T ns) a)+toLeaves = mapLeaf (const id)++-- | methods for accessing all the leaf rows of a matrix: restricted to 2d hence this class+class LeafC ns where+ traverseLeafC ::+ Applicative m =>+ (FinMat ns -> Vec (TP.Last1T ns) a -> m b) ->+ Mat ns a ->+ m (Mat (TP.Init1T ns) b)+ fromLeavesInternalC ::+ Mat (TP.Init1T ns) (Vec (TP.Last1T ns) a) ->+ Mat ns a++instance+ GL.TypeError ( 'GL.Text "LeafC: rows for 1D are not supported") =>+ LeafC (n ':| '[])+ where+ traverseLeafC = compileError "LeafC:traverseLeafC"+ fromLeavesInternalC = compileError "LeafC:fromLeavesInternalC"++instance LeafC (n ':| m ': ns) where+ traverseLeafC f w@(Mat _ (n :| ps)) =+ case ps of+ m : ns ->+ let (ny0, nx) = unsnoc1 (m :| ns)+ ny = n :| ny0+ g x = S.state $ \i -> (f (frp $ mkFinMat i (n :| m : ns)) x, i + unP nx)+ zs = frp $ chunkNVMat (units1 (productP ny)) (nx :| []) w+ tbs = sequenceA $ flip S.evalState 0 $ traverse g zs+ in (\zz -> MatIU (V.fromList (N.toList zz)) ny) <$> tbs+ [] -> programmError "traverseLeafC: missing indices"++ fromLeavesInternalC = coerce . concatMat++-- | get the start index for each row in a mat+finMatRows :: forall ns. NSC ns => NonEmpty (FinMat ns)+finMatRows =+ let (xs, _) = unsnoc1 (fromNSP @ns)+ ns = appendL1 xs (_1P :| [])+ fns = sequenceA $ N.map enumTo1 ns+ in forceRightP "finMatRows" $ traverse1 nonEmptyToFinMat fns++-- | reverse each row in a matrix+reverseRows :: LeafC ns => Mat ns a -> Mat ns a+reverseRows = mapLeafSimple (\_ (MatUnsafe v ps) -> MatUnsafe (V.reverse v) ps)++-- | sort each row of a mat using underlying 'Vec'+sortByRows :: LeafC ns => (a -> a -> Ordering) -> Mat ns a -> Mat ns a+sortByRows f = frp . wrapRows1 (N.sortBy f)++-- | visit each leaf row with a function from a nonempty to a nonempty list+wrapRows1 :: LeafC ns => (NonEmpty a -> NonEmpty b) -> Mat ns a -> Either String (Mat ns b)+wrapRows1 f = traverseLeafSimple (const (wrap1 f))++-- | reverse the dimensions of a matrix+reverseDim :: Mat ns a -> Mat (Reverse1T ns) a+reverseDim (Mat v ps) = MatIU v (N.reverse ps)++-- | resize a mat+redim :: forall ms ns a. (NSC ms, Product1T ns ~ Product1T ms) => Mat ns a -> Mat ms a+redim (Mat v _) = MatU v (fromNSP @ms)++{- | describes the resulting type of taking a slice from the mat+ but the indices must match pointwise unlike SliceT so we can use the concrete FinMat to specify the indices+-}+type SliceT' :: NonEmpty Nat -> NonEmpty Nat -> Type -> Type+type family SliceT' ns' ns a where+ SliceT' (n ':| '[]) (n ':| '[]) a = a+ SliceT' (_ ':| n' ': ns') (_ ':| '[]) _ =+ GL.TypeError+ ( 'GL.Text "SliceT': there are more ns' indices (lhs) than the actual matrix ns indices (rhs):"+ 'GL.:<>: 'GL.Text " extra ns'="+ 'GL.:<>: 'GL.ShowType (n' ': ns')+ )+ SliceT' (n ':| '[]) (n ':| n1 ': ns) a = Mat (n1 ':| ns) a+ SliceT' (n ':| n1' ': ns') (n ':| n1 ': ns) a = SliceT' (n1' ':| ns') (n1 ':| ns) a+-- todo: this condition doesnt fire in SliceC'+-- sliceC' (finMatC @(NN 11) @(NN 29)) (mm @235)+ SliceT' (n' ':| _) (n ':| _) _ =+ GL.TypeError+ ( 'GL.Text "SliceT': indices need to match pointwise:"+ 'GL.:<>: 'GL.Text "ie n' /= n:"+ 'GL.:<>: 'GL.ShowType n'+ 'GL.:<>: 'GL.Text " /= "+ 'GL.:<>: 'GL.ShowType n+ )++{- | allows viewing and updating a slice of a mat using concrete indices+ inference is better with n ~ n' but since we have committed to a instance+ we are missing nice errors when the indices dont match: eg+ sliceC' @(NS '[1]) @(NS '[7]) (FinMat 0 (_7P :| [])) (mm @7)+-}+type SliceC' :: NonEmpty Nat -> NonEmpty Nat -> Constraint+class SliceC' ns' ns where+ sliceC' :: FinMat ns' -> Mat ns a -> SliceT' ns' ns a+ sliceUpdateC' :: FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a++instance n ~ n' => SliceC' (n' ':| '[]) (n ':| '[]) where+ sliceC' (FinMat i _) (Mat v _) =+ case v V.!? i of+ Nothing -> programmError $ "sliceC': index " ++ show i ++ " out of bounds"+ Just a -> a+ sliceUpdateC' (FinMat i _) (Mat v ps) b =+ let (v1, v2) = V.splitAt i v+ in case V.uncons v2 of+ Just (_, v3) -> MatIU (v1 <> V.cons b v3) ps+ Nothing -> programmError $ "sliceUpdateC': index " ++ show i ++ " out of bounds"+instance n ~ n' => SliceC' (n' ':| '[]) (n ':| m ': ns) where+ sliceC' (FinMat i _) (Mat v (_ :| ps)) =+ case ps of+ m : ns ->+ let ps1 = m :| ns+ len1 = productPInt ps1+ in MatIU (V.slice (i * len1) len1 v) ps1+ [] -> programmError $ "sliceC': index " ++ show i ++ ": missing indices"++ sliceUpdateC' (FinMat i0 _) (Mat v w@(_ :| ps)) b =+ let len = productPInt ps+ i = i0 + 1+ v1 = V.slice 0 ((i - 1) * len) v+ v2 = V.slice (i * len) (productPInt w - i * len) v+ in MatIU (v1 <> mVec b <> v2) w++instance+ (n ~ n', SliceC' (n1' ':| ns') (n1 ':| ns)) =>+ SliceC' (n ':| n1' ': ns') (n' ':| n1 ': ns)+ where+ sliceC' fm@(FinMat _ (_ :| n1ns')) w@(Mat _ (n :| _)) =+ let x :| xs = finMatToNonEmpty fm+ i = unP x - 1+ in case (xs, n1ns') of+ (x1 : x1s, n1 : ns') ->+ let fn1 = frp $ nonEmptyToFinMat' (x1 :| x1s) (n1 :| ns')+ in sliceC' @(n1' ':| ns') @(n1 ':| ns) fn1 (sliceC' @(n' ':| '[]) @(n ':| n1 ': ns) (frp $ mkFinMat i (n :| [])) w)+ ([], _) -> programmError "sliceC': missing ns' indices"+ (_, []) -> programmError "sliceC': missing ns indices"+ sliceUpdateC' fm@(FinMat _ (_ :| n1ns')) (Mat v w@(_ :| ps0)) b =+ -- carve out the piece that is to be updated and pass that down then patch it all back together+ let x :| xs = finMatToNonEmpty fm+ i = unP x+ in case (ps0, xs, n1ns') of+ (_ : ns, x1 : x1s, n1 : ns') ->+ let fn1 = frp $ nonEmptyToFinMat' (x1 :| x1s) (n1 :| ns')+ ps1 = n1 :| ns+ len = productPInt ps1+ v1 = V.slice 0 ((i - 1) * len) v+ v2 = V.slice (i * len) (productPInt w - i * len) v+ m1 = MatIU (V.slice ((i - 1) * len) len v) ps1+ mx = sliceUpdateC' @(n1' ':| ns') @(n1 ':| ns) fn1 m1 b+ in MatIU (v1 <> mVec mx <> v2) w+ ([], _, _) -> programmError "sliceUpdateC': missing matrix indices"+ (_, [], _) -> programmError "sliceUpdateC': missing ns' indices"+ (_, _, []) -> programmError "sliceUpdateC': missing finmat indices"++instance (GL.TypeError ( 'GL.Text "too many indices ns': length ns' > length ns")) => SliceC' (n' ':| n1' ': ns') (n ':| '[]) where+ sliceC' = compileError "sliceC"+ sliceUpdateC' = compileError "sliceUpdateC"++-- | describes the resulting type of taking a slice from the matrix+type SliceToFinMatT :: NonEmpty Nat -> NonEmpty Nat -> NonEmpty Nat+type family SliceToFinMatT is ns where+ SliceToFinMatT (_ ':| '[]) (n ':| '[]) = n ':| '[]+ SliceToFinMatT (_ ':| i ': is) (_ ':| '[]) =+ GL.TypeError+ ( 'GL.Text "SliceToFinMatT: 'is' is larger in length than 'ns':"+ 'GL.:<>: 'GL.Text " extra 'is'="+ 'GL.:<>: 'GL.ShowType (i ': is)+ )+ SliceToFinMatT (_ ':| '[]) (n ':| _ ': _) = n ':| '[]+ SliceToFinMatT (_ ':| i1 ': is) (n ':| n1 ': ns) = TP.Cons1T n (SliceToFinMatT (i1 ':| is) (n1 ':| ns))++-- | converts a typelevel slice to a concrete 'FinMat'+sliceToFinMat ::+ forall is ns.+ (NSC (SliceToFinMatT is ns), NSC is, NSC ns) =>+ FinMat (SliceToFinMatT is ns)+sliceToFinMat =+ let is = fromNSP @is+ ns = fromNSP @ns+ in frp $ nonEmptyToFinMat (N.zipWith const is ns)++-- | get a slice by converting a typelevel slice to a concrete FinMat based slice+slice ::+ forall is ns a z.+ (z ~ SliceToFinMatT is ns, NSC is, NSC ns, NSC z, SliceC' z ns) =>+ Mat ns a ->+ SliceT' z ns a+slice = sliceC' (sliceToFinMat @is @ns)++-- | update a slice by converting a typelevel slice to a concrete FinMat based slice+sliceUpdate ::+ forall is ns a z.+ (z ~ SliceToFinMatT is ns, NSC is, NSC ns, NSC z, SliceC' z ns) =>+ Mat ns a ->+ SliceT' z ns a ->+ Mat ns a+sliceUpdate = sliceUpdateC' (sliceToFinMat @is @ns)++-- | describes the resulting type of taking a slice from the mat+type SliceT :: NonEmpty Nat -> NonEmpty Nat -> Type -> Type+type family SliceT is ns a where+ SliceT (_ ':| '[]) (_ ':| '[]) a = a+ SliceT (_ ':| i ': is) (_ ':| '[]) _ =+ GL.TypeError+ ( 'GL.Text "SliceT: 'is' must be a smaller in length than 'ns'"+ 'GL.:<>: 'GL.Text " extra 'is'="+ 'GL.:<>: 'GL.ShowType (i ': is)+ )+ SliceT (_ ':| '[]) (_ ':| n1 ': ns) a = Mat (n1 ':| ns) a+ SliceT (_ ':| i1 ': is) (_ ':| n1 ': ns) a = SliceT (i1 ':| is) (n1 ':| ns) a++-- | allows viewing and updating a slice of a mat+type SliceC :: NonEmpty Nat -> NonEmpty Nat -> Constraint+class SliceC is ns where+ sliceC :: Mat ns a -> SliceT is ns a+ sliceUpdateC :: Mat ns a -> SliceT is ns a -> Mat ns a++instance FinT i n => SliceC (i ':| '[]) (n ':| '[]) where+ sliceC (Mat v _) =+ let i = fromN @i - 1+ in case v V.!? i of+ Nothing -> programmError $ "sliceC: index " ++ show i ++ " out of bounds"+ Just a -> a+ sliceUpdateC (Mat v ps) b =+ let i = fromN @i - 1+ (v1, v2) = V.splitAt i v+ in case V.uncons v2 of+ Just (_, v3) -> MatIU (v1 <> V.cons b v3) ps+ Nothing -> programmError $ "sliceUpdateC: index " ++ show i ++ " out of bounds"+instance FinT i n => SliceC (i ':| '[]) (n ':| m ': ns) where+ sliceC (Mat v (_ :| ps)) =+ case ps of+ m : ns ->+ let i = fromN @i - 1+ ps1 = m :| ns+ len1 = productPInt ps1+ in MatIU (V.slice (i * len1) len1 v) ps1+ [] -> programmError $ "sliceUpdateC: index " ++ show (fromN @i) ++ ": missing indices"++ sliceUpdateC (Mat v w@(_ :| ps)) b =+ let i = fromN @i+ len = productPInt ps+ v1 = V.slice 0 ((i - 1) * len) v+ v2 = V.slice (i * len) (productPInt w - i * len) v+ in MatIU (v1 <> mVec b <> v2) w++instance+ (FinT i n, SliceC (i1 ':| is) (n1 ':| ns)) =>+ SliceC (i ':| i1 ': is) (n ':| n1 ': ns)+ where+ sliceC w =+ sliceC @(i1 ':| is) @(n1 ':| ns) (sliceC @(i ':| '[]) @(n ':| n1 ': ns) w)+ sliceUpdateC (Mat v w@(_ :| ps0)) b =+ -- carve out the piece that is to be updated and pass that down then patch it all back together+ case ps0 of+ n1 : ns ->+ let i = fromN @i+ ps1 = n1 :| ns+ len = productPInt ps1+ v1 = V.slice 0 ((i - 1) * len) v+ v2 = V.slice (i * len) (productPInt w - i * len) v+ m1 = MatIU (V.slice ((i - 1) * len) len v) ps1+ mx = sliceUpdateC @(i1 ':| is) @(n1 ':| ns) m1 b+ in MatIU (v1 <> mVec mx <> v2) w+ [] -> programmError $ "sliceUpdateC: index " ++ show (fromN @i) ++ ": missing indices"++instance (GL.TypeError ( 'GL.Text "too many indices 'is': length is > length ns")) => SliceC (i ':| i1 ': is) (n ':| '[]) where+ sliceC = compileError "sliceC (2)"+ sliceUpdateC = compileError "sliceUpdateC (2)"++-- | a lens indexing the outermost slice+_row ::+ forall (i :: Nat) (ns :: NonEmpty Nat) a.+ (SliceC (i ':| '[]) ns) =>+ Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)+_row = ixSlice @(i ':| '[])++-- | a lens for acccessing a column+_col ::+ forall (i :: Nat) n m ns a.+ (FinT i m) =>+ Lens' (Mat (n ':| m ': ns) a) (Mat (n ':| ns) a)+_col = _transposeMat . _row @i++-- | a lens for accessing a slice of a mat+ixSlice ::+ forall (is :: NonEmpty Nat) (ns :: NonEmpty Nat) a.+ (SliceC is ns) =>+ Lens' (Mat ns a) (SliceT is ns a)+ixSlice =+ lens+ (sliceC @is)+ (sliceUpdateC @is)++-- | a lens indexing a row using a concrete index 'Fin'+_row' ::+ forall (n :: Nat) (ns :: NonEmpty Nat) a.+ (SliceC' (n ':| '[]) ns) =>+ Fin n ->+ Lens' (Mat ns a) (SliceT' (n ':| '[]) ns a)+_row' (Fin i _) = ixSlice' @(n ':| '[]) (frp $ mkFinMat (unP i - 1) (succP i :| []))++-- | a lens for acccessing a column+_col' ::+ forall n m ns a.+ Fin m ->+ Lens' (Mat (n ':| m ': ns) a) (Mat (n ':| ns) a)+_col' fn = _transposeMat . _row' fn++-- | a lens for accessing a slice of a mat+ixSlice' ::+ forall (ns' :: NonEmpty Nat) (ns :: NonEmpty Nat) a.+ (SliceC' ns' ns) =>+ FinMat ns' ->+ Lens' (Mat ns a) (SliceT' ns' ns a)+ixSlice' fm =+ lens+ (sliceC' @ns' fm)+ (sliceUpdateC' @ns' fm)++-- | break up into rows+rows ::+ forall n m ns a.+ Mat (n ':| m ': ns) a ->+ Vec n (Mat (m ':| ns) a)+rows w@(Mat _ (n :| ps)) =+ case ps of+ m : ns ->+ let zs = frp $ chunkNVMat (unitsF @[] n) (m :| ns) w+ in MatIU (V.fromList zs) (n :| [])+ [] -> programmError "rows: missing indices"++-- | unbust from rows @see 'rows'+unrows ::+ forall n m ns a.+ Vec n (Mat (m ':| ns) a) ->+ Mat (n ':| m ': ns) a+unrows = concatMat++-- | split up a matrix into matrix chunks of dimension "ps" and fill a container "tz"+chunkNVMat ::+ forall ns t x a z.+ Traversable t =>+ t z ->+ NonEmpty Pos ->+ Mat x a ->+ Either String (t (Mat ns a))+chunkNVMat tz ps = (fmap . fmap) (`MatIU` ps) . chunkNV tz (productP ps) . mVec++-- | split up a vector into chunks of size "n" and fill a container "tz"+chunkNV ::+ forall t a z.+ Traversable t =>+ t z ->+ Pos ->+ Vector a ->+ Either String (t (Vector a))+chunkNV tz (Pos n) = chunkN' g tz+ where+ g = Right . swap . V.splitAt n++-- 4 conditions:+-- 1: (n:|[m]) a X (m:|[p]) b == (n:|[p]) (a->b->c)+-- 2: (n:|m:q:ns) a X (m:|[p]) b == (n:|[p]) ((q:|ns) a -> b -> c)+-- 3: (n:|m:q:ns) a X (m:|p:r:xs) b == (n:|[p]) ((q:|ns) a -> (r:|xs) b -> c)+-- 4: (n:|[m]) a X (m:|p:r:xs) b == (n:|[p]) (a -> (r:|xs) b -> c)++-- | generalised dot product+type DotC :: [Nat] -> [Nat] -> Type -> Type -> Type -> Type -> Constraint+class+ DotC ns ns' a b fa fb+ | ns ns' a -> fa+ , ns ns' b -> fb+ , ns ns' fa -> a+ , ns ns' fb -> b+ , fa fb a b -> ns ns'+ where+ dotC ::+ (fa -> fb -> c) ->+ (NonEmpty c -> d) ->+ Mat (n ':| m ': ns) a ->+ Mat (m ':| p ': ns') b ->+ Mat2 n p d++instance DotC '[] '[] a b a b where+ dotC = dot+instance DotC (q ': ns) '[] a b (Mat (q ':| ns) a) b where+ dotC f g m1 m2 = dot f g (toMat2 m1) m2+instance DotC '[] (r ': xs) a b a (Mat (r ':| xs) b) where+ dotC f g m1 m2 = dot f g m1 (toMat2 m2)+instance DotC (q ': ns) (r ': xs) a b (Mat (q ':| ns) a) (Mat (r ':| xs) b) where+ dotC f g m1 m2 = dot f g (toMat2 m1) (toMat2 m2)++-- | base case for generalised dot product+dot ::+ forall n m p a b c d.+ (a -> b -> c) ->+ (NonEmpty c -> d) ->+ Mat2 n m a ->+ Mat2 m p b ->+ Mat2 n p d+dot f g w1@(Mat _ (n :| ps1)) w2@(Mat _ (_ :| ps2)) =+ case (ps1, ps2) of+ ([m], [p]) ->+ let z1 = frp $ chunkNLen1 n m w1+ z2 = N.transpose $ frp $ chunkNLen1 m p w2+ w = liftA2 ((g . frp) .@ zipWithExact f) z1 z2+ in MatIU (V.fromList $ N.toList w) (n :| [p])+ o -> programmError $ "dot: missing indices " ++ show o++-- | multiply two matrices together+multMat ::+ forall n m p a.+ Num a =>+ Mat2 n m a ->+ Mat2 m p a ->+ Mat2 n p a+multMat = dot (*) sum1++-- | delete a row+deleteRow ::+ forall (i :: Nat) (n :: Nat) (ns :: [Nat]) a.+ FinT i (1 GN.+ n) =>+ Mat (1 GN.+ n ':| ns) a ->+ Mat (n ':| ns) a+deleteRow = deleteRow' (finC @i @(1 GN.+ n))++-- | delete a row using a concrete index+deleteRow' ::+ forall n ns a.+ Fin (1 GN.+ n) ->+ Mat (1 GN.+ n ':| ns) a ->+ Mat (n ':| ns) a+deleteRow' (Fin (Pos i) _) (Mat v (sn :| ps)) =+ let n = frp $ predP sn+ n1 = productPInt ps+ s = (i - 1) * n1+ v1 = V.slice 0 s v+ v2 = V.slice (s + n1) (productPInt (sn :| ps) - s - n1) v+ in MatIU (v1 <> v2) (n :| ps)++-- | delete a row from a matrix+insertRow ::+ forall i n m ns a.+ FinT i (1 GN.+ n) =>+ Mat (m ':| ns) a ->+ Mat (n ':| m ': ns) a ->+ Mat (1 GN.+ n ':| m ': ns) a+insertRow = insertRow' (finC @i @(1 GN.+ n))++-- | same as 'insertRow' but using a typelevel witness for the index+insertRow' ::+ forall n m ns a.+ Fin (1 GN.+ n) ->+ Mat (m ':| ns) a ->+ Mat (n ':| m ': ns) a ->+ Mat (1 GN.+ n ':| m ': ns) a+insertRow' (Fin (Pos i) _) (Mat v0 _) (Mat v (p :| ps)) =+ let s = (i - 1) * productPInt ps+ v1 = V.slice 0 s v+ v2 = V.slice s (productPInt (p :| ps) - s) v+ in MatIU (v1 <> v0 <> v2) (succP p :| ps)++-- | delete a column from a matrix (2d or higher)+deleteCol ::+ forall (i :: Nat) (n :: Nat) (n1 :: Nat) ns a.+ FinT i (1 GN.+ n1) =>+ Mat (n ':| (1 GN.+ n1) ': ns) a ->+ Mat (n ':| n1 ': ns) a+deleteCol = deleteCol' (finC @i @(1 GN.+ n1))++-- | same as 'deleteCol' but using a typelevel witness for the index+deleteCol' ::+ forall (n :: Nat) (n1 :: Nat) ns a.+ Fin (1 GN.+ n1) ->+ Mat (n ':| (1 GN.+ n1) ': ns) a ->+ Mat (n ':| n1 ': ns) a+deleteCol' fn = transposeMat @n1 @n . deleteRow' @n1 fn . transposeMat @n @(1 GN.+ n1)++-- | insert a column into a mat (2d and above)+insertCol ::+ forall (i :: Nat) (n :: Nat) (n1 :: Nat) ns a.+ FinT i (1 GN.+ n1) =>+ Mat (n ':| ns) a ->+ Mat (n ':| n1 ': ns) a ->+ Mat (n ':| (1 GN.+ n1) ': ns) a+insertCol = insertCol' (finC @i @(1 GN.+ n1))++-- | same as 'insertCol' but using a typelevel witness 'Fin'+insertCol' ::+ forall (n :: Nat) (n1 :: Nat) ns a.+ Fin (1 GN.+ n1) ->+ Mat (n ':| ns) a ->+ Mat (n ':| n1 ': ns) a ->+ Mat (n ':| (1 GN.+ n1) ': ns) a+insertCol' fn v = transposeMat @(1 GN.+ n1) @n . insertRow' fn v . transposeMat @n @n1++-- | swaps mat rows (1d or more)+swapRow ::+ forall (i :: Nat) (j :: Nat) (n :: Nat) ns a.+ (FinT i n, FinT j n) =>+ Mat (n ':| ns) a ->+ Mat (n ':| ns) a+swapRow = swapRow' (finC @i) (finC @j)++-- | swaps mat rows (1d or more)+swapRow' ::+ forall (n :: Nat) ns a.+ Fin n ->+ Fin n ->+ Mat (n ':| ns) a ->+ Mat (n ':| ns) a+swapRow' (Fin ix _) (Fin jx _) z@(Mat v w@(_ :| ps)) =+ let (Pos i, Pos j) = bool id swap (ix > jx) (ix, jx)+ len = productPInt ps+ in if i == j+ then z+ else+ let s0 = (i - 1) * len+ s1 = (j - 1) * len+ x1 = V.slice 0 s0 v+ x2 = V.slice s0 len v+ x3 = V.slice (s0 + len) (s1 - s0 - len) v+ x4 = V.slice s1 len v+ x5 = V.slice (s1 + len) (productPInt w - s1 - len) v+ in MatIU (x1 <> x4 <> x3 <> x2 <> x5) w++-- | swaps mat rows (2d or more)+swapCol ::+ forall (i :: Nat) (j :: Nat) (n :: Nat) (n1 :: Nat) ns a.+ (FinT i n1, FinT j n1) =>+ Mat (n ':| n1 ': ns) a ->+ Mat (n ':| n1 ': ns) a+swapCol = swapCol' (finC @i) (finC @j)++-- | swaps mat rows (2d or more)+swapCol' ::+ forall (n :: Nat) (n1 :: Nat) ns a.+ Fin n1 ->+ Fin n1 ->+ Mat (n ':| n1 ': ns) a ->+ Mat (n ':| n1 ': ns) a+swapCol' fni fnj = transposeMat . swapRow' fni fnj . transposeMat++-- | swaps a single value "a" from any location to any other location using type level indexes+swapMat ::+ forall (is :: NonEmpty Nat) (js :: NonEmpty Nat) ns a.+ (FinMatC is ns, FinMatC js ns) =>+ Mat ns a ->+ Mat ns a+swapMat = swapMat' (finMatC @is @ns) (finMatC @js @ns)++-- | same as 'swapMat' but using typelevel witnesses 'FinMat'+swapMat' ::+ forall ns a.+ FinMat ns ->+ FinMat ns ->+ Mat ns a ->+ Mat ns a+swapMat' (FinMat i _) (FinMat j _) (Mat v ps) =+ MatIU (V.update v (V.fromList [(i, v V.! j), (j, v V.! i)])) ps++-- | append two matrices vertically+appendV ::+ Mat (n ':| ns) a ->+ Mat (n' ':| ns) a ->+ Mat ((n GN.+ n') ':| ns) a+appendV (Mat v (p :| ps)) (Mat v1 (p1 :| _)) =+ MatIU (v <> v1) ((p +! p1) :| ps)++-- | append two matrices horizontally+appendH ::+ forall n m m' ns a.+ Mat (n ':| m ': ns) a ->+ Mat (n ':| m' ': ns) a ->+ Mat (n ':| (m GN.+ m') ': ns) a+appendH w@(Mat _ (n :| ps)) w1@(Mat _ (n' :| ps1))+ | n == n' =+ case (ps, ps1) of+ ([], _) -> programmError "appendH:lhs missing indices"+ (_, []) -> programmError "appendH:rhs missing indices"+ (m : ns, m' : ns')+ | ns == ns' ->+ let x1 = frp $ chunkNV (unitsF n) (productP (m :| ns)) (mVec w)+ x2 = frp $ chunkNV (unitsF @[] n) (productP (m' :| ns')) (mVec w1)+ ret = frp $ zipWithExact (<>) x1 x2+ ps2 = n :| ([m +! m'] <> ns)+ in MatIU (V.concat ret) ps2+ | otherwise -> programmError $ "appendH:ns/=ns' " ++ show (ns, ns')+ | otherwise = programmError $ "appendH: n/=n' " ++ show (n, n')++-- | return a mat as a permutation of a list (1d only) todo: extend to multidimensions+permutationsMat :: forall n a. Vec n a -> Mat2 (FacT n) n a+permutationsMat (Mat v (p :| _)) =+ let ret = L.permutations (V.toList v)+ lhs = productP (enumTo1 p)+ in MatIU (V.fromList $ concat ret) (lhs :| [p])++-- | find all elements in a mat that match the predicate+findMatElems :: NSC ns => (a -> Bool) -> Mat ns a -> [(FinMat ns, a)]+findMatElems p = ifoldMap (\i a -> bool [] [(i, a)] (p a))++-- | generate a 'Mat' with the given past and future rep values and a user state+buildMat ::+ forall ns a b.+ NSC ns =>+ ([FinMat ns] -> [FinMat ns] -> b -> FinMat ns -> (b, a)) ->+ b ->+ (b, Mat ns a)+buildMat = buildRepL++-- | cartesian product of two matrices with a combining function+cartesian ::+ (a -> b -> c) ->+ Mat (n ':| ns) a ->+ Mat (n' ':| ns') b ->+ Mat (n ':| ns TP.++ n' ': ns') c+cartesian f (Mat v ps) (Mat v1 ps1) =+ MatIU (liftA2 f v v1) (ps <> ps1)++-- | lens for bulk updates/gets on a matrix+bulkMat :: Vec x (FinMat ns) -> Lens' (Mat ns a) (Vec x a)+bulkMat fins =+ lens+ (getsMat fins)+ (\m lst -> setsMat (zipMat fins lst) m)++-- | bulk updates on a mat+updatesMat ::+ forall ns t a b.+ Foldable t =>+ (FinMat ns -> a -> b -> a) ->+ t (FinMat ns, b) ->+ Mat ns a ->+ Mat ns a+updatesMat f = flip (L.foldl' g)+ where+ g m (fm, b) = updateMat (\a -> f fm a b) fm m++-- | bulk gets from a mat: replaces the container of indices with the corresponding values+getsMat :: forall ns a t. Functor t => t (FinMat ns) -> Mat ns a -> t a+getsMat lst m = (`indexMat` m) <$> lst++-- | bulk updates on a mat+setsMat ::+ forall ns t a.+ Foldable t =>+ t (FinMat ns, a) ->+ Mat ns a ->+ Mat ns a+setsMat = flip (L.foldl' g)+ where+ g :: Mat ns a -> (FinMat ns, a) -> Mat ns a+ g m (fm, a) = setMat a fm m++-- | convert a matrix to a nested tuple+type MatTupleT :: NonEmpty Nat -> Type -> Type+type family MatTupleT ns a where+ MatTupleT (n ':| '[]) a = ListTupleT n a+ MatTupleT (n ':| n1 ': ns) a = ListTupleT n (MatTupleT (n1 ':| ns) a)++-- | convert a between a matrix and a nested tuple+type MatTupleC :: NonEmpty Nat -> Type -> Constraint+class MatTupleC ns a where+ toTupleC ::+ Mat ns a ->+ -- | convert a 'Mat' to a nested tuple+ MatTupleT ns a+ fromTupleC ::+ MatTupleT ns a ->+ -- | convert a well-formed nested tuple of type "a" to 'Mat'+ Mat ns a+ fmapTupleMatC ::+ (a -> b) ->+ MatTupleT ns a ->+ -- | fmap over a well-formed nested tuple+ MatTupleT ns b+ traversalTupleMatC ::+ -- | traversal over a well-formed nested tuple+ Traversal (MatTupleT ns a) (MatTupleT ns b) a b++instance ListTupleCInternal n => MatTupleC (n ':| '[]) a where+ toTupleC lst = toTupleCInternal lst+ fromTupleC x = fromTupleCInternal x+ fmapTupleMatC = fmapTupleInternal+ traversalTupleMatC = traversalTupleCInternal+instance+ (ListTupleCInternal n, NSC (n1 ':| ns), MatTupleC (n1 ':| ns) a) =>+ MatTupleC (n ':| n1 ': ns) a+ where+ toTupleC lst = toTupleCInternal @n (fmap (toTupleC @(n1 ':| ns)) (rows @n lst))+ fromTupleC x =+ let Mat v (n' :| _) = fromTupleCInternal (fmapTupleInternal (fromTupleC @(n1 ':| ns)) x)+ xs = foldMap mVec v+ ps1 = n' N.<| fromNSP @(n1 ':| ns)+ in MatIU @(n ':| n1 ': ns) xs ps1++ fmapTupleMatC f x = fmapTupleInternal (fmapTupleMatC @(n1 ':| ns) f) x -- below requires @(NS ns) cos i need to explicitly specify @(n1 ':| ns) here+ traversalTupleMatC afa = traversalTupleCInternal @n (traversalTupleMatC @(n1 ':| ns) afa)++-- | fmap over a n-tuple+fmapTupleInternal :: ListTupleCInternal n => (a -> b) -> ListTupleT n a -> ListTupleT n b+fmapTupleInternal f = runIdentity . traversalTupleCInternal (Identity . f)++-- | conversions between n-tuple and 'Vec'+type ListTupleCInternal :: Nat -> Constraint+class ListTupleCInternal n where+ -- | convert a 'Vec' to a tuple+ toTupleCInternal :: Vec n a -> ListTupleT n a++ -- | convert a tuple of type "a" to 'Vec'+ fromTupleCInternal :: ListTupleT n a -> Vec n a++ -- | traversal over a tuple+ traversalTupleCInternal :: Traversal (ListTupleT n a) (ListTupleT n b) a b++instance ListTupleCInternal 1 where+ toTupleCInternal (toNonEmptyMat -> a :| []) = One a+ toTupleCInternal _o = programmError "ListTupleCInternal 1"+ fromTupleCInternal (One a) = se1 a+ traversalTupleCInternal afa (One a) = One <$> afa a+instance ListTupleCInternal 2 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2]) = (a1, a2)+ toTupleCInternal _o = programmError "ListTupleCInternal 2"+ fromTupleCInternal (a1, a2) = a1 .| a2+ traversalTupleCInternal afa (a1, a2) = (,) <$> afa a1 <*> afa a2+instance ListTupleCInternal 3 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3]) = (a1, a2, a3)+ toTupleCInternal _o = programmError "ListTupleCInternal 3"+ fromTupleCInternal (a1, a2, a3) = a1 .: a2 .| a3+ traversalTupleCInternal afa (a1, a2, a3) = (,,) <$> afa a1 <*> afa a2 <*> afa a3+instance ListTupleCInternal 4 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4]) = (a1, a2, a3, a4)+ toTupleCInternal _o = programmError "ListTupleCInternal 4"+ fromTupleCInternal (a1, a2, a3, a4) = a1 .: a2 .: a3 .| a4+ traversalTupleCInternal afa (a1, a2, a3, a4) = (,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4+instance ListTupleCInternal 5 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4, a5]) = (a1, a2, a3, a4, a5)+ toTupleCInternal _o = programmError "ListTupleCInternal 5"+ fromTupleCInternal (a1, a2, a3, a4, a5) = a1 .: a2 .: a3 .: a4 .| a5+ traversalTupleCInternal afa (a1, a2, a3, a4, a5) = (,,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4 <*> afa a5+instance ListTupleCInternal 6 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4, a5, a6]) = (a1, a2, a3, a4, a5, a6)+ toTupleCInternal _o = programmError "ListTupleCInternal 6"+ fromTupleCInternal (a1, a2, a3, a4, a5, a6) = a1 .: a2 .: a3 .: a4 .: a5 .| a6+ traversalTupleCInternal afa (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4 <*> afa a5 <*> afa a6+instance ListTupleCInternal 7 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4, a5, a6, a7]) = (a1, a2, a3, a4, a5, a6, a7)+ toTupleCInternal _o = programmError "ListTupleCInternal 7"+ fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7) = a1 .: a2 .: a3 .: a4 .: a5 .: a6 .| a7+ traversalTupleCInternal afa (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4 <*> afa a5 <*> afa a6 <*> afa a7+instance ListTupleCInternal 8 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4, a5, a6, a7, a8]) = (a1, a2, a3, a4, a5, a6, a7, a8)+ toTupleCInternal _o = programmError "ListTupleCInternal 8"+ fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7, a8) = a1 .: a2 .: a3 .: a4 .: a5 .: a6 .: a7 .| a8+ traversalTupleCInternal afa (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4 <*> afa a5 <*> afa a6 <*> afa a7 <*> afa a8+instance ListTupleCInternal 9 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4, a5, a6, a7, a8, a9]) = (a1, a2, a3, a4, a5, a6, a7, a8, a9)+ toTupleCInternal _o = programmError "ListTupleCInternal 9"+ fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7, a8, a9) = a1 .: a2 .: a3 .: a4 .: a5 .: a6 .: a7 .: a8 .| a9+ traversalTupleCInternal afa (a1, a2, a3, a4, a5, a6, a7, a8, a9) = (,,,,,,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4 <*> afa a5 <*> afa a6 <*> afa a7 <*> afa a8 <*> afa a9+instance ListTupleCInternal 10 where+ toTupleCInternal (toNonEmptyMat -> a1 :| [a2, a3, a4, a5, a6, a7, a8, a9, a10]) = (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)+ toTupleCInternal _o = programmError "ListTupleCInternal 10"+ fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = a1 .: a2 .: a3 .: a4 .: a5 .: a6 .: a7 .: a8 .: a9 .| a10+ traversalTupleCInternal afa (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = (,,,,,,,,,) <$> afa a1 <*> afa a2 <*> afa a3 <*> afa a4 <*> afa a5 <*> afa a6 <*> afa a7 <*> afa a8 <*> afa a9 <*> afa a10++-- | an iso for transposing a matrix+_transposeMat :: Iso (Mat (n ':| m ': ns) a) (Mat (n ':| m ': ns) b) (Mat (m ':| n ': ns) a) (Mat (m ':| n ': ns) b)+_transposeMat = iso transposeMat transposeMat++-- | transpose a 2d or larger matrix+transposeMat :: forall n m ns a. Mat (n ':| m ': ns) a -> Mat (m ':| n ': ns) a+transposeMat w@(Mat _ (n :| ps)) =+ case ps of+ [] -> programmError "transposeMat"+ m : ns ->+ let ys = frp $ chunkNLen1 n (productP (m :| ns)) w+ zs = N.transpose $ N.map (chunksOf1 (productP ns)) ys+ in MatIU (V.fromList $ N.toList $ sconcat $ sconcat zs) (m :| (n : ns))++-- | validate and convert from a nested list to a matrix+nestedListToMatValidated :: forall ns x a. (x ~ ListNST ns a, ValidateNestedListC x (ValidateNestedListT x), MatConvertersC ns) => ListNST ns a -> Either String (Mat ns a)+nestedListToMatValidated w = do+ _ <- validateNestedList w+ nestedListToMatC w++-- | validate and convert from a nested nonempty list to a matrix+nestedNonEmptyToMatValidated :: forall ns x a. (x ~ NonEmptyNST ns a, ValidateNestedNonEmptyC x (ValidateNestedNonEmptyT x), MatConvertersC ns) => NonEmptyNST ns a -> Either String (Mat ns a)+nestedNonEmptyToMatValidated w = do+ _ <- validateNestedNonEmpty w+ nestedNonEmptyToMatC w++-- | class with methods to convert to and from Mat using nested structures+class MatConvertersC ns where+ -- | convert a 'Mat' to nested 'Vec'+ matToNestedVecC :: Mat ns a -> MatToNestedVecT ns a++ -- | convert a nested 'Vec' to a 'Mat'+ nestedVecToMatC :: MatToNestedVecT ns a -> Mat ns a++ -- | convert a 'Mat' to a nested list+ matToNestedListC :: Mat ns a -> ListNST ns a++ -- | convert a nested list to a 'Mat'+ nestedListToMatC :: ListNST ns a -> Either String (Mat ns a)++ -- | convert a 'Mat' to a nested nonempty list+ matToNestedNonEmptyC :: Mat ns a -> NonEmptyNST ns a++ -- | convert a nested nonempty list to a 'Mat'+ nestedNonEmptyToMatC :: NonEmptyNST ns a -> Either String (Mat ns a)++instance PosT n => MatConvertersC (n ':| '[]) where+ matToNestedVecC = id+ nestedVecToMatC = id+ matToNestedListC = toListMat+ matToNestedNonEmptyC = toNonEmptyMat+ nestedListToMatC = matImpl True+ nestedNonEmptyToMatC = matImpl True . N.toList+instance (PosT n, MatConvertersC (m ':| ns)) => MatConvertersC (n ':| m ': ns) where+ matToNestedVecC lst = fmap matToNestedVecC (rows @n lst)+ nestedVecToMatC lst@(Mat _ (n :| _)) =+ let zs@(Mat _ (m :| ns) :| _) = toNonEmptyMat $ fmap (nestedVecToMatC @(m ':| ns)) lst+ ys = foldMap mVec zs+ in MatIU ys (n :| m : ns)+ matToNestedListC w = toListMat $ fmap (matToNestedListC @(m ':| ns)) (rows @n w)+ matToNestedNonEmptyC w = toNonEmptyMat $ fmap (matToNestedNonEmptyC @(m ':| ns)) (rows @n w)+ nestedListToMatC = \case+ [] -> Left "nestedListToMatC: no data"+ w : ws -> nonEmptyMatsToMat =<< traverse (nestedListToMatC @(m ':| ns)) (w :| ws)+ nestedNonEmptyToMatC w = nonEmptyMatsToMat =<< traverse (nestedNonEmptyToMatC @(m ':| ns)) w++-- | create a matrix of one dimension higher from rows of a sub matrix+nonEmptyMatsToMat :: forall n m ns a t. (Foldable1 t, PosT n) => t (Mat (m ':| ns) a) -> Either String (Mat (n ':| m ': ns) a)+nonEmptyMatsToMat (toNonEmpty -> xs@(Mat _ ps :| _)) = do+ let n = fromNP @n+ ret <- lengthExact1 n xs+ pure $ MatIU (sconcat (fmap mVec ret)) (n N.<| ps)++-- | converts mat dimensions to a nested list+type MatToNestedVecT :: NonEmpty Nat -> Type -> Type+type family MatToNestedVecT ns a where+ MatToNestedVecT (n ':| '[]) a = Vec n a+ MatToNestedVecT (n ':| n1 ': ns) a = Vec n (MatToNestedVecT (n1 ':| ns) a)++-- | type synonym for the result of nesting a matrix: @see 'toND'+type MatToNDT :: Nat -> NonEmpty Nat -> Type -> Type+type MatToNDT i ns a = Mat (MatToMatNTA (NatToPeanoT i) ns) (Mat (MatToMatNTB (NatToPeanoT i) ns) a)++-- | create a nested matrix going "i" levels down: noop is not supported ie 4D matrix to a 4D matrix+matToNDImpl ::+ forall (i :: Nat) (ns :: NonEmpty Nat) a.+ PosT i =>+ Mat ns a ->+ MatToNDT i ns a+matToNDImpl w@(Mat _ ps) =+ let i = fromNP @i+ (ps1, bs) = splitAt1 i ps+ in case bs of+ y : ys ->+ let ps2 = y :| ys+ xs = frp $ chunkNVMat (unitsF (productP ps1)) ps2 w+ in MatIU (V.fromList xs) ps1+ [] -> programmError "toND:missing indices to the right"++type MatToMatNTA :: Peano -> NonEmpty Nat -> NonEmpty Nat+type family MatToMatNTA i ns where+ MatToMatNTA ( 'S 'Z) (_ ':| '[]) =+ GL.TypeError ( 'GL.Text "MatToMatNTA: noop as the depth 'i' is the same as the number of indices")+ MatToMatNTA ( 'S 'Z) (n ':| _ ': _) = n ':| '[]+ MatToMatNTA ( 'S _) (_ ':| '[]) =+ GL.TypeError ( 'GL.Text "MatToMatNTA: depth is more than the number of indices")+ MatToMatNTA ( 'S ( 'S i)) (n ':| m ': ns) = TP.Cons1T n (MatToMatNTA ( 'S i) (m ':| ns))++type MatToMatNTB :: Peano -> NonEmpty Nat -> NonEmpty Nat+type family MatToMatNTB i ns where+ MatToMatNTB ( 'S 'Z) (_ ':| '[]) =+ GL.TypeError ( 'GL.Text "MatToMatNTB: noop as the depth 'i' is the same as the number of indices")+ MatToMatNTB ( 'S 'Z) (_ ':| m ': ns) = m ':| ns+ MatToMatNTB ( 'S _) (_ ':| '[]) =+ GL.TypeError ( 'GL.Text "MatToMatNTB: depth is more than the number of indices")+ MatToMatNTB ( 'S ( 'S i)) (_ ':| m ': ns) = MatToMatNTB ( 'S i) (m ':| ns)++-- | create a nd matrix using a Nat @see 'toND+toND :: forall i ns a. i <=! i => Mat ns a -> MatToNDT i ns a+toND = matToNDImpl @i++-- | create a nested 1d matrix @see 'toND+toVec :: Mat ns a -> MatToNDT 1 ns a+toVec = toND @1++-- | create a nested 2d matrix @see 'toND+toMat2 :: Mat ns a -> MatToNDT 2 ns a+toMat2 = toND @2++-- | create a nested 3d matrix @see 'toND+toMat3 :: Mat ns a -> MatToNDT 3 ns a+toMat3 = toND @3++-- | squash a single nested matrix together into one+concatMat ::+ forall (n :: Nat) (ns :: [Nat]) (m :: Nat) (ms :: [Nat]) a.+ Mat (n ':| ns) (Mat (m ':| ms) a) ->+ Mat (n ':| (ns TP.++ m ': ms)) a+concatMat w =+ let hd :| tl = toNonEmptyMat w+ in MatIU (V.concat (map mVec (hd : tl))) (mIndices w <> mIndices hd)++-- | gets the diagonal elements of a 2d or greater square matrix: the diagonal of a n * n * ns matrix results in a n * ns matrix+diagonal :: Mat (n ':| n ': ns) a -> Mat (n ':| ns) a+diagonal (Mat v (n :| ps)) =+ case ps of+ _n : ns ->+ let len = productPInt ns+ xs = map (\i -> V.slice (i * (unP n + 1) * len) len v) [0 .. unP n - 1]+ in MatIU (V.concat xs) (n :| ns)+ [] -> programmError "diagonal: missing indices"++-- | take a subset of a matrix using the start and end rows+subsetRows ::+ forall i j n ns a.+ DiffTC i j n =>+ Mat (n ':| ns) a ->+ Mat (DiffT i j n ':| ns) a+subsetRows (Mat v (_ :| ns)) =+ let i = fromNP @i+ j = fromNP @j+ n1 = (unP i - 1) * productPInt ns+ n' = frp $ withOp2 ((-) . (+ 1)) j i+ ps1 = n' :| ns+ in MatIU (V.slice n1 (productPInt ps1) v) ps1++-- todo use FinMat versions of subsetRows and subsetCols ie not just typelevel: need typelevel for the count of rows/cols so no point++-- | take a subset of a matrix using the start and end columns+subsetCols ::+ forall i j m n ns a.+ DiffTC i j n =>+ Mat (m ':| n ': ns) a ->+ Mat (m ':| (DiffT i j n ': ns)) a+subsetCols = transposeMat . subsetRows @i @j . transposeMat++{- | shortcut way to construct a matrix with indices as the individual digits of the 'Nat' value+ @see 'gen''+-}+mm' :: forall n. NSC (NN n) => Mat (NN n) [Int]+mm' = gen' id++{- | shortcut way to construct a matrix with indices as the individual digits of the 'Nat' value+ @see 'gen'+-}+mm :: forall n. NSC (NN n) => Mat (NN n) Int+mm = gen (+ 1)++-- | isomorphism for nesting/unnesting a matrix one level deep+_rows ::+ forall n m ns a b.+ Iso+ (Mat (n ':| m ': ns) a)+ (Mat (n ':| m ': ns) b)+ (Vec n (Mat (m ':| ns) a))+ (Vec n (Mat (m ':| ns) b))+_rows = iso rows unrows++toListMat :: Mat ns a -> [a]+toListMat = toList++toNonEmptyMat :: Mat ns a -> NonEmpty a+toNonEmptyMat = toNonEmpty++-- | specialised version of 'readMat' for 'Vec'+readVec ::+ ( MatConvertersC (n ':| '[])+ , PosT n+ , Read [a]+ ) =>+ ReadS (Vec n a)+readVec = P.readP_to_S (readMatP defShowOpts)++-- | specialised version of 'readMat' for 'Mat2'+readMat2 ::+ ( MatConvertersC (n ':| '[m])+ , PosT n+ , PosT m+ , Read [[a]]+ ) =>+ ReadS (Mat2 n m a)+readMat2 = P.readP_to_S (readMatP defShowOpts)++-- | read in a matrix as a nested list using default 'ShowOpts'+readMat ::+ forall ns a.+ ( MatConvertersC ns+ , NSC ns+ , Read (ListNST ns a)+ ) =>+ ReadS (Mat ns a)+readMat = P.readP_to_S (readMatP defShowOpts)++instance (MatConvertersC ns, NSC ns, Read (ListNST ns a)) => Read (Mat ns a) where+ readPrec = PC.readP_to_Prec (const (readMatP defShowOpts))++-- | reader for 'showFin'+readMatP ::+ forall ns a.+ ( MatConvertersC ns+ , NSC ns+ , Read (ListNST ns a)+ ) =>+ ShowOpts ->+ P.ReadP (Mat ns a)+readMatP opts = do+ P.skipSpaces+ let ns = fromNSP @ns+ ns' <-+ (P.string "Mat@" *> pPositives '[' ']')+ P.+++ (P.string "Vec@" *> fmap pure pPosInt)+ P.+++ ((\n m -> n :| [m]) <$ P.string "Mat2@(" <*> pPosInt <* P.char ',' <*> pPosInt <* P.char ')')+ when (ns /= ns') P.pfail+ xs <- PC.readPrec_to_P (GR.readPrec @(ListNST ns a)) 1+ ret <- either (const P.pfail) pure (nestedListToMatC xs)+ when (addNewline ns opts) $ void $ P.char '\n'+ return ret++-- | print a matrix+prtMat :: forall ns a. (ShowMatC ns, Show a) => ShowOpts -> Mat ns a -> IO ()+prtMat = putStrLn .@ showMat++-- | show options for 'Mat'+data ShowOpts = ShowOpts+ { smIndent0 :: !Int+ -- ^ first indentation+ , smIndentN :: !Int+ -- ^ every subsequent indentation+ , smDivvy :: !Bool+ -- ^ split out into 'Vec' and 'Mat2' otherwise lump everything into 'Mat'+ , smInline1D :: !Bool+ -- ^ inline vector: large impact to output+ , smInlineNewLineEof :: !Bool+ -- ^ newline after each inlined vector: large impact to output+ , smOtherNewLineEof :: !Bool+ -- ^ newline after each except if inlined:large impact to output+ }+ deriving stock (Show, Eq, Ord)++-- | default show options for 'Mat'+defShowOpts :: ShowOpts+defShowOpts =+ ShowOpts+ { smIndent0 = 2+ , smIndentN = 0+ , smDivvy = True+ , smInline1D = True+ , smInlineNewLineEof = False+ , smOtherNewLineEof = True+ }++addNewline :: NonEmpty Pos -> ShowOpts -> Bool+addNewline (_ :| ns) opts =+ if null ns && smInline1D opts+ then smInlineNewLineEof opts+ else smOtherNewLineEof opts++instance (Show a, ShowMatC ns, NSC ns) => Show (Mat ns a) where+ show = showMat defShowOpts++-- | show a matrix+showMat :: forall ns a. (ShowMatC ns, Show a) => ShowOpts -> Mat ns a -> String+showMat opts w@(Mat _ (n :| ns)) =+ let s = showMatC opts w+ zs = L.intercalate "\n" s+ ret = case (smDivvy opts, ns) of+ (True, []) -> "Vec@" ++ show (unP n) ++ bool "\n" " " (smInline1D opts)+ (True, [m]) -> "Mat2@" ++ show (unP n, unP m) ++ "\n"+ (_, _) -> "Mat@" ++ show (fromPositives (n : ns)) ++ "\n"+ in ret ++ zs ++ bool mempty "\n" (addNewline (n :| ns) opts)++-- | class with methods to convert to and from Mat using nested structures+class ShowMatC ns where+ -- | show a matrix+ showMatC :: Show a => ShowOpts -> Mat ns a -> [String]+ showMatC = showMatC' 1 1++ showMatC' :: Show a => Int -> Int -> ShowOpts -> Mat ns a -> [String]++instance ShowMatC (n ':| '[]) where+ showMatC' i j _ (Mat v _) =+ let ret0 = show (V.toList v)+ in L.lines $ ret0 ++ if i == j then mempty else ","++instance ShowMatC (m ':| ns) => ShowMatC (n ':| m ': ns) where+ showMatC' i j opts w@(Mat _ (n :| _)) =+ let xs = toListMat $ rows w+ zz = replicate (3 + smIndent0 opts) ' ' -- 3 == length of "],["+ f s = [replicate (smIndent0 opts) ' ' ++ s]+ opts' = opts{smIndent0 = smIndentN opts}+ g i1 x1 = map (zz <>) (showMatC' (unP n) i1 opts' x1)+ s2 = concat $ zipWith g [1 ..] xs+ in case (i, j) of+ (1, 1) -> f "[" ++ s2 ++ f "]"+ (_, 1) -> f "[" ++ s2+ (_, _)+ | i == j -> f "],[" ++ s2 ++ f "]"+ | otherwise -> f "],[" ++ s2++-- | lens into row 1+class Row1 s a | s -> a where+ _r1 :: Lens' s a++-- | lens into row 2+class Row2 s a | s -> a where+ _r2 :: Lens' s a++-- | lens into row 3+class Row3 s a | s -> a where+ _r3 :: Lens' s a++-- | lens into row 4+class Row4 s a | s -> a where+ _r4 :: Lens' s a++-- | lens into row 5+class Row5 s a | s -> a where+ _r5 :: Lens' s a++-- | lens into row 6+class Row6 s a | s -> a where+ _r6 :: Lens' s a++-- | lens into row 7+class Row7 s a | s -> a where+ _r7 :: Lens' s a++-- | lens into row 8+class Row8 s a | s -> a where+ _r8 :: Lens' s a++-- | lens into row 9+class Row9 s a | s -> a where+ _r9 :: Lens' s a++-- | lens into row 10+class Row10 s a | s -> a where+ _r10 :: Lens' s a++-- | lens into the first row in a 2d or greater matrix+instance FinT 1 n => Row1 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r1 = _row @1++-- | lens into the first element in a 1d matrix+instance FinT 1 n => Row1 (Vec n a) a where+ _r1 = _row @1++instance (FinT 2 n) => Row2 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r2 = _row @2++instance (FinT 2 n) => Row2 (Vec n a) a where+ _r2 = _row @2++instance (FinT 3 n) => Row3 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r3 = _row @3++instance (FinT 3 n) => Row3 (Vec n a) a where+ _r3 = _row @3++instance (FinT 4 n) => Row4 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r4 = _row @4++instance (FinT 4 n) => Row4 (Vec n a) a where+ _r4 = _row @4++instance (FinT 5 n) => Row5 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r5 = _row @5++instance (FinT 5 n) => Row5 (Vec n a) a where+ _r5 = _row @5++instance (FinT 6 n) => Row6 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r6 = _row @6++instance (FinT 6 n) => Row6 (Vec n a) a where+ _r6 = _row @6++instance (FinT 7 n) => Row7 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r7 = _row @7++instance (FinT 7 n) => Row7 (Vec n a) a where+ _r7 = _row @7++instance (FinT 8 n) => Row8 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r8 = _row @8++instance (FinT 8 n) => Row8 (Vec n a) a where+ _r8 = _row @8++instance (FinT 9 n) => Row9 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r9 = _row @9++instance (FinT 9 n) => Row9 (Vec n a) a where+ _r9 = _row @9++instance (FinT 10 n) => Row10 (Mat (n ':| m ': ns) a) (Mat (m ':| ns) a) where+ _r10 = _row @10++instance (FinT 10 n) => Row10 (Vec n a) a where+ _r10 = _row @10++-- | lens into column 1 of a matrix+_c1 :: FinT 1 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c1 = _col @1++-- | lens into column 2 of a matrix+_c2 :: FinT 2 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c2 = _col @2++-- | lens into column 3 of a matrix+_c3 :: FinT 3 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c3 = _col @3++-- | lens into column 4 of a matrix+_c4 :: FinT 4 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c4 = _col @4++-- | lens into column 5 of a matrix+_c5 :: FinT 5 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c5 = _col @5++-- | lens into column 6 of a matrix+_c6 :: FinT 6 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c6 = _col @6++-- | lens into column 7 of a matrix+_c7 :: FinT 7 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c7 = _col @7++-- | lens into column 8 of a matrix+_c8 :: FinT 8 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c8 = _col @8++-- | lens into column 9 of a matrix+_c9 :: FinT 9 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c9 = _col @9++-- | lens into column 10 of a matrix+_c10 :: FinT 10 m => Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)+_c10 = _col @10++-- | marker representing the last value in a 1d matrix ie singleton+data Eof1 = Eof1 deriving stock (Show, Eq, Generic)++-- | marker representing the last row in a nd matrix ie singleton+data EofN = EofN deriving stock (Show, Eq, Generic)++type ConsMatCTA :: NonEmpty Nat -> Type -> Type+type family ConsMatCTA ns a where+ ConsMatCTA (1 ':| '[]) a = a+ ConsMatCTA (_ ':| '[]) a = a+ ConsMatCTA (1 ':| m ': ns) a = Mat (m ':| ns) a+ ConsMatCTA (_ ':| m ': ns) a = Mat (m ':| ns) a++type ConsMatCTB :: NonEmpty Nat -> Type -> Type+type family ConsMatCTB ns a where+ ConsMatCTB (1 ':| '[]) _ = Eof1+ ConsMatCTB (n ':| '[]) a = Vec (n GN.- 1) a+ ConsMatCTB (1 ':| _ ': _) _ = EofN+ ConsMatCTB (n ':| m ': ns) a = Mat ((n GN.- 1) ':| m ': ns) a++-- | iso and lenses to uncons a matrix+type ConsMatC :: NonEmpty Nat -> Type -> Type -> Constraint+class ConsMatC ns a b where+ consMat ::+ Iso+ (Mat ns a)+ (Mat ns b)+ (ConsMatCTA ns a, ConsMatCTB ns a)+ (ConsMatCTA ns b, ConsMatCTB ns b)+ headMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTA ns a)+ headMat = consMat . _Fst++ tailMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTB ns a)+ tailMat = consMat . _Snd++instance+ {-# OVERLAPPING #-}+ ( ConsMatCTA (1 ':| '[]) a ~ a+ , ConsMatCTA (1 ':| '[]) b ~ b+ , ConsMatCTB (1 ':| '[]) a ~ Eof1+ , ConsMatCTB (1 ':| '[]) b ~ Eof1+ ) =>+ ConsMatC (1 ':| '[]) a b+ where+ consMat = iso (\m -> (V.head (mVec m), Eof1)) (\(a, Eof1) -> se1 a)+instance+ {-# OVERLAPPABLE #-}+ ( ConsMatCTA (n ':| '[]) a ~ a+ , ConsMatCTA (n ':| '[]) b ~ b+ , ConsMatCTB (n ':| '[]) a ~ Vec (n GN.- 1) a+ , ConsMatCTB (n ':| '[]) b ~ Vec (n GN.- 1) b+ ) =>+ ConsMatC (n ':| '[]) a b+ where+ consMat =+ iso+ ( \(Mat v0 (sn :| ps)) ->+ let n = frp $ predP sn+ in case V.uncons v0 of -- stay within Vector+ Nothing -> programmError "consMat (1 GN.+ n ':| '[]): no data"+ Just (a, v) -> (a, MatIU v (n :| ps))+ )+ (\(a, Mat v (p :| ps)) -> MatIU (V.cons a v) (succP p :| ps))++instance+ {-# OVERLAPPING #-}+ ( ConsMatCTA (1 ':| m ': ns) a ~ Mat (m ':| ns) a+ , ConsMatCTA (1 ':| m ': ns) b ~ Mat (m ':| ns) b+ , ConsMatCTB (1 ':| m ': ns) a ~ EofN+ , ConsMatCTB (1 ':| m ': ns) b ~ EofN+ ) =>+ ConsMatC (1 ':| n1 ': ns) a b+ where+ consMat =+ iso+ ( \(Mat v (_ :| ps)) ->+ case ps of+ m : ns -> (MatIU v (m :| ns), EofN)+ [] -> programmError "consMat (1 ':| m ': ns): missing indices"+ )+ (\(Mat v ps, EofN) -> MatIU v (_1P N.<| ps))++instance+ {-# OVERLAPPING #-}+ ( ConsMatCTA (n ':| m ': ns) a ~ Mat (m ':| ns) a+ , ConsMatCTA (n ':| m ': ns) b ~ Mat (m ':| ns) b+ , ConsMatCTB (n ':| m ': ns) a ~ Mat ((n GN.- 1) ':| m ': ns) a+ , ConsMatCTB (n ':| m ': ns) b ~ Mat ((n GN.- 1) ':| m ': ns) b+ ) =>+ ConsMatC (n ':| m ': ns) a b+ where+ consMat =+ iso+ ( \(Mat v (sn :| ps)) ->+ case ps of+ m : ns ->+ let n = frp $ predP sn+ ps1 = m :| ns+ ps2 = n :| (m : ns)+ (v1, v2) = V.splitAt (productPInt ps1) v+ in ( MatIU v1 ps1+ , MatIU v2 ps2+ )+ [] -> programmError "consMatX:(1 GN.+ n ':| m ': ns): missing indices"+ )+ (\(Mat v1 _, Mat v2 (p2 :| ps2)) -> MatIU (v1 <> v2) (succP p2 :| ps2))++-- | iso and lenses to unsnoc a matrix+type SnocMatC :: NonEmpty Nat -> Type -> Type -> Constraint+class SnocMatC ns a b where+ snocMat ::+ Iso+ (Mat ns a)+ (Mat ns b)+ (ConsMatCTB ns a, ConsMatCTA ns a)+ (ConsMatCTB ns b, ConsMatCTA ns b)++ initMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTB ns a)+ initMat = snocMat . _Fst++ lastMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTA ns a)+ lastMat = snocMat . _Snd++instance {-# OVERLAPPING #-} SnocMatC (1 ':| '[]) a b where+ snocMat =+ iso+ (\m -> (Eof1, V.last (mVec m)))+ (\(Eof1, a) -> MatIU (V.singleton a) (_1P :| []))+instance+ {-# OVERLAPPABLE #-}+ ( ConsMatCTB (n ':| '[]) a ~ Vec (n GN.- 1) a+ , ConsMatCTB (n ':| '[]) b ~ Vec (n GN.- 1) b+ ) =>+ SnocMatC (n ':| '[]) a b+ where+ snocMat =+ iso+ ( \(Mat v0 (sn :| ps)) ->+ let n = frp $ predP sn+ in case V.unsnoc v0 of+ Nothing -> programmError "snocMat (1 GN.+ n ':| '[]): no data"+ Just (v, a) -> (MatIU v (n :| ps), a)+ )+ (\(Mat v (p :| ps), a) -> MatIU (V.snoc v a) (succP p :| ps))++instance {-# OVERLAPPING #-} SnocMatC (1 ':| n1 ': ns) a b where+ snocMat =+ iso+ ( \(Mat v (_ :| ps)) ->+ case ps of+ m : ns ->+ (EofN, MatIU v (m :| ns))+ [] -> programmError "snocMat (1 GN.+ n ':| '[]): missing indices"+ )+ (\(EofN, Mat v ps) -> MatIU v (_1P N.<| ps))++instance+ {-# OVERLAPPABLE #-}+ ( ConsMatCTB (n ':| m ': ns) a ~ Mat ((n GN.- 1) ':| m ': ns) a+ , ConsMatCTB (n ':| m ': ns) a ~ Mat ((n GN.- 1) ':| m ': ns) b+ ) =>+ SnocMatC (n ':| m ': ns) a b+ where+ snocMat =+ iso+ ( \(Mat v (sn :| ps)) ->+ case ps of+ m : ns ->+ let n = frp $ predP sn+ ps1 = m :| ns+ ps2 = n :| (m : ns)+ (v2, v1) = V.splitAt (productPInt ps2) v+ in ( MatIU v2 ps2+ , MatIU v1 ps1+ )+ [] -> programmError "snocMat:(1 GN.+ n ':| m ': ns): missing indices"+ )+ (\(Mat v1 (p1 :| ps1), Mat v2 _) -> MatIU (v1 <> v2) (succP p1 :| ps1))++-- | construct a new matrix based on a 1d matrix of row witnesses+rowsToMat ::+ forall x n m ns a.+ Vec x (Fin n) ->+ Mat (n ':| m ': ns) a ->+ Mat (x ':| m ': ns) a+rowsToMat w1@(Mat _ (x :| _)) w2@(Mat _ (_ :| ps)) =+ MatIU (V.concat $ toListMat $ fmap (\fn -> mVec (indexRow fn w2)) w1) (x :| ps)++-- | get a row from a matrix using a concrete index see '_row''+indexRow :: Fin n -> Mat (n ':| m ': ns) a -> Mat (m ':| ns) a+indexRow (Fin (Pos i) _n) (Mat v (_ :| ps)) =+ case ps of+ m : ns ->+ let s = (i - 1) * len+ len = productPInt (m :| ns)+ in MatIU (V.slice s len v) (m :| ns)+ [] -> programmError "indexRow: missing indices"++-- | 'Data.List.scanr' for a vector+scanrVec :: forall n a b. (a -> b -> b) -> b -> Vec n a -> Vec (n GN.+ 1) b+scanrVec f c (Mat v (p :| ps)) =+ MatIU (V.scanr' f c v) (succP p :| ps)++-- | 'Data.List.scanl'' for a vector+scanlVec :: forall n a b. (b -> a -> b) -> b -> Vec n a -> Vec (n GN.+ 1) b+scanlVec f c (Mat v (p :| ps)) =+ MatIU (V.scanl' f c v) (succP p :| ps)++{- | @see 'Data.Vector.postscanr''+ concrete version of 'Primus.Fold.postscanr+-}+postscanrMat :: forall ns a b. (a -> b -> b) -> b -> Mat ns a -> Mat ns b+postscanrMat f c (Mat v ps) =+ MatIU (V.postscanr' f c v) ps++{- | @see 'Data.Vector.postscanl''+ concrete version of 'Primus.Fold.postscanl'+-}+postscanlMat :: forall ns a b. (b -> a -> b) -> b -> Mat ns a -> Mat ns b+postscanlMat f c (Mat v ps) =+ MatIU (V.postscanl' f c v) ps++-- | matrix of dimension 1+dim1 :: Vec n a -> Vec n a+dim1 = id++-- | matrix of dimension 2+dim2 :: Mat2 n m a -> Mat2 n m a+dim2 = id++-- | matrix of dimension 3+dim3 :: Mat (n ':| '[m, p]) a -> Mat (n ':| '[m, p]) a+dim3 = id++-- | matrix of dimension 4+dim4 :: Mat (n ':| '[m, p, q]) a -> Mat (n ':| '[m, p, q]) a+dim4 = id++-- | matrix of dimension 5+dim5 :: Mat (n ':| '[m, p, q, r]) a -> Mat (n ':| '[m, p, q, r]) a+dim5 = id++-- | matrix of dimension 6+dim6 :: Mat (n ':| '[m, p, q, r, s]) a -> Mat (n ':| '[m, p, q, r, s]) a+dim6 = id++-- | matrix of dimension 7+dim7 :: Mat (n ':| '[m, p, q, r, s, t]) a -> Mat (n ':| '[m, p, q, r, s, t]) a+dim7 = id++-- | matrix of dimension 8+dim8 :: Mat (n ':| '[m, p, q, r, s, t, u]) a -> Mat (n ':| '[m, p, q, r, s, t, u]) a+dim8 = id++-- | matrix of dimension 9+dim9 :: Mat (n ':| '[m, p, q, r, s, t, u, v]) a -> Mat (n ':| '[m, p, q, r, s, t, u, v]) a+dim9 = id++-- | matrix of dimension 10+dim10 :: Mat (n ':| '[m, p, q, r, s, t, u, v, w]) a -> Mat (n ':| '[m, p, q, r, s, t, u, v, w]) a+dim10 = id
+ src/Cybus/NatHelper.hs view
@@ -0,0 +1,376 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{- |+Module : Cybus.NatHelper+Description : Nat helper methods+Copyright : (c) Grant Weyburne, 2022+License : BSD-3+-}+module Cybus.NatHelper (+ -- * peano+ NatToPeanoT,+ PeanoToNatT,+ Peano (..),++ -- * arithmetic+ DiffT,+ DiffTC,+ FacT,+ type (<=!),+ type (<!),+ LTEQT,++ -- * matrix dimension synonyms+ D1,+ D2,+ D3,+ D4,+ D5,+ D6,+ D7,+ D8,+ D9,+ D10,++ -- * matrix helpers+ NS,+ Product1T,+ NN,+ NN',+ Reverse1T,+ ListTupleT,++ -- * list and nonempty conversions+ ValidateNestedListC (..),+ ValidateNestedNonEmptyC (..),+ validateNestedList,+ validateNestedNonEmpty,+ ValidateNestedListT,+ ValidateNestedNonEmptyT,+ nestedNonEmptyToList,+ nestedListToNonEmpty,+ NestedListC (..),+ NonEmptyNST,+ ListNST,+) where++import Data.Kind+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import Data.Pos+import Data.Proxy+import qualified GHC.TypeLits as GL+import GHC.TypeNats (Nat)+import qualified GHC.TypeNats as GN+import Primus.Error+import Primus.Fold+import Primus.List+import Primus.NonEmpty+import Primus.One+import qualified Primus.TypeLevel as TP (Cons1T, FailUnless)++-- | get the factorial of a 'Nat'+type FacT :: Nat -> Nat+type family FacT x where+ FacT 0 = 1+ FacT 1 = 1+ FacT n = n GN.* FacT (n GN.- 1)++-- | constraint for ensuring that "i" <= "n"+type (<=!) :: Nat -> Nat -> Constraint+type i <=! n =+ ( TP.FailUnless+ (i GN.<=? n)+ ( 'GL.Text "i>n"+ 'GL.:<>: 'GL.Text ": i="+ 'GL.:<>: 'GL.ShowType i+ 'GL.:<>: 'GL.Text " n="+ 'GL.:<>: 'GL.ShowType n+ )+ , PosT i+ )++-- | constraint for ensuring that "i" <= "n" with a custom error message+type LTEQT :: GL.ErrorMessage -> Nat -> Nat -> Constraint+type LTEQT msg i n =+ ( TP.FailUnless+ (i GN.<=? n)+ ( 'GL.Text "i>n"+ 'GL.:<>: 'GL.Text ": i="+ 'GL.:<>: 'GL.ShowType i+ 'GL.:<>: 'GL.Text " n="+ 'GL.:<>: 'GL.ShowType n+ 'GL.:<>: msg+ )+ , PosT i+ )++-- | constraint for ensuring that "i" <= "n"+type (<!) :: Nat -> Nat -> Constraint+type i <! n =+ ( TP.FailUnless+ (i GN.+ 1 GN.<=? n)+ ( 'GL.Text "i>=n"+ 'GL.:<>: 'GL.Text ": i="+ 'GL.:<>: 'GL.ShowType i+ 'GL.:<>: 'GL.Text " n="+ 'GL.:<>: 'GL.ShowType n+ )+ , GN.KnownNat i+ )++-- | constraint for DiffC with better error messages+type DiffTC :: Nat -> Nat -> Nat -> Constraint+type DiffTC i j n = (i <=! j, j <=! n)++-- | find the number of N between "i" and "j" while ensuring i<=j and j<=n+type DiffT :: Nat -> Nat -> Nat -> Nat+type DiffT i j n = j GN.+ 1 GN.- i++-- | product of a type level nonempty list as a 'Nat'+type Product1T :: NonEmpty Nat -> Nat+type family Product1T ns where+ Product1T (n ':| '[]) = n+ Product1T (n ':| n1 ': ns) = n GN.* Product1T (n1 ':| ns)++-- | convert a list of 'Nat' into a nonempty list of 'Nat'+type NS :: [Nat] -> NonEmpty Nat+type family NS ns where+ NS '[] = GL.TypeError ( 'GL.Text "NS: must have at least one Nat value for NonEmpty Nat")+ NS (n ': '[]) = n ':| '[]+ NS (n ': m ': ns) = TP.Cons1T n (NS (m ': ns))++-- | used for reversing the indices of a matrix using type level list of nonempty indices+type Reverse1T :: forall k. NonEmpty k -> NonEmpty k+type family Reverse1T ns where+ Reverse1T (n ':| ns) = Reverse1T' (n ': ns) '[]++-- | used by 'Reverse1T'+type Reverse1T' :: forall k. [k] -> [k] -> NonEmpty k+type family Reverse1T' ns ret where+ Reverse1T' '[] (r ': rs) = r ':| rs+ Reverse1T' (n ': ns) ret = Reverse1T' ns (n ': ret)++-- | extracts the dimensions of a nested list+type ValidateNestedListT :: Type -> Peano+type family ValidateNestedListT x where+ ValidateNestedListT [x] = 'S (ValidateNestedListT x)+ ValidateNestedListT _ = 'S 'Z++-- | extracts the dimensions of a nested nonempty list+type ValidateNestedNonEmptyT :: Type -> Peano+type family ValidateNestedNonEmptyT x where+ ValidateNestedNonEmptyT (NonEmpty x) = 'S (ValidateNestedNonEmptyT x)+ ValidateNestedNonEmptyT _ = 'S 'Z++-- | validate that the nested nonempty list is consistent in size along all dimensions+validateNestedNonEmpty :: forall x. ValidateNestedNonEmptyC x (ValidateNestedNonEmptyT x) => x -> Either String (NonEmpty Pos)+validateNestedNonEmpty x = validateNestedNonEmptyC @x @(ValidateNestedNonEmptyT x) [] x []++-- | validate that the nested list is consistent in size along all dimensions+validateNestedList :: forall x. ValidateNestedListC x (ValidateNestedListT x) => x -> Either String (NonEmpty Pos)+validateNestedList x = validateNestedListC @x @(ValidateNestedListT x) [] x []++-- | extracts the dimensions of a nested nonempty list: doesnt allow empty dimensions+type ValidateNestedNonEmptyC :: Type -> Peano -> Constraint+class ValidateNestedNonEmptyC x y where+ validateNestedNonEmptyC :: [Pos] -> x -> [x] -> Either String (NonEmpty Pos)++instance GL.TypeError ( 'GL.Text "ValidateNestedNonEmptyC: not defined at 'Z") => ValidateNestedNonEmptyC x 'Z where+ validateNestedNonEmptyC = compileError "validateNestedNonEmptyC: ValidateNestedNonEmptyC x 'Z"+instance ValidateNestedNonEmptyC x ( 'S 'Z) where+ validateNestedNonEmptyC ixes _ _ =+ case ixes of+ i : is -> Right (i :| is)+ [] -> programmError "ValidateNestedNonEmptyC: ('S 'Z): empty list of indices"+instance ValidateNestedNonEmptyC x ( 'S zs) => ValidateNestedNonEmptyC (NonEmpty x) ( 'S ( 'S zs)) where+ validateNestedNonEmptyC ixes x@(n :| ns) xs =+ let cs = map clOrdering $ compareLengths (x :| xs)+ in if all (Just EQ ==) cs+ then+ let zs = ns <> concatMap N.toList xs+ in validateNestedNonEmptyC @x @( 'S zs) (ixes `snocL` lengthP x) n zs+ else Left $ "validateNestedNonEmptyC: lengths=" ++ show (map length (x : xs)) ++ " ixes=" ++ show (map unP ixes)++-- | extracts the dimensions of a nested list: doesnt allow empty dimensions+type ValidateNestedListC :: Type -> Peano -> Constraint+class ValidateNestedListC x y where+ validateNestedListC :: [Pos] -> x -> [x] -> Either String (NonEmpty Pos)++instance GL.TypeError ( 'GL.Text "ValidateNestedListC: not defined at 0") => ValidateNestedListC x 'Z where+ validateNestedListC = compileError "validateNestedListC: ValidateNestedListC x 'Z"+instance ValidateNestedListC x ( 'S 'Z) where+ validateNestedListC ixes _ _ =+ case ixes of+ i : is -> Right (i :| is)+ [] -> programmError "ValidateNestedListC: ('S 'Z): empty list of indices"+instance ValidateNestedListC x ( 'S n) => ValidateNestedListC [x] ( 'S ( 'S n)) where+ validateNestedListC ixes [] _ = Left $ "validateNestedListC: ixes=" ++ show ixes ++ ":no data!"+ validateNestedListC ixes x@(n : ns) xs =+ let cs = map clOrdering $ compareLengths (x :| xs)+ in if all (Just EQ ==) cs+ then+ let zs = ns <> concat xs+ in validateNestedListC @x @( 'S n) (ixes `snocL` lengthP (n :| ns)) n zs+ else Left $ "validateNestedListC: lengths=" ++ show (map length (x : xs)) ++ " ixes=" ++ show ixes++-- | peano numbers for converting between 'Nat' and peano+data Peano = Z | S !Peano deriving stock (Ord, Show, Eq)++-- | convert Nat to Peano+type NatToPeanoT :: Nat -> Peano+type family NatToPeanoT n where+ NatToPeanoT 0 = 'Z+ NatToPeanoT n = 'S (NatToPeanoT (n GN.- 1))++-- | convert Peano to Nat+type PeanoToNatT :: Peano -> Nat+type family PeanoToNatT n where+ PeanoToNatT 'Z = 0+ PeanoToNatT ( 'S n) = 1 GN.+ PeanoToNatT n++-- | convert a matrix index into nested lists+type ListNST :: NonEmpty Nat -> Type -> Type+type family ListNST ns a where+ ListNST (_ ':| '[]) a = [a]+ ListNST (_ ':| n1 ': ns) a = [ListNST (n1 ':| ns) a]++-- | convert a matrix index into nested lists+type NonEmptyNST :: NonEmpty Nat -> Type -> Type+type family NonEmptyNST ns a where+ NonEmptyNST (_ ':| '[]) a = NonEmpty a+ NonEmptyNST (_ ':| n1 ': ns) a = NonEmpty (NonEmptyNST (n1 ':| ns) a)++-- | convert a nested nonempty list into a nested list+nestedNonEmptyToList :: forall ns a. NestedListC ns => NonEmptyNST ns a -> Either String (ListNST ns a)+nestedNonEmptyToList = nestedNonEmptyToListC @ns (Proxy @a)++-- | convert a nested list into a nested nonempty list+nestedListToNonEmpty :: forall ns a. NestedListC ns => ListNST ns a -> Either String (NonEmptyNST ns a)+nestedListToNonEmpty = nestedListToNonEmptyC @ns @_ @a Proxy++-- | methods for working with nested lists+type NestedListC :: NonEmpty Nat -> Constraint+class NestedListC ns where+ -- | convert a nested list to a nested nonempty list+ nestedListToNonEmptyC :: proxy a -> ListNST ns a -> Either String (NonEmptyNST ns a)++ -- | convert a nested nonempty list to a nested list+ nestedNonEmptyToListC :: proxy a -> NonEmptyNST ns a -> Either String (ListNST ns a) -- need a proxy to make it work and find the correct 'a'++ flattenNestedListC :: proxy a -> ListNST ns a -> Either String [a]++instance PosT n => NestedListC (n ':| '[]) where+ nestedListToNonEmptyC _ = \case+ [] -> Left "nestedListToNonEmptyC 'SZ no data"+ x : xs -> lmsg "nestedListToNonEmptyC 'SZ" $ lengthExact1 (fromNP @n) (x :| xs)+ nestedNonEmptyToListC _ lst = N.toList <$> lmsg "nestedNonEmptyToListC 'SZ" (lengthExact1 (fromNP @n) lst)+ flattenNestedListC _ = \case+ [] -> Left "flattenNestedListC 'SZ no data"+ x : xs -> lmsg "flattenNestedListC 'SZ" $ lengthExact (fromN @n) (x : xs)++instance (PosT n, NestedListC (n1 ':| ns)) => NestedListC (n ':| n1 ': ns) where+ nestedListToNonEmptyC p = \case+ [] -> Left "nestedListToNonEmptyC 'SS no data"+ x : xs -> do+ ys <- lmsg "nestedListToNonEmptyC 'SS" $ lengthExact1 (fromNP @n) (x :| xs)+ traverse (nestedListToNonEmptyC @(n1 ':| ns) p) ys+ nestedNonEmptyToListC p lst = do+ xs <- lmsg "nestedNonEmptyToListC 'SS" $ lengthExact1 (fromNP @n) lst+ N.toList <$> traverse (nestedNonEmptyToListC @(n1 ':| ns) p) xs+ flattenNestedListC p = \case+ [] -> Left "flattenNestedListC 'SS no data"+ x : xs -> do+ ys <- lmsg "flattenNestedListC 'SS" $ lengthExact (fromN @n) (x : xs)+ concat <$> traverse (flattenNestedListC @(n1 ':| ns) p) ys++-- mapM_ (putStrLn . genListTupleT) [2..20] -- to generate from two onwards++-- | translates a type of size "n" to a tuple of size "n"+type ListTupleT :: Nat -> Type -> Type+type family ListTupleT n a = result | result -> n a where+ ListTupleT 1 a = One a+ ListTupleT 2 a = (a, a)+ ListTupleT 3 a = (a, a, a)+ ListTupleT 4 a = (a, a, a, a)+ ListTupleT 5 a = (a, a, a, a, a)+ ListTupleT 6 a = (a, a, a, a, a, a)+ ListTupleT 7 a = (a, a, a, a, a, a, a)+ ListTupleT 8 a = (a, a, a, a, a, a, a, a)+ ListTupleT 9 a = (a, a, a, a, a, a, a, a, a)+ ListTupleT 10 a = (a, a, a, a, a, a, a, a, a, a)+ ListTupleT 11 a = (a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 12 a = (a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 13 a = (a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 14 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 15 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 16 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 17 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 18 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 19 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a)+ ListTupleT 20 a = (a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a, a)++-- | generates a nonempty list of indices using each digit of the given 'Nat'+type NN :: Nat -> NonEmpty Nat+type NN n = NS (NN' '[] n)++-- | generates a list of indices using the individual digits of the given 'Nat'+type NN' :: [Nat] -> Nat -> [Nat]+type family NN' ns n where+ NN' ns 0 = ns+ NN' ns n = NN' (GN.Mod n 10 ': ns) (GN.Div n 10)++-- | matrix dimension of degree 1+type D1 :: Nat -> NonEmpty Nat+type D1 a = a ':| '[]++-- | matrix dimension of degree 2+type D2 :: Nat -> Nat -> NonEmpty Nat+type D2 a b = a ':| '[b]++-- | matrix dimension of degree 3+type D3 :: Nat -> Nat -> Nat -> NonEmpty Nat+type D3 a b c = a ':| '[b, c]++-- | matrix dimension of degree 4+type D4 :: Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D4 a b c d = a ':| '[b, c, d]++-- | matrix dimension of degree 5+type D5 :: Nat -> Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D5 a b c d e = a ':| '[b, c, d, e]++-- | matrix dimension of degree 6+type D6 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D6 a b c d e f = a ':| '[b, c, d, e, f]++-- | matrix dimension of degree 7+type D7 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D7 a b c d e f g = a ':| '[b, c, d, e, f, g]++-- | matrix dimension of degree 8+type D8 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D8 a b c d e f g h = a ':| '[b, c, d, e, f, g, h]++-- | matrix dimension of degree 9+type D9 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D9 a b c d e f g h i = a ':| '[b, c, d, e, f, g, h, i]++-- | matrix dimension of degree 10+type D10 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> NonEmpty Nat+type D10 a b c d e f g h i j = a ':| '[b, c, d, e, f, g, h, i, j]
+ test/CheckerHelper.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module CheckerHelper where++import qualified GHC.Generics as G+import Test.QuickCheck+import Test.QuickCheck.Checkers+import Test.Tasty+import qualified Test.Tasty.QuickCheck as TQ++checkersToProps :: [TestBatch] -> [(String, Property)]+checkersToProps = concatMap (\(a, bs) -> map (\(x, y) -> (a ++ " " ++ x, y)) bs)++adj' :: Bool -> Int -> Int -> Int -> TestTree -> TestTree+adj' v sz n ratio =+ adjustOption (const $ TQ.QuickCheckMaxSize sz)+ . adjustOption (max $ TQ.QuickCheckTests n)+ . adjustOption (max $ TQ.QuickCheckMaxRatio ratio)+ . adjustOption (const (TQ.QuickCheckVerbose v))++newtype MA = MA Int+ deriving stock (G.Generic, Show, Eq, Ord)+ deriving newtype (CoArbitrary, EqProp, Arbitrary)+newtype MB = MB Int+ deriving stock (G.Generic, Show, Eq, Ord)+ deriving newtype (CoArbitrary, EqProp, Arbitrary)+newtype MC = MC Int+ deriving stock (G.Generic, Show, Eq, Ord)+ deriving newtype (CoArbitrary, EqProp, Arbitrary)+newtype MD = MD Int+ deriving stock (G.Generic, Show, Eq, Ord)+ deriving newtype (CoArbitrary, EqProp, Arbitrary)++instance Semigroup MA where+ MA i <> MA j = MA (i + j)+instance Monoid MA where+ mempty = MA 0+ mappend = (<>)++instance Semigroup MB where+ MB i <> MB j = MB (i + j)+instance Monoid MB where+ mempty = MB 0+ mappend = (<>)++instance Semigroup MC where+ MC i <> MC j = MC (i + j)+instance Monoid MC where+ mempty = MC 0+ mappend = (<>)++instance Semigroup MD where+ MD i <> MD j = MD (i + j)+instance Monoid MD where+ mempty = MD 0+ mappend = (<>)++instance Function MA+instance Function MB+instance Function MC+instance Function MD
+ test/Main.hs view
@@ -0,0 +1,33 @@+module Main where++import System.Environment+import Test.Tasty+import qualified TestEnum+import qualified TestFin+import qualified TestFinMat+import qualified TestMat+import qualified TestNatHelper++main :: IO ()+main = do+ xs <- getArgs+ let x1 =+ [ TestMat.suiteCheckers+ ]+ (os, zs) <- case xs of+ "0" : os -> putStrLn "NORMAL (Explicit)" >> return (os, mempty)+ "1" : os -> putStrLn "VERBOSE" >> return (os, x1)+ -- "2" : os -> putStrLn "EXTRA VERBOSE" >> return (os, x1 ++ x2)+ os -> putStrLn "NORMAL" >> return (os, [])+ withArgs os $+ defaultMain $+ testGroup+ "alltests"+ ( [ TestEnum.suite+ , TestFin.suite+ , TestFinMat.suite+ , TestMat.suite+ , TestNatHelper.suite+ ]+ ++ zs+ )
+ test/TestEnum.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module TestEnum where++import Control.Arrow+import Cybus.Fin+import Cybus.FinMat+import Cybus.Mat+import Cybus.NatHelper+import Data.Foldable+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import Data.Pos+import Primus.AsMaybe+import Primus.Enum+import Primus.Rep+import Test.Tasty+import Test.Tasty.HUnit++suite :: TestTree+suite =+ testGroup+ "TestEnum"+ [ testCase "toEnum" $+ toEnum @(Mat2 3 4 ()) 0+ @?= mat' @(NS '[3, 4]) (replicate 12 ())+ , testCase "toEnum" $+ toEnum @(Mat (NS '[2, 3]) ()) 0+ @?= mat' @(NS '[2, 3]) [(), (), (), (), (), ()]+ , testCase "toEnum" $+ left (const ()) (toEnumRep @(Mat (NS '[2, 3])) @() 2)+ @?= Left ()+ , testCase "toenum" $+ toEnum @(Fin 10) 0+ @?= FinU _1P _10P+ , testCase "toenum" $+ toEnum @(Fin 10) 1+ @?= FinU _2P _10P+ , testCase "toenum" $+ toEnum @(Fin 10) 2+ @?= FinU _3P _10P+ , testCase "toenum" $+ toEnum @(Fin 2) 1+ @?= FinU _2P _2P+ , testCase "min" $+ minBound @(Fin 5)+ @?= FinU _1P _5P+ , testCase "max" $+ maxBound @(Fin 5)+ @?= FinU _5P _5P+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[3, 4])) (-2)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[3, 4])) (-1)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[3, 4])) 0+ @?= Right []+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[3, 4])) 1+ @?= Right [FinMatU 1 (_3P :| [_4P])]+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[3, 4])) 4+ @?= Right [FinMatU 4 (_3P :| [_4P])]+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[3, 4])) 5+ @?= Right [FinMatU 5 (_3P :| [_4P])]+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[1, 1, 1, 1])) (-2)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[1, 1, 1, 1])) 0+ @?= Right []+ , testCase "toEnumList" $+ toEnumList @(FinMat (NS '[1, 1, 1, 1])) 2+ @?= Left "calcNextEnum:not defined for positive numbers"+ , testCase "toEnumList" $+ toEnumList @(Fin 1) (-1)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toEnumList" $+ toEnumList @(Fin 1) 0+ @?= Right []+ , testCase "toEnumList" $+ toEnumList @(Fin 1) 1+ @?= Left "calcNextEnum:not defined for positive numbers"+ , testCase "toEnumList" $+ toEnumList @(Fin 2) (-10)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toEnumList" $+ toEnumList @(Fin 2) 0+ @?= Right []+ , testCase "toEnumList" $+ toEnumList @(Fin 2) 1+ @?= Right [FinU _2P _2P :: Fin 2]+ , testCase "toEnumList" $+ toEnumList @(Fin 2) 12+ @?= Right [FinU _2P _2P, FinU _2P _2P, FinU _1P _2P, FinU _1P _2P :: Fin 2]+ , testCase "toEnumList" $+ toEnumList @(Fin 2) 100+ @?= Right [FinU _2P _2P, FinU _2P _2P, FinU _1P _2P, FinU _1P _2P, FinU _2P _2P, FinU _1P _2P, FinU _1P _2P :: Fin 2]+ , testCase "universe1 fin" $+ universe1 @(Fin 5)+ @?= FinU @5 _1P _5P :| [FinU @5 _2P _5P, FinU @5 _3P _5P, FinU @5 _4P _5P, FinU @5 _5P _5P]+ , testCase "universe1 nextfin" $+ iterateT1 succSafe (FinU _1P _5P)+ @?= FinU @5 _1P _5P :| [FinU @5 _2P _5P, FinU @5 _3P _5P, FinU @5 _4P _5P, FinU @5 _5P _5P]+ , testCase "universe1 prevfin" $+ let f5 = FinU @5 _1P _5P :| [FinU @5 _2P _5P, FinU @5 _3P _5P, FinU @5 _4P _5P, FinU @5 _5P _5P]+ in iterateT1 predSafe (N.last f5)+ @?= N.reverse f5+ , testCase "universe1 prevfin" $+ iterateT1 predSafe (FinU @5 _1P _5P)+ @?= FinU _1P _5P :| []+ , testCase "toEnumRep" $+ toEnumRep @(Mat (NS '[4])) @Ordering 10+ @?= Right (mat' @(NS '[4]) [LT, EQ, LT, EQ])+ , testCase "toEnumRep" $+ toEnumRep @(Mat (NS '[4])) @Ordering 0+ @?= Right (mat' @(NS '[4]) [LT, LT, LT, LT])+ , testCase "toEnumList" $+ toEnumList @(Vec 3 Ordering) 0+ @?= Right []+ , testCase "toEnumList" $+ toEnumList @(Vec 3 Ordering) 1+ @?= Right [mat' @(NS '[3]) [LT, LT, EQ]]+ , testCase "toEnumList" $+ toEnumList @(Vec 3 Ordering) 200+ @?= Right [mat' @(NS '[3]) [LT, GT, EQ], mat' @(NS '[3]) [EQ, LT, GT]]+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 Ordering) 0+ @?= Right (mat' @(NS '[3]) [LT, LT, LT] :| [])+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 Ordering) 1+ @?= Right (mat' @(NS '[3]) [LT, LT, EQ] :| [])+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 Ordering) 26+ @?= Right (mat' @(NS '[3]) [GT, GT, GT] :| [])+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 Ordering) 27+ @?= Right (mat' @(NS '[3]) [LT, LT, EQ] :| [mat' @(NS '[3]) [LT, LT, LT]])+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 Ordering) 200+ @?= Right (mat' @(NS '[3]) [LT, GT, EQ] :| [mat' @(NS '[3]) [EQ, LT, GT]])+ , testCase "succTraversable" $+ universe1 @(Vec 3 Ordering)+ @?= iterateT1 succSafe minBound+ , testCase "toEnumList" $+ toEnumList @(Vec 3 ()) 1+ @?= Left "calcNextEnum:not defined for positive numbers"+ , testCase "toEnumList" $+ toEnumList @(Vec 3 ()) 0+ @?= Right []+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 ()) 0+ @?= Right ((() .: () .| ()) :| [])+ , testCase "toEnumList" $+ toEnumList @(Vec 3 Bool) 20+ @?= Right [False .: True .| False, True .: False .| False]+ , testCase "toEnumList1" $+ toEnumList1 @(Vec 3 Bool) 20+ @?= Right ((False .: True .| False) :| [True .: False .| False])+ , testCase "toEnumTraversable" $+ toEnumTraversable @Ordering (pure @(Mat (NS '[6])) ()) 10+ @?= Right (LT .: LT .: LT .: EQ .: LT .| EQ)+ , testCase "toEnumRep" $+ toEnumRep @(Mat (NS '[6])) @Ordering 10+ @?= Right (LT .: LT .: LT .: EQ .: LT .| EQ)+ , testCase "universe1" $+ universe1 @(FinMat (NN 123))+ @?= let ns = _1P :| [_2P, _3P]+ in FinMatU 0 ns :| [FinMatU 1 ns, FinMatU 2 ns, FinMatU 3 ns, FinMatU 4 ns, FinMatU 5 ns]+ , testCase "universeTraversable" $+ universeTraversable (pure @(Vec 2) GT)+ @?= Right ((LT .| LT) :| [LT .| EQ, LT .| GT, EQ .| LT, EQ .| EQ, EQ .| GT, GT .| LT, GT .| EQ, GT .| GT])+ , testCase "universeTraversable" $+ universeTraversable (replicate 2 (minBound @(Fin 5)))+ @?= let ff p n = FinU @5 p n+ in Right ([ff _1P _5P, ff _1P _5P] :| [[ff _1P _5P, ff _2P _5P], [ff _1P _5P, ff _3P _5P], [ff _1P _5P, ff _4P _5P], [ff _1P _5P, ff _5P _5P], [ff _2P _5P, ff _1P _5P], [ff _2P _5P, ff _2P _5P], [ff _2P _5P, ff _3P _5P], [ff _2P _5P, ff _4P _5P], [ff _2P _5P, ff _5P _5P], [ff _3P _5P, ff _1P _5P], [ff _3P _5P, ff _2P _5P], [ff _3P _5P, ff _3P _5P], [ff _3P _5P, ff _4P _5P], [ff _3P _5P, ff _5P _5P], [ff _4P _5P, ff _1P _5P], [ff _4P _5P, ff _2P _5P], [ff _4P _5P, ff _3P _5P], [ff _4P _5P, ff _4P _5P], [ff _4P _5P, ff _5P _5P], [ff _5P _5P, ff _1P _5P], [ff _5P _5P, ff _2P _5P], [ff _5P _5P, ff _3P _5P], [ff _5P _5P, ff _4P _5P], [ff _5P _5P, ff _5P _5P]])+ , testCase "universeTraversable" $+ universeTraversable (vec @2 (repeat (finMatC @(1 ':| '[1]) @(2 ':| '[3]))))+ @?= let ff i = FinMatU i (_2P :| [_3P])+ in Right ((ff 0 .| ff 0) :| [ff 0 .| ff 1, ff 0 .| ff 2, ff 0 .| ff 3, ff 0 .| ff 4, ff 0 .| ff 5, ff 1 .| ff 0, ff 1 .| ff 1, ff 1 .| ff 2, ff 1 .| ff 3, ff 1 .| ff 4, ff 1 .| ff 5, ff 2 .| ff 0, ff 2 .| ff 1, ff 2 .| ff 2, ff 2 .| ff 3, ff 2 .| ff 4, ff 2 .| ff 5, ff 3 .| ff 0, ff 3 .| ff 1, ff 3 .| ff 2, ff 3 .| ff 3, ff 3 .| ff 4, ff 3 .| ff 5, ff 4 .| ff 0, ff 4 .| ff 1, ff 4 .| ff 2, ff 4 .| ff 3, ff 4 .| ff 4, ff 4 .| ff 5, ff 5 .| ff 0, ff 5 .| ff 1, ff 5 .| ff 2, ff 5 .| ff 3, ff 5 .| ff 4, ff 5 .| ff 5])+ , testCase "capacity" $+ capacity @(FinMat (2 ':| '[3])) (replicate 2 ())+ @?= Right (0, 35)+ , testCase "capacity" $+ capacity @(FinMat (1 ':| '[3, 5, 6])) (replicate 7 ())+ @?= Right (0, 47829689999999)+ , testCase "iterateT1 succTraversable FinMat" $+ fmap (toList . fmap fmPos) (iterateT1 succTraversable (vec' @2 [finMatC @(NS '[3, 3]) @(NS '[4, 3]), finMatC @(NS '[2, 1]) @(NS '[4, 3])]))+ @?= [8, 3] :| [[8, 4], [8, 5], [8, 6], [8, 7], [8, 8], [8, 9], [8, 10], [8, 11], [9, 0], [9, 1], [9, 2], [9, 3], [9, 4], [9, 5], [9, 6], [9, 7], [9, 8], [9, 9], [9, 10], [9, 11], [10, 0], [10, 1], [10, 2], [10, 3], [10, 4], [10, 5], [10, 6], [10, 7], [10, 8], [10, 9], [10, 10], [10, 11], [11, 0], [11, 1], [11, 2], [11, 3], [11, 4], [11, 5], [11, 6], [11, 7], [11, 8], [11, 9], [11, 10], [11, 11]]+ , testCase "iterateT1 succTraversable FinMat" $+ fmap (toList . fmap fmPos) (iterateT1 succTraversable [finMatC @(NS '[3, 3]) @(NS '[3, 3]), finMatC @(NS '[2, 1]), finMatC @(NS '[3, 1])])+ @?= [8, 3, 6] :| [[8, 3, 7], [8, 3, 8], [8, 4, 0], [8, 4, 1], [8, 4, 2], [8, 4, 3], [8, 4, 4], [8, 4, 5], [8, 4, 6], [8, 4, 7], [8, 4, 8], [8, 5, 0], [8, 5, 1], [8, 5, 2], [8, 5, 3], [8, 5, 4], [8, 5, 5], [8, 5, 6], [8, 5, 7], [8, 5, 8], [8, 6, 0], [8, 6, 1], [8, 6, 2], [8, 6, 3], [8, 6, 4], [8, 6, 5], [8, 6, 6], [8, 6, 7], [8, 6, 8], [8, 7, 0], [8, 7, 1], [8, 7, 2], [8, 7, 3], [8, 7, 4], [8, 7, 5], [8, 7, 6], [8, 7, 7], [8, 7, 8], [8, 8, 0], [8, 8, 1], [8, 8, 2], [8, 8, 3], [8, 8, 4], [8, 8, 5], [8, 8, 6], [8, 8, 7], [8, 8, 8]]+ , testCase "iterateT1 succTraversable Fin" $+ fmap (toList . fmap fnPos) (iterateT1 succTraversable [finC @4 @5, finC @3, finC @2])+ @?= [_4P, _3P, _2P] :| [[_4P, _3P, _3P], [_4P, _3P, _4P], [_4P, _3P, _5P], [_4P, _4P, _1P], [_4P, _4P, _2P], [_4P, _4P, _3P], [_4P, _4P, _4P], [_4P, _4P, _5P], [_4P, _5P, _1P], [_4P, _5P, _2P], [_4P, _5P, _3P], [_4P, _5P, _4P], [_4P, _5P, _5P], [_5P, _1P, _1P], [_5P, _1P, _2P], [_5P, _1P, _3P], [_5P, _1P, _4P], [_5P, _1P, _5P], [_5P, _2P, _1P], [_5P, _2P, _2P], [_5P, _2P, _3P], [_5P, _2P, _4P], [_5P, _2P, _5P], [_5P, _3P, _1P], [_5P, _3P, _2P], [_5P, _3P, _3P], [_5P, _3P, _4P], [_5P, _3P, _5P], [_5P, _4P, _1P], [_5P, _4P, _2P], [_5P, _4P, _3P], [_5P, _4P, _4P], [_5P, _4P, _5P], [_5P, _5P, _1P], [_5P, _5P, _2P], [_5P, _5P, _3P], [_5P, _5P, _4P], [_5P, _5P, _5P]]+ , testCase "iterateT1 predTraversable Fin" $+ fmap (toList . fmap fnPos) (iterateT1 predTraversable [finC @4 @5, finC @3, finC @2])+ @?= [_4P, _3P, _2P] :| [[_4P, _3P, _1P], [_4P, _2P, _5P], [_4P, _2P, _4P], [_4P, _2P, _3P], [_4P, _2P, _2P], [_4P, _2P, _1P], [_4P, _1P, _5P], [_4P, _1P, _4P], [_4P, _1P, _3P], [_4P, _1P, _2P], [_4P, _1P, _1P], [_3P, _5P, _5P], [_3P, _5P, _4P], [_3P, _5P, _3P], [_3P, _5P, _2P], [_3P, _5P, _1P], [_3P, _4P, _5P], [_3P, _4P, _4P], [_3P, _4P, _3P], [_3P, _4P, _2P], [_3P, _4P, _1P], [_3P, _3P, _5P], [_3P, _3P, _4P], [_3P, _3P, _3P], [_3P, _3P, _2P], [_3P, _3P, _1P], [_3P, _2P, _5P], [_3P, _2P, _4P], [_3P, _2P, _3P], [_3P, _2P, _2P], [_3P, _2P, _1P], [_3P, _1P, _5P], [_3P, _1P, _4P], [_3P, _1P, _3P], [_3P, _1P, _2P], [_3P, _1P, _1P], [_2P, _5P, _5P], [_2P, _5P, _4P], [_2P, _5P, _3P], [_2P, _5P, _2P], [_2P, _5P, _1P], [_2P, _4P, _5P], [_2P, _4P, _4P], [_2P, _4P, _3P], [_2P, _4P, _2P], [_2P, _4P, _1P], [_2P, _3P, _5P], [_2P, _3P, _4P], [_2P, _3P, _3P], [_2P, _3P, _2P], [_2P, _3P, _1P], [_2P, _2P, _5P], [_2P, _2P, _4P], [_2P, _2P, _3P], [_2P, _2P, _2P], [_2P, _2P, _1P], [_2P, _1P, _5P], [_2P, _1P, _4P], [_2P, _1P, _3P], [_2P, _1P, _2P], [_2P, _1P, _1P], [_1P, _5P, _5P], [_1P, _5P, _4P], [_1P, _5P, _3P], [_1P, _5P, _2P], [_1P, _5P, _1P], [_1P, _4P, _5P], [_1P, _4P, _4P], [_1P, _4P, _3P], [_1P, _4P, _2P], [_1P, _4P, _1P], [_1P, _3P, _5P], [_1P, _3P, _4P], [_1P, _3P, _3P], [_1P, _3P, _2P], [_1P, _3P, _1P], [_1P, _2P, _5P], [_1P, _2P, _4P], [_1P, _2P, _3P], [_1P, _2P, _2P], [_1P, _2P, _1P], [_1P, _1P, _5P], [_1P, _1P, _4P], [_1P, _1P, _3P], [_1P, _1P, _2P], [_1P, _1P, _1P]]+ ]
+ test/TestFin.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module TestFin where++import Cybus.Fin+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import Data.Pos+import Primus.Enum+import Primus.Num1+import Test.Tasty+import Test.Tasty.HUnit++doit :: IO ()+doit = defaultMain suite++suite :: TestTree+suite =+ testGroup+ "TestFin"+ [ testCase "read" $+ reads @(Fin 3) "Fin(2,5)"+ @?= []+ , testCase "read" $+ reads @(Fin 4) (show $ FinU @3 _1P _3P)+ @?= []+ , testCase "readF" $+ reads @(Fin 3) (show $ FinU @3 _1P _3P)+ @?= [(FinU _1P _3P, "")]+ , testCase "read" $+ reads @(Fin 5) "Fin(2,5)"+ @?= [(FinU _2P _5P, "")]+ , testCase "showFin" $+ showFin (FinU _1P _3P :: Fin 3)+ @?= "Fin(1,3)"+ , testCase "showFin" $+ showFin (FinU _4P _9P :: Fin 9)+ @?= "Fin(4,9)"+ , testCase "finC" $+ finC @2 @5+ @?= FinU _2P _5P+ , testCase "finC" $+ finC @3 @3+ @?= FinU _3P _3P+ , testCase "enumFrom" $+ [FinU @5 _1P _5P ..]+ @?= map (`FinU` _5P) [_1P .. _5P]+ , testCase "enumFromThen" $+ [FinU @5 _1P _5P, FinU _3P _5P ..]+ @?= [FinU @5 _1P _5P, FinU _3P _5P, FinU _5P _5P]+ , testCase "universe1" $+ universe1 @(Fin 4)+ @?= (FinU _1P _4P :| [FinU _2P _4P, FinU _3P _4P, FinU _4P _4P])+ , testCase "enum roundtrip" $+ let xs = universe1 @(Fin 11)+ ys = fromEnum <$> xs+ in do+ fmap (toEnum @(Fin 11)) ys @?= xs+ ys @?= (0 :| [1 .. 10])+ N.head xs @?= minBound+ N.last xs @?= maxBound+ , testCase "Num1" $+ withOp (subtract 4) (minBound :: Fin 4)+ @?= Left "integerToEnumSafe:underflow where -4 not in range [0..3]"+ , testCase "Num1" $+ withOp (* 0) (minBound :: Fin 4)+ @?= Right (FinU _1P _4P)+ , testCase "Num" $+ ((minBound :: Fin 4) * (1 :: Fin 4)) -- keep hlint happy as "x * 1 == x"+ @?= FinU _1P _4P+ , testCase "Num" $+ ((minBound :: Fin 4) + 1)+ @?= FinU _2P _4P+ , testCase "Num" $+ (1 :: Fin 4)+ @?= FinU _2P _4P+ , testCase "Num" $+ ((minBound :: Fin 10) + 7)+ @?= FinU _8P _10P+ , testCase "Num" $+ (toEnum 7 :: Fin 10)+ @?= FinU _8P _10P+ , testCase "Num" $+ withOp (+ 0) (minBound :: Fin 4)+ @?= Right (FinU _1P _4P)+ , testCase "Num" $+ withOp (+ 1) (minBound :: Fin 4)+ @?= Right (FinU _2P _4P)+ , testCase "Num" $+ ((minBound :: Fin 4) + 2)+ @?= FinU _3P _4P+ , testCase "Num" $+ withOp2 (-) (maxBound :: Fin 4) maxBound+ @?= Right (FinU _1P _4P)+ , testCase "Num" $+ withOp2 (-) (minBound :: Fin 4) maxBound+ @?= Left "integerToEnumSafe:underflow where -3 not in range [0..3]"+ , testCase "Num" $+ (Right (minBound :: Fin 4) .- Right maxBound)+ @?= Left "(.-):integerToEnumSafe:underflow where -3 not in range [0..3]"+ , testCase "Num" $+ (finC @3 @15 * finC @5)+ @?= FinU _9P _15P+ , testCase "Num" $+ (Right (finC @4 @16) .* Right (finC @6))+ @?= Right (FinU @16 _16P _16P)+ , testCase "Num1" $+ (pure (finC @4 @7) .+ pure minBound .+ pure maxBound)+ @?= Left "(.+):integerToEnumSafe:overflow where 9 not in range [0..6]"+ , testCase "Num1" $+ (pure (finC @4 @5) .- fromInteger1 minBound 1)+ @?= Right (FinU @5 _3P _5P)+ , testCase "Num1" $+ fromInteger1 (minBound @(Fin 5)) 99+ @?= Left "integerToEnumSafe:overflow where 99 not in range [0..4]"+ , testCase "Num1" $+ fromInteger1 (minBound @(Fin 5)) 3+ @?= Right (FinU @5 _4P _5P)+ , testCase "Num1" $+ toInteger1 (finC @11 @17)+ @?= 10+ , testCase "Num1" $+ toInteger1 (finC @17 @17)+ @?= 16+ , testCase "Num1" $+ toInteger1 (finC @1 @17)+ @?= 0+ , testCase "Num1" $+ fromInteger1 (minBound @(Fin 5)) 0+ @?= Right (FinU @5 _1P _5P)+ , testCase "Num1" $+ (pure (finC @4 @5) .- fromInteger1 minBound 6)+ @?= Left "integerToEnumSafe:overflow where 6 not in range [0..4]"+ , testCase "Num1" $+ (pure (finC @4 @5) .- fromInteger1 minBound 4)+ @?= Left "(.-):integerToEnumSafe:underflow where -1 not in range [0..4]"+ , testCase "Num1" $+ (pure (finC @4 @5) .- fromInteger1 minBound 7)+ @?= Left "integerToEnumSafe:overflow where 7 not in range [0..4]"+ , testCase "Num1" $+ (pure (finC @4 @10) .- fromInteger1 minBound 9)+ @?= Left "(.-):integerToEnumSafe:underflow where -6 not in range [0..9]"+ , testCase "Num1" $+ (pure (finC @4 @5) .+ pure minBound .* pure maxBound)+ @?= Right (FinU @5 _4P _5P)+ , testCase "Num1" $+ -- 2 * 14 - 7 * 2 - 1 = 13 == _14P+ withOp3 (\a b c -> b * c - a * 2 - 1) 7 (finC @3 @15) maxBound+ @?= Right (FinU @15 _14P _15P)+ , testCase "Num1" $+ withOp3 (\a b c -> a + b * c - 7) (finC @1 @15) minBound maxBound+ @?= Left "integerToEnumSafe:underflow where -7 not in range [0..14]"+ , testCase "_Fin" $+ finC @4 @5+ @?= FinU @5 _4P _5P+ , testCase "_Fin" $+ mkFinC @5 _4P _5P+ @?= Right (FinU @5 _4P _5P)+ , testCase "_Fin" $+ mkFinC @5 _10P _5P+ @?= Left "mkFin:10P is too large: maximum is 5P"+ , testCase "mkFinC" $+ mkFinC @9 _4P _10P+ @?= Left "mkFinC: 10P /= 9P at typelevel"+ , testCase "mkFinC" $+ mkFinC @9 _12P _10P+ @?= Left "mkFinC: 10P /= 9P at typelevel"+ , testCase "signum1" $+ signum1 (Right (FinU @5 _4P _5P))+ @?= Right (FinU @5 _1P _5P)+ , testCase "signum1" $+ signum1 (Right (FinU @5 _1P _5P))+ @?= Right (FinU @5 _1P _5P)+ , testCase "signum1" $+ signum1 (Right (FinU @1 _1P _1P))+ @?= Right (FinU @1 _1P _1P)+ , testCase "abs1" $+ abs1 (Right (FinU @1 _1P _1P))+ @?= Right (FinU @1 _1P _1P)+ , testCase "abs1" $+ abs1 (Right (FinU @20 _7P _20P))+ @?= Right (FinU @20 _7P _20P)+ , testCase "_F4" $+ _F4 @10 @?= FinU @10 _4P _10P+ , testCase "withOp2" $+ withOp2 (+) (_F4 @10) _F9+ @?= Left "integerToEnumSafe:overflow where 11 not in range [0..9]"+ , testCase "withOp2" $+ withOp2 (+) (_F4 @10) _F6+ @?= Right (FinU @10 _9P _10P)+ , testCase "withOp2" $+ withOp2 (+) (_F4 @10) _F7+ @?= Right (FinU @10 _10P _10P)+ , testCase "withOp2" $+ withOp2 (-) (_F4 @10) _F7+ @?= Left "integerToEnumSafe:underflow where -3 not in range [0..9]"+ , testCase "withOp2" $+ withOp2 (-) (_F7 @10) _F7+ @?= Right (FinU @10 _1P _10P)+ , testCase "withOp2" $+ withOp2 (-) (_F8 @10) _F7+ @?= Right (FinU @10 _2P _10P)+ , testCase "pred1" $+ pred1 (Right (FinU @5 _1P _5P))+ @?= Left "pred1:integerToEnumSafe:underflow where -1 not in range [0..4]"+ , testCase "succ1" $+ succ1 (Right (FinU @5 _5P _5P))+ @?= Left "succ1:integerToEnumSafe:overflow where 5 not in range [0..4]"+ , testCase "pred1" $+ pred1 (Right (FinU @5 _2P _5P))+ @?= Right (FinU @5 _1P _5P)+ , testCase "succ1" $+ succ1 (Right (FinU @5 _2P _5P))+ @?= Right (FinU @5 _3P _5P)+ , testCase "abs1" $+ abs1 (Right (FinU @5 _2P _5P))+ @?= Right (FinU @5 _2P _5P)+ , testCase "negate1" $+ negate1 (Right (FinU @5 _5P _5P))+ @?= Left "negate1:integerToEnumSafe:underflow where -4 not in range [0..4]"+ , testCase "fin" $+ fin @10 0 @?= Left "eitherPos: i<=0: found 0"+ , testCase "fin" $+ fin @10 (-5) @?= Left "eitherPos: i<=0: found -5"+ , testCase "fin" $+ fin @10 11 @?= Left "mkFin:11P is too large: maximum is 10P"+ , testCase "fin" $+ fin @10 10 @?= Right (FinU _10P _10P)+ , testCase "fin" $+ fin @10 5 @?= Right (FinU _5P _10P)+ , testCase "finC" $+ _F7 @10 @?= FinU @10 _7P _10P+ , testCase "finC" $+ _F1 @7 @?= FinU @7 _1P _7P+ , testCase "finC" $+ _F1 @1 @?= FinU @1 _1P _1P+ , testCase "finC" $+ _F3 @3 @?= FinU @3 _3P _3P+ , testCase "readFin" $+ readFin @13 "Fin(10,13)xyz" @?= [(finC @10 @13, "xyz")]+ , testCase "readFin" $+ let m = finC @10 @13+ in readFin @13 (show m ++ " ") @?= [(m, " ")]+ , testCase "readFin" $+ readFin @13 "Fin(14,13)xyz" @?= []+ , testCase "readFin" $+ readFin @15 "Fin(12,13)xyz" @?= []+ , testCase "readFin" $+ readFin @13 "Fin(0,13)xyz" @?= []+ ]
+ test/TestFinMat.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module TestFinMat where++import Control.Lens+import Control.Monad+import Cybus.Fin+import Cybus.FinMat+import Cybus.NatHelper+import Data.Either+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import Data.Pos+import Primus.AsMaybe+import Primus.Enum+import Primus.Error+import Primus.NonEmpty+import Primus.Num1+import Test.Tasty+import Test.Tasty.HUnit++doit :: IO ()+doit = defaultMain suite++suite :: TestTree+suite =+ testGroup+ "TestFinMat"+ [ testCase "succSafe universe" $+ universe1 @(FinMat (NS '[2, 3, 4]))+ @?= iterateT1 succSafe minBound+ , testCase "predSafe universe" $+ universe1 @(FinMat (NS '[2, 3, 4]))+ @?= N.reverse (iterateT1 predSafe maxBound)+ , testCase "next finMat" $+ succSafe (maxBound :: FinMat (3 ':| '[4, 5, 3]))+ @?= Nothing+ , testCase "prev finMat" $+ predSafe (minBound :: FinMat (3 ':| '[4, 5, 3]))+ @?= Nothing+ , testCase "universe enums" $+ universe1 @(FinMat (NS '[2, 3, 4]))+ @?= iterateT1 succSafe minBound+ , testCase "prev FinMat universe" $+ universe1 @(FinMat (NS '[2, 3, 4]))+ @?= N.reverse (iterateT1 predSafe maxBound)+ , testCase "minBound" $+ (minBound :: FinMat (3 ':| '[4, 5, 1]))+ @?= FinMatU 0 (_3P :| [_4P, _5P, _1P])+ , testCase "maxBound" $+ (maxBound :: FinMat (3 ':| '[4, 5, 1]))+ @?= FinMatU 59 (_3P :| [_4P, _5P, _1P])+ , testCase "maxBound" $+ fromPositives (finMatToNonEmpty (maxBound :: FinMat (3 ':| '[4, 5, 1])))+ @?= [3, 4, 5, 1]+ , testCase "prev finMat" $+ fmap (fromPositives . finMatToNonEmpty) (predSafe (maxBound :: FinMat (3 ':| '[4, 5, 1])))+ @?= Just [3, 4, 4, 1]+ , testCase "prev finMat" $+ fmap (fromPositives . finMatToNonEmpty) (predSafe (maxBound :: FinMat (3 ':| '[4, 5, 3])))+ @?= Just [3, 4, 5, 2]+ , testCase "next finMat" $+ succSafe (maxBound :: FinMat (3 ':| '[4, 5, 3]))+ @?= Nothing+ , testCase "prev finMat" $+ predSafe (minBound :: FinMat (3 ':| '[4, 5, 3]))+ @?= Nothing+ , testCase "next5 finMat" $+ fmap (fromPositives . finMatToNonEmpty) (take1 _5P $ enumFrom1 (fr $ nonEmptyToFinMat (_2P :| [_3P, _4P]) :: FinMat (3 ':| '[4, 5])))+ @?= [2, 3, 4] :| [[2, 3, 5], [2, 4, 1], [2, 4, 2], [2, 4, 3]]+ , testCase "prev5 finMat" $+ fmap (fromPositives . finMatToNonEmpty) (take1 _5P $ enumFrom1R (fr $ nonEmptyToFinMat (_2P :| [_3P, _4P]) :: FinMat (3 ':| '[4, 5])))+ @?= [2, 3, 4] :| [[2, 3, 3], [2, 3, 2], [2, 3, 1], [2, 2, 5]]+ , testCase "universe1 enum" $+ universe1 @(FinMat (NS '[2, 3, 7]))+ @?= fmi237'+ , testCase "universe1 enum" $+ universe1 @(FinMat (NS '[1, 3, 5, 7, 2, 1]))+ @?= fmiNS'+ , testCase "toEnum" $+ N.map toEnum (0 :| [1 .. 41])+ @?= fmi237'+ , testCase "mkFinMatC fail" $+ mkFinMatC @(NS '[2, 3, 7]) 42 (_2P :| [_3P, _7P])+ @?= Left "mkFinMat:is too large: maximum is 41 but found 42"+ , testCase "mkFinMatC fail" $+ mkFinMatC @(NS '[2, 3, 7]) (-1) (_2P :| [_3P, _7P])+ @?= Left "mkFinMat:cant be less than 0: i=-1"+ , testCase "mkFinMatC" $+ mkFinMatC @(NS '[2, 3, 7]) 41 (_2P :| [_3P, _7P])+ @?= Right maxBound+ , testCase "mkFinMatC" $+ mkFinMatC @(NS '[2, 3, 7]) 41 (_2P :| [_3P, _7P])+ @?= Right (FinMatU @(NS '[2, 3, 7]) 41 (_2P :| [_3P, _7P]))+ , testCase "mkFinMatC" $+ mkFinMatC @(NS '[2, 3, 7]) 0 (_2P :| [_3P, _7P])+ @?= Right minBound+ , testCase "mkFinMatC" $+ mkFinMatC @(NS '[2, 3, 7]) 0 (_2P :| [_3P, _7P])+ @?= Right (FinMatU @(NS '[2, 3, 7]) 0 (_2P :| [_3P, _7P]))+ , testCase "mkFinMatC" $+ mkFinMatC @(NS '[2, 3, 7]) 17 (_2P :| [_3P, _7P])+ @?= Right (FinMatU @(NS '[2, 3, 7]) 17 (_2P :| [_3P, _7P]))+ , testCase "nonEmptyToFinMat" $+ nonEmptyToFinMat @(NS '[2, 3, 7]) (_1P :| [_3P, _4P])+ @?= Right (FinMatU 17 (_2P :| [_3P, _7P]))+ , testCase "nonEmptyToFinMat" $+ nonEmptyToFinMat' @(NS '[2, 3, 7]) (_1P :| [_3P, _4P]) (_2P :| [_3P, _7P])+ @?= Right (FinMatU 17 (_2P :| [_3P, _7P]))+ , testCase "pos" $+ finMatC @(NS '[3, 1]) @(NS '[3, 4])+ @?= FinMatU 8 (_3P :| [_4P])+ , testCase "pos" $+ finMatC @(NS '[1, 1, 1, 1]) @(NS '[1, 2, 3, 4])+ @?= FinMatU 0 (_1P :| [_2P, _3P, _4P])+ , testCase "pos" $+ finMatC @(NS '[3, 3, 3]) @(NS '[4, 4, 4])+ @?= FinMatU 42 (_4P :| [_4P, _4P])+ , testCase "finMatC" $+ finMatToNonEmpty (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]))+ @?= _1P :| [_3P, _4P]+ , testCase "finMatC" $+ finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7])+ @?= FinMatU 17 (_2P :| [_3P, _7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) ^. _i1)+ @?= finC @1 @2+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) ^. _i2)+ @?= finC @3 @3+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) ^. _i3)+ @?= finC @4 @7+ , testCase "fromEnum" $+ N.map fromEnum fmi237'+ @?= 0 :| [1 .. 41]+ , testCase "toEnum one" $+ toEnum 1+ @?= FinMatU @(NS '[2, 3, 7]) 1 (_2P :| [_3P, _7P])+ , testCase "fromEnum one" $+ fromEnum @(FinMat (NS '[2, 3, 4])) (FinMatU 4 (_2P :| [_3P, _4P]))+ @?= 4+ , testCase "toEnum one" $+ (toEnum 1 :: FinMat (NS '[2, 3, 7]))+ @?= FinMatU 1 (_2P :| [_3P, _7P])+ , testCase "fromEnum one" $+ fromEnum (FinMatU 7 (_2P :| [_3P, _7P]) :: FinMat (NS '[2, 3, 7]))+ @?= 7+ , testCase "minbound" $+ minBound @(FinMat (NS '[2, 3, 4]))+ @?= FinMatU 0 (_2P :| [_3P, _4P])+ , testCase "enum" $+ finMatToNonEmpty (fr $ nonEmptyToFinMat @(NS '[2, 3, 4, 5]) (_1P :| [_3P, _4P, _5P]))+ @?= _1P :| [_3P, _4P, _5P]+ , testCase "succ" $+ finMatToNonEmpty (succ (fr $ nonEmptyToFinMat @(NS '[2, 3, 4, 5]) (_1P :| [_3P, _4P, _5P])))+ @?= _2P :| [_1P, _1P, _1P]+ , testCase "pred" $+ finMatToNonEmpty (pred (fr $ nonEmptyToFinMat @(NS '[2, 3, 4, 5]) (_1P :| [_3P, _4P, _5P])))+ @?= _1P :| [_3P, _4P, _4P]+ , testCase "mkFinMatC" $+ let (xs, ys) = partitionEithers $ map (\i -> mkFinMatC @(NS '[2, 4, 2, 4]) i (_2P :| [_4P, _2P, _4P])) [-10 .. 100]+ in (length xs, length ys, length (groupByAdjacent1 (<) (N.fromList ys)))+ @?= (47, 64, 1)+ , testCase "maxBound" $+ (maxBound :: FinMat (NS '[2, 3, 6]))+ @?= FinMatU 35 (_2P :| [_3P, _6P])+ , testCase "minBound" $+ (minBound :: FinMat (NS '[2, 3, 6]))+ @?= FinMatU 0 (_2P :| [_3P, _6P])+ , testCase "iterateT1 next" $+ iterateT1 succSafe minBound+ @?= fmi237'+ , testCase "iterateT1 prev" $+ iterateT1 predSafe maxBound+ @?= N.reverse fmi237'+ , testCase "iterateT1 next" $+ iterateT1 succSafe minBound+ @?= fmiNS' @(NS '[1, 3, 5, 7, 3, 2])+ , testCase "fmiNS" $+ fmiNS'+ @?= fmi237'+ , testCase "enumFrom" $+ [minBound :: FinMat (NS '[2, 3]) ..]+ @?= map (`FinMatU` (_2P :| [_3P])) [0 .. 5]+ , testCase "_i2 view" $+ (mkFinMatC @(NS '[2, 3, 4]) 10 (_2P :| [_3P, _4P]) ^. _Right . _i2)+ @?= (FinU _3P _3P :: Fin 3)+ , testCase "_i3 view" $+ (mkFinMatC @(NS '[2, 3, 4]) 10 (_2P :| [_3P, _4P]) ^. _Right . _i3)+ @?= (FinU _3P _4P :: Fin 4)+ , testCase "_i2 update" $+ (mkFinMatC @(NS '[2, 3, 4]) 0 (_2P :| [_3P, _4P]) & _Right . _i2 %~ succ)+ @?= Right (FinMatU 4 (_2P :| [_3P, _4P]))+ , testCase "read" $+ (read @(FinMat (NS '[2, 3, 4])) $ show (finMatC @(NS '[2, 3, 4]) @(NS '[2, 3, 4])))+ @?= finMatC @(NS '[2, 3, 4]) @(NS '[2, 3, 4])+ , testCase "read" $+ (read @(FinMat (NS '[2, 3, 4])) $ show (finMatC @(NS '[1, 3, 2]) @(NS '[2, 3, 4])))+ @?= finMatC @(NS '[1, 3, 2]) @(NS '[2, 3, 4])+ , testCase "enum roundtrip" $+ let xs = universe1 @(FinMat (NS '[2, 4, 3]))+ ys = fromEnum <$> xs+ in do+ fmap (toEnum @(FinMat (NS '[2, 4, 3]))) ys @?= xs+ ys @?= 0 :| [1 .. 23]+ N.head xs @?= minBound+ N.last xs @?= maxBound+ , testCase "showFinMat" $+ map showFinMat [FinMatU @(NS '[2, 3, 5]) 0 (_2P :| [_3P, _5P]), toEnum 5 ..]+ @?= ["0@{2,3,5}", "5@{2,3,5}", "10@{2,3,5}", "15@{2,3,5}", "20@{2,3,5}", "25@{2,3,5}"]+ , testCase "nonEmptyToFinMat'" $+ nonEmptyToFinMat' (_1P :| [_4P, _3P]) (_1P :| [_3P, _4P])+ @?= Left "nonEmptyToFinMat:These es=outofbounds (4P,3P) as=(1P,1P) :| [(3P,4P)]"+ , testCase "nonEmptyToFinMat'" $+ nonEmptyToFinMat' (_1P :| [_2P, _3P, _6P]) (_1P :| [_3P, _4P])+ @?= Left "nonEmptyToFinMat:too many indices: expected 3 is=1P :| [2P,3P,6P] ns=1P :| [3P,4P]"+ , testCase "nonEmptyToFinMat'" $+ nonEmptyToFinMat' (_1P :| [_2P]) (_1P :| [_3P, _4P])+ @?= Left "nonEmptyToFinMat:not enough indices: expected 3 is=1P :| [2P] ns=1P :| [3P,4P]"+ , testCase "nonEmptyToFinMat'" $+ nonEmptyToFinMat' (_3P :| [_1P, _4P]) (_3P :| [_8P, _7P])+ @?= Right (FinMatU @(NS '[3, 8, 7]) 115 (_3P :| [_8P, _7P]))+ , testCase "finMatToNonEmpty" $+ finMatToNonEmpty (FinMatU @(NS '[3, 8, 7]) 115 (_3P :| [_8P, _7P])) @?= _3P :| [_1P, _4P]+ , testCase "finMatToNonEmpty" $+ finMatToNonEmpty (FinMatU @(NS '[3, 8, 7]) 167 (_3P :| [_8P, _7P])) @?= _3P :| [_8P, _7P]+ , testCase "finMatToNonEmpty" $+ finMatToNonEmpty (FinMatU @(NS '[3, 8, 7]) 0 (_3P :| [_8P, _7P])) @?= _1P :| [_1P, _1P]+ , testCase "finMatToNonEmpty" $+ finMatToNonEmpty (FinMatU @(NS '[1]) 0 (_1P :| [])) @?= _1P :| []+ , testCase "finMatToNonEmpty" $+ finMatToNonEmpty (FinMatU @(NS '[7]) 0 (_7P :| [])) @?= _1P :| []+ , testCase "finMatToNonEmpty" $+ finMatToNonEmpty (FinMatU @(NS '[7]) 6 (_7P :| [])) @?= _7P :| []+ , testCase "finMatC" $+ (finMatC @(NN 1234) @(NN 1234) - minBound)+ @?= FinMatU @(1 ':| '[2, 3, 4]) 23 (_1P :| [_2P, _3P, _4P])+ , testCase "finMatC" $+ (pure (finMatC @(NN 1234) @(NN 1234)) .- pure minBound)+ @?= Right (FinMatU @(1 ':| '[2, 3, 4]) 23 (_1P :| [_2P, _3P, _4P]))+ , testCase "finMatC" $+ pure (finMatC @(NN 1234) @(NN 1234)) .+ pure maxBound+ @?= Left "(.+):mkFinMat:is too large: maximum is 23 but found 46"+ , testCase "Num1" $+ (pure (FinMatU @(NN 345) 14 (_3P :| [_4P, _5P])) .+ pure minBound)+ @?= Right (FinMatU @(NN 345) 14 (_3P :| [_4P, _5P]))+ , testCase "Num1" $+ pure (FinMatU @(NN 345) 14 (_3P :| [_4P, _5P])) .+ pure maxBound+ @?= Left "(.+):mkFinMat:is too large: maximum is 59 but found 73"+ , testCase "Num1" $+ (pure (FinMatU @(NN 345) 14 (_3P :| [_4P, _5P])) .+ pure 5)+ @?= Right (FinMatU @(NN 345) 19 (_3P :| [_4P, _5P]))+ , testCase "Num1" $+ (pure 5 .* pure 7)+ @?= Right (FinMatU @(NN 236) 35 (_2P :| [_3P, _6P]))+ , testCase "Num1" $+ (pure 7 .- pure 4)+ @?= Right (FinMatU @(NN 236) 3 (_2P :| [_3P, _6P]))+ , testCase "Num1" $+ finMatC @(NN 111) @(NN 123)+ @?= FinMatU @(NN 123) 0 (_1P :| [_2P, _3P])+ , testCase "Num1" $+ (pure (finMatC @(NN 111) @(NN 123)) .- pure minBound)+ @?= Right (FinMatU @(NN 123) 0 (_1P :| [_2P, _3P]))+ , testCase "Num1" $+ (pure (finMatC @(NN 111) @(NN 123)) .- pure (finMatC @(NN 111)))+ @?= Right (FinMatU @(NN 123) 0 (_1P :| [_2P, _3P]))+ , testCase "Num1" $+ pure (finMatC @(NN 111) @(NN 123)) .- pure (finMatC @(NN 112))+ @?= Left "(.-):mkFinMat:cant be less than 0: i=-1"+ , testCase "Num1" $+ (pure (finMatC @(NN 111) @(NN 123)) .+ pure (finMatC @(NN 112)))+ @?= Right (FinMatU @(NN 123) 1 (_1P :| [_2P, _3P]))+ , testCase "Num1" $+ (pure (finMatC @(NN 111) @(NN 123)) .+ pure (finMatC @(NN 122)))+ @?= Right (FinMatU @(NN 123) 4 (_1P :| [_2P, _3P]))+ , testCase "Num1" $+ (pure (finMatC @(NN 312) @(NN 573)) .+ pure (finMatC @(NN 363)))+ @?= Right (FinMatU @(NN 573) 102 (_5P :| [_7P, _3P]))+ , testCase "Num1" $+ mkFinMatC @(NN 573) 102 (_1P :| [_2P, _3P])+ @?= Left "mkFinMatC: invalid indices: typelevel [5,7,3] /= [1,2,3]"+ , testCase "Num1" $+ pure (finMatC @(NN 312) @(NN 573)) .+ pure (finMatC @(NN 373))+ @?= Left "(.+):mkFinMat:is too large: maximum is 104 but found 105"+ , testCase "signum1" $+ signum1 (Right (FinMatU @(NN 345) 0 (_3P :| [_4P, _5P])))+ @?= Right (FinMatU @(NN 345) 0 (_3P :| [_4P, _5P]))+ , testCase "signum1" $+ signum1 (Right (FinMatU @(NN 345) 1 (_3P :| [_4P, _5P])))+ @?= Right (FinMatU @(NN 345) 1 (_3P :| [_4P, _5P]))+ , testCase "signum1" $+ signum1 (Right (FinMatU @(NN 345) 10 (_3P :| [_4P, _5P])))+ @?= Right (FinMatU @(NN 345) 1 (_3P :| [_4P, _5P]))+ , testCase "Num1" $+ (pure (finMatC @(NN 217) @(NN 537)) .+ pure minBound .* pure maxBound)+ @?= Right (FinMatU @(NN 537) 27 (_5P :| [_3P, _7P]))+ , testCase "Num1" $+ pure (finMatC @(NN 21) @(NN 53)) .+ pure maxBound+ @?= Left "(.+):mkFinMat:is too large: maximum is 14 but found 17"+ , testCase "withOp" $+ withOp succ (finMatC @(NN 234) @(NN 234))+ @?= Left "mkFinMat:is too large: maximum is 23 but found 24"+ , testCase "withOp" $+ withOp pred (finMatC @(NN 234) @(NN 234))+ @?= Right (FinMatU 22 (_2P :| [_3P, _4P]))+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) & _i3 %~ succ . succ)+ @?= FinMatU @(NS '[2, 3, 7]) 19 (_2P :| [_3P, _7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) & _i1 %~ succ)+ @?= FinMatU @(NS '[2, 3, 7]) 38 (_2P :| [_3P, _7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) & _i3 .~ _F2)+ @?= FinMatU @(NS '[2, 3, 7]) 15 (_2P :| [_3P, _7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 3, 4]) @(NS '[2, 3, 7]) & _i3 .~ _F3)+ @?= FinMatU @(NS '[2, 3, 7]) 16 (_2P :| [_3P, _7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 1]) @(NS '[11, 7]) & _i1 %~ succ)+ @?= FinMatU @(NS '[11, 7]) 7 (_11P :| [_7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 1]) @(NS '[11, 7]) & _i1 %~ id)+ @?= FinMatU @(NS '[11, 7]) 0 (_11P :| [_7P])+ , testCase "finMatC" $+ (finMatC @(NS '[1, 1]) @(NS '[11, 7]) & _i1 %~ succ . succ)+ @?= FinMatU @(NS '[11, 7]) 14 (_11P :| [_7P])+ , testCase "finMatC" $+ (finMatC @(NN 543) @(NN 789) ^. _i1)+ @?= FinU _5P _7P+ , testCase "finMatC" $+ (finMatC @(NN 543) @(NN 789) ^. _i2)+ @?= FinU _4P _8P+ , testCase "finMatC" $+ (finMatC @(NN 543) @(NN 789) ^. _i3)+ @?= FinU _3P _9P+ , testCase "toFinMatFromPos" $+ toFinMatFromPos @0 @(NN 345)+ @?= FinMatU @(3 ':| '[4, 5]) 0 (_3P :| [_4P, _5P])+ , testCase "toFinMatFromPos" $+ toFinMatFromPos @59 @(NN 345)+ @?= FinMatU @(3 ':| '[4, 5]) 59 (_3P :| [_4P, _5P])+ , testCase "toFinMatFromPos" $+ toFinMatFromPos @34 @(NN 345)+ @?= FinMatU @(3 ':| '[4, 5]) 34 (_3P :| [_4P, _5P])+ , testCase "toFinMatFromPos" $+ toFinMatFromPos @0 @(1 ':| '[])+ @?= FinMatU @(1 ':| '[]) 0 (_1P :| [])+ , testCase "toFinMatFromPos" $+ toFinMatFromPos @0 @(2 ':| '[])+ @?= FinMatU @(2 ':| '[]) 0 (_2P :| [])+ , testCase "toFinMatFromPos" $+ toFinMatFromPos @1 @(2 ':| '[])+ @?= FinMatU @(2 ':| '[]) 1 (_2P :| [])+ , testCase "relPos" $+ relPos ((_1P, _3P) :| []) @?= (_3P, 0)+ , testCase "relPos" $+ relPos ((_2P, _3P) :| []) @?= (_3P, 1)+ , testCase "relPos" $+ relPos ((_1P, _1P) :| [(_1P, _1P)]) @?= (_1P, 0)+ , testCase "relPos" $+ relPos ((_1P, _1P) :| [(_1P, _5P), (_5P, _5P)]) @?= (_P @25, 4)+ , testCase "relPos" $+ relPos ((_4P, _7P) :| [(_3P, _5P), (_2P, _5P)]) @?= (_P @175, 86)+ , testCase "readFinMat" $+ readFinMat @(NS '[7, 3, 3]) "5@{7,3,3}xyz" @?= [(finMatC @(NS '[1, 2, 3]) @(NS '[7, 3, 3]), "xyz")]+ , testCase "readFinMat" $+ let m = finMatC @(NS '[1, 2, 3]) @(NS '[7, 3, 3])+ in readFinMat @(NS '[7, 3, 3]) (show m ++ " ") @?= [(m, " ")]+ , testCase "readFinMat" $+ readFinMat @(NS '[7, 3, 3]) "6@{1,2,3}xyz" @?= []+ , testCase "readFinMat" $+ readFinMat @(NS '[1, 2, 3]) " 4@{ 1, 2, 3}xy"+ @?= [(FinMatU @(NS '[1, 2, 3]) 4 (_1P :| [_2P, _3P]), "xy")]+ , testCase "showFinMat'" $+ showFinMat' (finMatC @(2 ':| '[3, 5]) @(4 ':| '[4, 6]))+ @?= "40@{2,3,5|4,4,6}"+ , testCase "showFinMat'" $+ showFinMat' (finMatC @(1 ':| '[]) @(1 ':| '[]))+ @?= "0@{1|1}"+ , testCase "showFinMat'" $+ showFinMat' (finMatC @(NN 123) @(NN 234))+ @?= "6@{1,2,3|2,3,4}"+ , testCase "showFinMat'" $+ showFinMat' (finMatC @(NN 111) @(NN 234))+ @?= "0@{1,1,1|2,3,4}"+ , testCase "showFinMat'" $+ showFinMat' (finMatC @(NN 114) @(NN 234))+ @?= "3@{1,1,4|2,3,4}"+ , testCase "showFinMat'" $+ showFinMat' (finMatC @(NN 9) @(NN 9))+ @?= "8@{9|9}"+ , testCase "showFinMat" $+ showFinMat (finMatC @(1 ':| '[]) @(1 ':| '[]))+ @?= "0@{1}"+ , testCase "showFinMat" $+ showFinMat (finMatC @(1 ':| '[]) @(10 ':| '[]))+ @?= "0@{10}"+ , testCase "showFinMat" $+ showFinMat (finMatC @(10 ':| '[]) @(10 ':| '[]))+ @?= "9@{10}"+ , testCase "showFinMat" $+ showFinMat (finMatC @(4 ':| '[]) @(10 ':| '[]))+ @?= "3@{10}"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(FinMat (2 ':| '[3, 4]))) 0+ @?= Right (FinMatU @(NS '[2, 3, 4]) 0 (_2P :| [_3P, _4P]))+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(FinMat (2 ':| '[3, 4]))) (-5)+ @?= Left "mkFinMat:cant be less than 0: i=-5"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(FinMat (2 ':| '[3, 4]))) 23+ @?= Right (FinMatU @(NS '[2, 3, 4]) 23 (_2P :| [_3P, _4P]))+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(FinMat (2 ':| '[3, 4]))) 24+ @?= Left "mkFinMat:is too large: maximum is 23 but found 24"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(FinMat (2 ':| '[3, 4]))) (-1)+ @?= Left "mkFinMat:cant be less than 0: i=-1"+ , testCase "toInteger1" $+ toInteger1 (FinMatU @(NS '[2, 3, 4]) 0 (_2P :| [_3P, _4P]))+ @?= 0+ , testCase "toInteger1" $+ toInteger1 (FinMatU @(NS '[2, 3, 4]) 23 (_2P :| [_3P, _4P]))+ @?= 23+ , testCase "toInteger1" $+ toInteger1 (FinMatU @(NS '[2, 3, 4]) 12 (_2P :| [_3P, _4P]))+ @?= 12+ ]++fmi237' :: NonEmpty (FinMat (NS '[2, 3, 7]))+fmi237' = frp $ traverse (nonEmptyToFinMat <=< toPositives) fmi237++fmi237 :: NonEmpty (NonEmpty Int)+fmi237 = fmap N.fromList $ [1, 1, 1] :| [[1, 1, 2], [1, 1, 3], [1, 1, 4], [1, 1, 5], [1, 1, 6], [1, 1, 7], [1, 2, 1], [1, 2, 2], [1, 2, 3], [1, 2, 4], [1, 2, 5], [1, 2, 6], [1, 2, 7], [1, 3, 1], [1, 3, 2], [1, 3, 3], [1, 3, 4], [1, 3, 5], [1, 3, 6], [1, 3, 7], [2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 1, 4], [2, 1, 5], [2, 1, 6], [2, 1, 7], [2, 2, 1], [2, 2, 2], [2, 2, 3], [2, 2, 4], [2, 2, 5], [2, 2, 6], [2, 2, 7], [2, 3, 1], [2, 3, 2], [2, 3, 3], [2, 3, 4], [2, 3, 5], [2, 3, 6], [2, 3, 7]]++fmiNS' :: forall ns. NSC ns => NonEmpty (FinMat ns)+fmiNS' = frp $ traverse (nonEmptyToFinMat @ns <=< toPositives) (fmiNS (fmap unP (fromNSP @ns)))++fmiNS :: NonEmpty Int -> NonEmpty (NonEmpty Int)+fmiNS = traverse (N.fromList . enumFromTo 1)
+ test/TestMat.hs view
@@ -0,0 +1,915 @@+{-# OPTIONS -Wno-orphans #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module TestMat where++import CheckerHelper+import Control.Arrow+import Control.Lens+import Control.Monad+import Cybus.Fin+import Cybus.FinMat+import Cybus.Mat+import Cybus.NatHelper+import Data.Char+import Data.Foldable+import Data.Int+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as N+import qualified Data.Monoid as MM+import Data.Pos+import Data.Semigroup.Foldable+import qualified Data.Vector as V+import GHC.TypeNats (Nat)+import Primus.Enum+import Primus.Error+import Primus.Fold+import Primus.Num1+import Primus.One+import Primus.Rep+import Test.QuickCheck+import Test.QuickCheck.Checkers+import "checkers" Test.QuickCheck.Classes+import Test.Tasty+import Test.Tasty.HUnit+import qualified Test.Tasty.QuickCheck as TQ++instance (NSC ns, Arbitrary a) => Arbitrary (Mat ns a) where+ arbitrary = sequenceA $ mat @ns (repeat arbitrary)++instance Eq a => EqProp (Mat ns a) where (=-=) = eq++testLawsMat :: forall (ns :: NonEmpty Nat). (ShowMatC ns, NSC ns) => [TestBatch]+testLawsMat =+ [functor z, applicative z, monoid z, monad z, semigroup (z, Fixed (10 :: Int)), foldable z1] -- , traversable z]+ where+ z = undefined :: Mat ns (MA, MB, MC)+ z1 = undefined :: Mat ns (MA, MB, MC, Int, MD)++testLawsMat' :: forall (ns :: NonEmpty Nat). (ShowMatC ns, NSC ns) => [TestBatch]+testLawsMat' =+ [functor z, applicative z, monoid z, monad z, semigroup (z, Fixed (10 :: Int)), foldable z1] -- , traversable z]+ where+ z = undefined :: Mat ns (MM.Sum Integer, String, MM.Sum Int)+ z1 = undefined :: Mat ns (String, Integer, String, Int, Bool)++-- testLawsMat @(NS '[2,3,4])+testLawsMatIO :: forall (ns :: NonEmpty Nat). (ShowMatC ns, NSC ns) => IO ()+testLawsMatIO = traverse_ verboseBatch (testLawsMat @ns)++testLawsMatIO' :: forall (ns :: NonEmpty Nat). (ShowMatC ns, NSC ns) => IO ()+testLawsMatIO' = traverse_ verboseBatch (testLawsMat' @ns)++doit :: IO ()+doit = defaultMain suite++m345 :: Mat (NS '[3, 4, 5]) Char+m345 = mat' ['A' .. '|']++m345' :: Mat (NS '[3, 4, 5]) Int+m345' = mat' [1 .. 60]++m35 :: Mat (NS '[3, 5]) Int+m35 = mat' [1 .. 15]++suite :: TestTree+suite =+ testGroup+ "TestMat"+ [ testCase "gen" $+ gen @(NS '[2, 3]) id+ @?= MatU (V.fromList [0 .. 5]) (_2P :| [_3P])+ , testCase "gen" $+ gen @(NS '[9]) id+ @?= MatU (V.fromList [0 .. 8]) (_9P :| [])+ , testCase "get index 0" $+ indexMat (FinMatU 0 (_3P :| [_4P, _5P])) m345+ @?= 'A'+ , testCase "get index 4" $+ indexMat (FinMatU 4 (_2P :| [_3P, _6P])) (gen' @(NS '[2, 3, 6]) id)+ @?= [1, 1, 5]+ , testCase "get index 4" $+ indexMat (finMatC @(NS '[2, 1, 5])) (gen' @(NS '[2, 3, 6]) id)+ @?= [2, 1, 5]+ , testCase "get index 2" $+ m345 ^. ixMat' @(NS '[1, 2, 1])+ @?= 'F'+ , testCase "update index 2" $+ matToNestedListC (m345' & ixMat' @(NS '[1, 2, 1]) %~ succ)+ @?= [[[1, 2, 3, 4, 5], [7, 7, 8, 9, 10], [11, 12, 13, 14, 15], [16, 17, 18, 19, 20]], [[21, 22, 23, 24, 25], [26, 27, 28, 29, 30], [31, 32, 33, 34, 35], [36, 37, 38, 39, 40]], [[41, 42, 43, 44, 45], [46, 47, 48, 49, 50], [51, 52, 53, 54, 55], [56, 57, 58, 59, 60]]]+ , testCase "reverseRows" $+ matToNestedListC (reverseRows m345)+ @?= [["EDCBA", "JIHGF", "ONMLK", "TSRQP"], ["YXWVU", "^]\\[Z", "cba`_", "hgfed"], ["mlkji", "rqpon", "wvuts", "|{zyx"]]+ , testCase "reverseT" $+ matToNestedListC (reverseT m345)+ @?= [["|{zyx", "wvuts", "rqpon", "mlkji"], ["hgfed", "cba`_", "^]\\[Z", "YXWVU"], ["TSRQP", "ONMLK", "JIHGF", "EDCBA"]]+ , testCase "reverseRows 2" $+ reverseRows (reverseRows m345)+ @?= m345+ , testCase "update index 2" $+ matToNestedListC (m345' & ixMat' @(NS '[1, 2, 1]) %~ succ)+ @?= [[[1, 2, 3, 4, 5], [7, 7, 8, 9, 10], [11, 12, 13, 14, 15], [16, 17, 18, 19, 20]], [[21, 22, 23, 24, 25], [26, 27, 28, 29, 30], [31, 32, 33, 34, 35], [36, 37, 38, 39, 40]], [[41, 42, 43, 44, 45], [46, 47, 48, 49, 50], [51, 52, 53, 54, 55], [56, 57, 58, 59, 60]]]+ , testCase "transpose" $+ matToNestedListC (transposeMat m35)+ @?= [[1, 6, 11], [2, 7, 12], [3, 8, 13], [4, 9, 14], [5, 10, 15]]+ , testCase "transpose2" $+ transposeMat (transposeMat m35)+ @?= m35+ , testCase "fmap" $+ matToNestedListC (fmap (show . succ) m35)+ @?= [["2", "3", "4", "5", "6"], ["7", "8", "9", "10", "11"], ["12", "13", "14", "15", "16"]]+ , testCase "totuple" $+ toTupleC (mat' @(NS '[2, 3, 2]) [1 :: Int .. 12])+ @?= (((1, 2), (3, 4), (5, 6)), ((7, 8), (9, 10), (11, 12)))+ , testCase "fromtuple" $+ fromTupleC (((1, 2), (3, 4), (5, 6)), ((7, 8), (9, 10), (11, 12)))+ @?= mat' @(NS '[2, 3, 2]) [1 :: Int .. 12]+ , testCase "change row" $+ (mat' @(NS '[3, 4]) [1 :: Int .. 12] & ixSlice @(NS '[2, 3]) .~ 999)+ @?= mat' @(NS '[3, 4]) [1, 2, 3, 4, 5, 6, 999, 8, 9, 10, 11, 12]+ , testCase "change row" $+ (mat' @(NS '[3, 4]) [1 :: Int .. 12] & ixSlice @(NS '[1]) *~ 999)+ @?= mat' @(NS '[3, 4]) [999, 1998, 2997, 3996, 5, 6, 7, 8, 9, 10, 11, 12]+ , testCase "change row" $+ m345 ^. ixSlice @(NS '[2, 3])+ @?= mat' @(NS '[5]) ['_' .. 'c']+ , testCase "change row" $+ (m35 & ixSlice @(NS '[2]) . traverse *~ 100)+ @?= mat' @(NS '[3, 5]) [1, 2, 3, 4, 5, 600, 700, 800, 900, 1000, 11, 12, 13, 14, 15]+ , testCase "change row" $+ (mat' @(NS '[2, 1, 2, 3, 4]) [1 :: Int .. 48] & ixSlice @(NS '[2, 1, 1]) . traverse *~ 100)+ @?= mat' @(NS '[2, 1, 2, 3, 4]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 2500, 2600, 2700, 2800, 2900, 3000, 3100, 3200, 3300, 3400, 3500, 3600, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48]+ , testCase "change row" $+ m345 ^. ixSlice @(NS '[2])+ @?= mat' @(NS '[4, 5]) ['U' .. 'h']+ , testCase "not as useful: nests all stuff" $+ fmap sum (matToNestedVecC @(NS '[2, 3]) (mat' [1 :: Int .. 6]))+ @?= 6 .| 15+ , testCase "mapLeaf: change the lowest rows into lists" $+ mapLeaf (const sum) (mat' @(NS '[4, 3]) [1 :: Int .. 12])+ @?= mat' @(NS '[4]) [6, 15, 24, 33]+ , testCase "mapLeafSimple" $+ mapLeafSimple (fmap . (,) . fmPos) (mm' @43)+ @?= mat' @(NS '[4, 3]) [(0, [1, 1]), (0, [1, 2]), (0, [1, 3]), (3, [2, 1]), (3, [2, 2]), (3, [2, 3]), (6, [3, 1]), (6, [3, 2]), (6, [3, 3]), (9, [4, 1]), (9, [4, 2]), (9, [4, 3])]+ , testCase "toLeaves" $+ toLeaves (mm' @23)+ @?= mat' @(NS '[2]) [mat' @(NS '[3]) [[1, 1], [1, 2], [1, 3]], mat' [[2, 1], [2, 2], [2, 3]]]+ , testCase "toLeaves" $+ mat' @(NS '[2]) [mat' @(NS '[3]) [[1, 1], [1, 2], [1, 3]], mat' [[2, 1], [2, 2], [2, 3]]]+ @?= toLeaves (mm' @23)+ , testCase "fromLeavesInternalC toLeaves" $+ fromLeavesInternalC (toLeaves (mm' @3214))+ @?= mm' @3214+ , testCase "foldMapLeaf" $+ foldMapLeaf (\i m -> [(fmPos i, sum m, toList m)]) (mm @234)+ @?= [(0, 10, [1, 2, 3, 4]), (4, 26, [5, 6, 7, 8]), (8, 42, [9, 10, 11, 12]), (12, 58, [13, 14, 15, 16]), (16, 74, [17, 18, 19, 20]), (20, 90, [21, 22, 23, 24])]+ , testCase "foldMapLeafR" $+ foldMapLeafR (\i m -> [(fmPos i, sum m, toList m)]) (mm @234)+ @?= [(20, 90, [21, 22, 23, 24]), (16, 74, [17, 18, 19, 20]), (12, 58, [13, 14, 15, 16]), (8, 42, [9, 10, 11, 12]), (4, 26, [5, 6, 7, 8]), (0, 10, [1, 2, 3, 4])]+ , testCase "addition" $+ mat' @(NS '[2, 3]) [1 .. 6] + mat' [100 :: Int .. 105]+ @?= mat' [101, 103, 105, 107, 109, 111]+ , testCase "multiplication" $+ mat' @(NS '[2, 3]) [1 .. 6] * mat' [100 :: Int .. 105]+ @?= mat' [100, 202, 306, 412, 520, 630] -- note: have to use mat' for inference to work+ , testCase "transpose" $+ transposeMat (mat' @(NS '[2, 3]) [1 :: Int .. 6])+ @?= mat' [1, 4, 2, 5, 3, 6]+ , testCase "transpose iso" $+ transposeMat (transposeMat m345)+ @?= m345+ , testCase "diagonal" $+ diagonal (mat' @(NS '[3, 3, 4]) [1 :: Int .. 36])+ @?= mat' [1, 2, 3, 4, 17, 18, 19, 20, 33, 34, 35, 36]+ , testCase "diagonal" $+ diagonal (gen @(NS '[4, 4]) succ)+ @?= mat' [1, 6, 11, 16]+ , testCase "diagonal" $+ diagonal (diagonal (diagonal (mm' @3333)))+ @?= mat' @(NS '[3]) [[1, 1, 1, 1], [2, 2, 2, 2], [3, 3, 3, 3]]+ , testCase "fromNSP" $+ fromNSP @(NS '[4, 2, 3, 5, 1])+ @?= _4P :| [_2P, _3P, _5P, _1P]+ , testCase "finMatMatrix" $+ finMatMatrix @(NS '[2, 3, 1])+ @?= mat' (toList (N.map (fr . (nonEmptyToFinMat <=< toPositives)) ([1, 1, 1] :| [[1, 2, 1], [1, 3, 1], [2, 1, 1], [2, 2, 1], [2, 3, 1]])))+ , testCase "insert row" $+ insertRow @2 (mat' @(NS '[3, 4]) [100 .. 111]) (mat' @(NS '[2, 3, 4]) [1 :: Int .. 24])+ @?= mat' [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "insert column" $+ insertCol @2 (mat' @(NS '[2, 4]) [100 .. 107]) (mat' @(NS '[2, 3, 4]) [1 :: Int .. 24])+ @?= mat' [1, 2, 3, 4, 100, 101, 102, 103, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 104, 105, 106, 107, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "delete row" $+ deleteRow @2 (mat' @(NS '[2, 3, 4]) [1 :: Int .. 24])+ @?= mat' [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]+ , testCase "insert/delete row" $+ deleteRow @2 (insertRow @2 (mat' @(NS '[4, 5]) [100 .. 119]) m345')+ @?= m345'+ , testCase "to nested lists" $+ matToNestedListC (mat' @(NS '[2, 3, 4]) [1 :: Int .. 24])+ @?= [[[1, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12]], [[13, 14, 15, 16], [17, 18, 19, 20], [21, 22, 23, 24]]]+ , testCase "concat vertically" $+ matToNestedListC (appendV (mat' @(NS '[2, 3, 2]) [1 .. 12]) (mat' @(NS '[5, 3, 2]) [100 :: Int .. 129]))+ @?= [[[1, 2], [3, 4], [5, 6]], [[7, 8], [9, 10], [11, 12]], [[100, 101], [102, 103], [104, 105]], [[106, 107], [108, 109], [110, 111]], [[112, 113], [114, 115], [116, 117]], [[118, 119], [120, 121], [122, 123]], [[124, 125], [126, 127], [128, 129]]]+ , testCase "concat vertically" $+ matToNestedListC (appendV (mat' @(NS '[2, 3]) [1 .. 6]) (mat' @(NS '[7, 3]) [100 :: Int .. 120]))+ @?= [[1, 2, 3], [4, 5, 6], [100, 101, 102], [103, 104, 105], [106, 107, 108], [109, 110, 111], [112, 113, 114], [115, 116, 117], [118, 119, 120]]+ , testCase "concat horizontally" $+ matToNestedListC (appendH (mat' @(NS '[5, 2, 2]) [1 .. 20]) (mat' @(NS '[5, 3, 2]) [100 :: Int .. 129]))+ @?= [[[1, 2], [3, 4], [100, 101], [102, 103], [104, 105]], [[5, 6], [7, 8], [106, 107], [108, 109], [110, 111]], [[9, 10], [11, 12], [112, 113], [114, 115], [116, 117]], [[13, 14], [15, 16], [118, 119], [120, 121], [122, 123]], [[17, 18], [19, 20], [124, 125], [126, 127], [128, 129]]]+ , testCase "concat horizontally" $+ matToNestedListC (appendH (mat' @(NS '[3, 2]) [1 .. 6]) (mat' @(NS '[3, 7]) [100 :: Int .. 120]))+ @?= [[1, 2, 100, 101, 102, 103, 104, 105, 106], [3, 4, 107, 108, 109, 110, 111, 112, 113], [5, 6, 114, 115, 116, 117, 118, 119, 120]]+ , testCase "consMat" $+ (gen @(NS '[3, 4]) succ ^. consMat)+ @?= (1 .: 2 .: 3 .| 4, 5 .: 6 .: 7 .| 8 .|| (9 .: 10 .: 11 .| 12))+ , testCase "snocMat" $+ (gen @(NS '[3, 4]) succ ^. snocMat)+ @?= (1 .: 2 .: 3 .| 4 .|| (5 .: 6 .: 7 .| 8), 9 .: 10 .: 11 .| 12)+ , testCase "consMat" $+ (gen @(NS '[3, 4]) succ & consMat . _1 +~ 1000)+ @?= ((1001 .: 1002 .: 1003 .| 1004) .:: (5 .: 6 .: 7 .| 8) .|| (9 .: 10 .: 11 .| 12))+ , testCase "snocMat" $+ (gen @(NS '[3, 4]) succ & snocMat . _2 +~ 1000)+ @?= ((1 .: 2 .: 3 .| 4) .:: (5 .: 6 .: 7 .| 8) .|| (1009 .: 1010 .: 1011 .| 1012))+ , testCase "consMat" $+ (gen @(NS '[5]) succ ^. consMat)+ @?= (1, 2 .: 3 .: 4 .| 5)+ , testCase "snocMat" $+ (gen @(NS '[5]) succ ^. snocMat)+ @?= (1 .: 2 .: 3 .| 4, 5)+ , testCase "consMat" $+ (gen @(NS '[5]) succ & consMat . _1 +~ 1000)+ @?= (1001 .: 2 .: 3 .: 4 .| 5)+ , testCase "consMat" $+ (gen @(NS '[5]) succ & consMat . _2 +~ 1000)+ @?= (1 .: 1002 .: 1003 .: 1004 .| 1005)+ , testCase "snocMat" $+ (gen @(NS '[5]) succ & snocMat . _2 +~ 1000)+ @?= (1 .: 2 .: 3 .: 4 .| 1005)+ , testCase "snocMat" $+ (gen @(NS '[5]) succ & snocMat . _1 +~ 1000)+ @?= (1001 .: 1002 .: 1003 .: 1004 .| 5)+ , testCase "consMat" $+ (gen @(NS '[1]) succ ^. consMat)+ @?= (1, Eof1)+ , testCase "snocMat" $+ (gen @(NS '[1]) succ ^. snocMat)+ @?= (Eof1, 1)+ , testCase "consMat" $+ (gen @(NS '[1, 4]) succ ^. consMat)+ @?= (1 .: 2 .: 3 .| 4, EofN)+ , testCase "snocMat" $+ (gen @(NS '[1, 4]) succ ^. snocMat)+ @?= (EofN, 1 .: 2 .: 3 .| 4)+ , testCase "consMat" $+ (gen @(NS '[1, 4]) succ & consMat . _1 +~ 999)+ @?= se2 (1000 .: 1001 .: 1002 .| 1003)+ , testCase "snocMat" $+ (gen @(NS '[1, 4]) succ & snocMat . _2 +~ 999)+ @?= se2 (1000 .: 1001 .: 1002 .| 1003)+ , testCase "swapMat" $+ swapMat @(NS '[2, 3, 1]) @(NS '[2, 1, 1]) (gen @(NS '[2, 3, 4]) id)+ @?= mat' [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 20, 13, 14, 15, 16, 17, 18, 19, 12, 21, 22, 23]+ , testCase "matToNestedVecC" $+ nestedVecToMatC (matToNestedVecC m345)+ @?= m345 -- works without @(NS '[3,4,5]) cos @?= tells us the type+ , testCase "delete item from 1d mat'" $+ deleteRow @4 (mat' @(NS '[10]) [1 :: Int .. 10])+ @?= mat' [1, 2, 3, 5, 6, 7, 8, 9, 10]+ , testCase "redim" $+ redim (mat' @(NS '[2, 3, 5]) [1 :: Int .. 30])+ @?= mat' @(NS '[6, 5]) [1 :: Int .. 30]+ , testCase "redim" $+ redim (mat' @(NS '[5, 9, 4]) [1 :: Int .. 180])+ @?= mat' @(NS '[3, 6, 10]) [1 :: Int .. 180]+ , testCase "redim" $+ redim (mat' @(NS '[18]) [1 :: Int .. 18])+ @?= mat' @(NS '[3, 2, 3]) [1 :: Int .. 18]+ , testCase "redim" $+ redim (mat' @(NS '[3, 2, 3]) [1 :: Int .. 18])+ @?= mat' @(NS '[18]) [1 :: Int .. 18]+ , testCase "diagonal" $+ diagonal (gen @(NS '[4, 4]) succ)+ @?= mat' @(NS '[4]) [1, 6, 11, 16]+ , testCase "diagonal" $+ diagonal (gen @(NS '[3, 3, 4, 2]) succ)+ @?= mat' @(NS '[3, 4, 2]) [1, 2, 3, 4, 5, 6, 7, 8, 33, 34, 35, 36, 37, 38, 39, 40, 65, 66, 67, 68, 69, 70, 71, 72]+ , testCase "diagonal" $+ diagonal (mm @99)+ @?= mat' @(NS '[9]) [1, 11, 21, 31, 41, 51, 61, 71, 81]+ , testCase "multMat" $+ multMat (mat' @(NS '[2, 5]) [1 :: Int .. 10]) (mat' @(NS '[5, 6]) [1 :: Int .. 30])+ @?= mat' @(NS '[2, 6]) [255, 270, 285, 300, 315, 330, 580, 620, 660, 700, 740, 780]+ , testCase "universe1 enum" $+ toNonEmpty (finMatMatrix @(NS '[2, 3, 7]))+ @?= universe1 @(FinMat (NS '[2, 3, 7]))+ , testCase "finmat enum" $+ toList (finMatMatrix @(NS '[2, 3, 7]))+ @?= toList fmi237'+ , testCase "D3" $+ mat' @(D3 2 3 4) [1 :: Int .. 24]+ @?= mat' @(NS '[2, 3, 4]) [1 .. 24]+ , testCase "ixMat" $+ (mat' @(NS '[2, 3, 4]) [1 :: Int .. 24] & ixMat (finMatC @(NS '[2, 3, 1])) +~ 100)+ @?= mat' @(NS '[2, 3, 4]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 121, 22, 23, 24]+ , testCase "ixMat" $+ (mat' @(NS '[2, 3, 4]) [1 :: Int .. 24] & ixMat (finMatC @(NS '[2, 3, 4])) +~ 100)+ @?= mat' @(NS '[2, 3, 4]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 124]+ , testCase "read" $+ (read @(Mat (D1 4) Int) $ show $ mat' @(NS '[4]) [1 :: Int .. 4])+ @?= (1 .: 2 .: 3 .| 4)+ , testCase "read" $+ let m = gen' @(NS '[1]) id+ in read (show m) @?= m+ , testCase "read" $+ let m = gen' @(NS '[1, 1, 1, 1]) id+ in read (show m) @?= m+ , testCase "read" $+ let m = gen' @(NS '[2, 3, 4, 5]) id+ in read (show m) @?= m+ , testCase "read" $+ let m = gen' @(NS '[9, 2, 1]) id+ in read (show m) @?= m+ , testCase "read" $+ let m = gen' @(NS '[1, 2, 3]) id+ in read (show m) @?= m+ , testCase "read" $+ let m = ('x', True, ['a' .. 'z'], gen' @(NS '[1, 2, 3]) id, False)+ in read (show m) @?= m+ , testCase "read" $+ let m = mat' @(NS '[4, 5]) [1 :: Int .. 20]+ in read @(Mat (D2 4 5) Int) (show m) @?= m+ , testCase "read" $+ let m = mat' @(NS '[1, 2, 3, 4]) [1 :: Int .. 24]+ in read (show m) @?= m+ , testCase "read" $+ let m = toND @1 (mm @2352)+ in read (show m) @?= m+ , testCase "read" $+ let m = toND @2 (mm @2352)+ in read (show m) @?= m+ , testCase "read" $+ let m = mat' @(NS '[26]) ['a' .. 'z']+ in read (show m) @?= m+ , testCase "sortByRows" $+ sortByRows (flip compare) (mat' @(NS '[4, 2]) [10, 9, 1, 2, 100, 200, 300, 400])+ @?= mat' [10, 9, 2, 1, 200, 100, 400, 300 :: Int]+ , testCase "sortByT" $+ sortByT (flip compare) (mat' @(NS '[4]) [10 :: Int, 9, 1, 2])+ @?= (10 .: 9 .: 2 .| 1)+ , testCase "sortByT" $+ sortByT compare (mat' @(NS '[4]) [10 :: Int, 9, 1, 2])+ @?= (1 .: 2 .: 9 .| 10)+ , testCase "sortByRows" $+ sortByRows compare (mat' @(NS '[4, 2]) [10 :: Int, 9, 1, 2, 100, 200, 300, 400])+ @?= mat' [9, 10, 1, 2, 100, 200, 300, 400]+ , testCase "totuple" $+ toTupleC (vec' "abc")+ @?= ('a', 'b', 'c')+ , testCase "totuple" $+ toTupleC (vec' "a")+ @?= One 'a'+ , testCase "fromtuple" $+ fromTupleC (One 'a')+ @?= se1 'a'+ , testCase "fromtuple" $+ fromTupleC (1, 2, 3 :: Int)+ @?= 1 .: 2 .| 3+ , testCase "consMat" $+ (mat' @(NS '[1]) "x" ^. consMat)+ @?= ('x', Eof1)+ , testCase "consMat" $+ (mat' @(NS '[1, 1]) "x" ^. consMat)+ @?= (se1 'x', EofN)+ , testCase "consMat" $+ (mat' @(NS '[1, 1, 1]) "x" ^. consMat)+ @?= (se2 (se1 'x'), EofN)+ , testCase "consMat" $+ (mat' @(NS '[4]) "xyz{" ^. consMat)+ @?= ('x', vec' "yz{")+ , testCase "consMat" $+ (mat' @(NS '[1, 4]) "xyz{" ^. consMat)+ @?= (mat' "xyz{", EofN)+ , testCase "consMat" $+ (mat' @(NS '[4, 1]) "xyz{" ^. consMat)+ @?= (se1 'x', mat' @(NS '[3, 1]) "yz{")+ , testCase "consMat" $+ (mat' @(NS '[5, 3]) ['A' .. 'O'] ^. consMat)+ @?= (mat' @(NS '[3]) "ABC", mat' @(NS '[4, 3]) ['D' .. 'O'])+ , testCase "snocMat" $+ (mat' @(NS '[1]) "x" ^. snocMat)+ @?= (Eof1, 'x')+ , testCase "snocMat" $+ (mat' @(NS '[1, 1]) "x" ^. snocMat)+ @?= (EofN, se1 'x')+ , testCase "snocMat" $+ (mat' @(NS '[1, 1, 1]) "x" ^. snocMat)+ @?= (EofN, se2 (se1 'x'))+ , testCase "snocMat" $+ (mat' @(NS '[4]) "xyz{" ^. snocMat)+ @?= (vec' "xyz", '{')+ , testCase "snocMat" $+ (mat' @(NS '[1, 4]) "xyz{" ^. snocMat)+ @?= (EofN, vec' "xyz{")+ , testCase "snocMat" $+ (mat' @(NS '[4, 1]) "xyz{" ^. snocMat)+ @?= (mat' @(NS '[3, 1]) "xyz", se1 '{')+ , testCase "snocMat" $+ (mat' @(NS '[5, 3]) ['A' .. 'O'] ^. snocMat)+ @?= (mat' @(NS '[4, 3]) ['A' .. 'L'], mat' @(NS '[3]) "MNO")+ , testCase "field lens" $+ (mat' @(NS '[3, 3, 4]) [1 :: Int .. 36] ^. _r3 . _r1)+ @?= vec' @4 [25, 26, 27, 28]+ , testCase "field lens" $+ (mat' @(NS '[3, 3, 4]) [1 :: Int .. 36] ^. _r3 . _r1)+ @?= vec' @4 [25, 26, 27, 28]+ , testCase "field lens update" $+ (mat' @(NS '[2, 1, 4]) ['A' .. 'H'] & _r2 . _r1 . _r3 %~ toLower)+ @?= mat' "ABCDEFgH"+ , testCase "field lens" $+ (mat' @(NS '[7]) [1 :: Int .. 7] ^. _r3)+ @?= 3+ , testCase "field lens" $+ (mat' @(NS '[7, 4]) [1 :: Int .. 28] ^. _r3 . _r2)+ @?= 10+ , testCase "subsetRows" $+ subsetRows @2 @2 (gen @(NS '[2, 5]) succ)+ @?= mat' @(NS '[1, 5]) [6, 7, 8, 9, 10]+ , testCase "subsetRows" $+ subsetRows @1 @2 (gen @(NS '[2, 5]) succ)+ @?= mat' @(NS '[2, 5]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]+ , testCase "subsetRows" $+ subsetRows @2 @4 (gen @(NS '[4, 5]) succ)+ @?= mat' @(NS '[3, 5]) [6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]+ , testCase "subsetRows" $+ subsetRows @2 @4 (gen @(NS '[5, 7]) succ)+ @?= mat' @(NS '[3, 7]) [8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28]+ , testCase "subsetRows" $+ subsetRows @2 @2 (gen @(NS '[4]) succ)+ @?= mat' @(NS '[1]) [2]+ , testCase "subsetRows" $+ subsetRows @2 @3 (gen @(NS '[4]) succ)+ @?= mat' @(NS '[2]) [2, 3]+ , testCase "subsetCols" $+ subsetCols @2 @4 (gen @(NS '[7, 6]) succ)+ @?= mat' @(NS '[7, 3]) [2, 3, 4, 8, 9, 10, 14, 15, 16, 20, 21, 22, 26, 27, 28, 32, 33, 34, 38, 39, 40]+ , testCase "subsetCols" $+ subsetCols @1 @1 (gen @(NS '[3, 5]) succ)+ @?= mat' @(NS '[3, 1]) [1, 6, 11]+ , testCase "subsetCols" $+ subsetCols @1 @2 (gen @(NS '[3, 5]) succ)+ @?= mat' @(NS '[3, 2]) [1, 2, 6, 7, 11, 12]+ , testCase "sliceC 35" $+ sliceC @(NS '[3, 5]) @(NS '[4, 6, 2]) (gen' id)+ @?= mat' @(NS '[2]) [[3, 5, 1], [3, 5, 2]]+ , testCase "sliceC 3" $+ sliceC @(NS '[3]) @(NS '[4, 6, 2]) (gen' id)+ @?= mat' @(NS '[6, 2]) [[3, 1, 1], [3, 1, 2], [3, 2, 1], [3, 2, 2], [3, 3, 1], [3, 3, 2], [3, 4, 1], [3, 4, 2], [3, 5, 1], [3, 5, 2], [3, 6, 1], [3, 6, 2]]+ , testCase "sliceC' 35" $ -- (3-1) * 6 + (5-1) == 16 cos all indexes start at 1+ sliceC' @(NS '[4, 6]) @(NS '[4, 6, 2]) (FinMatU 16 (_4P :| [_6P])) (gen' id)+ @?= mat' @(NS '[2]) [[3, 5, 1], [3, 5, 2]]+ , testCase "sliceC' 3" $+ sliceC' @(NS '[4]) @(NS '[4, 6, 2]) (FinMatU 2 (_4P :| [])) (gen' id)+ @?= mat' @(NS '[6, 2]) [[3, 1, 1], [3, 1, 2], [3, 2, 1], [3, 2, 2], [3, 3, 1], [3, 3, 2], [3, 4, 1], [3, 4, 2], [3, 5, 1], [3, 5, 2], [3, 6, 1], [3, 6, 2]]+ , testCase "sliceC' 35" $+ map (\i -> sliceC' @(NS '[5, 3]) @(NS '[5, 3, 2]) (FinMatU i (_5P :| [_3P])) (gen succ)) [0 .. 14]+ @?= [1 .| 2, 3 .| 4, 5 .| 6, 7 .| 8, 9 .| 10, 11 .| 12, 13 .| 14, 15 .| 16, 17 .| 18, 19 .| 20, 21 .| 22, 23 .| 24, 25 .| 26, 27 .| 28, 29 .| 30]+ , testCase "sliceC' 2" $+ sliceC' @(NS '[1, 7, 3, 2, 6]) @(NS '[1, 7, 3, 2, 6]) (FinMatU 2 (_1P :| [_7P, _3P, _2P, _6P])) (gen' id)+ @?= [1, 1, 1, 1, 3]+ , testCase "sliceC' 43" $+ sliceC' @(NS '[1, 7, 3, 2, 6]) @(NS '[1, 7, 3, 2, 6]) (FinMatU 43 (_1P :| [_7P, _3P, _2P, _6P])) (gen' id)+ @?= [1, 2, 1, 2, 2]+ , testCase "sliceC 2" $+ sliceC @(NS '[1, 1, 1, 1, 3]) @(NS '[1, 7, 3, 2, 6]) (gen' id)+ @?= [1, 1, 1, 1, 3]+ , testCase "sliceC 43" $+ sliceC @(NS '[1, 2, 1, 2, 2]) @(NS '[1, 7, 3, 2, 6]) (gen' id)+ @?= [1, 2, 1, 2, 2]+ , testCase "sliceUpdateC' 0" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3, 2]) (FinMatU 0 (_4P :| [_3P])) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [999, 1000, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC' 1" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3, 2]) (FinMatU 1 (_4P :| [_3P])) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 999, 1000, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC' 2" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3, 2]) (FinMatU 2 (_4P :| [_3P])) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 3, 4, 999, 1000, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC' 5" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3, 2]) (FinMatU 5 (_4P :| [_3P])) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 999, 1000, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC' 11" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3, 2]) (FinMatU 11 (_4P :| [_3P])) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 999, 1000]+ , testCase "sliceUpdateC 0" $+ sliceUpdateC @(NS '[1, 1]) @(NS '[4, 3, 2]) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [999, 1000, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC 1" $+ sliceUpdateC @(NS '[1, 2]) @(NS '[4, 3, 2]) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 999, 1000, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC 2" $+ sliceUpdateC @(NS '[1, 3]) @(NS '[4, 3, 2]) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 3, 4, 999, 1000, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC 5" $+ sliceUpdateC @(NS '[2, 3]) @(NS '[4, 3, 2]) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 999, 1000, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24]+ , testCase "sliceUpdateC 11" $+ sliceUpdateC @(NS '[4, 3]) @(NS '[4, 3, 2]) (gen succ) (mat [999 ..])+ @?= mat' @(NS [4, 3, 2]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 999, 1000]+ , testCase "sliceUpdateC' 0" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3]) (FinMatU 0 (_4P :| [_3P])) (gen succ) 999+ @?= mat' @(NS '[4, 3]) [999, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]+ , testCase "sliceUpdateC' 7" $+ sliceUpdateC' @(NS '[4, 3]) @(NS '[4, 3]) (FinMatU 7 (_4P :| [_3P])) (gen succ) 999+ @?= mat' @(NS '[4, 3]) [1, 2, 3, 4, 5, 6, 7, 999, 9, 10, 11, 12]+ , testCase "sliceUpdateC 0" $+ sliceUpdateC @(NS '[1, 1]) @(NS '[4, 3]) (gen succ) 999+ @?= mat' @(NS '[4, 3]) [999, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]+ , testCase "sliceUpdateC' 7" $+ sliceUpdateC @(NS '[3, 2]) @(NS '[4, 3]) (gen succ) 999+ @?= mat' @(NS '[4, 3]) [1, 2, 3, 4, 5, 6, 7, 999, 9, 10, 11, 12]+ , testCase "sliceUpdateC' 0" $+ sliceUpdateC' @(NS '[7]) @(NS '[7]) (FinMatU 0 (_7P :| [])) (gen succ) 999+ @?= mat' @(NS '[7]) [999, 2, 3, 4, 5, 6, 7]+ , testCase "sliceUpdateC' 4" $+ sliceUpdateC' @(NS '[7]) @(NS '[7]) (FinMatU 4 (_7P :| [])) (gen succ) 999+ @?= mat' @(NS '[7]) [1, 2, 3, 4, 999, 6, 7]+ , testCase "sliceUpdateC 0" $+ sliceUpdateC @(NS '[1]) @(NS '[7]) (gen succ) 999+ @?= mat' @(NS '[7]) [999, 2, 3, 4, 5, 6, 7]+ , testCase "sliceUpdateC 4" $+ sliceUpdateC @(NS '[5]) @(NS '[7]) (gen succ) 999+ @?= mat' @(NS '[7]) [1, 2, 3, 4, 999, 6, 7]+ , testCase "toND" $+ toND @1 (gen' @(NS '[5, 3]) id)+ @?= mat' @(NS '[5])+ ( map+ mat'+ [ [[1, 1], [1, 2], [1, 3]]+ , [[2, 1], [2, 2], [2, 3]]+ , [[3, 1], [3, 2], [3, 3]]+ , [[4, 1], [4, 2], [4, 3]]+ , [[5, 1], [5, 2], [5, 3]]+ ]+ )+ , testCase "concatMat toND" $+ let m = gen' @(NS '[5, 3, 2]) id+ in concatMat (toND @1 m) @?= m+ , testCase "concatMat toND" $+ let m = gen' @(NS '[5, 3, 2]) id+ in concatMat (toND @2 m) @?= m+ , testCase "nonEmptyMatsToMat" $+ nonEmptyMatsToMat @10 (gen @(NS '[2, 5]) id :| [])+ @?= Left "LT: not enough elements: expected 10 found 1"+ , testCase "nonEmptyMatsToMat" $+ nonEmptyMatsToMat @1 (gen @(NS '[2, 5]) id :| [])+ @?= Right (mat' @(NS '[1, 2, 5]) [0, 1, 2, 3, 4, 5, 6, 7, 8, 9])+ , testCase "nonEmptyMatsToMat" $+ nonEmptyMatsToMat @2 (gen @(NS '[2, 5]) succ :| [gen @(NS '[2, 5]) (+ 100)])+ @?= Right (mat' @(NS '[2, 2, 5]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109])+ , testCase "nonEmptyMatsToMat" $+ nonEmptyMatsToMat @1 (gen @(NS '[2, 5]) succ :| [gen @(NS '[2, 5]) (+ 100)])+ @?= Left "GT: too many elements: expected 1"+ , testCase "nonEmptyMatsToMat" $+ nonEmptyMatsToMat @3 (gen @(NS '[2, 5]) succ :| [gen @(NS '[2, 5]) (+ 100)])+ @?= Left "LT: not enough elements: expected 3 found 2"+ , testCase "cartesian" $+ cartesian (,) (gen @(NS '[4]) succ) (gen @(NS '[7]) (+ 101))+ @?= mat' @(NS '[4, 7]) [(1, 101), (1, 102), (1, 103), (1, 104), (1, 105), (1, 106), (1, 107), (2, 101), (2, 102), (2, 103), (2, 104), (2, 105), (2, 106), (2, 107), (3, 101), (3, 102), (3, 103), (3, 104), (3, 105), (3, 106), (3, 107), (4, 101), (4, 102), (4, 103), (4, 104), (4, 105), (4, 106), (4, 107)]+ , testCase "bulkMat" $+ (mat' @(NS '[4, 4]) ['a' .. 'p'] ^. bulkMat (finMatC @(NS '[1, 2]) .: finMatC @(NS '[1, 4]) .| (finMatC @(NS '[4, 3]))))+ @?= ('b' .: 'd' .| 'o')+ , testCase "bulkMat" $+ (mat' @(NS '[4, 4]) ['a' .. 'p'] & bulkMat (finMatC @(NS '[1, 2]) .: finMatC @(NS '[1, 4]) .: finMatC @(NS '[3, 1]) .| (finMatC @(NS '[4, 3]))) %~ fmap toUpper)+ @?= (('a' .: 'B' .: 'c' .| 'D') .:: ('e' .: 'f' .: 'g' .| 'h') .:: ('I' .: 'j' .: 'k' .| 'l') .|| ('m' .: 'n' .: 'O' .| 'p'))+ , testCase "findMatElems" $+ findMatElems ((== 0) . flip mod 5) (gen @(NS '[2, 3, 5]) succ)+ @?= [ (finMatC @(NS '[1, 1, 5]), 5)+ , (finMatC @(NS '[1, 2, 5]), 10)+ , (finMatC @(NS '[1, 3, 5]), 15)+ , (finMatC @(NS '[2, 1, 5]), 20)+ , (finMatC @(NS '[2, 2, 5]), 25)+ , (finMatC @(NS '[2, 3, 5]), 30)+ ]+ , testCase "permutationsMat" $+ permutationsMat @4 "abcd"+ @?= mat' @(NS '[24, 4]) "abcdbacdcbadbcadcabdacbddcbacdbacbdadbcabdcabcdadabcadbcabdcdbacbdacbadcdacbadcbacdbdcabcdabcadb"+ , testCase "swapRow" $+ swapRow @2 @5 (gen @(NS '[6, 3, 2]) succ)+ @?= mat' @(NS '[6, 3, 2]) [1, 2, 3, 4, 5, 6, 25, 26, 27, 28, 29, 30, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 7, 8, 9, 10, 11, 12, 31, 32, 33, 34, 35, 36]+ , testCase "swapRow'" $+ swapRow' (FinU _3P _7P) (FinU _3P _7P) (gen @(NS '[7]) succ)+ @?= mat' @(NS '[7]) [1, 2, 3, 4, 5, 6, 7]+ , testCase "swapRow'" $+ swapRow' (FinU _1P _7P) (FinU _7P _7P) (gen @(NS '[7]) succ)+ @?= mat' @(NS '[7]) [7, 2, 3, 4, 5, 6, 1]+ , testCase "swapRow'" $+ swapRow' (FinU _3P _3P) (FinU _2P _3P) (gen @(NS '[3, 2, 2, 1]) succ)+ @?= mat' @(NS '[3, 2, 2, 1]) [1, 2, 3, 4, 9, 10, 11, 12, 5, 6, 7, 8]+ , testCase "ixSlice" $+ (gen' @(NS '[2, 4, 5]) id ^. ixSlice @(NS '[2]))+ @?= mat' @(NS '[4, 5]) [[2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 1, 4], [2, 1, 5], [2, 2, 1], [2, 2, 2], [2, 2, 3], [2, 2, 4], [2, 2, 5], [2, 3, 1], [2, 3, 2], [2, 3, 3], [2, 3, 4], [2, 3, 5], [2, 4, 1], [2, 4, 2], [2, 4, 3], [2, 4, 4], [2, 4, 5]]+ , testCase "ixSlice" $+ (gen' @(NS '[2, 4, 5]) id ^. ixSlice @(NS '[2, 1]))+ @?= mat' @(NS '[5]) [[2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 1, 4], [2, 1, 5]]+ , testCase "ixSlice" $+ (gen' @(NS '[2, 4, 5]) id ^. ixSlice @(NS '[2, 1, 5]))+ @?= [2, 1, 5]+ , testCase "gen'" $+ (gen @(NS '[4]) succ ^. _row @4)+ @?= 4+ , testCase "gen'" $+ (gen @(NS '[4, 3]) succ ^. _row @4)+ @?= mat' @(NS '[3]) [10, 11, 12]+ , testCase "rowsToMat" $+ rowsToMat (vec' @2 [_F1, _F1]) (mm @57)+ @?= mat' @(NS '[2, 7]) [1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7]+ , testCase "rowsToMat" $+ rowsToMat (vec' @2 [_F1, _F3]) (mm @57)+ @?= mat' @(NS '[2, 7]) [1, 2, 3, 4, 5, 6, 7, 15, 16, 17, 18, 19, 20, 21]+ , testCase "rowsToMat" $+ rowsToMat (vec' @4 [_F1, _F3, _F5, _F3]) (mm @57)+ @?= mat' @(NS '[4, 7]) [1, 2, 3, 4, 5, 6, 7, 15, 16, 17, 18, 19, 20, 21, 29, 30, 31, 32, 33, 34, 35, 15, 16, 17, 18, 19, 20, 21]+ , testCase "_row'" $+ (mm @235 ^. _row' _F1)+ @?= mat @(NS '[3, 5]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15]+ , testCase "_row'" $ (mm @7 ^. _row' _F5) @?= 5+ , testCase "_row'" $ (mm @17 ^. _row' _F1 . _row' _F7) @?= 7+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 123) @(NN 456)+ @?= FinMatU 8 (_4P :| [_5P, _6P])+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 45) @(NN 456)+ @?= FinMatU 19 (_4P :| [_5P])+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 12) @(NN 456)+ @?= FinMatU 1 (_4P :| [_5P])+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 111) @(NN 456)+ @?= FinMatU 0 (_4P :| [_5P, _6P])+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 11) @(NN 456)+ @?= FinMatU 0 (_4P :| [_5P])+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 1) @(NN 4567)+ @?= FinMatU 0 (_4P :| [])+ , testCase "sliceToFinMat" $+ sliceToFinMat @(NN 3) @(NN 4567)+ @?= FinMatU 2 (_4P :| [])+ , testCase "consMat" $+ (mm @5 & consMat %~ (show *** fmap show))+ @?= mat' @(5 ':| '[]) ["1", "2", "3", "4", "5"]+ , testCase "consMat" $+ let z = se1 'x' ^. consMat+ in z ^. from (consMat @(1 ':| '[])) @?= se1 'x'+ , testCase "consMat" $+ (('x', Eof1) ^. from (consMat @(1 ':| '[])))+ @?= se1 'x'+ , testCase "nestedListToMatC" $+ nestedListToMatC @(2 ':| '[3, 5]) [[[1 :: Int, 2, 3, 4, 5], [6, 7, 8, 9, 10], [11, 12, 13, 14, 15]], [[16, 17, 18, 19, 20], [21, 22, 23, 24, 25], [26, 27, 28, 29, 30]]]+ @?= Right (mat' @(2 ':| '[3, 5]) [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30])+ , testCase "nestedListToMatC" $+ nestedListToMatC @(3 ':| '[3, 5]) [[[1 :: Int, 2, 3, 4, 5], [6, 7, 8, 9, 10], [11, 12, 13, 14, 15]], [[16, 17, 18, 19, 20], [21, 22, 23, 24, 25], [26, 27, 28, 29, 30]]]+ @?= Left "LT: not enough elements: expected 3 found 2"+ , testCase "nestedListToMatC" $+ nestedListToMatC @(2 ':| '[3, 6]) [[[1 :: Int, 2, 3, 4, 5], [6, 7, 8, 9, 10], [11, 12, 13, 14, 15]], [[16, 17, 18, 19, 20], [21, 22, 23, 24, 25], [26, 27, 28, 29, 30]]]+ @?= Left "not enough elements: expected 6 found 5"+ , testCase "indexRow" $+ indexRow (fr $ fin @7 1) (mm' @73)+ @?= vec' [[1, 1], [1, 2], [1, 3]]+ , testCase "indexRow" $+ indexRow (fr $ fin @7 3) (mm' @73)+ @?= vec' [[3, 1], [3, 2], [3, 3]]+ , testCase "indexRow" $+ indexRow (fr $ fin @7 7) (mm' @73)+ @?= vec' [[7, 1], [7, 2], [7, 3]]+ , testCase "readVec" $+ readVec @5 @Int (show (mm @5)) @?= [(vec' [1 .. 5], "")]+ , testCase "readMat2" $+ let m = mat' @(3 ':| '[7]) ['a' .. 'u']+ in readMat2 @3 @7 @Char (show m ++ "xyz") @?= [(m, "xyz")]+ , testCase "readVec" $+ let m = mat' @(7 ':| '[]) ['a' .. 'g']+ in readVec @7 @Char (show m ++ " xyz") @?= [(m, " xyz")]+ , testCase "readMat2" $+ let m = mm @372+ in readMat @(NN 372) @Int (show m ++ "xyz") @?= [(m, "xyz")] -- dont need type application but here we have inference+ , testCase "readMat12" $+ let m = toVec (mm @372)+ in readVec @3 @(Mat2 7 2 Int) (show m ++ "xyz") @?= [(m, "xyz")] -- dont need type application but here we have inference+ , testCase "readMat3456" $+ let m = toMat2 (mm @3456)+ in readMat2 @3 @4 @(Mat2 5 6 Int) (show m ++ "xyz") @?= [(m, "xyz")] -- dont need type application but here we have inference+ , testCase "readMat23456" $+ let m = toMat2 (mm @23456)+ in readMat2 @2 @3 @(Mat (4 ':| '[5, 6]) Int) (show m ++ "xyz") @?= [(m, "xyz")] -- dont need type application but here we have inference+ , testCase "showMat" $+ showMat defShowOpts (mm @5) @?= "Vec@5 [1,2,3,4,5]"+ , testCase "showMat" $+ showMat defShowOpts (mm @52) @?= "Mat2@(5,2)\n [\n [1,2],\n [3,4],\n [5,6],\n [7,8],\n [9,10]\n ]\n"+ , testCase "showMat" $+ showMat defShowOpts (mm @222) @?= "Mat@[2,2,2]\n [\n [\n [1,2],\n [3,4]\n ],[\n [5,6],\n [7,8]\n ]\n ]\n"+ , testCase "(.:)" $+ se1 @Int 99+ @?= vec' @1 [99]+ , testCase "(.:)" $+ (12 .: 44 .| 99)+ @?= vec' @3 [12 :: Int, 44, 99]+ , testCase "(.:)" $+ (5 .| 10 .:: 15 .| 20 .|| (25 .| 30))+ @?= mat2' @3 @2 [5 :: Int, 10, 15, 20, 25, 30]+ , testCase "(.:)" $+ se2 (5 .| 10 .:: 15 .| 20 .|| (25 .| 30))+ @?= mat' @(1 ':| '[3, 2]) [5 :: Int, 10, 15, 20, 25, 30]+ , testCase "nestedListToMatValidated" $+ let x = [[[[1 :: Int, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12]], [[13, 14, 15, 16], [17, 18, 19, 20], [21, 22, 23, 24, 25, 26, 27]]]]+ in nestedListToMatValidated @(NN 1234) x @?= Left "validateNestedListC: lengths=[4,4,4,4,4,7] ixes=[1P,2P,3P]"+ , testCase "nestedListToMatValidated" $+ let x = [[[[1 :: Int, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12]], [[13, 14, 15, 16], [17, 18, 19, 20], []]]]+ in nestedListToMatValidated @(NN 1234) x @?= Left "validateNestedListC: lengths=[4,4,4,4,4,0] ixes=[1P,2P,3P]"+ , testCase "nestedListToMatValidated" $+ let x = [[[[1 :: Int, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12]], [[13, 14, 15, 16], [17, 18, 19, 20], [21, 22, 23, 24]]]]+ in nestedListToMatValidated @(NN 1234) x @?= Right (mat' @(1 ':| '[2, 3, 4]) [1 .. 24])+ , testCase "matToNestedNonEmptyC" $+ matToNestedNonEmptyC (mm @234)+ @?= ((1 :| [2 :: Int, 3, 4]) :| [5 :| [6, 7, 8], 9 :| [10, 11, 12]]) :| [(13 :| [14, 15, 16]) :| [17 :| [18, 19, 20], 21 :| [22, 23, 24]]]+ , testCase "nestedNonEmptyToMatValidated" $+ let x = ((1 :| [2 :: Int, 3, 4]) :| [5 :| [6, 7, 8], 9 :| [10, 11, 12]]) :| [(13 :| [14, 15, 16]) :| [17 :| [18, 19, 20], 21 :| [22, 23, 24]]]+ in nestedNonEmptyToMatValidated @(NN 234) x @?= Right (mat' @(2 ':| '[3, 4]) [1 .. 24])+ , testCase "nestedNonEmptyToMatValidated" $+ let x = ((1 :| [2 :: Int, 3, 4]) :| [5 :| [6, 7, 8], 9 :| [10, 11, 12]]) :| [(13 :| []) :| [17 :| [18, 19, 20], 21 :| [22, 23, 24]]]+ in nestedNonEmptyToMatValidated @(NN 234) x @?= Left "validateNestedNonEmptyC: lengths=[4,4,4,1,4,4] ixes=[2,3]"+ , testCase "nestedNonEmptyToMatValidated" $+ let x = ((1 :| [2 :: Int, 3, 4]) :| [5 :| [6, 7, 8], 9 :| [10, 11, 12]]) :| [(13 :| [1 .. 20]) :| [17 :| [18, 19, 20], 21 :| [22, 23, 24]]]+ in nestedNonEmptyToMatValidated @(NN 234) x @?= Left "validateNestedNonEmptyC: lengths=[4,4,4,21,4,4] ixes=[2,3]"+ , testCase "tailsT" $+ tailsT (mm @52)+ @?= mat' @(NN 52)+ [ 1 :| [2, 3, 4, 5, 6, 7, 8, 9, 10]+ , 2 :| [3, 4, 5, 6, 7, 8, 9, 10]+ , 3 :| [4, 5, 6, 7, 8, 9, 10]+ , 4 :| [5, 6, 7, 8, 9, 10]+ , 5 :| [6, 7, 8, 9, 10]+ , 6 :| [7, 8, 9, 10]+ , 7 :| [8, 9, 10]+ , 8 :| [9, 10]+ , 9 :| [10]+ , 10 :| []+ ]+ , testCase "initsT" $+ initsT (mm @52)+ @?= mat' @(NN 52)+ [ 1 :| []+ , 1 :| [2]+ , 1 :| [2, 3]+ , 1 :| [2, 3, 4]+ , 1 :| [2, 3, 4, 5]+ , 1 :| [2, 3, 4, 5, 6]+ , 1 :| [2, 3, 4, 5, 6, 7]+ , 1 :| [2, 3, 4, 5, 6, 7, 8]+ , 1 :| [2, 3, 4, 5, 6, 7, 8, 9]+ , 1 :| [2, 3, 4, 5, 6, 7, 8, 9, 10]+ ]+ , testCase "ipostscanr" $+ ipostscanr (\i a zs -> (fmPos i, a) : zs) [] (mat @(NN 32) ['a' ..])+ @?= mat2' @3 @2 [[(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd'), (4, 'e'), (5, 'f')], [(1, 'b'), (2, 'c'), (3, 'd'), (4, 'e'), (5, 'f')], [(2, 'c'), (3, 'd'), (4, 'e'), (5, 'f')], [(3, 'd'), (4, 'e'), (5, 'f')], [(4, 'e'), (5, 'f')], [(5, 'f')]]+ , testCase "ipostscanr" $+ ipostscanr (\i a zs -> (fmPos i, a) : zs) [(999, 'Z')] (mat @(NN 32) ['a' ..])+ @?= mat2' @3 @2 [[(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd'), (4, 'e'), (5, 'f'), (999, 'Z')], [(1, 'b'), (2, 'c'), (3, 'd'), (4, 'e'), (5, 'f'), (999, 'Z')], [(2, 'c'), (3, 'd'), (4, 'e'), (5, 'f'), (999, 'Z')], [(3, 'd'), (4, 'e'), (5, 'f'), (999, 'Z')], [(4, 'e'), (5, 'f'), (999, 'Z')], [(5, 'f'), (999, 'Z')]]+ , testCase "ipostscanl" $+ ipostscanl (\i zs a -> (fmPos i, a) : zs) [] (mat @(NN 32) ['a' ..])+ @?= mat2' @3 @2 [[(0, 'a')], [(1, 'b'), (0, 'a')], [(2, 'c'), (1, 'b'), (0, 'a')], [(3, 'd'), (2, 'c'), (1, 'b'), (0, 'a')], [(4, 'e'), (3, 'd'), (2, 'c'), (1, 'b'), (0, 'a')], [(5, 'f'), (4, 'e'), (3, 'd'), (2, 'c'), (1, 'b'), (0, 'a')]]+ , testCase "ipostscanl" $+ ipostscanl (\i zs a -> (fmPos i, a) : zs) [(999, 'Z')] (mat @(NN 32) ['a' ..])+ @?= mat2' @3 @2 [[(0, 'a'), (999, 'Z')], [(1, 'b'), (0, 'a'), (999, 'Z')], [(2, 'c'), (1, 'b'), (0, 'a'), (999, 'Z')], [(3, 'd'), (2, 'c'), (1, 'b'), (0, 'a'), (999, 'Z')], [(4, 'e'), (3, 'd'), (2, 'c'), (1, 'b'), (0, 'a'), (999, 'Z')], [(5, 'f'), (4, 'e'), (3, 'd'), (2, 'c'), (1, 'b'), (0, 'a'), (999, 'Z')]]+ , testCase "postscanlMat" $+ postscanlMat (flip (:)) [] (vec @6 ['a' ..])+ @?= vec' @6 ["a", "ba", "cba", "dcba", "edcba", "fedcba"]+ , testCase "postscanrMat" $+ postscanrMat (:) [] (vec @6 ['a' ..])+ @?= vec' @6 ["abcdef", "bcdef", "cdef", "def", "ef", "f"]+ , testCase "postscanlMat" $+ postscanlMat (flip (:)) [] (mat @(NN 222) ['a' ..])+ @?= mat' @(2 ':| '[2, 2]) ["a", "ba", "cba", "dcba", "edcba", "fedcba", "gfedcba", "hgfedcba"]+ , testCase "scanlVec" $+ scanlVec (flip (:)) [] (vec @6 ['a' ..])+ @?= vec' @7 ["", "a", "ba", "cba", "dcba", "edcba", "fedcba"]+ , testCase "scanrVec" $+ scanrVec (:) ['Z'] (vec @6 ['a' ..])+ @?= vec' @7 ["abcdefZ", "bcdefZ", "cdefZ", "defZ", "efZ", "fZ", "Z"]+ , testCase "unfoldlRep" $+ unfoldlRep @(Vec 5) (\i s -> (drop 1 s, (fmPos i, head s))) ['a' .. 'h']+ @?= ("fgh", vec' @5 [(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd'), (4, 'e')])+ , testCase "unfoldrRep" $+ unfoldrRep @(Vec 5) (\i s -> (drop 1 s, (fmPos i, head s))) ['a' .. 'h']+ @?= ("fgh", vec' @5 [(0, 'e'), (1, 'd'), (2, 'c'), (3, 'b'), (4, 'a')])+ , testCase "fillTraversable" $+ fillTraversable @(MatN 234) (pure ()) [1 :: Int .. 40]+ @?= Right ([25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40], mat' @(2 ':| '[3, 4]) [1 .. 24])+ , testCase "toInteger1" $+ toInteger1 (pure @(Mat2 4 2) EQ)+ @?= 3280+ , testCase "toInteger1" $+ toInteger1 (pure @(Mat2 4 2) LT)+ @?= 0+ , testCase "toInteger1" $+ toInteger1 (pure @(Mat2 4 2) GT)+ @?= 6560+ , testCase "toInteger1" $+ fmap toInteger1 (withOp (+ 123) (pure @(Mat2 4 2) EQ))+ @?= Right 3403+ , testCase "toInteger1" $+ fmap toInteger1 (withOp (+ 1) (pure @(Mat2 4 2) GT))+ @?= Left "cap=(0,6560):padL: negative fill: would need to truncate the data"+ , testCase "toInteger1" $+ fmap toInteger1 (withOp (subtract 1) (pure @(Mat2 4 2) LT))+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toInteger1" $+ fmap toInteger1 (withOp2 ((+) . (+ 1)) (pure @(Mat2 4 2) EQ) minBound)+ @?= Right 3281+ , testCase "mempty" $+ (mempty :: Vec 10 Ordering)+ @?= vec' @10 [EQ, EQ, EQ, EQ, EQ, EQ, EQ, EQ, EQ, EQ]+ , testCase "minBound" $+ (minBound :: Vec 10 Ordering)+ @?= vec' @10 [LT, LT, LT, LT, LT, LT, LT, LT, LT, LT]+ , testCase "maxBound" $+ (maxBound :: Vec 10 Ordering)+ @?= vec' @10 [GT, GT, GT, GT, GT, GT, GT, GT, GT, GT]+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Ordering)) 0+ @?= Right (mat' @(NS '[2, 5]) [LT, LT, LT, LT, LT, LT, LT, LT, LT, LT])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Ordering)) (-5)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 0+ @?= Right (mat' @(NS '[2, 5]) [0, 0, 0, 0, 0, 0, 0, 0, 0, 0])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 128+ @?= Right (mat' @(NS '[2, 5]) [0, 0, 0, 0, 0, 0, 0, 0, 1, 0])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) (-129)+ @?= Right (mat' @(NS '[2, 5]) [0, 0, 0, 0, 0, 0, 0, 0, -1, 0])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Ordering)) 23+ @?= Right (mat' @(NS '[2, 5]) [LT, LT, LT, LT, LT, LT, LT, GT, EQ, GT])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Ordering)) 59049+ @?= Left "cap=(0,59048):padL: negative fill: would need to truncate the data"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Ordering)) 59048+ @?= Right (mat' @(NS '[2, 5]) [GT, GT, GT, GT, GT, GT, GT, GT, GT, GT])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 99999999999999+ @?= Right (mat' @(NS '[2, 5]) [0, 0, 0, 22, 94, 49, 3, 104, 127, 127])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Ordering)) (-1)+ @?= Left "calcNextEnum:not defined for negative numbers"+ , testCase "toInteger1" $+ toInteger1 (mat' @(NS '[2, 5]) [LT, LT, LT, LT, LT, LT, LT, LT, LT, LT])+ @?= 0+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 99999999999999999999+ @?= Right (mat2' @2 @5 [10, 107, 99, 87, 69, 86, 24, 63, 127, 127])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 99999999999999999999999+ @?= Left "cap=(-1276136419117121619200,1180591620717411303423):padL: negative fill: would need to truncate the data"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 1180591620717411303423+ @?= Right (mat2' @2 @5 [127, 127, 127, 127, 127, 127, 127, 127, 127, 127])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) 1180591620717411303424+ @?= Left "cap=(-1276136419117121619200,1180591620717411303423):padL: negative fill: would need to truncate the data"+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) (-1276136419117121619200)+ @?= Right (mat2' @2 @5 [-128, -128, -128, -128, -128, -128, -128, -128, -128, -128])+ , testCase "fromInteger1" $+ fromInteger1 (minBound @(Mat (2 ':| '[5]) Int8)) (-1276136419117121619201)+ @?= Left "cap=(-1276136419117121619200,1180591620717411303423):padL: negative fill: would need to truncate the data"+ ]++suiteCheckers :: TestTree+suiteCheckers =+ testGroup+ "TestMat Checkers"+ [ adj' False 10 500 10 $ TQ.testProperties "mat [2,3,4]" (checkersToProps (testLawsMat @(NS '[2, 3, 4])))+ , adj' False 10 500 10 $ TQ.testProperties "mat [5]" (checkersToProps (testLawsMat' @(NS '[5])))+ , adj' False 10 500 10 $ TQ.testProperties "mat [1]" (checkersToProps (testLawsMat' @(NS '[1])))+ , adj' False 10 500 10 $ TQ.testProperties "mat [1,5]" (checkersToProps (testLawsMat' @(NS '[1, 5])))+ ]++fmi237' :: NonEmpty (FinMat (NS '[2, 3, 7]))+fmi237' = frp $ traverse (nonEmptyToFinMat <=< toPositives) fmi237++fmi237 :: NonEmpty (NonEmpty Int)+fmi237 = fmap N.fromList ([1, 1, 1] :| [[1, 1, 2], [1, 1, 3], [1, 1, 4], [1, 1, 5], [1, 1, 6], [1, 1, 7], [1, 2, 1], [1, 2, 2], [1, 2, 3], [1, 2, 4], [1, 2, 5], [1, 2, 6], [1, 2, 7], [1, 3, 1], [1, 3, 2], [1, 3, 3], [1, 3, 4], [1, 3, 5], [1, 3, 6], [1, 3, 7], [2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 1, 4], [2, 1, 5], [2, 1, 6], [2, 1, 7], [2, 2, 1], [2, 2, 2], [2, 2, 3], [2, 2, 4], [2, 2, 5], [2, 2, 6], [2, 2, 7], [2, 3, 1], [2, 3, 2], [2, 3, 3], [2, 3, 4], [2, 3, 5], [2, 3, 6], [2, 3, 7]])
+ test/TestNatHelper.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module TestNatHelper where++import Cybus.NatHelper+import Data.List.NonEmpty (NonEmpty (..))+import Data.Pos+import Test.Tasty+import Test.Tasty.HUnit++doit :: IO ()+doit = defaultMain suite++suite :: TestTree+suite =+ testGroup+ "TestNatHelper"+ [ testCase "nestedNonEmptyToList nestedListToNonEmpty" $+ let m = [[[1 :: Int, 2, 3], [4, 5, 6]], [[7, 8, 9], [10, 11, 12]], [[13, 14, 15], [16, 17, 18]]]+ in (nestedNonEmptyToList @(NN 323) =<< nestedListToNonEmpty @(NN 323) m) @?= Right m+ , testCase "nestedNonEmptyToList" $+ let m = [[[1 :: Int, 2, 3], [4, 5, 6]], [[7, 8, 9], [10, 11, 12]], [[13, 14, 15], [16, 17, 18]]]+ in nestedListToNonEmpty @(NN 323) m @?= Right (((1 :| [2, 3]) :| [4 :| [5, 6]]) :| [(7 :| [8, 9]) :| [10 :| [11, 12]], (13 :| [14, 15]) :| [16 :| [17, 18]]])+ , testCase "validateNestedList" $+ validateNestedList [True, False, True]+ @?= Right (_3P :| [])+ , testCase "validateNestedList" $+ validateNestedList [[[True, False, True]]]+ @?= Right (_1P :| [_1P, _3P])+ , testCase "validateNestedList" $+ validateNestedList [[[True, False, True], [False, False, False]]]+ @?= Right (_1P :| [_2P, _3P])+ , testCase "validateNestedList" $+ validateNestedList [()]+ @?= Right (_1P :| [])+ , testCase "validateNestedList" $+ validateNestedList ([] :: [()])+ @?= Left "validateNestedListC: ixes=[]:no data!"+ , testCase "validateNestedList" $+ validateNestedList [[1 :: Int, 2], [1, 2], [1, 2, 3]] @?= Left "validateNestedListC: lengths=[2,2,3] ixes=[3P]"+ ]