Cleanup combination accessing code

2021-12-06 14:18:11 +00:00
parent 40195d033c
commit 766a1dda83
6 changed files with 98 additions and 112 deletions
@@ -1,95 +1,41 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Combine where
+module Dodge.Combine 
+    ( combinePoss
+    , combineSizes
+    , combineItemListYou
+    , toggleCombineInv
+    , enterCombineInv
+    ) where
+import Dodge.Combine.Combinations
 import Dodge.Base.You
 import Dodge.Data
 import Dodge.Item.Amount
 --import Dodge.Combine.Data
 import Multiset
-import Dodge.Item.Weapon.BulletGuns
-import Dodge.Item.Weapon.Launcher
--import Dodge.Item.Craftable
 import SimpleTrie

 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')

-itemCombinations :: [ (M.Map CombineType Int, Item) ]
-itemCombinations = map (first toMultiset) itemCombinations'
-
 combinationsTrie :: Trie CombineType Item
 combinationsTrie = foldr (uncurry insertInTrie) emptyTrie
-    $ map (first sort) itemCombinations'
-
-itemCombinations' :: [([CombineType],Item)]
-itemCombinations' =
-    [ p [PIPE,HARDWARE] (bangStick 1)
-    , p [BANGSTICK 1,TIN] pistol
-    , p [PISTOL, SPRING, HARDWARE] autoPistol
-    , p [AUTOPISTOL, PLANK, HARDWARE] smg
-    , p [AUTOPISTOL, HARDWARE] machinePistol
-    , p [BANGSTICK 1,CAN] revolver
-    , p [REVOLVER, SPRING, HARDWARE] $ revolverX 1
-
-    , p [PIPE,TUBE,HARDWARE] bangCone
-    , p [BANGCONE,PLANK] blunderbuss
-    , p [BLUNDERBUSS,TUBE] grapeShotCannon
-    , p [BANGCONE,PUMP,HARDWARE] $ grenadeLauncher 1
-    , p [GRENADELAUNCHER 1,MOTOR,DRUM] $ grenadeLauncher 2
-
-    , p [PIPE,PIPE,HARDWARE] bangCane
-    , p [BANGCANE,PIPE,PIPE] (bangCaneX 2)
-    , p [BANGCANE,TIN] rifle
-    , p [RIFLE,SPRING,HARDWARE] autoRifle
-    , p [RIFLE,SPRING,CAN] assaultRifle
-    , p [BANGCANE,BANGCANE] miniGun
-
-    , p [PIPE,PIPE,PIPE,HARDWARE] bangRod
-    , p [BANGROD,PLANK,HARDWARE]  elephantGun
-    , p [ELEPHANTGUN,HARDWARE,TIN] amr
-    , p [ELEPHANTGUN,HARDWARE,CAN] sniperRifle
-    , p [BANGROD,PLATE,DRUM,MOTOR] machineGun
-
-    , p [TUBE,TUBE,TUBE,HARDWARE] launcher
-    ] 
-    ++ map (\i -> ([PIPE,BANGSTICK i],bangStick (i+1))) [1..8]
-    ++ map (\i -> ([REVOLVERX i,CAN] ,revolverX (i+1))) [1..5]
-    ++ map (\i -> ([BANGCANEX i,PIPE,PIPE] ,bangCaneX (i+1))) [1..5]
-  where
-    p = (,)
-
-combineToItem :: M.Map CombineType Int -> Maybe Item
-combineToItem m = lookup m itemCombinations
-
-expandItem :: (Int,Item) -> [(Int,CombineType)]
-expandItem (i,it) = case it ^? itConsumption . itAmount of
-    Nothing -> [(i,_itType it)]
-    Just j  -> replicate j (i,_itType it)
-
-combineItemList :: IM.IntMap Item -> [([Int],Item)]
-combineItemList m 
-    = mapMaybe (pushoutmaybe . second combineToItem)
-    . concatMap itemsMultisets
-    . powlistN 4
-    $ IM.toList m
-  where
-    pushoutmaybe (_,Nothing) = Nothing
-    pushoutmaybe (x,Just y)  = Just (x,y)
+    $ map (first sort) itemCombinations

 lookupTypeTrie :: [CombineType] -> Maybe Item
 lookupTypeTrie = flip lookupTrie combinationsTrie . sort

-combineItemList' :: IM.IntMap Item -> [([Int],Item)]
-combineItemList'
-    = mapMaybe (pushoutmaybe . second lookupTypeTrie)
+combineItemList :: IM.IntMap Item -> [([Int],Item)]
+combineItemList = mapMaybe (pushOutMaybe . second lookupTypeTrie)
    . listCombos
-  where
-    pushoutmaybe (_,Nothing) = Nothing
-    pushoutmaybe (x,Just y)  = Just (x,y)
+
+pushOutMaybe :: (a,Maybe b) -> Maybe (a,b)
+pushOutMaybe (_,Nothing) = Nothing
+pushOutMaybe (x,Just y)  = Just (x,y)

 listCombos :: IM.IntMap Item -> [([Int], [CombineType])]
 listCombos = concatMap expandOut . invertListInvMult
