justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup combination accessing code

Browse Source
This commit is contained in:
justin
2021-12-06 14:18:11 +00:00
parent 40195d033c
commit 766a1dda83
6 changed files with 98 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+19 -100
View File
@@ -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
src/Dodge/Combine/Combinations.hs
+40
View File
@@ -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 = (,)
src/Dodge/Combine/Data.hs
+2 -2
View File
@@ -1,7 +1,7 @@
module Dodge.Combine.Data
(CombineType (..)
)
where
) where
-- TODO make this an enum somehow...?
data CombineType
= NOTDEFINED
-- Weapons
src/MaybeHelp.hs
+1 -1
View File
@@ -5,7 +5,7 @@ import Control.Lens
-- | Strict maybe
data Maybe' a
= Just' {_Just' :: a }
= Just' {__Just' :: a }
| Nothing'
fromJust' :: Maybe' a -> a
src/Multiset.hs
+34 -7
View File
@@ -4,15 +4,42 @@ import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Control.Monad
import Data.List (subsequences)
powlistN :: Int -> [a] ->[[a]]
powlistN _ [] = [[]]
powlistN n (x:xs)
-- naive solution
powlistUpToN' :: Int -> [a] ->[[a]]
powlistUpToN' _ [] = [[]]
powlistUpToN' n (x:xs)
| n <=0 = [[]]
| otherwise = ((x:) <$> powlistN (n-1) xs) ++ powlistN n xs
powlistN' :: Int -> [a] ->[[a]]
powlistN' k = filter ( ( k >= ) . length ) . subsequences
| otherwise = ((x:) <$> powlistUpToN' (n-1) xs) ++ powlistUpToN' n xs
-- adapted from
-- https://stackoverflow.com/questions/21265454/subsequences-of-length-n-from-list-performance/59932616#59932616
-- uses dynamic programming: the important part is the use of "next" twice
-- there is a (probably) faster SO answer that produces power lists of size
-- exactly N, but that answer is harder to adapt
powlistUpToN :: Int -> [a] -> [[a]]
powlistUpToN n xs =
let l = length xs
in if n > l then [] else concat $ drop (l-n) (subseqsBySize xs)
where
subseqsBySize [] = [[[]]]
subseqsBySize (y:ys) =
let next = subseqsBySize ys
in zipWith (++) ([]:next) (map (map (y:)) next ++ [[]])
-- this is the code producing all exactly n length sublists
combinationsOf :: Int -> [a] -> [[a]]
combinationsOf 1 as = map pure as
combinationsOf k' as@(_:xs) = run (l-1) (k'-1) as $ combinationsOf (k'-1) xs
where
l = length as
run :: Int -> Int -> [a] -> [[a]] -> [[a]]
run n k ys cs
| n == k = map (ys ++) cs
| otherwise = map (q:) cs ++ run (n-1) k qs (drop dc cs)
where
(q:qs) = take (n-k+1) ys
dc = product [(n-k+1)..(n-1)] `div` product [1..(k-1)]
combinationsOf _ [] = []
-- exponential, so don't use it on long lists
powlist :: [a] -> [[a]]
src/SimpleTrie.hs
+2 -2
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
module SimpleTrie where
import Data.Map
import Data.Map.Strict
import Control.Lens
data Trie a b = Trie
{ _trieMVal :: Maybe b
@@ -22,5 +22,5 @@ insertInTrie (k:ks) x = trieChildren %~ insertWith f k (singletonTrie ks x)
f _ = insertInTrie ks x
lookupTrie :: Ord a => [a] -> Trie a b -> Maybe b
lookupTrie [] t = _trieMVal t
lookupTrie (k:ks) t = _trieChildren t !? k >>= lookupTrie ks
lookupTrie [] t = _trieMVal t