module Algebra.Ring.Polynomial.Monomorphic where
import qualified Algebra.Algorithms.Groebner as Gr
import Algebra.Internal
import Algebra.Ring.Noetherian
import qualified Algebra.Ring.Polynomial as Poly
import Control.Arrow
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Monomorphic
data Variable = Variable { varName :: Char
, varIndex :: Maybe Int
} deriving (Eq, Ord)
instance Show Variable where
showsPrec _ v = showChar (varName v) . maybe id ((showChar '_' .) . shows) (varIndex v)
type Polyn = [(Rational, [(Variable, Integer)])]
buildVarsList :: Polyn -> [Variable]
buildVarsList = nub . sort . concatMap (map fst . snd)
encodeMonomList :: [Variable] -> [(Variable, Integer)] -> [Int]
encodeMonomList vars mono = map (maybe 0 fromInteger . flip lookup mono) vars
encodeMonomial :: [Variable] -> [(Variable, Integer)] -> Monomorphic (Vector Int)
encodeMonomial vars mono = promote $ encodeMonomList vars mono
encodePolynomial :: Polyn -> Monomorphic (Poly.Polynomial Rational)
encodePolynomial = promote . toPolynomialSetting
toPolynomialSetting :: Polyn -> PolynomialSetting
toPolynomialSetting p =
PolySetting { polyn = p
, dimension = promote $ length $ buildVarsList p
}
data PolynomialSetting = PolySetting { dimension :: Monomorphic SNat
, polyn :: Polyn
} deriving (Show)
instance Poly.IsMonomialOrder ord => Monomorphicable (Poly.OrderedPolynomial Rational ord) where
type MonomorphicRep (Poly.OrderedPolynomial Rational ord) = PolynomialSetting
promote PolySetting{..} =
case dimension of
Monomorphic dim ->
case singInstance dim of
SingInstance -> Monomorphic $ Poly.polynomial $ M.fromList (map ((Poly.OrderedMonomial . Poly.fromList dim . encodeMonomList vars . snd) &&& fst) polyn)
where
vars = buildVarsList polyn
demote (Monomorphic f) =
PolySetting { polyn = map (second $ toMonom . map toInteger . demote . Monomorphic) $ Poly.getTerms f
, dimension = Monomorphic $ Poly.sDegree f
}
where
toMonom = zip $ Variable 'X' Nothing : [Variable 'X' (Just i) | i <- [1..]]
uniformlyPromote :: Poly.IsMonomialOrder ord
=> [Polyn] -> Monomorphic (Ideal :.: Poly.OrderedPolynomial Rational ord)
uniformlyPromote ps =
case promote (length vars) of
Monomorphic dim ->
case singInstance dim of
SingInstance -> Monomorphic $ Comp $ toIdeal $ map (Poly.polynomial . M.fromList . map (Poly.OrderedMonomial . Poly.fromList dim . encodeMonomList vars . snd &&& fst)) ps
where
vars = nub $ sort $ concatMap buildVarsList ps
instance Poly.IsMonomialOrder ord => Monomorphicable (Ideal :.: Poly.OrderedPolynomial Rational ord) where
type MonomorphicRep (Ideal :.: Poly.OrderedPolynomial Rational ord) = [Polyn]
promote = uniformlyPromote
demote (Monomorphic (Comp (Ideal v))) = map (polyn . demote . Monomorphic) $ toList v
promoteList :: Poly.IsMonomialOrder ord => [Polyn] -> Monomorphic ([] :.: Poly.OrderedPolynomial Rational ord)
promoteList ps =
case promote (length vars) of
Monomorphic dim ->
case singInstance dim of
SingInstance -> Monomorphic $ Comp $ map (Poly.polynomial . M.fromList . map (Poly.OrderedMonomial . Poly.fromList dim . encodeMonomList vars . snd &&& fst)) ps
where
vars = nub $ sort $ concatMap buildVarsList ps
renameVars :: [Variable] -> Polyn -> Polyn
renameVars vars = map (second $ map $ first ren)
where
ren v = fromMaybe v $ lookup v dic
dic = zip (Variable 'X' Nothing : [Variable 'X' (Just i) | i <- [1..]]) vars
showPolyn :: Polyn -> String
showPolyn f =
case encodePolynomial f of
Monomorphic f' ->
case singInstance (Poly.sDegree f') of
SingInstance -> Poly.showPolynomialWithVars dic f'
where
dic = zip [1..] $ map show $ buildVarsList f