{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module Text.Regex.Anagram.Test
  ( testAnagrex
  ) where

import           Control.Arrow (second)
import           Control.Monad (join)
import qualified Data.Bits as B
import           Data.Functor.Identity (runIdentity)
import qualified Data.IntMap.Strict as M
import           Data.List (mapAccumL)
import           Data.Maybe (isJust, fromJust)
import           Data.Ord (comparing)
import qualified Data.Vector as V
import           Numeric.Natural (Natural)

import Text.Regex.Anagram.Types
import Text.Regex.Anagram.Util
import Text.Regex.Anagram.Compile
import Text.Regex.Anagram.Bits

-- |All subsets of a given length (choose p)
subsets :: Int -> RLE a -> [RLE a]
subsets :: Int -> RLE a -> [RLE a]
subsets Int
size RLE a
list = ([RL a] -> RLE a) -> [[RL a]] -> [RLE a]
forall a b. (a -> b) -> [a] -> [b]
map [RL a] -> RLE a
forall (f :: * -> *) a. f (RL a) -> RLEof f a
RLE ([[RL a]] -> [RLE a]) -> [[RL a]] -> [RLE a]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [RL a] -> [[RL a]]
forall a. Int -> Int -> [RL a] -> [[RL a]]
ss Int
size (RLE a -> Int
forall a. RLE a -> Int
rleLength RLE a
list) (RLE a -> [RL a]
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLE a
list) where
  ss :: Int -> Int -> [RL a] -> [[RL a]]
ss Int
0 Int
_ [RL a]
_ = [[]]
  ss Int
n Int
s [RL a]
l = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
s of
    Ordering
GT -> []
    Ordering
EQ -> [[RL a]
l]
    Ordering
LT -> do
      let ~(RL a
x Int
r:[RL a]
m) = [RL a]
l
      Int
i <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)..Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
r]
      (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (a -> Int -> RL a
forall a. a -> Int -> RL a
RL a
x Int
i RL a -> [RL a] -> [RL a]
forall a. a -> [a] -> [a]
:) else [RL a] -> [RL a]
forall a. a -> a
id) ([RL a] -> [RL a]) -> [[RL a]] -> [[RL a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> [RL a] -> [[RL a]]
ss (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) [RL a]
m

newtype BitVec = BitVec{ BitVec -> Natural
unBitVec :: Natural }
  deriving (BitVec -> BitVec -> Bool
(BitVec -> BitVec -> Bool)
-> (BitVec -> BitVec -> Bool) -> Eq BitVec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitVec -> BitVec -> Bool
$c/= :: BitVec -> BitVec -> Bool
== :: BitVec -> BitVec -> Bool
$c== :: BitVec -> BitVec -> Bool
Eq, Eq BitVec
BitVec
Eq BitVec
-> (BitVec -> BitVec -> BitVec)
-> (BitVec -> BitVec -> BitVec)
-> (BitVec -> BitVec -> BitVec)
-> (BitVec -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> BitVec
-> (Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> Bool)
-> (BitVec -> Maybe Int)
-> (BitVec -> Int)
-> (BitVec -> Bool)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int -> BitVec)
-> (BitVec -> Int)
-> Bits BitVec
Int -> BitVec
BitVec -> Bool
BitVec -> Int
BitVec -> Maybe Int
BitVec -> BitVec
BitVec -> Int -> Bool
BitVec -> Int -> BitVec
BitVec -> BitVec -> BitVec
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: BitVec -> Int
$cpopCount :: BitVec -> Int
rotateR :: BitVec -> Int -> BitVec
$crotateR :: BitVec -> Int -> BitVec
rotateL :: BitVec -> Int -> BitVec
$crotateL :: BitVec -> Int -> BitVec
unsafeShiftR :: BitVec -> Int -> BitVec
$cunsafeShiftR :: BitVec -> Int -> BitVec
shiftR :: BitVec -> Int -> BitVec
$cshiftR :: BitVec -> Int -> BitVec
unsafeShiftL :: BitVec -> Int -> BitVec
$cunsafeShiftL :: BitVec -> Int -> BitVec
shiftL :: BitVec -> Int -> BitVec
$cshiftL :: BitVec -> Int -> BitVec
isSigned :: BitVec -> Bool
$cisSigned :: BitVec -> Bool
bitSize :: BitVec -> Int
$cbitSize :: BitVec -> Int
bitSizeMaybe :: BitVec -> Maybe Int
$cbitSizeMaybe :: BitVec -> Maybe Int
testBit :: BitVec -> Int -> Bool
$ctestBit :: BitVec -> Int -> Bool
complementBit :: BitVec -> Int -> BitVec
$ccomplementBit :: BitVec -> Int -> BitVec
clearBit :: BitVec -> Int -> BitVec
$cclearBit :: BitVec -> Int -> BitVec
setBit :: BitVec -> Int -> BitVec
$csetBit :: BitVec -> Int -> BitVec
bit :: Int -> BitVec
$cbit :: Int -> BitVec
zeroBits :: BitVec
$czeroBits :: BitVec
rotate :: BitVec -> Int -> BitVec
$crotate :: BitVec -> Int -> BitVec
shift :: BitVec -> Int -> BitVec
$cshift :: BitVec -> Int -> BitVec
complement :: BitVec -> BitVec
$ccomplement :: BitVec -> BitVec
xor :: BitVec -> BitVec -> BitVec
$cxor :: BitVec -> BitVec -> BitVec
.|. :: BitVec -> BitVec -> BitVec
$c.|. :: BitVec -> BitVec -> BitVec
.&. :: BitVec -> BitVec -> BitVec
$c.&. :: BitVec -> BitVec -> BitVec
$cp1Bits :: Eq BitVec
B.Bits, Bits BitVec
Bits BitVec -> (BitVec -> [Int]) -> FindBits BitVec
BitVec -> [Int]
forall b. Bits b -> (b -> [Int]) -> FindBits b
findBits :: BitVec -> [Int]
$cfindBits :: BitVec -> [Int]
$cp1FindBits :: Bits BitVec
FindBits, Int -> BitVec -> ShowS
[BitVec] -> ShowS
BitVec -> String
(Int -> BitVec -> ShowS)
-> (BitVec -> String) -> ([BitVec] -> ShowS) -> Show BitVec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitVec] -> ShowS
$cshowList :: [BitVec] -> ShowS
show :: BitVec -> String
$cshow :: BitVec -> String
showsPrec :: Int -> BitVec -> ShowS
$cshowsPrec :: Int -> BitVec -> ShowS
Show)

instance Semigroup BitVec where
  BitVec Natural
x <> :: BitVec -> BitVec -> BitVec
<> BitVec Natural
y = Natural -> BitVec
BitVec (Natural -> BitVec) -> Natural -> BitVec
forall a b. (a -> b) -> a -> b
$ Natural
x Natural -> Natural -> Natural
forall a. Bits a => a -> a -> a
B..|. Natural
y
instance Monoid BitVec where
  mempty :: BitVec
mempty = Natural -> BitVec
BitVec Natural
0

instance Ord BitVec where
  compare :: BitVec -> BitVec -> Ordering
compare (BitVec Natural
x) (BitVec Natural
y) = (Natural -> Int) -> Natural -> Natural -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Natural -> Int
forall a. Bits a => a -> Int
B.popCount Natural
x Natural
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Natural
x Natural
y

allBitv :: RLEV a -> BitVec
allBitv :: RLEV a -> BitVec
allBitv = Natural -> BitVec
BitVec (Natural -> BitVec) -> (RLEV a -> Natural) -> RLEV a -> BitVec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall b. (Enum b, Bits b) => Int -> b
allBits (Int -> Natural) -> (RLEV a -> Int) -> RLEV a -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (RL a) -> Int
forall a. Vector a -> Int
V.length (Vector (RL a) -> Int)
-> (RLEV a -> Vector (RL a)) -> RLEV a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLEV a -> Vector (RL a)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE

data Pat
  = Req !BitVec
  | Opt
  | Star
  deriving (Pat -> Pat -> Bool
(Pat -> Pat -> Bool) -> (Pat -> Pat -> Bool) -> Eq Pat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pat -> Pat -> Bool
$c/= :: Pat -> Pat -> Bool
== :: Pat -> Pat -> Bool
$c== :: Pat -> Pat -> Bool
Eq, Eq Pat
Eq Pat
-> (Pat -> Pat -> Ordering)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Bool)
-> (Pat -> Pat -> Pat)
-> (Pat -> Pat -> Pat)
-> Ord Pat
Pat -> Pat -> Bool
Pat -> Pat -> Ordering
Pat -> Pat -> Pat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pat -> Pat -> Pat
$cmin :: Pat -> Pat -> Pat
max :: Pat -> Pat -> Pat
$cmax :: Pat -> Pat -> Pat
>= :: Pat -> Pat -> Bool
$c>= :: Pat -> Pat -> Bool
> :: Pat -> Pat -> Bool
$c> :: Pat -> Pat -> Bool
<= :: Pat -> Pat -> Bool
$c<= :: Pat -> Pat -> Bool
< :: Pat -> Pat -> Bool
$c< :: Pat -> Pat -> Bool
compare :: Pat -> Pat -> Ordering
$ccompare :: Pat -> Pat -> Ordering
$cp1Ord :: Eq Pat
Ord, Int -> Pat -> ShowS
[Pat] -> ShowS
Pat -> String
(Int -> Pat -> ShowS)
-> (Pat -> String) -> ([Pat] -> ShowS) -> Show Pat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pat] -> ShowS
$cshowList :: [Pat] -> ShowS
show :: Pat -> String
$cshow :: Pat -> String
showsPrec :: Int -> Pat -> ShowS
$cshowsPrec :: Int -> Pat -> ShowS
Show)

-- |just a lens
class HasBitVec a where
  getBitVec :: a -> BitVec
  mapBitVec :: (BitVec -> BitVec) -> a -> a

instance HasBitVec BitVec where
  getBitVec :: BitVec -> BitVec
getBitVec = BitVec -> BitVec
forall a. a -> a
id
  mapBitVec :: (BitVec -> BitVec) -> BitVec -> BitVec
mapBitVec = (BitVec -> BitVec) -> BitVec -> BitVec
forall a. a -> a
id

instance HasBitVec (a, BitVec) where
  getBitVec :: (a, BitVec) -> BitVec
getBitVec = (a, BitVec) -> BitVec
forall a b. (a, b) -> b
snd
  mapBitVec :: (BitVec -> BitVec) -> (a, BitVec) -> (a, BitVec)
mapBitVec = (BitVec -> BitVec) -> (a, BitVec) -> (a, BitVec)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second

instance HasBitVec Pat where
  getBitVec :: Pat -> BitVec
getBitVec ~(Req BitVec
a) = BitVec
a
  mapBitVec :: (BitVec -> BitVec) -> Pat -> Pat
mapBitVec BitVec -> BitVec
f (Req BitVec
a) = BitVec -> Pat
Req (BitVec -> BitVec
f BitVec
a)
  mapBitVec BitVec -> BitVec
_ Pat
p = Pat
p

instance HasBitVec a => HasBitVec (RL a) where
  getBitVec :: RL a -> BitVec
getBitVec = a -> BitVec
forall a. HasBitVec a => a -> BitVec
getBitVec (a -> BitVec) -> (RL a -> a) -> RL a -> BitVec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL a -> a
forall a. RL a -> a
unRL
  mapBitVec :: (BitVec -> BitVec) -> RL a -> RL a
mapBitVec BitVec -> BitVec
f = (a -> a) -> RL a -> RL a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BitVec -> BitVec) -> a -> a
forall a. HasBitVec a => (BitVec -> BitVec) -> a -> a
mapBitVec BitVec -> BitVec
f)

transpose' :: (HasBitVec a, HasBitVec b) => RLEV a -> RLEV b -> RLEV b
transpose' :: RLEV a -> RLEV b -> RLEV b
transpose' (RLE Vector (RL a)
al) (RLE Vector (RL b)
bl) =
  (Vector (RL b) -> RLEV b
forall (f :: * -> *) a. f (RL a) -> RLEof f a
RLE (Vector (RL b) -> RLEV b) -> Vector (RL b) -> RLEV b
forall a b. (a -> b) -> a -> b
$ (Int -> RL b -> RL b) -> Vector (RL b) -> Vector (RL b)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap ((b -> b) -> RL b -> RL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b) -> RL b -> RL b)
-> (Int -> b -> b) -> Int -> RL b -> RL b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> b
forall a. HasBitVec a => Int -> a -> a
tp) Vector (RL b)
bl)
  where
  tp :: Int -> a -> a
tp Int
i = (BitVec -> BitVec) -> a -> a
forall a. HasBitVec a => (BitVec -> BitVec) -> a -> a
mapBitVec ((BitVec -> BitVec) -> a -> a) -> (BitVec -> BitVec) -> a -> a
forall a b. (a -> b) -> a -> b
$ BitVec -> BitVec -> BitVec
forall a b. a -> b -> a
const (BitVec -> BitVec -> BitVec) -> BitVec -> BitVec -> BitVec
forall a b. (a -> b) -> a -> b
$ (BitVec -> Int -> RL a -> BitVec)
-> BitVec -> Vector (RL a) -> BitVec
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl' (\BitVec
y Int
j RL a
v -> if BitVec -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit (RL a -> BitVec
forall a. HasBitVec a => a -> BitVec
getBitVec RL a
v) Int
i then BitVec -> Int -> BitVec
forall a. Bits a => a -> Int -> a
B.setBit BitVec
y Int
j else BitVec
y) BitVec
forall a. Monoid a => a
mempty Vector (RL a)
al

data Matrix a b = Matrix
  { Matrix a b -> RLEV a
matCols :: !(RLEV a)
  , Matrix a b -> RLEV b
matRows :: !(RLEV b)
  } deriving (Int -> Matrix a b -> ShowS
[Matrix a b] -> ShowS
Matrix a b -> String
(Int -> Matrix a b -> ShowS)
-> (Matrix a b -> String)
-> ([Matrix a b] -> ShowS)
-> Show (Matrix a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Matrix a b -> ShowS
forall a b. (Show a, Show b) => [Matrix a b] -> ShowS
forall a b. (Show a, Show b) => Matrix a b -> String
showList :: [Matrix a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Matrix a b] -> ShowS
show :: Matrix a b -> String
$cshow :: forall a b. (Show a, Show b) => Matrix a b -> String
showsPrec :: Int -> Matrix a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Matrix a b -> ShowS
Show)

transpose :: Matrix a b -> Matrix b a
transpose :: Matrix a b -> Matrix b a
transpose (Matrix RLEV a
a RLEV b
b) = RLEV b -> RLEV a -> Matrix b a
forall a b. RLEV a -> RLEV b -> Matrix a b
Matrix RLEV b
b RLEV a
a

data PatMatrix = PatMatrix
  { PatMatrix -> Matrix BitVec Pat
patMatrix :: !(Matrix BitVec Pat)
  , PatMatrix -> Maybe Int
patMatReq :: !(Maybe Int)
  } deriving (Int -> PatMatrix -> ShowS
[PatMatrix] -> ShowS
PatMatrix -> String
(Int -> PatMatrix -> ShowS)
-> (PatMatrix -> String)
-> ([PatMatrix] -> ShowS)
-> Show PatMatrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatMatrix] -> ShowS
$cshowList :: [PatMatrix] -> ShowS
show :: PatMatrix -> String
$cshow :: PatMatrix -> String
showsPrec :: Int -> PatMatrix -> ShowS
$cshowsPrec :: Int -> PatMatrix -> ShowS
Show)

initMatrix :: PatCharsOf RLE -> ChrStr -> Maybe PatMatrix
initMatrix :: PatCharsOf RLE -> ChrStr -> Maybe PatMatrix
initMatrix PatChars{PatChar
RLE PatChar
patStar :: forall (f :: * -> *). PatCharsOf f -> PatChar
patOpts :: forall (f :: * -> *). PatCharsOf f -> f PatChar
patReqs :: forall (f :: * -> *). PatCharsOf f -> f PatChar
patStar :: PatChar
patOpts :: RLE PatChar
patReqs :: RLE PatChar
..} ChrStr
cs =
  Bool -> PatMatrix -> Maybe PatMatrix
forall (m :: * -> *) a. Alternative m => Bool -> a -> m a
guard' ((RL BitVec -> Bool) -> [RL BitVec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((BitVec
forall a. Monoid a => a
mempty BitVec -> BitVec -> Bool
forall a. Eq a => a -> a -> Bool
/=) (BitVec -> Bool) -> (RL BitVec -> BitVec) -> RL BitVec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL BitVec -> BitVec
forall a. RL a -> a
unRL) ([RL BitVec] -> Bool) -> [RL BitVec] -> Bool
forall a b. (a -> b) -> a -> b
$ RLEof [] BitVec -> [RL BitVec]
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEof [] BitVec
reqv) (PatMatrix -> Maybe PatMatrix) -> PatMatrix -> Maybe PatMatrix
forall a b. (a -> b) -> a -> b
$
    Matrix BitVec Pat -> Maybe Int -> PatMatrix
PatMatrix (RLEV BitVec -> RLEV Pat -> Matrix BitVec Pat
forall a b. RLEV a -> RLEV b -> Matrix a b
Matrix (RLEV (Pat, BitVec) -> RLEV BitVec -> RLEV BitVec
forall a b.
(HasBitVec a, HasBitVec b) =>
RLEV a -> RLEV b -> RLEV b
transpose' RLEV (Pat, BitVec)
pv (RLEV BitVec -> RLEV BitVec) -> RLEV BitVec -> RLEV BitVec
forall a b. (a -> b) -> a -> b
$ BitVec
forall a. Monoid a => a
mempty BitVec -> RLEof Vector Int -> RLEV BitVec
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RLEof Vector Int
cv) (((Pat, BitVec) -> Pat) -> RLEV (Pat, BitVec) -> RLEV Pat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pat, BitVec) -> Pat
forall a b. (a, b) -> a
fst RLEV (Pat, BitVec)
pv)) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [RL (Pat, BitVec)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RL (Pat, BitVec)] -> Int) -> [RL (Pat, BitVec)] -> Int
forall a b. (a -> b) -> a -> b
$ RLEof [] (Pat, BitVec) -> [RL (Pat, BitVec)]
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEof [] (Pat, BitVec)
reqs)
  where
  cv :: RLEof Vector Int
cv = ([RL Int] -> Vector (RL Int)) -> RLEof [] Int -> RLEof Vector Int
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE [RL Int] -> Vector (RL Int)
forall a. [a] -> Vector a
V.fromList (RLEof [] Int -> RLEof Vector Int)
-> RLEof [] Int -> RLEof Vector Int
forall a b. (a -> b) -> a -> b
$ ChrStr -> RLEof [] Int
chrStrRLE ChrStr
cs
  si :: ChrStr
si = [(Int, Int)] -> ChrStr
forall a. [(Int, a)] -> IntMap a
M.fromAscList ([(Int, Int)] -> ChrStr) -> [(Int, Int)] -> ChrStr
forall a b. (a -> b) -> a -> b
$ Vector (Int, Int) -> [(Int, Int)]
forall a. Vector a -> [a]
V.toList (Vector (Int, Int) -> [(Int, Int)])
-> Vector (Int, Int) -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> RL Int -> (Int, Int))
-> Vector (RL Int) -> Vector (Int, Int)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (RL Int
c Int
_) -> (Int
c,Int
i)) (Vector (RL Int) -> Vector (Int, Int))
-> Vector (RL Int) -> Vector (Int, Int)
forall a b. (a -> b) -> a -> b
$ RLEof Vector Int -> Vector (RL Int)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEof Vector Int
cv
  pv :: RLEV (Pat, BitVec)
pv = ([RL (Pat, BitVec)] -> Vector (RL (Pat, BitVec)))
-> RLEof [] (Pat, BitVec) -> RLEV (Pat, BitVec)
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE [RL (Pat, BitVec)] -> Vector (RL (Pat, BitVec))
forall a. [a] -> Vector a
V.fromList (RLEof [] (Pat, BitVec) -> RLEV (Pat, BitVec))
-> RLEof [] (Pat, BitVec) -> RLEV (Pat, BitVec)
forall a b. (a -> b) -> a -> b
$ RLEof [] (Pat, BitVec)
reqs RLEof [] (Pat, BitVec)
-> RLEof [] (Pat, BitVec) -> RLEof [] (Pat, BitVec)
forall a. Semigroup a => a -> a -> a
<> RLEof [] (Pat, BitVec)
opts RLEof [] (Pat, BitVec)
-> RLEof [] (Pat, BitVec) -> RLEof [] (Pat, BitVec)
forall a. Semigroup a => a -> a -> a
<> RLEof [] (Pat, BitVec)
stars
  reqv :: RLEof [] BitVec
reqv =                         (PatChar -> BitVec) -> RLE PatChar -> RLEof [] BitVec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatChar -> BitVec
vp RLE PatChar
patReqs
  optv :: RLEof [] BitVec
optv = (BitVec -> Bool) -> RLEof [] BitVec -> RLEof [] BitVec
forall a. (a -> Bool) -> RLE a -> RLE a
filterRLE (BitVec
forall a. Monoid a => a
mempty BitVec -> BitVec -> Bool
forall a. Eq a => a -> a -> Bool
/=) (RLEof [] BitVec -> RLEof [] BitVec)
-> RLEof [] BitVec -> RLEof [] BitVec
forall a b. (a -> b) -> a -> b
$ (PatChar -> BitVec) -> RLE PatChar -> RLEof [] BitVec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatChar -> BitVec
vp RLE PatChar
patOpts
  reqs :: RLEof [] (Pat, BitVec)
reqs = (BitVec -> (Pat, BitVec))
-> RLEof [] BitVec -> RLEof [] (Pat, BitVec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BitVec -> BitVec -> (Pat, BitVec)) -> BitVec -> (Pat, BitVec)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((,) (Pat -> BitVec -> (Pat, BitVec))
-> (BitVec -> Pat) -> BitVec -> BitVec -> (Pat, BitVec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVec -> Pat
Req)) (RLEof [] BitVec -> RLEof [] (Pat, BitVec))
-> RLEof [] BitVec -> RLEof [] (Pat, BitVec)
forall a b. (a -> b) -> a -> b
$ RLEof [] BitVec -> RLEof [] BitVec
forall a. Ord a => RLE a -> RLE a
sortRLE RLEof [] BitVec
reqv
  opts :: RLEof [] (Pat, BitVec)
