wgaffa/deck-delta - Change M54PYKIOETT3UT4N6HHTAENU4D5HB7MNEFEXM5CX6PJ4FTQIRAAAC

Fix a few issues

These changes are experimental and for learning purpose so they are a bit hard to explain. But in hindsight the old algorithm didn't deal with cards moving between categories correctly. This algorithm works according to ghci testing between two decklists.

Created by wgaffa on April 6, 2024

M54PYKIOETT3UT4N6HHTAENU4D5HB7MNEFEXM5CX6PJ4FTQIRAAAC

Dependencies

In channels

main

Change contents

Replacement in src/Diff.hs at line 101 [5.3955]

B:BD[4.3164] → [4.3164:3370]

    go acc [] [] = pure acc -- TODO: The resourcequeue needs to be emptied and converted to card changes
    go acc xs [] = do
        changes <- forM xs $ \x -> do
            res <- fulfill (x ^. copies)

[4.3164]

[4.3370]

    go acc [] [] = do
        requested <- ResourceQueue.takeRequested

Replacement in src/Diff.hs at line 104 [5.3955]

B:BD[4.3371] → [3.29:103]

∅:D[3.103] → [4.3442:3734]

B:BD[4.3442] → [4.3442:3734]

            let totalFulfilled = sum . fmap (toNumber @Int) $ Compose res
            when (totalFulfilled < toNumber @Int (x ^. copies)) $
                resource
                    (x ^. Category.name)
                    ( PositiveNumber . unsafeRefine . fromIntegral $
                        toNumber @Int (x ^. copies) - totalFulfilled
                    )

[4.3371]

[4.3734]

        changes <- forM requested $ \x -> do
            res <- ResourceQueue.take (x ^. _2)

Replacement in src/Diff.hs at line 107 [5.3955]

B:BD[4.3735] → [4.3735:3805]

            pure $ map (uncurry (Diff.move (x ^. Category.name))) res

[4.3735]

[4.3805]

            let totalTaken = sum . fmap (toNumber @Int) $ Compose res
                moves = map (uncurry (`Diff.move` (x ^. _1))) res
                deltas =
                    if totalTaken < toNumber @Int (x ^. _2)
                        then
                            let difference = toNumber @Int (x ^. _2) - totalTaken
                             in singleton $ Diff.deltaCopies difference (x ^. _1)
                        else mempty

Replacement in src/Diff.hs at line 116 [5.3955]

B:BD[4.3806] → [4.3806:3856]

        go (mconcat changes ++ acc) mempty mempty

[4.3806]

[4.3856]

            pure $ moves ++ deltas
        available <- gets fst
        let deltas = 
                Map.foldrWithKey'
                    (\k a xs -> Diff.deltaCopies (negate (toNumber @Int a)) k : xs)
                    []
                    available
        put (mempty, mempty)
        pure (acc ++ mconcat changes ++ deltas)
    go acc xs [] = do
        changes <- forM xs $ \x -> fulfillRequest (x ^. copies) (x ^. Category.name)
        go (acc ++ mconcat changes) mempty mempty

Replacement in src/Diff.hs at line 133 [5.3955]

B:BD[4.3878] → [4.3878:3946]

        forM_ ys $ \x -> do
            uncurry request $ mkTuple x

[4.3878]

[4.3946]

        changes <- forM ys $ \y -> takeAvailable (y ^. copies) (y ^. Category.name)

Replacement in src/Diff.hs at line 135 [5.3955]

B:BD[4.3947] → [4.3947:3976]

∅:D[4.3976] → [6.992:1029]

B:BD[6.992] → [6.992:1029]

        go acc mempty mempty
    go acc lx@(x : xs) ly@(y : ys) =

[4.3947]

[6.1029]

        go (acc ++ mconcat changes) mempty mempty
    go acc lx@(x : xs) ly@(y : ys) = do

Replacement in src/Diff.hs at line 138 [5.3955]

B:BD[6.1083] → [4.3977:4153]

            LT -> uncurry resource (mkTuple x) >> go acc xs ly -- We need to add these to the available resources -- go (Diff.remove cardname (x ^. Category.name) : acc) xs ly

[6.1083]

[4.4153]

            LT -> uncurry resource (mkTuple x) >> go acc xs ly

Replacement in src/Diff.hs at line 141 [5.3955]

