{- HLINT ignore "Evaluate" -}

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- Provides functions for selecting coins for use as collateral from a UTxO
-- set.
--
-- See the documentation for 'performSelection' for more details.
--
module Cardano.Wallet.CoinSelection.Internal.Collateral
    (
    -- * Public API

      performSelection
    , PerformSelection
    , SelectionConstraints (..)
    , SelectionParams (..)
    , SelectionResult (..)
    , selectionResultEmpty
    , SelectionCollateralError (..)
    , SearchSpaceLimit (..)
    , searchSpaceLimitDefault

    -- * Internal API

    -- ** Selecting collateral by giving priority to smallest values first
    , selectCollateralSmallest

    -- ** Selecting collateral by giving priority to largest values first
    , selectCollateralLargest

    -- ** Guarding search space size
    , SearchSpaceRequirement (..)
    , guardSearchSpaceSize

    -- ** Generating submaps
    , submaps

    -- ** Generating subsequences
    , subsequencesOfSize
    , numberOfSubsequencesOfSize

    -- ** Control flow
    , firstRight
    , takeUntil
    )
    where

import Cardano.Wallet.Primitive.Types.Coin
    ( Coin )
import Data.Function
    ( (&) )
import Data.IntCast
    ( intCast, intCastMaybe )
import Data.List.NonEmpty
    ( NonEmpty )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( listToMaybe, mapMaybe )
import Data.Ord
    ( Down (..) )
import Data.Semigroup
    ( sconcat )
import Data.Set
    ( Set )
import GHC.Generics
    ( Generic )

import Prelude

import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Math.Combinatorics.Exact.Binomial as MathExact
import qualified Numeric.SpecFunctions as MathFast

--------------------------------------------------------------------------------
-- Public API
--------------------------------------------------------------------------------

-- | The type of all functions that perform selections.
--
type PerformSelection u =
    SelectionConstraints ->
    SelectionParams u ->
    Either (SelectionCollateralError u) (SelectionResult u)

-- | Specifies all constraints required for collateral selection.
--
-- Selection constraints:
--
--    - are dependent on the current set of protocol parameters.
--
--    - are not specific to a given selection.
--
--    - place limits on the selection algorithm, enabling it to produce
--      selections that are acceptable to the ledger.
--
data SelectionConstraints = SelectionConstraints
    { SelectionConstraints -> Int
maximumSelectionSize
        :: Int
        -- ^ An upper bound on the number of unique coins that can be selected
        -- as collateral.
    , SelectionConstraints -> SearchSpaceLimit
searchSpaceLimit
        :: SearchSpaceLimit
        -- ^ An upper bound on the search space size, to protect the wallet
        -- against computations that use excessive amounts of time or space.
    }
    deriving (SelectionConstraints -> SelectionConstraints -> Bool
(SelectionConstraints -> SelectionConstraints -> Bool)
-> (SelectionConstraints -> SelectionConstraints -> Bool)
-> Eq SelectionConstraints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionConstraints -> SelectionConstraints -> Bool
$c/= :: SelectionConstraints -> SelectionConstraints -> Bool
== :: SelectionConstraints -> SelectionConstraints -> Bool
$c== :: SelectionConstraints -> SelectionConstraints -> Bool
Eq, (forall x. SelectionConstraints -> Rep SelectionConstraints x)
-> (forall x. Rep SelectionConstraints x -> SelectionConstraints)
-> Generic SelectionConstraints
forall x. Rep SelectionConstraints x -> SelectionConstraints
forall x. SelectionConstraints -> Rep SelectionConstraints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectionConstraints x -> SelectionConstraints
$cfrom :: forall x. SelectionConstraints -> Rep SelectionConstraints x
Generic, Int -> SelectionConstraints -> ShowS
[SelectionConstraints] -> ShowS
SelectionConstraints -> String
(Int -> SelectionConstraints -> ShowS)
-> (SelectionConstraints -> String)
-> ([SelectionConstraints] -> ShowS)
-> Show SelectionConstraints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionConstraints] -> ShowS
$cshowList :: [SelectionConstraints] -> ShowS
show :: SelectionConstraints -> String
$cshow :: SelectionConstraints -> String
showsPrec :: Int -> SelectionConstraints -> ShowS
$cshowsPrec :: Int -> SelectionConstraints -> ShowS
Show)

