Improve combinations algorithm speed

src/Dodge/Combine.hs

@@ -1,4 +1,4 @@
---{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections #-}
 module Dodge.Combine 
     ( combinePoss
     , combineSizes
@@ -18,20 +18,36 @@ import Control.Lens
 import Data.Bifunctor
 import qualified Data.IntMap.Strict as IM
 --import qualified Data.IntSet as IS
---import qualified Data.Map.Strict as M
+import qualified Data.Map.Strict as M
 import Data.Maybe
-import Data.List (sort,scanl')
+import Data.List (sort,scanl',sortOn)
 
-combinationsTrie :: Trie CombineType Item
+combinationsTrie :: Trie (Int,CombineType) Item
 combinationsTrie = foldr (uncurry insertInTrie) emptyTrie
-    $ map (first sort) itemCombinations
+    $ map (first (sortOn snd)) itemCombinations
 
-lookupTypeTrie :: [CombineType] -> Maybe Item
-lookupTypeTrie = flip lookupTrie combinationsTrie . sort
+lookupTypeTrie :: [(CombineType,Int,Int)] -> Maybe ([Int],Item)
+lookupTypeTrie = undefined
+
+lookupItems' :: [(CombineType,Int,Int)] -> [ ([Int],Item) ]
+lookupItems' xs = lookupItems (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie
+
+lookupItems :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ]
+lookupItems [] t = maybeToList $ fmap ([],) $ _trieMVal t
+lookupItems ((ct,i,n):xs) t = do
+    n' <- [1..min n 4]
+    let is = replicate n' i
+    concatMap (map (first (is ++)) . lookupItems xs) $ maybeToList (_trieChildren t M.!? (n',ct))
+
+--lookupTypeTrie' :: [CombineType] -> Maybe Item
+--lookupTypeTrie' = flip lookupTrie combinationsTrie . sort
 
 combineItemList :: IM.IntMap Item -> [([Int],Item)]
-combineItemList = mapMaybe (pushOutMaybe . second lookupTypeTrie)
-    . listCombos
+combineItemList = undefined
+
+--combineItemList :: IM.IntMap Item -> [([Int],Item)]
+--combineItemList = mapMaybe (pushOutMaybe . second lookupTypeTrie)
+--    . listCombos
 
 pushOutMaybe :: (a,Maybe b) -> Maybe (a,b)
 pushOutMaybe (_,Nothing) = Nothing
@@ -54,8 +70,10 @@ invertListInv = IM.foldrWithKey
     (\k it -> ((_itType it, k, itStackAmount it) :) )
     []
 
+combineItemListYou' :: World -> [([Int],Item)]
+combineItemListYou' = combineItemList . yourInv
 combineItemListYou :: World -> [([Int],Item)]
-combineItemListYou = combineItemList . yourInv
+combineItemListYou = concatMap lookupItems' . invertListInvMult . yourInv
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _inventoryMode w of