opts = (BitVec -> (Pat, BitVec))
-> RLEof [] BitVec -> RLEof [] (Pat, BitVec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap       ((,)   Pat
Opt)  (RLEof [] BitVec -> RLEof [] (Pat, BitVec))
-> RLEof [] BitVec -> RLEof [] (Pat, BitVec)
forall a b. (a -> b) -> a -> b
$ RLEof [] BitVec -> RLEof [] BitVec
forall a. Ord a => RLE a -> RLE a
sortRLE RLEof [] BitVec
optv
  stars :: RLEof [] (Pat, BitVec)
stars
    | PatChar -> Bool
nullChar PatChar
patStar Bool -> Bool -> Bool
|| BitVec
vps BitVec -> BitVec -> Bool
forall a. Eq a => a -> a -> Bool
== BitVec
forall a. Monoid a => a
mempty = [RL (Pat, BitVec)] -> RLEof [] (Pat, BitVec)
forall (f :: * -> *) a. f (RL a) -> RLEof f a
RLE []
    | Bool
otherwise = [RL (Pat, BitVec)] -> RLEof [] (Pat, BitVec)
forall (f :: * -> *) a. f (RL a) -> RLEof f a
RLE [(Pat, BitVec) -> Int -> RL (Pat, BitVec)
forall a. a -> Int -> RL a
RL (Pat
Star, BitVec
vps) (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
B.unsafeShiftR Int
forall a. Bounded a => a
maxBound Int
1)]
    where vps :: BitVec
vps = PatChar -> BitVec
vp PatChar
patStar
  vp :: PatChar -> BitVec
vp (PatChr Int
c) = BitVec -> (Int -> BitVec) -> Maybe Int -> BitVec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BitVec
forall a. Monoid a => a
mempty Int -> BitVec
forall a. Bits a => Int -> a
B.bit (Maybe Int -> BitVec) -> Maybe Int -> BitVec
forall a b. (a -> b) -> a -> b
$ Int -> ChrStr -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
c ChrStr
si
  vp (PatSet ChrSet
s) = (BitVec -> Int -> BitVec) -> BitVec -> ChrStr -> BitVec
forall a b. (a -> b -> a) -> a -> IntMap b -> a
M.foldl' BitVec -> Int -> BitVec
forall a. Bits a => a -> Int -> a
B.setBit   BitVec
forall a. Monoid a => a
mempty       (ChrStr -> BitVec) -> ChrStr -> BitVec
forall a b. (a -> b) -> a -> b
$ ChrStr -> ChrSet -> ChrStr
forall a. IntMap a -> ChrSet -> IntMap a
M.restrictKeys ChrStr
si ChrSet
s
  vp (PatNot ChrSet
n) = (BitVec -> Int -> BitVec) -> BitVec -> ChrStr -> BitVec
forall a b. (a -> b -> a) -> a -> IntMap b -> a
M.foldl' BitVec -> Int -> BitVec
forall a. Bits a => a -> Int -> a
B.clearBit (RLEof Vector Int -> BitVec
forall a. RLEV a -> BitVec
allBitv RLEof Vector Int
cv) (ChrStr -> BitVec) -> ChrStr -> BitVec
forall a b. (a -> b) -> a -> b
$ ChrStr -> ChrSet -> ChrStr
forall a. IntMap a -> ChrSet -> IntMap a
M.restrictKeys ChrStr
si ChrSet
n
    -- M.foldl' B.setBit mempty $ M.withoutKeys si n

decrRows :: (HasBitVec a, HasBitVec b) => Int -> Matrix a b -> RLE (Int, RL b) -> Matrix a b
decrRows :: Int -> Matrix a b -> RLE (Int, RL b) -> Matrix a b
decrRows Int
i (Matrix RLEV a
cm RLEV b
rm) RLE (Int, RL b)
l = Matrix :: forall a b. RLEV a -> RLEV b -> Matrix a b
Matrix
  { matCols :: RLEV a
matCols = (Vector (RL a) -> Vector (RL a)) -> RLEV a -> RLEV a
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE ((RL a -> RL a) -> Vector (RL a) -> Vector (RL a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((BitVec -> BitVec) -> RL a -> RL a
forall a. HasBitVec a => (BitVec -> BitVec) -> a -> a
mapBitVec (BitVec
m BitVec -> BitVec -> BitVec
forall a. Bits a => a -> a -> a
B..&.))) RLEV a
cm
  , matRows :: RLEV b
matRows = (Vector (RL b) -> Vector (RL b)) -> RLEV b -> RLEV b
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE (Vector (RL b) -> [(Int, RL b)] -> Vector (RL b)
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int, RL b)]
u) RLEV b
rm
  }
  where
  (BitVec
m, [(Int, RL b)]
u) = (BitVec -> RL (Int, RL b) -> (BitVec, (Int, RL b)))
-> BitVec -> [RL (Int, RL b)] -> (BitVec, [(Int, RL b)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\BitVec
x (RL (Int
j, RL b
jp Int
jr) Int
r) -> if Int
jr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
      then (BitVec -> Int -> BitVec
forall a. Bits a => a -> Int -> a
B.clearBit BitVec
x Int
j, (Int
j, b -> Int -> RL b
forall a. a -> Int -> RL a
RL ((BitVec -> BitVec) -> b -> b
forall a. HasBitVec a => (BitVec -> BitVec) -> a -> a
mapBitVec (BitVec -> BitVec -> BitVec
forall a b. a -> b -> a
const BitVec
forall a. Monoid a => a
mempty)   b
jp) Int
0))
      else (           BitVec
x,   (Int
j, b -> Int -> RL b
forall a. a -> Int -> RL a
RL ((BitVec -> BitVec) -> b -> b
forall a. HasBitVec a => (BitVec -> BitVec) -> a -> a
mapBitVec (BitVec -> Int -> BitVec
forall a. Bits a => a -> Int -> a
`B.clearBit` Int
i) b
jp) (Int
jr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r))))
    (RLEV b -> BitVec
forall a. RLEV a -> BitVec
allBitv RLEV b
rm) ([RL (Int, RL b)] -> (BitVec, [(Int, RL b)]))
-> [RL (Int, RL b)] -> (BitVec, [(Int, RL b)])
forall a b. (a -> b) -> a -> b
$ RLE (Int, RL b) -> [RL (Int, RL b)]
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLE (Int, RL b)
l

tryCol :: (HasBitVec a, HasBitVec b) => Int -> RL a -> Matrix a b -> [Matrix a b]
tryCol :: Int -> RL a -> Matrix a b -> [Matrix a b]
tryCol Int
i RL a
iv Matrix a b
m = (RLE (Int, RL b) -> Matrix a b)
-> [RLE (Int, RL b)] -> [Matrix a b]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Matrix a b -> RLE (Int, RL b) -> Matrix a b
forall a b.
(HasBitVec a, HasBitVec b) =>
Int -> Matrix a b -> RLE (Int, RL b) -> Matrix a b
decrRows Int
i Matrix a b
m')
  ([RLE (Int, RL b)] -> [Matrix a b])
-> [RLE (Int, RL b)] -> [Matrix a b]
forall a b. (a -> b) -> a -> b
$ Int -> RLE (Int, RL b) -> [RLE (Int, RL b)]
forall a. Int -> RLE a -> [RLE a]
subsets (RL a -> Int
forall a. RL a -> Int
rl RL a
iv)
    (RLE (Int, RL b) -> [RLE (Int, RL b)])
-> RLE (Int, RL b) -> [RLE (Int, RL b)]
forall a b. (a -> b) -> a -> b
$ [RL (Int, RL b)] -> RLE (Int, RL b)
forall (f :: * -> *) a. f (RL a) -> RLEof f a
RLE ([RL (Int, RL b)] -> RLE (Int, RL b))
-> [RL (Int, RL b)] -> RLE (Int, RL b)
forall a b. (a -> b) -> a -> b
$ (Int -> RL (Int, RL b)) -> [Int] -> [RL (Int, RL b)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
j ->
      let jr :: RL b
jr = Vector (RL b) -> Int -> RL b
forall a. Vector a -> Int -> a
V.unsafeIndex (RLEof Vector b -> Vector (RL b)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE (RLEof Vector b -> Vector (RL b))
-> RLEof Vector b -> Vector (RL b)
forall a b. (a -> b) -> a -> b
$ Matrix a b -> RLEof Vector b
forall a b. Matrix a b -> RLEV b
matRows Matrix a b
m) Int
j in
      (Int, RL b) -> Int -> RL (Int, RL b)
forall a. a -> Int -> RL a
RL (Int
j, RL b
jr) (RL b -> Int
forall a. RL a -> Int
rl RL b
jr))
    ([Int] -> [RL (Int, RL b)]) -> [Int] -> [RL (Int, RL b)]
forall a b. (a -> b) -> a -> b
$ BitVec -> [Int]
forall b. FindBits b => b -> [Int]
findBits (BitVec -> [Int]) -> BitVec -> [Int]
forall a b. (a -> b) -> a -> b
$ RL a -> BitVec
forall a. HasBitVec a => a -> BitVec
getBitVec RL a
iv
  where
  m' :: Matrix a b
m' = Matrix a b
m{ matCols :: RLEV a
matCols = (Vector (RL a) -> Vector (RL a)) -> RLEV a -> RLEV a
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE (Vector (RL a) -> [(Int, RL a)] -> Vector (RL a)
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
i, RL a
iv{ rl :: Int
rl = Int
0 })]) (RLEV a -> RLEV a) -> RLEV a -> RLEV a
forall a b. (a -> b) -> a -> b
$ Matrix a b -> RLEV a
forall a b. Matrix a b -> RLEV a
matCols Matrix a b
m }

