Commit 15bde6cb authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

wta: Avoid integeger overflows

64bit ints were just too small to fit the number of edges in very big graphs.
parent 3af243c5
...@@ -12,8 +12,8 @@ import Data.Coerce ...@@ -12,8 +12,8 @@ import Data.Coerce
import Data.Maybe import Data.Maybe
import Data.Foldable import Data.Foldable
import Control.Arrow ( (&&&) ) import Control.Arrow ( (&&&) )
import qualified Data.IntMap.Strict as M import qualified Data.Map.Strict as M
import qualified Data.IntSet as S import qualified Data.Set as S
import Data.Coerce import Data.Coerce
import Types hiding ( spec ) import Types hiding ( spec )
......
...@@ -11,14 +11,14 @@ import Types ...@@ -11,14 +11,14 @@ import Types
import Debug.Trace import Debug.Trace
newtype IndexedTransition = Index Int newtype IndexedTransition = Index Integer
deriving (Show) deriving (Show)
maxIndex :: WTASpec m -> IndexedTransition maxIndex :: WTASpec m -> IndexedTransition
maxIndex spec = maxIndex spec =
let n = numStates spec let n = numStates spec
(t, _) = transitionsPerState spec (t, _) = transitionsPerState spec
in Index (n * t) in Index (fromIntegral n * t)
fromIndex :: WTASpec m -> IndexedTransition -> (State, Transition ()) fromIndex :: WTASpec m -> IndexedTransition -> (State, Transition ())
fromIndex spec (Index i) = fromIndex spec (Index i) =
...@@ -47,7 +47,7 @@ fromIndex spec (Index i) = ...@@ -47,7 +47,7 @@ fromIndex spec (Index i) =
, successors = V.map State successors , successors = V.map State successors
} }
in (State state, trans) in (State (fromIntegral state), trans)
index :: WTASpec m1 -> Int -> Transition m2 -> IndexedTransition index :: WTASpec m1 -> Int -> Transition m2 -> IndexedTransition
index spec state trans = index spec state trans =
...@@ -55,10 +55,10 @@ index spec state trans = ...@@ -55,10 +55,10 @@ index spec state trans =
arity :: Int = summandArity spec (summand trans) arity :: Int = summandArity spec (summand trans)
symbolBounds :: Vector Int = V.cons (numSymbols spec V.! arity) (V.replicate arity (numStates spec)) symbolBounds :: Vector Int = V.cons (numSymbols spec V.! arity) (V.replicate arity (numStates spec))
arityIdx :: Int = encodeAsInt symbolBounds (V.cons (symbol trans) (V.map fromState $ successors trans)) arityIdx :: Integer = encodeAsInt symbolBounds (V.cons (symbol trans) (V.map fromState $ successors trans))
stateLocal :: Int = symbolSums V.! arity + arityIdx stateLocal :: Integer = symbolSums V.! arity + arityIdx
in Index $ state * t + stateLocal in Index $ (fromIntegral state) * t + stateLocal
-- Helpers -- Helpers
...@@ -70,20 +70,20 @@ aritySummand spec arity = ...@@ -70,20 +70,20 @@ aritySummand spec arity =
let arities = numSymbols spec let arities = numSymbols spec
in V.length (V.filter (/= 0) (V.take arity arities)) in V.length (V.filter (/= 0) (V.take arity arities))
transitionsPerState :: WTASpec m -> (Int, Vector Int) transitionsPerState :: WTASpec m -> (Integer, Vector Integer)
transitionsPerState spec = transitionsPerState spec =
let n = numStates spec let n = numStates spec
tPerSymbol = (V.imap (\i syms -> syms * n ^ i) (numSymbols spec)) tPerSymbol = (V.imap (\i syms -> fromIntegral $ syms * n ^ i) (numSymbols spec))
runningTotal = V.scanl' (+) 0 tPerSymbol runningTotal = V.scanl' (+) 0 tPerSymbol
in (V.last runningTotal, runningTotal) in (V.last runningTotal, runningTotal)
encodeAsInt :: Vector Int -> Vector Int -> Int encodeAsInt :: Vector Int -> Vector Int -> Integer
encodeAsInt maxBounds digits = encodeAsInt maxBounds digits =
let factors = V.prescanr' (*) 1 maxBounds let factors = V.prescanr' (*) 1 (fmap fromIntegral maxBounds)
in sum (V.zipWith (*) factors digits) in sum (V.zipWith (*) factors (fmap fromIntegral digits))
decodeFromInt :: Vector Int -> Int -> Vector Int decodeFromInt :: Vector Int -> Integer -> Vector Int
decodeFromInt maxBounds encoded = decodeFromInt maxBounds encoded =
V.map fst $ V.postscanr' doDigit (0, encoded) maxBounds V.map (fromIntegral . fst) $ V.postscanr' doDigit (0, encoded) (fmap fromIntegral maxBounds)
where doDigit bound (_, current) = (swap $ current `divMod` bound) where doDigit bound (_, current) = (swap $ current `divMod` bound)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment