Use 'n choose k' to choose Gauss-Seidel dimensions

This commit is contained in:
sheaf 2024-04-21 21:15:07 +02:00
parent 0e6b9a822b
commit 0e59d85143
4 changed files with 61 additions and 20 deletions

View file

@ -185,8 +185,7 @@ benchCases =
, narrowAbs <- [ 5e-2 ] , narrowAbs <- [ 5e-2 ]
, let opts = , let opts =
RootIsolationOptions RootIsolationOptions
{ minWidth { rootIsolationAlgorithms = defaultRootIsolationAlgorithms minWidth narrowAbs
, cuspFindingAlgorithms = defaultRootIsolationAlgorithms minWidth narrowAbs
} }
] ]

View file

@ -229,6 +229,8 @@ data OutlineInfo =
{ outlineFn :: OutlineFn { outlineFn :: OutlineFn
, outlineDefiniteCusps, outlinePotentialCusps :: [ Cusp ] } , outlineDefiniteCusps, outlinePotentialCusps :: [ Cusp ] }
type N = 2
computeStrokeOutline :: computeStrokeOutline ::
forall ( clo :: SplineType ) usedParams brushParams crvData ptData s forall ( clo :: SplineType ) usedParams brushParams crvData ptData s
. ( KnownSplineType clo . ( KnownSplineType clo

View file

@ -10,7 +10,8 @@ module Math.Linear
-- * Points and vectors (second version) -- * Points and vectors (second version)
, (..), T(.., V2, V3, V4) , (..), T(.., V2, V3, V4)
, Fin(..), MFin(..), universe, coordinates , Fin(..), MFin(..)
, universe, coordinates, choose
, RepDim, RepresentableQ(..) , RepDim, RepresentableQ(..)
, Representable(..), set, injection, projection , Representable(..), set, injection, projection
, Vec(..), (!), find, zipIndices , Vec(..), (!), find, zipIndices
@ -34,7 +35,9 @@ import GHC.Generics
import GHC.Stack import GHC.Stack
( HasCallStack ) ( HasCallStack )
import GHC.TypeNats import GHC.TypeNats
( Nat, KnownNat, natVal' ) ( Nat, KnownNat, type (<=)
, natVal'
)
-- acts -- acts
import Data.Act import Data.Act
@ -136,6 +139,27 @@ coordinates :: forall r u. ( Representable r u ) => u -> Vec ( RepDim u ) r
coordinates u = fmap ( index u ) $ universe @( RepDim u ) coordinates u = fmap ( index u ) $ universe @( RepDim u )
{-# INLINEABLE coordinates #-} {-# INLINEABLE coordinates #-}
-- | Binomial coefficient: choose all subsets of size @k@ of the given set
-- of size @n@.
choose
:: forall n k
. ( KnownNat n, KnownNat k
, 1 <= n, 1 <= k, k <= n
)
=> [ Vec k ( Fin n ) ]
choose = coerce $ go ( fromIntegral $ natVal' @n proxy# )
( fromIntegral $ natVal' @k proxy# )
where
go :: Word -> Word -> [ [ Word ] ]
go n k
| k == 1
= [ [ i ] | i <- [ 1 .. n ] ]
| n == k
= [ [ 1 .. n ] ]
go n k = go ( n - 1 ) k
++ ( map ( ++ [ n ] ) $ go ( n - 1 ) ( k - 1 ) )
{-# INLINEABLE choose #-}
infixl 9 ! infixl 9 !
(!) :: forall l a. HasCallStack => Vec l a -> Fin l -> a (!) :: forall l a. HasCallStack => Vec l a -> Fin l -> a
( Vec l ) ! Fin i = l !! ( fromIntegral i - 1 ) ( Vec l ) ! Fin i = l !! ( fromIntegral i - 1 )

View file

@ -24,10 +24,6 @@ module Math.Root.Isolation
-- ** Trees recording search space of root isolation algorithms -- ** Trees recording search space of root isolation algorithms
, RootIsolationTree(..), showRootIsolationTree , RootIsolationTree(..), showRootIsolationTree
, RootIsolationStep(..) , RootIsolationStep(..)
-- * Hack for changing between 2 and 3 d formulations
-- for my personal testing
, N
) )
where where
@ -52,13 +48,19 @@ import Data.List.NonEmpty
( NonEmpty ) ( NonEmpty )
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
( NonEmpty(..), cons, filter, fromList, last, singleton, sort ) ( NonEmpty(..), cons, filter, fromList, last, singleton, sort )
import Data.Proxy
( Proxy(..) )
import Data.Semigroup import Data.Semigroup
( Arg(..), Dual(..) ) ( Arg(..), Dual(..) )
import Data.Type.Ord
( OrderingI(..) )
import Numeric import Numeric
( showFFloat ) ( showFFloat )
import GHC.TypeNats import GHC.TypeNats
( Nat, KnownNat ( Nat, KnownNat
, type (<=) ) , type (<=)
, cmpNat
)
-- containers -- containers
import Data.Tree import Data.Tree
@ -88,7 +90,7 @@ import Math.Linear
import Math.Module import Math.Module
( Module(..) ) ( Module(..) )
import Math.Monomial import Math.Monomial
( MonomialBasis(..) ( MonomialBasis(..), Deg, Vars
, linearMonomial, zeroMonomial , linearMonomial, zeroMonomial
) )
import qualified Math.Ring as Ring import qualified Math.Ring as Ring
@ -137,10 +139,18 @@ showArea area = "(area " ++ showFFloat (Just 6) area "" ++ ")"
type Box n = 𝕀 n type Box n = 𝕀 n
type BoxHistory n = [ NE.NonEmpty ( RootIsolationStep, Box n ) ] type BoxHistory n = [ NE.NonEmpty ( RootIsolationStep, Box n ) ]
type N = 2
type BoxCt n d = ( n ~ N, d ~ 3 ) -- | Dimension constraints for root isolation in a system of equations:
{- --
( Show ( 𝕀 n ), Show ( n ) -- - @n@: number of variables
-- - @d@: number of equations
--
-- NB: we require n <= d (no support for under-constrained systems).
type BoxCt n d =
( KnownNat n, KnownNat d
, 1 <= n, 1 <= d, n <= d
, Show ( 𝕀 n ), Show ( n )
, Eq ( n ) , Eq ( n )
, Representable Double ( n ) , Representable Double ( n )
, MonomialBasis ( D 1 ( n ) ) , MonomialBasis ( D 1 ( n ) )
@ -153,7 +163,6 @@ type BoxCt n d = ( n ~ N, d ~ 3 )
, Module Double ( T ( d ) ) , Module Double ( T ( d ) )
, Representable Double ( d ) , Representable Double ( d )
) )
-}
-- | Options for the root isolation methods in 'isolateRootsIn'. -- | Options for the root isolation methods in 'isolateRootsIn'.
type RootIsolationOptions :: Nat -> Nat -> Type type RootIsolationOptions :: Nat -> Nat -> Type
@ -235,6 +244,7 @@ defaultRootIsolationOptions =
where where
minWidth = 1e-5 minWidth = 1e-5
ε_eq = 5e-3 ε_eq = 5e-3
{-# INLINEABLE defaultRootIsolationOptions #-}
defaultRootIsolationAlgorithms defaultRootIsolationAlgorithms
:: forall n d :: forall n d
@ -284,11 +294,17 @@ defaultRootIsolationAlgorithms minWidth ε_eq box history
GaussSeidelOptions GaussSeidelOptions
{ gsPreconditioner = InverseMidJacobian { gsPreconditioner = InverseMidJacobian
, gsPickEqs = , gsPickEqs =
\ ( 𝕀 ( 3 a_lo b_lo c_lo ) ( 3 a_hi b_hi c_hi ) ) -> case cmpNat @n @d Proxy Proxy of
case length history `mod` 3 of EQI -> id
0 -> 𝕀 ( 2 a_lo b_lo ) ( 2 a_hi b_hi ) LTI ->
1 -> 𝕀 ( 2 b_lo c_lo ) ( 2 b_hi c_hi ) -- If there are more equations (d) than variables (n),
_ -> 𝕀 ( 2 a_lo c_lo ) ( 2 a_hi c_hi ) -- pick a size n subset of the variables,
-- (go through all combinations cyclically).
let choices :: [ Vec n ( Fin d ) ]
choices = choose @d @n
choice :: Vec n ( Fin d )
choice = choices !! ( length history `mod` length choices )
in \ u -> tabulate \ i -> index u ( choice ! i )
} }
-- Did we reduce the box width by at least ε_eq -- Did we reduce the box width by at least ε_eq