tryPat :: Int -> RL Pat    -> PatMatrix -> [PatMatrix]
tryChr :: Int -> RL BitVec -> PatMatrix -> [PatMatrix]
tryPat :: Int -> RL Pat -> PatMatrix -> [PatMatrix]
tryPat Int
i RL Pat
iv PatMatrix
pm = (Matrix Pat BitVec -> PatMatrix)
-> [Matrix Pat BitVec] -> [PatMatrix]
forall a b. (a -> b) -> [a] -> [b]
map (\Matrix Pat BitVec
m -> PatMatrix
pm{ patMatrix :: Matrix BitVec Pat
patMatrix = Matrix Pat BitVec -> Matrix BitVec Pat
forall a b. Matrix a b -> Matrix b a
transpose Matrix Pat BitVec
m }) ([Matrix Pat BitVec] -> [PatMatrix])
-> [Matrix Pat BitVec] -> [PatMatrix]
forall a b. (a -> b) -> a -> b
$ Int -> RL Pat -> Matrix Pat BitVec -> [Matrix Pat BitVec]
forall a b.
(HasBitVec a, HasBitVec b) =>
Int -> RL a -> Matrix a b -> [Matrix a b]
tryCol Int
i RL Pat
iv (Matrix Pat BitVec -> [Matrix Pat BitVec])
-> Matrix Pat BitVec -> [Matrix Pat BitVec]
forall a b. (a -> b) -> a -> b
$ Matrix BitVec Pat -> Matrix Pat BitVec
forall a b. Matrix a b -> Matrix b a
transpose (Matrix BitVec Pat -> Matrix Pat BitVec)
-> Matrix BitVec Pat -> Matrix Pat BitVec
forall a b. (a -> b) -> a -> b
$ PatMatrix -> Matrix BitVec Pat
patMatrix PatMatrix
pm
tryChr :: Int -> RL BitVec -> PatMatrix -> [PatMatrix]
tryChr Int
i RL BitVec
iv PatMatrix
pm = (Matrix BitVec Pat -> PatMatrix)
-> [Matrix BitVec Pat] -> [PatMatrix]
forall a b. (a -> b) -> [a] -> [b]
map (\Matrix BitVec Pat
m -> PatMatrix
pm{ patMatrix :: Matrix BitVec Pat
patMatrix = Matrix BitVec Pat
m })           ([Matrix BitVec Pat] -> [PatMatrix])
-> [Matrix BitVec Pat] -> [PatMatrix]
forall a b. (a -> b) -> a -> b
$ Int -> RL BitVec -> Matrix BitVec Pat -> [Matrix BitVec Pat]
forall a b.
(HasBitVec a, HasBitVec b) =>
Int -> RL a -> Matrix a b -> [Matrix a b]
tryCol Int
i RL BitVec
iv             (Matrix BitVec Pat -> [Matrix BitVec Pat])
-> Matrix BitVec Pat -> [Matrix BitVec Pat]
forall a b. (a -> b) -> a -> b
$ PatMatrix -> Matrix BitVec Pat
patMatrix PatMatrix
pm