-- | Specifies all parameters that are specific to a given selection.
--
data SelectionParams u = SelectionParams
    { SelectionParams u -> Map u Coin
coinsAvailable
        :: Map u Coin
        -- ^ The set of all coins available for selection as collateral.
    , SelectionParams u -> Coin
minimumSelectionAmount
        :: Coin
        -- ^ A lower bound on the sum of coins to be selected as collateral.
    }
    deriving (SelectionParams u -> SelectionParams u -> Bool
(SelectionParams u -> SelectionParams u -> Bool)
-> (SelectionParams u -> SelectionParams u -> Bool)
-> Eq (SelectionParams u)
forall u. Eq u => SelectionParams u -> SelectionParams u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionParams u -> SelectionParams u -> Bool
$c/= :: forall u. Eq u => SelectionParams u -> SelectionParams u -> Bool
== :: SelectionParams u -> SelectionParams u -> Bool
$c== :: forall u. Eq u => SelectionParams u -> SelectionParams u -> Bool
Eq, (forall x. SelectionParams u -> Rep (SelectionParams u) x)
-> (forall x. Rep (SelectionParams u) x -> SelectionParams u)
-> Generic (SelectionParams u)
forall x. Rep (SelectionParams u) x -> SelectionParams u
forall x. SelectionParams u -> Rep (SelectionParams u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x. Rep (SelectionParams u) x -> SelectionParams u
forall u x. SelectionParams u -> Rep (SelectionParams u) x
$cto :: forall u x. Rep (SelectionParams u) x -> SelectionParams u
$cfrom :: forall u x. SelectionParams u -> Rep (SelectionParams u) x
Generic, Int -> SelectionParams u -> ShowS
[SelectionParams u] -> ShowS
SelectionParams u -> String
(Int -> SelectionParams u -> ShowS)
-> (SelectionParams u -> String)
-> ([SelectionParams u] -> ShowS)
-> Show (SelectionParams u)
forall u. Show u => Int -> SelectionParams u -> ShowS
forall u. Show u => [SelectionParams u] -> ShowS
forall u. Show u => SelectionParams u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionParams u] -> ShowS
$cshowList :: forall u. Show u => [SelectionParams u] -> ShowS
show :: SelectionParams u -> String
$cshow :: forall u. Show u => SelectionParams u -> String
showsPrec :: Int -> SelectionParams u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> SelectionParams u -> ShowS
Show)

-- | Specifies an upper bound on the search space size.
--
data SearchSpaceLimit
    = SearchSpaceLimit Int
    -- ^ Specifies an upper bound on the number of coin combinations that can
    -- be considered in any single step.
    | UnsafeNoSearchSpaceLimit
    -- ^ Specifies that there is no search space limit. This should only be
    -- used for testing purposes.
    deriving (SearchSpaceLimit -> SearchSpaceLimit -> Bool
(SearchSpaceLimit -> SearchSpaceLimit -> Bool)
-> (SearchSpaceLimit -> SearchSpaceLimit -> Bool)
-> Eq SearchSpaceLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchSpaceLimit -> SearchSpaceLimit -> Bool
$c/= :: SearchSpaceLimit -> SearchSpaceLimit -> Bool
== :: SearchSpaceLimit -> SearchSpaceLimit -> Bool
$c== :: SearchSpaceLimit -> SearchSpaceLimit -> Bool
Eq, Int -> SearchSpaceLimit -> ShowS
[SearchSpaceLimit] -> ShowS
SearchSpaceLimit -> String
(Int -> SearchSpaceLimit -> ShowS)
-> (SearchSpaceLimit -> String)
-> ([SearchSpaceLimit] -> ShowS)
-> Show SearchSpaceLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchSpaceLimit] -> ShowS
$cshowList :: [SearchSpaceLimit] -> ShowS
show :: SearchSpaceLimit -> String
$cshow :: SearchSpaceLimit -> String
showsPrec :: Int -> SearchSpaceLimit -> ShowS
$cshowsPrec :: Int -> SearchSpaceLimit -> ShowS
Show)

-- | The default search space limit.
--
-- This constant is used by the test suite, so we can be reasonably confident
-- that performing selections with this limit will not use inordinate amounts
-- of time and space.
--
searchSpaceLimitDefault :: SearchSpaceLimit
searchSpaceLimitDefault :: SearchSpaceLimit
searchSpaceLimitDefault = Int -> SearchSpaceLimit
SearchSpaceLimit Int
1_000_000

-- | Represents a successful selection of collateral.
--
newtype SelectionResult u = SelectionResult
    { SelectionResult u -> Map u Coin
coinsSelected :: Map u Coin
        -- ^ The coins that were selected for collateral.
    }
    deriving (SelectionResult u -> SelectionResult u -> Bool
(SelectionResult u -> SelectionResult u -> Bool)
-> (SelectionResult u -> SelectionResult u -> Bool)
-> Eq (SelectionResult u)
forall u. Eq u => SelectionResult u -> SelectionResult u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionResult u -> SelectionResult u -> Bool
$c/= :: forall u. Eq u => SelectionResult u -> SelectionResult u -> Bool
== :: SelectionResult u -> SelectionResult u -> Bool
$c== :: forall u. Eq u => SelectionResult u -> SelectionResult u -> Bool
Eq, (forall x. SelectionResult u -> Rep (SelectionResult u) x)
-> (forall x. Rep (SelectionResult u) x -> SelectionResult u)
-> Generic (SelectionResult u)
forall x. Rep (SelectionResult u) x -> SelectionResult u
forall x. SelectionResult u -> Rep (SelectionResult u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x. Rep (SelectionResult u) x -> SelectionResult u
forall u x. SelectionResult u -> Rep (SelectionResult u) x
$cto :: forall u x. Rep (SelectionResult u) x -> SelectionResult u
$cfrom :: forall u x. SelectionResult u -> Rep (SelectionResult u) x
Generic, Int -> SelectionResult u -> ShowS
[SelectionResult u] -> ShowS
SelectionResult u -> String
(Int -> SelectionResult u -> ShowS)
-> (SelectionResult u -> String)
-> ([SelectionResult u] -> ShowS)
-> Show (SelectionResult u)
forall u. Show u => Int -> SelectionResult u -> ShowS
forall u. Show u => [SelectionResult u] -> ShowS
forall u. Show u => SelectionResult u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionResult u] -> ShowS
$cshowList :: forall u. Show u => [SelectionResult u] -> ShowS
show :: SelectionResult u -> String
$cshow :: forall u. Show u => SelectionResult u -> String
showsPrec :: Int -> SelectionResult u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> SelectionResult u -> ShowS
Show)

