{-# LANGUAGE FlexibleInstances #-}

-- | Pretty-printing.
--
-- Tip: you can try putting something like this into your @.ghci@ file to
-- make life more convenient:
--
-- > :m    +Math.Algebra.Polynomial.Pretty  
-- > :seti -interactive-print=prettyPrint
--
 
module Math.Algebra.Polynomial.Pretty where

--------------------------------------------------------------------------------

import Data.List
import Data.Ratio

import Math.Algebra.Polynomial.FreeModule ( FreeMod, ZMod, QMod )
import qualified Math.Algebra.Polynomial.FreeModule as ZMod

import Math.Algebra.Polynomial.Misc

--------------------------------------------------------------------------------

class Pretty a where
  pretty :: a -> String

  prettyInParens :: a -> String
  prettyInParens = a -> String
forall a. Pretty a => a -> String
pretty

prettyPrint :: Pretty a => a -> IO ()
prettyPrint :: a -> IO ()
prettyPrint = String -> IO ()
putStrLn (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
pretty

--------------------------------------------------------------------------------

-- instance Pretty a => Pretty (ZMod a) where
--   pretty = prettyZMod pretty

instance (Num c, Eq c, Pretty c, IsSigned c, Pretty b) => Pretty (FreeMod c b) where
  pretty :: FreeMod c b -> String
pretty = Bool -> (b -> String) -> FreeMod c b -> String
forall c b.
(Num c, Eq c, IsSigned c, Pretty c) =>
Bool -> (b -> String) -> FreeMod c b -> String
prettyFreeMod' Bool
True b -> String
forall a. Pretty a => a -> String
pretty
  prettyInParens :: FreeMod c b -> String
prettyInParens FreeMod c b
x = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FreeMod c b -> String
forall a. Pretty a => a -> String
pretty FreeMod c b
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

--------------------------------------------------------------------------------

instance Pretty Int where
  pretty :: Int -> String
pretty = Int -> String
forall a. Show a => a -> String
show

instance Pretty Integer where
  pretty :: Integer -> String
pretty = Integer -> String
forall a. Show a => a -> String
show

instance (Eq a, Num a, Pretty a) => Pretty (Ratio a) where
  pretty :: Ratio a -> String
pretty Ratio a
q = case Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
q of
    a
1 -> a -> String
forall a. Pretty a => a -> String
prettyInParens (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q)
    a
_ -> a -> String
forall a. Pretty a => a -> String
prettyInParens (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
prettyInParens (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
q)

--------------------------------------------------------------------------------
-- * Pretty printing elements of free modules

-- | Example: @showVarPower "x" 5 == "x^5"@
showVarPower :: String -> Int -> String
showVarPower :: String -> Int -> String
showVarPower String
name Int
expo = case Int
expo of
  Int
0 -> String
"1"
  Int
1 -> String
name
  Int
_ -> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
expo

--------------------------------------------------------------------------------

-- | no multiplication sign (ok for mathematica and humans)
prettyZMod_ :: (b -> String) -> ZMod b -> String
prettyZMod_ :: (b -> String) -> ZMod b -> String
prettyZMod_ = Bool -> (b -> String) -> ZMod b -> String
forall c b.
(Num c, Eq c, IsSigned c, Pretty c) =>
Bool -> (b -> String) -> FreeMod c b -> String
prettyFreeMod' Bool
False
  
-- | multiplication sign (ok for maple etc)
prettyZMod :: (b -> String) -> ZMod b -> String
prettyZMod :: (b -> String) -> ZMod b -> String
prettyZMod = Bool -> (b -> String) -> ZMod b -> String
forall c b.
(Num c, Eq c, IsSigned c, Pretty c) =>
Bool -> (b -> String) -> FreeMod c b -> String
prettyFreeMod' Bool
True

--------------------------------------------------------------------------------

prettyFreeMod' 
  :: (Num c, Eq c, IsSigned c, Pretty c) 
  => Bool                -- ^ use star for multiplication (@False@ means just concatenation)
  -> (b -> String)       -- ^ show base
  -> FreeMod c b 
  -> String
prettyFreeMod' :: Bool -> (b -> String) -> FreeMod c b -> String
prettyFreeMod' Bool
star b -> String
showBase FreeMod c b
what = String
final where
  final :: String
final = if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 String
stuff String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
" + " then Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
stuff else Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
stuff
  stuff :: String
stuff = ((b, c) -> String) -> [(b, c)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (b, c) -> String
forall a. (Eq a, Num a, IsSigned a, Pretty a) => (b, a) -> String
f (FreeMod c b -> [(b, c)]
forall c b. FreeMod c b -> [(b, c)]
ZMod.toList FreeMod c b
what) 
  f :: (b, a) -> String
f (b
g,  a
1) = String
plus  String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
showBase' b
g
  f (b
g, -1) = String
minus String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
showBase' b
g
  f (b
g, a
c)  = case b -> String
showBase' b
g of
    String
"1" -> a -> String
forall a. IsSigned a => a -> String
sgn a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Pretty a => a -> String
prettyInParens (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
c)
    String
b   -> a -> String
forall a. IsSigned a => a -> String
sgn a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Pretty a => a -> String
prettyInParens (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
starStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
  -- cond (_,c) = (c/=0)
  starStr :: String
starStr = if Bool
star then String
"*" else String
" "
  showBase' :: b -> String
showBase' b
g = case b -> String
showBase b
g of
    String
"" -> String
"1"  -- "(1)"
    String
s  -> String
s
  sgn :: a -> String
sgn a
c = case a -> Maybe Sign
forall a. IsSigned a => a -> Maybe Sign
signOf a
c of
    Just Sign
Minus -> String
minus
    Maybe Sign
_          -> String
plus
  plus :: String
plus  = String
" + "
  minus :: String
minus = String
" - "

prettyFreeMod'' 
  :: (c -> String)    -- ^ show coefficient
  -> (b -> String)    -- ^ show base
  -> FreeMod c b 
  -> String
prettyFreeMod'' :: (c -> String) -> (b -> String) -> FreeMod c b -> String
prettyFreeMod'' c -> String
showCoeff b -> String
showBase FreeMod c b
what = String
result where
  result :: String
result = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" + " (((b, c) -> String) -> [(b, c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (b, c) -> String
f ([(b, c)] -> [String]) -> [(b, c)] -> [String]
forall a b. (a -> b) -> a -> b
$ FreeMod c b -> [(b, c)]
forall c b. FreeMod c b -> [(b, c)]
ZMod.toList FreeMod c b
what) 
  f :: (b, c) -> String
f (b
g, c
c) = case b -> String
showBase b
g of
    String
""  -> c -> String
showCoeff c
c
    String
"1" -> c -> String
showCoeff c
c
    String
b   -> c -> String
showCoeff c
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
starStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
  starStr :: String
starStr = String
"*"

--------------------------------------------------------------------------------

{-
-- * Utility

-- | Put into parentheses
paren :: String -> String
paren s = '(' : s ++ ")"

--------------------------------------------------------------------------------

{-

-- | Exponential form of a partition
expFormString :: Partition -> String
expFormString p = "(" ++ intercalate "," (map f ies) ++ ")" where
  ies = toExponentialForm p
  f (i,e) = show i ++ "^" ++ show e
-}

extendStringL :: Int -> String -> String
extendStringL k s = s ++ replicate (k - length s) ' '

extendStringR :: Int -> String -> String
extendStringR k s = replicate (k - length s) ' ' ++ s

--------------------------------------------------------------------------------
-- * Mathematica-formatted output

class Mathematica a where
  mathematica :: a -> String

instance Mathematica Int where
  mathematica = show

instance Mathematica Integer where
  mathematica = show

instance Mathematica String where
  mathematica = show

{-
instance Mathematica Partition where
  mathematica (Partition ps) = "{" ++ intercalate "," (map show ps) ++ "}"
-}

data Indexed a = Indexed String a

instance Mathematica a => Mathematica (Indexed a) where
  mathematica (Indexed x sub) = "Subscript[" ++ x ++ "," ++ mathematica sub ++ "]"

--------------------------------------------------------------------------------

-}