prio :: HasBitVec a => RL a -> RL a -> Ordering
prio :: RL a -> RL a -> Ordering
prio (RL a
_ Int
0) (RL a
_ Int
0) = Ordering
EQ
prio (RL a
_ Int
0) RL a
_        = Ordering
GT
prio RL a
_        (RL a
_ Int
0) = Ordering
LT
prio (RL a
a Int
r) (RL a
b Int
s) = (a -> Int) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (BitVec -> Int
forall a. Bits a => a -> Int
B.popCount (BitVec -> Int) -> (a -> BitVec) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BitVec
forall a. HasBitVec a => a -> BitVec
getBitVec) a
a a
b Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
s Int
r

doneReq :: PatMatrix -> [PatMatrix]
doneReq :: PatMatrix -> [PatMatrix]
doneReq (PatMatrix m :: Matrix BitVec Pat
m@(Matrix RLEV BitVec
cm RLEV Pat
pm) ~(Just Int
pr))
  | RL Pat
Star Int
_ <- Vector (RL Pat) -> RL Pat
forall a. Vector a -> a
V.last (RLEV Pat -> Vector (RL Pat)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEV Pat
pm) = Int -> Matrix BitVec Pat -> [PatMatrix]
next Int
j (Matrix BitVec Pat -> [PatMatrix])
-> Matrix BitVec Pat -> [PatMatrix]
forall a b. (a -> b) -> a -> b
$ RLEV BitVec -> RLEV Pat -> Matrix BitVec Pat
forall a b. RLEV a -> RLEV b -> Matrix a b
Matrix
    ((Vector (RL BitVec) -> Vector (RL BitVec))
-> RLEV BitVec -> RLEV BitVec
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE ((RL BitVec -> RL BitVec)
-> Vector (RL BitVec) -> Vector (RL BitVec)
forall a b. (a -> b) -> Vector a -> Vector b
V.map RL BitVec -> RL BitVec
forall a. (Bits a, Monoid a) => RL a -> RL a
ts) RLEV BitVec
cm)
    ((Vector (RL Pat) -> Vector (RL Pat)) -> RLEV Pat -> RLEV Pat
forall (f :: * -> *) a (g :: * -> *) b.
(f (RL a) -> g (RL b)) -> RLEof f a -> RLEof g b
withRLE Vector (RL Pat) -> Vector (RL Pat)
forall a. Vector a -> Vector a
V.init RLEV Pat
pm)
  | Bool
otherwise = Int -> Matrix BitVec Pat -> [PatMatrix]
next (Int -> Int
forall a. Enum a => a -> a
succ Int
j) Matrix BitVec Pat
m
  where
  next :: Int -> Matrix BitVec Pat -> [PatMatrix]
next Int
j' Matrix BitVec Pat
m' = (if Int
pr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
j' then PatMatrix -> [PatMatrix]
forall (m :: * -> *) a. Monad m => a -> m a
return else PatMatrix -> [PatMatrix]
tryMatrix) (PatMatrix -> [PatMatrix]) -> PatMatrix -> [PatMatrix]
forall a b. (a -> b) -> a -> b
$ Matrix BitVec Pat -> Maybe Int -> PatMatrix
PatMatrix Matrix BitVec Pat
m' Maybe Int
forall a. Maybe a
Nothing
  ts :: RL a -> RL a
ts v :: RL a
v@(RL a
x Int
_)
    | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit a
x Int
j = a -> Int -> RL a
forall a. a -> Int -> RL a
RL a
forall a. Monoid a => a
mempty Int
0
    | Bool
otherwise = RL a
v
  j :: Int
j = Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Vector (RL Pat) -> Int
forall a. Vector a -> Int
V.length (Vector (RL Pat) -> Int) -> Vector (RL Pat) -> Int
forall a b. (a -> b) -> a -> b
$ RLEV Pat -> Vector (RL Pat)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEV Pat
pm

tryMatrix :: PatMatrix -> [PatMatrix]
tryMatrix :: PatMatrix -> [PatMatrix]
tryMatrix m :: PatMatrix
m@(PatMatrix (Matrix RLEV BitVec
cm RLEV Pat
pm) Maybe Int
pr)
  | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
pr Bool -> Bool -> Bool
&& (Maybe Int
pr Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 Bool -> Bool -> Bool
|| Int
jr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) = PatMatrix -> [PatMatrix]
doneReq PatMatrix
m
  | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
pr Bool -> Bool -> Bool
&& (BitVec -> Int
forall a. Bits a => a -> Int
B.popCount BitVec
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
|| BitVec -> Int
forall a. Bits a => a -> Int
B.popCount BitVec
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) =
    PatMatrix -> [PatMatrix]
tryMatrix (PatMatrix -> [PatMatrix]) -> [PatMatrix] -> [PatMatrix]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> RL Pat -> PatMatrix -> [PatMatrix]
tryPat Int
j RL Pat
jv PatMatrix
m
  | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
pr Bool -> Bool -> Bool
&& Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
  |              Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [PatMatrix
m]
  | BitVec
x BitVec -> BitVec -> Bool
forall a. Eq a => a -> a -> Bool
== BitVec
forall a. Monoid a => a
mempty = []
  | Bool
otherwise =
    PatMatrix -> [PatMatrix]
tryMatrix (PatMatrix -> [PatMatrix]) -> [PatMatrix] -> [PatMatrix]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> RL BitVec -> PatMatrix -> [PatMatrix]
tryChr Int
i RL BitVec
iv PatMatrix
m
  where
  i :: Int
i = (RL BitVec -> RL BitVec -> Ordering) -> Vector (RL BitVec) -> Int
forall a. (a -> a -> Ordering) -> Vector a -> Int
V.minIndexBy RL BitVec -> RL BitVec -> Ordering
forall a. HasBitVec a => RL a -> RL a -> Ordering
prio (Vector (RL BitVec) -> Int) -> Vector (RL BitVec) -> Int
forall a b. (a -> b) -> a -> b
$                        RLEV BitVec -> Vector (RL BitVec)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEV BitVec
cm
  j :: Int
