Improve item combination algorithm

This commit is contained in:
2022-06-08 16:12:44 +01:00
parent 1b3988f961
commit ba8b33a87c
14 changed files with 77 additions and 22 deletions
+29 -10
View File
@@ -27,33 +27,52 @@ import Data.Map.Merge.Strict
import Data.Maybe
import Data.List (scanl',sortOn,sort)
combinationsTrie :: Trie (Int,ItemBaseType) Item
combinationsTrie :: Trie (IcAmount,ItemBaseType) Item
combinationsTrie = foldr
(uncurry insertInTrie . first (sortOn snd))
(uncurry insertInTrie . first sort)
emptyTrie
itemCombinations
invertInventory :: IM.IntMap Item -> [(ItemBaseType,IcAmount,Int)]
invertInventory = IM.foldrWithKey
(\k it -> ((_iyBase $ _itType it, itStackAmount it,k) :) )
[]
splitIcAmounts :: [(ItemBaseType,IcAmount,Int)] -> [((IcAmount,ItemBaseType),(IcAmount,Int))]
splitIcAmounts = concatMap f
where
f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]]
lookupItems' :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
lookupItems' = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
combineItemListYou :: World -> [([Int],Item)]
combineItemListYou = map (first f) . lookupItems' . yourInv
where
f = concatMap g
g (amount,i) = replicate (_toInt amount) i
-- this can probably be improved by going through accessing the combinations
-- trie going through each combine type in your inventory in order, rather than
-- creating all multisets of combine types.
lookupItems :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]
lookupItems :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]
-> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]
-> Trie (Int,ItemBaseType) Item
lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]
-> Trie (IcAmount,ItemBaseType) Item
-> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do
n' <- [1..min n 4]
let is = replicate n' (mods,i)
let is = replicate (_toInt n') (mods,i)
concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]]
invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]]
invertListInvMult = powlistUpToN 4 . invertListInv
invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]
invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]
invertListInv = IM.foldrWithKey
(\k it -> ((_iyModules $ _itType it,_iyBase $ _itType it, k, itStackAmount it) :) )
[]
@@ -61,8 +80,8 @@ invertListInv = IM.foldrWithKey
-- gives a list of indices-item pairs.
-- Note that within the pair, indices can be repeated if two or more of an item
-- are needed
combineItemListYou :: World -> [([Int],Item)]
combineItemListYou = map (second fst) . combineItemListYou'
combineItemListYou'' :: World -> [([Int],Item)]
combineItemListYou'' = map (second fst) . combineItemListYou'
combineItemListYou' :: World -> [([Int],(Item,[String]))]
combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv