The first half of Fractran.hs is implementing semiring functionality for IntMap, which is a map from prime factors to exponents. Perhaps we should isolate this into into its own file for the sake of readability?
-- Factored.hs
import Data.Semiring
import Data.Map.Strict qualified as M
import Math.NumberTheory.Primes
newtype Factored i
= Factored { factors :: M.Map (Prime i) Word }
deriving
( Show, Eq, Ord
)
factored =
Factored . M.fromList . factorise
unfactored =
factorBack . M.toList . factors
instance (Ord i, Semiring i, UniqueFactorisation i) => Semiring (Factored i)
where
one = Factored M.empty
zero = one
plus a b =
factored $ unfactored a + unfactored b
times (Factored a) (Factored b) =
Factored $ M.unionWith (+) a b
instance (Ord i, Semiring i, UniqueFactorisation i) => GcdDomain (Factored i)
where
coprime (Factored a) (Factored b) =
M.disjoint a b
gcd (Factored a) (Factored b) =
Factored $ M.intersectionWith min a b
divide (Factored a) (Factored b) =
[ Factored
$ M.differenceWith (\a b -> a-b <$ guard (a>b)) a b
| M.isSubmapOfBy (<=) b a
]Here's an old/new comparison of a function that uses the instances.
fracOpt :: _ => [Ratio i] -> Factored i -> [Factored i]
fracOpt fracs = eval ifs
where
ifs =
zip [0..] fmaps
fmaps =
[(factored a, factored b) | a:%b <- fracs]
eval fs n = do
(i,p):_ <- [[(i,x*r) | (i,(x,divide n->Just r)) <- fs]]
p : eval (opts ! i) p
opts =
listArray (0, length fmaps - 1) $
zipWith3 (\a b c -> f a b ++ c)
fmaps
(inits ifs)
(init $ tails ifs)
f (num,_) pre =
[ p | p@(_,(_,x)) <- pre, not $ coprime num x ]
-- vs.
optArr :: [(IntMap, IntMap)] -> Array Int [(Int, (IntMap, IntMap))]
optArr fs = listArray (0, length fs - 1) opts where
ifs = zip [0..] fs
opts = [opt i f | (i,f) <- ifs]
opt i f = let (pre,post) = splitAt i ifs in (preOpt f pre ++ post)
preOpt (num, _) pre = (filter (couldPre num . snd . snd) pre)
couldPre a b = not . M.null $ M.intersection a b
msg = unlines $ [show (i, map fst o) | (i,o)<-zip [0..] opts]
fracOpt :: [Rational] -> Integer -> [IntMap]
fracOpt fracs init = fracOpt' fracs $ facmap init
fracOpt' fracs init = eval ifs $ validateIM init where
fmaps = [(facmap $ numerator f, facmap $ denominator f) | f<-fracs]
ifs = (zip [0..] fmaps) :: [(Int, (IntMap, IntMap))]
opts = optArr fmaps
match fs n = (find (compat n . snd) fs) :: Maybe (Int, (IntMap, IntMap))
eval fs n = maybe [] (next . times' n) $ match fs n
times' n (i, f) = (i, times n f)
next (i, p) = p : (eval :: [(Int, (IntMap, IntMap))] -> IntMap -> [IntMap]) (opts ! i) p
The first half of
Fractran.hsis implementing semiring functionality for IntMap, which is a map from prime factors to exponents. Perhaps we should isolate this into into its own file for the sake of readability?Here's an old/new comparison of a function that uses the instances.