-- | A completely empty result, with no inputs selected.
--
selectionResultEmpty :: SelectionResult u
selectionResultEmpty :: SelectionResult u
selectionResultEmpty = SelectionResult :: forall u. Map u Coin -> SelectionResult u
SelectionResult
    { $sel:coinsSelected:SelectionResult :: Map u Coin
coinsSelected = Map u Coin
forall k a. Map k a
Map.empty
    }

-- | Represents an unsuccessful attempt to select collateral.
--
data SelectionCollateralError u = SelectionCollateralError
    { SelectionCollateralError u -> Map u Coin
largestCombinationAvailable :: Map u Coin
        -- ^ The largest combination of coins available.
    , SelectionCollateralError u -> Coin
minimumSelectionAmount :: Coin
        -- ^ A lower bound on the sum of coins to be selected as collateral.
    }
    deriving (SelectionCollateralError u -> SelectionCollateralError u -> Bool
(SelectionCollateralError u -> SelectionCollateralError u -> Bool)
-> (SelectionCollateralError u
    -> SelectionCollateralError u -> Bool)
-> Eq (SelectionCollateralError u)
forall u.
Eq u =>
SelectionCollateralError u -> SelectionCollateralError u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionCollateralError u -> SelectionCollateralError u -> Bool
$c/= :: forall u.
Eq u =>
SelectionCollateralError u -> SelectionCollateralError u -> Bool
== :: SelectionCollateralError u -> SelectionCollateralError u -> Bool
$c== :: forall u.
Eq u =>
SelectionCollateralError u -> SelectionCollateralError u -> Bool
Eq, (forall x.
 SelectionCollateralError u -> Rep (SelectionCollateralError u) x)
-> (forall x.
    Rep (SelectionCollateralError u) x -> SelectionCollateralError u)
-> Generic (SelectionCollateralError u)
forall x.
Rep (SelectionCollateralError u) x -> SelectionCollateralError u
forall x.
SelectionCollateralError u -> Rep (SelectionCollateralError u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x.
Rep (SelectionCollateralError u) x -> SelectionCollateralError u
forall u x.
SelectionCollateralError u -> Rep (SelectionCollateralError u) x
$cto :: forall u x.
Rep (SelectionCollateralError u) x -> SelectionCollateralError u
$cfrom :: forall u x.
SelectionCollateralError u -> Rep (SelectionCollateralError u) x
Generic, Int -> SelectionCollateralError u -> ShowS
[SelectionCollateralError u] -> ShowS
SelectionCollateralError u -> String
(Int -> SelectionCollateralError u -> ShowS)
-> (SelectionCollateralError u -> String)
-> ([SelectionCollateralError u] -> ShowS)
-> Show (SelectionCollateralError u)
forall u. Show u => Int -> SelectionCollateralError u -> ShowS
forall u. Show u => [SelectionCollateralError u] -> ShowS
forall u. Show u => SelectionCollateralError u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionCollateralError u] -> ShowS
$cshowList :: forall u. Show u => [SelectionCollateralError u] -> ShowS
show :: SelectionCollateralError u -> String
$cshow :: forall u. Show u => SelectionCollateralError u -> String
showsPrec :: Int -> SelectionCollateralError u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> SelectionCollateralError u -> ShowS
Show)

-- | Selects coins for collateral.
--
-- This function tries two strategies in the following order, picking the first
-- strategy that succeeds:
--
--    1. Attempt to select an amount of collateral that is as small as possible.
--    2. Attempt to select collateral from the largest coins available.
--
-- The first strategy, given unlimited computation time, will always produce an
-- optimal result: the smallest possible amount of collateral. However, if the
-- required search space is large, and if the 'searchSpaceLimit' parameter is
-- set to a value that's smaller than the required search space size, then this
-- strategy will fail without computing a result.
--
-- The second strategy sacrifices optimality and always produces a result if
-- one is available, by looking only at the very largest coins available. This
-- result can be computed very quickly, without using much search space.
--
-- The combination of these two strategies means that we can satisfy the
-- following properties:
--
-- If the attempt to select collateral succeeds:
--
--    >>> sum  coinsSelected ≥ minimumSelectionAmount
--    >>> size coinsSelected ≤ maximumSelectionSize
--    >>>      coinsSelected ⊆ coinsAvailable
--
-- If the attempt to select collateral fails:
--
--    >>> sum  largestCombinationAvailable < minimumSelectionAmount
--    >>> size largestCombinationAvailable ≤ maximumSelectionSize
--    >>>      largestCombinationAvailable ⊆ coinsAvailable
--
performSelection :: forall u. Ord u => PerformSelection u
performSelection :: PerformSelection u
performSelection SelectionConstraints
constraints =
    NonEmpty
  (SelectionParams u
   -> Either (SelectionCollateralError u) (SelectionResult u))
-> SelectionParams u
-> Either (SelectionCollateralError u) (SelectionResult u)
forall a e r. NonEmpty (a -> Either e r) -> a -> Either e r
firstRight (NonEmpty
   (SelectionParams u
    -> Either (SelectionCollateralError u) (SelectionResult u))
 -> SelectionParams u
 -> Either (SelectionCollateralError u) (SelectionResult u))
-> NonEmpty
     (SelectionParams u
      -> Either (SelectionCollateralError u) (SelectionResult u))
-> SelectionParams u
-> Either (SelectionCollateralError u) (SelectionResult u)
forall a b. (a -> b) -> a -> b
$ (PerformSelection u
 -> SelectionParams u
 -> Either (SelectionCollateralError u) (SelectionResult u))
-> NonEmpty (PerformSelection u)
-> NonEmpty
     (SelectionParams u
      -> Either (SelectionCollateralError u) (SelectionResult u))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PerformSelection u -> PerformSelection u
forall a b. (a -> b) -> a -> b
$ SelectionConstraints
constraints)
        [ Item (NonEmpty (PerformSelection u))
forall u. Ord u => PerformSelection u
selectCollateralSmallest
        , Item (NonEmpty (PerformSelection u))
forall u. Ord u => PerformSelection u
selectCollateralLargest
        ]

--------------------------------------------------------------------------------
-- Internal API
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Selecting collateral by giving priority to smallest values first
--------------------------------------------------------------------------------

-- | Attempts to select an amount of collateral that is as small as possible.
--
-- This function, given unlimited computation time, will always produce an
-- optimal result: the smallest possible amount of collateral. However, if the
-- required search space is large, and if the 'searchSpaceLimit' parameter is
-- set to a value that's smaller than the required search space size, then this
-- function will return without computing a result.
--
selectCollateralSmallest :: forall u. Ord u => PerformSelection u
selectCollateralSmallest :: PerformSelection u
selectCollateralSmallest SelectionConstraints
constraints SelectionParams u
params =
    case Maybe (Map u Coin)
smallestValidCombination of
        Just Map u Coin
coinsSelected ->
            SelectionResult u
-> Either (SelectionCollateralError u) (SelectionResult u)
forall a b. b -> Either a b
Right SelectionResult :: forall u. Map u Coin -> SelectionResult u
SelectionResult {Map u Coin
coinsSelected :: Map u Coin
$sel:coinsSelected:SelectionResult :: Map u Coin
coinsSelected}
        Maybe (Map u Coin)
Nothing ->
            SelectionCollateralError u
-> Either (SelectionCollateralError u) (SelectionResult u)
forall a b. a -> Either a b
Left SelectionCollateralError :: forall u. Map u Coin -> Coin -> SelectionCollateralError u
SelectionCollateralError
                { $sel:largestCombinationAvailable:SelectionCollateralError :: Map u Coin
largestCombinationAvailable = Map u Coin
forall a. Monoid a => a
mempty
                , Coin
minimumSelectionAmount :: Coin
$sel:minimumSelectionAmount:SelectionCollateralError :: Coin
minimumSelectionAmount
                }
  where
    coinsToConsider :: [(u, Coin)]
    coinsToConsider :: [(u, Coin)]
coinsToConsider = Map u Coin
coinsAvailable
        Map u Coin -> (Map u Coin -> [(u, Coin)]) -> [(u, Coin)]
forall a b. a -> (a -> b) -> b
& Map u Coin -> [(u, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(u, Coin)] -> ([(u, Coin)] -> [(u, Coin)]) -> [(u, Coin)]
forall a b. a -> (a -> b) -> b
& ((u, Coin) -> Coin) -> [(u, Coin)] -> [(u, Coin)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (u, Coin) -> Coin
forall a b. (a, b) -> b
snd
        [(u, Coin)] -> ([(u, Coin)] -> [(u, Coin)]) -> [(u, Coin)]
forall a b. a -> (a -> b) -> b
& ((u, Coin) -> Bool) -> [(u, Coin)] -> [(u, Coin)]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil ((Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
minimumSelectionAmount) (Coin -> Bool) -> ((u, Coin) -> Coin) -> (u, Coin) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u, Coin) -> Coin
forall a b. (a, b) -> b
snd)

    numberOfCoinsToConsider :: Int
    numberOfCoinsToConsider :: Int
numberOfCoinsToConsider = [(u, Coin)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(u, Coin)]
coinsToConsider

    smallestValidCombination :: Maybe (Map u Coin)
    smallestValidCombination :: Maybe (Map u Coin)
smallestValidCombination =
        [Map u Coin] -> Maybe (Map u Coin)
forall a. [a] -> Maybe a
listToMaybe ([Map u Coin] -> Maybe (Map u Coin))
-> [Map u Coin] -> Maybe (Map u Coin)
forall a b. (a -> b) -> a -> b
$ (Map u Coin -> Coin) -> [Map u Coin] -> [Map u Coin]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn Map u Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold [Map u Coin]
validCombinations
      where
        validCombinations :: [Map u Coin]
        validCombinations :: [Map u Coin]
validCombinations =
            (Int -> Maybe (Map u Coin)) -> [Int] -> [Map u Coin]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe (Map u Coin)
smallestValidCombinationOfSize
            [Item [Int]
1 .. Int
Item [Int]
maximumSelectionSize]

    smallestValidCombinationOfSize :: Int -> Maybe (Map u Coin)
    smallestValidCombinationOfSize :: Int -> Maybe (Map u Coin)
smallestValidCombinationOfSize Int
size =
        SearchSpaceRequirement
-> SearchSpaceLimit -> Maybe (Map u Coin) -> Maybe (Map u Coin)
forall a.
SearchSpaceRequirement -> SearchSpaceLimit -> Maybe a -> Maybe a
guardSearchSpaceSize SearchSpaceRequirement
searchSpaceRequirement SearchSpaceLimit
searchSpaceLimit Maybe (Map u Coin)
result
      where
        result :: Maybe (Map u Coin)
        result :: Maybe (Map u Coin)
result = [(u, Coin)]
coinsToConsider
            [(u, Coin)] -> ([(u, Coin)] -> [[(u, Coin)]]) -> [[(u, Coin)]]
forall a b. a -> (a -> b) -> b
& ([(u, Coin)] -> Int -> [[(u, Coin)]]
forall a. [a] -> Int -> [[a]]
`subsequencesOfSize` Int
size)
            [[(u, Coin)]]
-> ([[(u, Coin)]] -> [([(u, Coin)], Coin)])
-> [([(u, Coin)], Coin)]
forall a b. a -> (a -> b) -> b
& ([(u, Coin)] -> ([(u, Coin)], Coin))
-> [[(u, Coin)]] -> [([(u, Coin)], Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(u, Coin)]
ics -> ([(u, Coin)]
ics, ((u, Coin) -> Coin) -> [(u, Coin)] -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (u, Coin) -> Coin
forall a b. (a, b) -> b
snd [(u, Coin)]
ics))
            [([(u, Coin)], Coin)]
-> ([([(u, Coin)], Coin)] -> [([(u, Coin)], Coin)])
-> [([(u, Coin)], Coin)]
forall a b. a -> (a -> b) -> b
& (([(u, Coin)], Coin) -> Coin)
-> [([(u, Coin)], Coin)] -> [([(u, Coin)], Coin)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn ([(u, Coin)], Coin) -> Coin
forall a b. (a, b) -> b
snd
            [([(u, Coin)], Coin)]
-> ([([(u, Coin)], Coin)] -> [([(u, Coin)], Coin)])
-> [([(u, Coin)], Coin)]
forall a b. a -> (a -> b) -> b
& (([(u, Coin)], Coin) -> Bool)
-> [([(u, Coin)], Coin)] -> [([(u, Coin)], Coin)]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile ((Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
minimumSelectionAmount) (Coin -> Bool)
-> (([(u, Coin)], Coin) -> Coin) -> ([(u, Coin)], Coin) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(u, Coin)], Coin) -> Coin
forall a b. (a, b) -> b
snd)
            [([(u, Coin)], Coin)]
-> ([([(u, Coin)], Coin)] -> Maybe ([(u, Coin)], Coin))
-> Maybe ([(u, Coin)], Coin)
forall a b. a -> (a -> b) -> b
& [([(u, Coin)], Coin)] -> Maybe ([(u, Coin)], Coin)
forall a. [a] -> Maybe a
listToMaybe
            Maybe ([(u, Coin)], Coin)
-> (Maybe ([(u, Coin)], Coin) -> Maybe (Map u Coin))
-> Maybe (Map u Coin)
forall a b. a -> (a -> b) -> b
& (([(u, Coin)], Coin) -> Map u Coin)
-> Maybe ([(u, Coin)], Coin) -> Maybe (Map u Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(u, Coin)] -> Map u Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(u, Coin)] -> Map u Coin)
-> (([(u, Coin)], Coin) -> [(u, Coin)])
-> ([(u, Coin)], Coin)
-> Map u Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(u, Coin)], Coin) -> [(u, Coin)]
forall a b. (a, b) -> a
fst)

        searchSpaceRequirement :: SearchSpaceRequirement
        searchSpaceRequirement :: SearchSpaceRequirement
searchSpaceRequirement = SearchSpaceRequirement
-> (Int -> SearchSpaceRequirement)
-> Maybe Int
-> SearchSpaceRequirement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            SearchSpaceRequirement
SearchSpaceRequirementUnknown
            Int -> SearchSpaceRequirement