j = (RL Pat -> RL Pat -> Ordering) -> Vector (RL Pat) -> Int
forall a. (a -> a -> Ordering) -> Vector a -> Int
V.minIndexBy RL Pat -> RL Pat -> Ordering
forall a. HasBitVec a => RL a -> RL a -> Ordering
prio (Vector (RL Pat) -> Int) -> Vector (RL Pat) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Vector (RL Pat) -> Vector (RL Pat)
forall a. Int -> Vector a -> Vector a
V.take (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
pr) (Vector (RL Pat) -> Vector (RL Pat))
-> Vector (RL Pat) -> Vector (RL Pat)
forall a b. (a -> b) -> a -> b
$ RLEV Pat -> Vector (RL Pat)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEV Pat
pm
  iv :: RL BitVec
iv@(RL       BitVec
x  Int
ir) = Vector (RL BitVec) -> Int -> RL BitVec
forall a. Vector a -> Int -> a
V.unsafeIndex (RLEV BitVec -> Vector (RL BitVec)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEV BitVec
cm) Int
i
  jv :: RL Pat
jv@(RL ~(Req BitVec
y) Int
jr) = Vector (RL Pat) -> Int -> RL Pat
forall a. Vector a -> Int -> a
V.unsafeIndex (RLEV Pat -> Vector (RL Pat)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE RLEV Pat
pm) Int
j

testPat :: Int -> ChrStr -> AnaPat -> Bool
testPat :: Int -> ChrStr -> AnaPat -> Bool
testPat Int
l ChrStr
s AnaPat{ Int
PatChars
PatCharsOf Identity
PatCharsOf RLE
Inf Int
patMax :: AnaPat -> Inf Int
patMin :: AnaPat -> Int
patSets :: AnaPat -> PatCharsOf Identity
patChars :: AnaPat -> PatCharsOf RLE
patUncompiled :: AnaPat -> PatChars
patMax :: Inf Int
patMin :: Int
patSets :: PatCharsOf Identity
patChars :: PatCharsOf RLE
patUncompiled :: PatChars
.. }
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
patMin = Bool
False
  | Int -> Inf Int
forall a. a -> Inf a
Fin Int
l Inf Int -> Inf Int -> Bool
forall a. Ord a => a -> a -> Bool
> Inf Int
patMax = Bool
False
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PatChar -> ChrStr -> Bool
allChrs (PatCharsOf Identity -> PatChar
forall (f :: * -> *). PatCharsOf f -> PatChar
patStar PatCharsOf Identity
patSets) ChrStr
s = Bool
False
  | ChrStr -> Bool
forall a. IntMap a -> Bool
M.null ChrStr
s' = [RL PatChar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([RL PatChar] -> Bool) -> [RL PatChar] -> Bool
forall a b. (a -> b) -> a -> b
$ RLE PatChar -> [RL PatChar]
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE (RLE PatChar -> [RL PatChar]) -> RLE PatChar -> [RL PatChar]
forall a b. (a -> b) -> a -> b
$ PatCharsOf RLE -> RLE PatChar
forall (f :: * -> *). PatCharsOf f -> f PatChar
patReqs PatCharsOf RLE
patChars
  | Bool
otherwise = Bool -> (PatMatrix -> Bool) -> Maybe PatMatrix -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False
    ((PatMatrix -> Bool) -> [PatMatrix] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((RL BitVec -> Bool) -> Vector (RL BitVec) -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all ((Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool) -> (RL BitVec -> Int) -> RL BitVec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL BitVec -> Int
forall a. RL a -> Int
rl) (Vector (RL BitVec) -> Bool)
-> (PatMatrix -> Vector (RL BitVec)) -> PatMatrix -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLEV BitVec -> Vector (RL BitVec)
forall (f :: * -> *) a. RLEof f a -> f (RL a)
unRLE (RLEV BitVec -> Vector (RL BitVec))
-> (PatMatrix -> RLEV BitVec) -> PatMatrix -> Vector (RL BitVec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix BitVec Pat -> RLEV BitVec
forall a b. Matrix a b -> RLEV a
matCols (Matrix BitVec Pat -> RLEV BitVec)
-> (PatMatrix -> Matrix BitVec Pat) -> PatMatrix -> RLEV BitVec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatMatrix -> Matrix BitVec Pat
patMatrix)
      ([PatMatrix] -> Bool)
-> (PatMatrix -> [PatMatrix]) -> PatMatrix -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatMatrix -> [PatMatrix]
tryMatrix) (Maybe PatMatrix -> Bool) -> Maybe PatMatrix -> Bool
forall a b. (a -> b) -> a -> b
$ PatCharsOf RLE -> ChrStr -> Maybe PatMatrix
initMatrix PatCharsOf RLE
patChars ChrStr
s'
  where
  s' :: ChrStr
s' = PatChar -> ChrStr -> ChrStr
intersectChrStr (Identity PatChar -> PatChar
forall a. Identity a -> a
runIdentity (Identity PatChar -> PatChar) -> Identity PatChar -> PatChar
forall a b. (a -> b) -> a -> b
$ PatCharsOf Identity -> Identity PatChar
forall (f :: * -> *). PatCharsOf f -> f PatChar
patOpts PatCharsOf Identity
patSets) ChrStr
s

-- |Check if any permutations of a string matches a parsed regular expression.  Always matches the full string.
testAnagrex :: Anagrex -> String -> Bool
testAnagrex :: Anagrex -> String -> Bool
testAnagrex (Anagrex [AnaPat]
l) String
s = (AnaPat -> Bool) -> [AnaPat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> ChrStr -> AnaPat -> Bool
testPat (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (ChrStr -> AnaPat -> Bool) -> ChrStr -> AnaPat -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> ChrStr
chrStr ([Int] -> ChrStr) -> [Int] -> ChrStr
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
forall a. Enum a => a -> Int
fromEnum String
s) [AnaPat]
l