@@ -98,45 +44,18 @@ expandOut :: [(CombineType,Int,Int)] -> [([Int],[CombineType])]
 expandOut [] = [([],[])]
 expandOut (x:xs) = (<>) <$> f x <*> expandOut xs
  where
-    f (ct,i,n) = map (\j -> (replicate j i,replicate j ct)) [1..n]
+    f (ct,i,n) = map (\j -> (replicate j i,replicate j ct)) [1..min 4 n]

 invertListInvMult :: IM.IntMap Item -> [[(CombineType,Int,Int)]]
-invertListInvMult = powlistN 4 . invertListInv
+invertListInvMult = powlistUpToN 4 . invertListInv

 invertListInv :: IM.IntMap Item -> [(CombineType,Int,Int)]
 invertListInv = IM.foldrWithKey
    (\k it -> ((_itType it, k, itStackAmount it) :) )
    []

-invertInv :: IM.IntMap Item -> M.Map CombineType (IM.IntMap Int)
-invertInv = IM.foldrWithKey
-    (\k it -> M.insertWith IM.union (_itType it) (IM.singleton k (itStackAmount it)))
-    M.empty
-
-expandCounts :: (Int,(Int,a)) -> [[(Int,a)]]
-expandCounts (i,(j,ct)) = [ replicate k (i,ct) | k <- [1..j]]
-
-multisetsWithCounts :: IM.IntMap Item -> [[(Int,(Int,CombineType))]]
-multisetsWithCounts = powlistN 4 . IM.toList . IM.map countAndType
-  where
-    countAndType it = (fromMaybe 1 $ it ^? itConsumption . itAmount
-        , _itType it)
-
-- multiple multisets produced by a single item stack are combined using the list monad
-itemsMultisets :: [(Int,Item)] -> [([Int],M.Map CombineType Int)]
-itemsMultisets = map mconcat . mapM itemMultisets
-
-- "individual" items can produce multiple multisets if they are in fact
-- a stack of more than one item
-itemMultisets :: (Int,Item) -> [([Int],M.Map CombineType Int)]
-itemMultisets (i,it) = case it ^? itConsumption . itAmount of
-    Nothing -> [ ([i], M.singleton thetype 1 ) ]
-    Just n  -> map (\k -> (replicate k i, M.singleton thetype k)) [1..n]
-  where
-    thetype = _itType it
-
 combineItemListYou :: World -> [([Int],Item)]
-combineItemListYou = combineItemList' . yourInv
+combineItemListYou = combineItemList . yourInv

 toggleCombineInv :: World -> World
 toggleCombineInv w = case _inventoryMode w of
@@ -0,0 +1,40 @@
+module Dodge.Combine.Combinations where
+import Dodge.Data
+import Dodge.Item.Weapon.BulletGuns
+import Dodge.Item.Weapon.Launcher
+itemCombinations :: [([CombineType],Item)]
+itemCombinations =
+    [ p [PIPE,HARDWARE] (bangStick 1)
+    , p [BANGSTICK 1,TIN] pistol
+    , p [PISTOL, SPRING, HARDWARE] autoPistol
+    , p [AUTOPISTOL, PLANK, HARDWARE] smg
+    , p [AUTOPISTOL, HARDWARE] machinePistol
+    , p [BANGSTICK 1,CAN] revolver
+    , p [REVOLVER, SPRING, HARDWARE] $ revolverX 1
+
+    , p [PIPE,TUBE,HARDWARE] bangCone
+    , p [BANGCONE,PLANK] blunderbuss
+    , p [BLUNDERBUSS,TUBE] grapeShotCannon
+    , p [BANGCONE,PUMP,HARDWARE] $ grenadeLauncher 1
+    , p [GRENADELAUNCHER 1,MOTOR,DRUM] $ grenadeLauncher 2
+
+    , p [PIPE,PIPE,HARDWARE] bangCane
+    , p [BANGCANE,PIPE,PIPE] (bangCaneX 2)
+    , p [BANGCANE,TIN] rifle
+    , p [RIFLE,SPRING,HARDWARE] autoRifle
+    , p [RIFLE,SPRING,CAN] assaultRifle
+    , p [BANGCANE,BANGCANE] miniGun
+
+    , p [PIPE,PIPE,PIPE,HARDWARE] bangRod
+    , p [BANGROD,PLANK,HARDWARE]  elephantGun
+    , p [ELEPHANTGUN,HARDWARE,TIN] amr
+    , p [ELEPHANTGUN,HARDWARE,CAN] sniperRifle
+    , p [BANGROD,PLATE,DRUM,MOTOR] machineGun
+
+    , p [TUBE,TUBE,TUBE,HARDWARE] launcher
+    ] 
+    ++ map (\i -> ([PIPE,BANGSTICK i],bangStick (i+1))) [1..8]
+    ++ map (\i -> ([REVOLVERX i,CAN] ,revolverX (i+1))) [1..5]
+    ++ map (\i -> ([BANGCANEX i,PIPE,PIPE] ,bangCaneX (i+1))) [1..5]
+  where
+    p = (,)
@@ -1,7 +1,7 @@
 module Dodge.Combine.Data
    (CombineType (..)
-    )
-    where
+    ) where
+-- TODO make this an enum somehow...?
 data CombineType
    = NOTDEFINED
    -- Weapons