SearchSpaceRequirement
            (Int
numberOfCoinsToConsider Int -> Int -> Maybe Int
`numberOfSubsequencesOfSize` Int
size)

    SelectionConstraints
        { Int
maximumSelectionSize :: Int
$sel:maximumSelectionSize:SelectionConstraints :: SelectionConstraints -> Int
maximumSelectionSize
        , SearchSpaceLimit
searchSpaceLimit :: SearchSpaceLimit
$sel:searchSpaceLimit:SelectionConstraints :: SelectionConstraints -> SearchSpaceLimit
searchSpaceLimit
        } = SelectionConstraints
constraints
    SelectionParams
        { Map u Coin
coinsAvailable :: Map u Coin
$sel:coinsAvailable:SelectionParams :: forall u. SelectionParams u -> Map u Coin
coinsAvailable
        , Coin
minimumSelectionAmount :: Coin
$sel:minimumSelectionAmount:SelectionParams :: forall u. SelectionParams u -> Coin
minimumSelectionAmount
        } = SelectionParams u
params

--------------------------------------------------------------------------------
-- Selecting collateral by giving priority to largest values first
--------------------------------------------------------------------------------

-- | Selects collateral from the largest coins available.
--
-- This function sacrifices optimality and always produces a result if one is
-- available, by looking only at the very largest coins available.
--
-- This result can be computed very quickly, without using much search space.
--
selectCollateralLargest :: forall u. Ord u => PerformSelection u
selectCollateralLargest :: PerformSelection u
selectCollateralLargest SelectionConstraints
constraints SelectionParams u
params =
    case Maybe (Map u Coin)
smallestValidSubmapOfLargestCombinationAvailable of
        Just Map u Coin
coinsSelected ->
            SelectionResult u
-> Either (SelectionCollateralError u) (SelectionResult u)
forall a b. b -> Either a b
Right SelectionResult :: forall u. Map u Coin -> SelectionResult u
SelectionResult {Map u Coin
coinsSelected :: Map u Coin
$sel:coinsSelected:SelectionResult :: Map u Coin
coinsSelected}
        Maybe (Map u Coin)
Nothing ->
            SelectionCollateralError u
-> Either (SelectionCollateralError u) (SelectionResult u)
forall a b. a -> Either a b
Left SelectionCollateralError :: forall u. Map u Coin -> Coin -> SelectionCollateralError u
SelectionCollateralError
                { Map u Coin
largestCombinationAvailable :: Map u Coin
$sel:largestCombinationAvailable:SelectionCollateralError :: Map u Coin
largestCombinationAvailable
                , Coin
minimumSelectionAmount :: Coin
$sel:minimumSelectionAmount:SelectionCollateralError :: Coin
minimumSelectionAmount
                }
  where
    largestCombinationAvailable :: Map u Coin
    largestCombinationAvailable :: Map u Coin
largestCombinationAvailable =
        Map u Coin
coinsAvailable
            Map u Coin -> (Map u Coin -> [(u, Coin)]) -> [(u, Coin)]