B:BD[4.4217] → [4.4217:4820]

                    change 0 = acc
                    change n = Diff.deltaCopies n (x ^. Category.name) : acc
                unless (delta == 0) $ do
                    if delta > 0
                        then
                            resource
                                (x ^. Category.name)
                                (PositiveNumber . unsafeRefine . fromIntegral $ delta)
                        else
                            request
                                (x ^. Category.name)
                                (PositiveNumber . unsafeRefine . abs . fromIntegral $ delta)

[4.4217]

[4.4820]

                changes <- case compare delta 0 of
                    LT -> takeAvailable (PositiveNumber . unsafeRefine . fromIntegral . abs $ delta) (x ^. Category.name)
                    EQ -> pure acc
                    GT -> fulfillRequest (PositiveNumber . unsafeRefine . fromIntegral $ delta) (x ^. Category.name)

Replacement in src/Diff.hs at line 146 [5.3955]

B:BD[4.4821] → [4.4821:4924]

                go (change delta) xs ys
            GT -> uncurry resource (mkTuple x) >> go acc lx ys

[4.4821]

[4.4924]

                go changes xs ys
            GT -> uncurry request (mkTuple y) >> go acc lx ys

Replacement in src/Diff.hs at line 150 [5.3955]

B:BD[6.1532] → [4.4926:5012]

    diffCopies x y = uncurry (-) $ (y ^. copies, x ^. copies) & both %~ toNumber @Int

[6.1532]

[6.1613]

    diffCopies x y = uncurry (-) $ (x ^. copies, y ^. copies) & both %~ toNumber @Int

Insertion in src/Diff.hs at line 152 [5.3955]

[6.1646]

    fulfillRequest count categoryname = do
        requests <- ResourceQueue.fulfill count
        let totalTaken = sum . fmap (toNumber @Int) $ Compose requests
        when (totalTaken < toNumber @Int count) $
            resource
                categoryname
                ( PositiveNumber . unsafeRefine . fromIntegral $
                    toNumber @Int count - totalTaken
                )
        pure $ map (uncurry (Diff.move categoryname)) requests
    takeAvailable count categoryname = do
        available <- ResourceQueue.take count

Insertion in src/Diff.hs at line 167 [5.3955]

[6.1647]

        let totalTaken = sum . fmap (toNumber @Int) $ Compose available
        when (totalTaken < toNumber @Int count) $
            request
                categoryname
                ( PositiveNumber . unsafeRefine . fromIntegral $
                    toNumber @Int count - totalTaken
                )
        pure $ map (uncurry (`Diff.move` categoryname)) available

Replacement in src/Diff.hs at line 192 [5.3955]

B:BD[6.2043] → [6.2043:2087]

            go (acc ++ categoryDiffs) xs ys

[6.2043]

[6.2087]

            go (acc ++ singleton categoryDiffs) xs ys

Replacement in src/StateRep.hs at line 93 [5.36]

B:BD[2.232] → [2.232:287]

            copiesToMove = oldCopies <&> max numCopies

[2.232]

[7.694]

            copiesToMove = oldCopies <&> min numCopies

Replacement in src/StateRep.hs at line 106 [5.36]

B:BD[2.459] → [2.459:669]

                         in if (y ^. copies) <= numCopies
                            then Nothing
                            else Just $ y & copies .~ (PositiveNumber . unsafeRefine . fromIntegral $ (r - l))

[2.459]

[2.669]

                         in if l <= r
                                then Nothing
                                else
                                    Just $ y & copies .~ (PositiveNumber . unsafeRefine . fromIntegral $ (l - r))

Replacement in src/StateRep.hs at line 112 [5.36]

B:BD[2.724] → [2.724:876]

                    (card ^. categories)
         in copiesToMove <&> (\x -> x & categories .~ updateOld) . (\x -> card & categories .~ updateCopies x)

[2.724]

[8.207]

         in copiesToMove
                <&> (\x -> x & categories %~ updateOld)
                    . (\x -> card & categories .~ updateCopies x)

Insertion in src/ResourceQueue.hs at line 10 [4.41]
[4.207]
[4.207]
```
    flush,
    takeRequested,
```

Insertion in src/ResourceQueue.hs at line 29 [4.41]

[4.500]


flush ::
    ResourceQueue
        ([(CategoryName, PositiveNumber)], [(CategoryName, PositiveNumber)])
flush = do
    (available, requested) <- get

Insertion in src/ResourceQueue.hs at line 36 [4.41]

[4.501]

    put (Map.empty, Map.empty)
    pure (Map.toAscList available, Map.toAscList requested)
takeRequested :: ResourceQueue [(CategoryName, PositiveNumber)]
takeRequested = do
    (available, requested) <- get
    put (available, Map.empty)
    pure (Map.toAscList requested)