forall a b. a -> (a -> b) -> b
& Map u Coin -> [(u, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList
            [(u, Coin)] -> ([(u, Coin)] -> [(u, Coin)]) -> [(u, Coin)]
forall a b. a -> (a -> b) -> b
& ((u, Coin) -> Down Coin) -> [(u, Coin)] -> [(u, Coin)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Coin -> Down Coin
forall a. a -> Down a
Down (Coin -> Down Coin)
-> ((u, Coin) -> Coin) -> (u, Coin) -> Down Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u, Coin) -> Coin
forall a b. (a, b) -> b
snd)
            [(u, Coin)] -> ([(u, Coin)] -> [(u, Coin)]) -> [(u, Coin)]
forall a b. a -> (a -> b) -> b
& Int -> [(u, Coin)] -> [(u, Coin)]
forall a. Int -> [a] -> [a]
L.take Int
maximumSelectionSize
            [(u, Coin)] -> ([(u, Coin)] -> Map u Coin) -> Map u Coin
forall a b. a -> (a -> b) -> b
& [(u, Coin)] -> Map u Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

    smallestValidSubmapOfLargestCombinationAvailable :: Maybe (Map u Coin)
    smallestValidSubmapOfLargestCombinationAvailable :: Maybe (Map u Coin)
smallestValidSubmapOfLargestCombinationAvailable =
        Map u Coin
largestCombinationAvailable
            Map u Coin -> (Map u Coin -> Set (Map u Coin)) -> Set (Map u Coin)
forall a b. a -> (a -> b) -> b
& Map u Coin -> Set (Map u Coin)
forall a b. (Ord a, Ord b) => Map a b -> Set (Map a b)
submaps
            Set (Map u Coin)
-> (Set (Map u Coin) -> [Map u Coin]) -> [Map u Coin]
forall a b. a -> (a -> b) -> b
& Set (Map u Coin) -> [Map u Coin]
forall a. Set a -> [a]
Set.toList
            [Map u Coin]
-> ([Map u Coin] -> [(Map u Coin, Coin)]) -> [(Map u Coin, Coin)]
forall a b. a -> (a -> b) -> b
& (Map u Coin -> (Map u Coin, Coin))
-> [Map u Coin] -> [(Map u Coin, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map u Coin
ics -> (Map u Coin
ics, Map u Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Map u Coin
ics))
            [(Map u Coin, Coin)]
-> ([(Map u Coin, Coin)] -> [(Map u Coin, Coin)])
-> [(Map u Coin, Coin)]
forall a b. a -> (a -> b) -> b
& ((Map u Coin, Coin) -> Coin)
-> [(Map u Coin, Coin)] -> [(Map u Coin, Coin)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Map u Coin, Coin) -> Coin
forall a b. (a, b) -> b
snd
            [(Map u Coin, Coin)]
-> ([(Map u Coin, Coin)] -> [(Map u Coin, Coin)])
-> [(Map u Coin, Coin)]
forall a b. a -> (a -> b) -> b
& ((Map u Coin, Coin) -> Bool)
-> [(Map u Coin, Coin)] -> [(Map u Coin, Coin)]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile ((Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
minimumSelectionAmount) (Coin -> Bool)
-> ((Map u Coin, Coin) -> Coin) -> (Map u Coin, Coin) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map u Coin, Coin) -> Coin
forall a b. (a, b) -> b
snd)
            [(Map u Coin, Coin)]
-> ([(Map u Coin, Coin)] -> [Map u Coin]) -> [Map u Coin]
forall a b. a -> (a -> b) -> b
& ((Map u Coin, Coin) -> Map u Coin)
-> [(Map u Coin, Coin)] -> [Map u Coin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map u Coin, Coin) -> Map u Coin
forall a b. (a, b) -> a
fst
            [Map u Coin]
-> ([Map u Coin] -> Maybe (Map u Coin)) -> Maybe (Map u Coin)
forall a b. a -> (a -> b) -> b
& [Map u Coin] -> Maybe (Map u Coin)
forall a. [a] -> Maybe a
listToMaybe

    SelectionConstraints
        { Int
maximumSelectionSize :: Int
$sel:maximumSelectionSize:SelectionConstraints :: SelectionConstraints -> Int
maximumSelectionSize
        } = SelectionConstraints
constraints
    SelectionParams
        { Map u Coin
coinsAvailable :: Map u Coin
$sel:coinsAvailable:SelectionParams :: forall u. SelectionParams u -> Map u Coin
coinsAvailable
        , Coin
minimumSelectionAmount :: Coin
$sel:minimumSelectionAmount:SelectionParams :: forall u. SelectionParams u -> Coin
minimumSelectionAmount
        } = SelectionParams u
params

--------------------------------------------------------------------------------
-- Generating submaps
--------------------------------------------------------------------------------

-- | Generates all submaps of a given map.
--
-- This function is analogous to 'Set.powerSet'.
--
-- For a map 'm' of size 'n', this function will generate all possible submaps,
-- including the empty map and the original map 'm'.
--
submaps :: forall a b. (Ord a, Ord b) => Map a b -> Set (Map a b)
submaps :: Map a b -> Set (Map a b)
submaps Map a b
m = (Set a -> Map a b) -> Set (Set a) -> Set (Map a b)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Map a b -> Set a -> Map a b
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map a b
m) (Set a -> Set (Set a)
forall a. Set a -> Set (Set a)
Set.powerSet (Map a b -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a b
m))

--------------------------------------------------------------------------------
-- Guarding search space size
--------------------------------------------------------------------------------

data SearchSpaceRequirement
    = SearchSpaceRequirement Int
      -- ^ Indicates a known search space requirement.
    | SearchSpaceRequirementUnknown
      -- ^ Indicates that the search space requirement is unknown.

guardSearchSpaceSize
    :: SearchSpaceRequirement
    -- ^ The search space requirement
    -> SearchSpaceLimit
    -- ^ The search space limit
    -> Maybe a
    -- ^ A computation that potentially yields a value
    -> Maybe a
    -- ^ The guarded computation
guardSearchSpaceSize :: SearchSpaceRequirement -> SearchSpaceLimit -> Maybe a -> Maybe a
guardSearchSpaceSize SearchSpaceRequirement
requirement SearchSpaceLimit
limit =
    case SearchSpaceRequirement
requirement of
        -- When the search space requirement is unknown, err on the side of
        -- caution and avoid evaluating the computation, unless the caller
        -- has explicitly specified that there is no limit:
        SearchSpaceRequirement
SearchSpaceRequirementUnknown ->
            case SearchSpaceLimit
limit of
                SearchSpaceLimit Int
_       -> Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
                SearchSpaceLimit
UnsafeNoSearchSpaceLimit -> Maybe a -> Maybe a
forall a. a -> a
id
        -- When the search space requirement is known, only evaluate the
        -- computation if the requirement is not greater than the limit:
        SearchSpaceRequirement Int
r ->
            case SearchSpaceLimit
limit of
                SearchSpaceLimit Int
l | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r -> Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
                SearchSpaceLimit Int
_         -> Maybe a -> Maybe a
forall a. a -> a
id
                SearchSpaceLimit
UnsafeNoSearchSpaceLimit   -> Maybe a -> Maybe a
forall a. a -> a
id

--------------------------------------------------------------------------------
-- Generating subsequences
--------------------------------------------------------------------------------

-- | Computes the number of subsequences generated by 'subsequencesOfSize'.
--
-- This function can be used to determine whether calling 'subsequencesOfSize'
-- would use an excessive amount of time and space, and if so, avoid calling
-- it.
--
-- Returns 'Nothing' if the result is larger than 'maxBound :: Int'.
--
numberOfSubsequencesOfSize
    :: Int
    -- ^ Indicates the size of the sequence.
    -> Int
    -- ^ Indicates the size of subsequences.
    -> Maybe Int
numberOfSubsequencesOfSize :: Int -> Int -> Maybe Int
numberOfSubsequencesOfSize Int
n Int
k
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<   Int
0      = Maybe Int
forall a. Maybe a
Nothing
    | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==  Int
n      = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
    | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
    | Bool
resultOutOfBounds      = Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise              = Integer -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
intCastMaybe Integer
resultExact
  where
    resultExact :: Integer
    resultExact :: Integer
resultExact = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
MathExact.choose
        (Int -> Integer
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast @Int @Integer Int
n)
        (Int -> Integer
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast @Int @Integer Int
k)

    resultFast :: Integer
    resultFast :: Integer
resultFast = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Int -> Double
MathFast.choose Int
n Int
k)

    resultOutOfBounds :: Bool
    resultOutOfBounds :: Bool
resultOutOfBounds = Bool
False
        Bool -> Bool -> Bool
|| Integer
resultFast  Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        Bool -> Bool -> Bool
|| Integer
resultFast  Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast @Int @Integer (Bounded Int => Int
forall a. Bounded a => a
maxBound @Int)
        Bool -> Bool -> Bool
|| Integer
resultExact Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        Bool -> Bool -> Bool
|| Integer
resultExact Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast @Int @Integer (Bounded Int => Int
forall a. Bounded a => a
maxBound @Int)

-- | Generates all subsequences of size 'k' from a particular sequence.
--
-- Warning: this function can use an excessive amount of time and space.
--
-- To check how many results would be returned without actually generating
-- them, use the 'numberOfSubsequencesOfSize' function.
--
-- Properties:
--
--    >>> all (== k) (length <$> xs `subsequencesOfSize` k)
--
--    >>> length (xs `subsequencesOfSize` k) ==
--    >>>     length xs `numberOfSubsequencesOfSize` k
--
subsequencesOfSize
    :: [a]
    -- ^ The sequence from which to generate subsequences.
    -> Int
    -- ^ The size 'k' of subsequences to generate.
    -> [[a]]
    -- ^ All subsequences of size 'k'.
subsequencesOfSize :: [a] -> Int -> [[a]]
subsequencesOfSize [a]
xs Int
k
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 =
        []
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs =
        []
    | Bool
otherwise =
        case Int -> [[[a]]] -> [[[a]]]
forall a. Int -> [a] -> [a]
drop Int
k ([a] -> [[[a]]]
forall a. [a] -> [[[a]]]
subsequencesBySize [a]
xs) of
            [[a]]
result : [[[a]]]
_ -> [[a]]
result
            [] -> []
  where
    subsequencesBySize :: [a] -> [[[a]]]
subsequencesBySize [] = [[[]]]
    subsequencesBySize (a
y : [a]
ys) =
        ([[a]] -> [[a]] -> [[a]]) -> [[[a]]] -> [[[a]]] -> [[[a]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
(++)
            ([] [[a]] -> [[[a]]] -> [[[a]]]
forall a. a -> [a] -> [a]
: ([[a]] -> [[a]]) -> [[[a]]] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [[[a]]]
next)
            ([[[a]]]
next [[[a]]] -> [[[a]]] -> [[[a]]]
forall a. [a] -> [a] -> [a]
++ [[]])
      where
        next :: [[[a]]]
next = [a] -> [[[a]]]
subsequencesBySize [a]
ys

--------------------------------------------------------------------------------
-- Control flow
--------------------------------------------------------------------------------

-- | Applies a sequence of functions to an argument until one succeeds.
--
-- This function iterates through the specified sequence from left to right,
-- applying each function to the given argument, and returning the very first
-- 'Right' result encountered, without evaluating the subsequent functions.
--
-- If none of the given functions produces a 'Right' result, then this function
-- returns the 'Left' result produced by the last function in the sequence.
--
firstRight :: NonEmpty (a -> Either e r) -> (a -> Either e r)
firstRight :: NonEmpty (a -> Either e r) -> a -> Either e r
firstRight = NonEmpty (a -> Either e r) -> a -> Either e r
forall a. Semigroup a => NonEmpty a -> a
sconcat

-- | Takes items from a list until a predicate becomes true.
--
-- The returned list is a prefix of the original list, and includes the very
-- first item that satisfies the predicate.
--
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
ys -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: if a -> Bool
p a
x then [] else [a]
ys) []