Add the SelectionStrategy type.

lib/core/src/Cardano/Wallet.hs

@@ -230,6 +230,7 @@ import Cardano.Wallet.CoinSelection
     , SelectionReportDetailed
     , SelectionReportSummarized
     , SelectionSkeleton (..)
+    , SelectionStrategy (..)
     , UnableToConstructChangeError (..)
     , emptySkeleton
     , makeSelectionReportDetailed
@@ -1540,6 +1541,7 @@ balanceTransaction
                 , utxoAvailableForInputs
                 , utxoAvailableForCollateral
                 , wallet
+                , selectionStrategy = SelectionStrategyOptimal
                 }
                 transform
 
@@ -1929,6 +1931,8 @@ data SelectAssetsParams s result = SelectAssetsParams
     , utxoAvailableForCollateral :: Map InputId TokenBundle
     , utxoAvailableForInputs :: UTxOSelection InputId
     , wallet :: Wallet s
+    , selectionStrategy :: SelectionStrategy
+        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
     }
     deriving Generic
 
@@ -1986,6 +1990,8 @@ selectAssets ctx pp params transform = do
                 intCast @Word16 @Int $ view #maximumCollateralInputCount pp
             , minimumCollateralPercentage =
                 view #minimumCollateralPercentage pp
+            , selectionStrategy =
+                view #selectionStrategy params
             }
     let selectionParams = SelectionParams
             { assetsToMint =

lib/core/src/Cardano/Wallet/CoinSelection.hs

@@ -31,6 +31,7 @@ module Cardano.Wallet.CoinSelection
     , SelectionLimitOf (..)
     , SelectionOf (..)
     , SelectionParams (..)
+    , SelectionStrategy (..)
 
     -- * Selection skeletons
     , SelectionSkeleton (..)
@@ -69,6 +70,7 @@ import Cardano.Wallet.CoinSelection.Internal.Balance
     , SelectionBalanceError (..)
     , SelectionLimit
     , SelectionLimitOf (..)
+    , SelectionStrategy (..)
     , UnableToConstructChangeError (..)
     , balanceMissing
     )
@@ -163,6 +165,9 @@ data SelectionConstraints = SelectionConstraints
         :: Natural
         -- ^ Specifies the minimum required amount of collateral as a
         -- percentage of the total transaction fee.
+    , selectionStrategy
+        :: SelectionStrategy
+        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
     }
     deriving Generic
 

lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs

@@ -72,6 +72,7 @@ import Cardano.Wallet.CoinSelection.Internal.Balance
     , SelectionDelta (..)
     , SelectionLimit
     , SelectionSkeleton
+    , SelectionStrategy (..)
     )
 import Cardano.Wallet.CoinSelection.Internal.Collateral
     ( SelectionCollateralError )
@@ -175,6 +176,9 @@ data SelectionConstraints = SelectionConstraints
         :: Natural
         -- ^ Specifies the minimum required amount of collateral as a
         -- percentage of the total transaction fee.
+    , selectionStrategy
+        :: SelectionStrategy
+        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
     }
     deriving Generic
 
@@ -371,6 +375,8 @@ toBalanceConstraintsParams (constraints, params) =
                 & adjustComputeSelectionLimit
         , assessTokenBundleSize =
             view #assessTokenBundleSize constraints
+        , selectionStrategy =
+            view #selectionStrategy constraints
         }
       where
         adjustComputeMinimumCost

lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs

@@ -38,6 +38,7 @@ module Cardano.Wallet.CoinSelection.Internal.Balance
     , SelectionSkeleton (..)
     , SelectionResult
     , SelectionResultOf (..)
+    , SelectionStrategy (..)
     , SelectionBalanceError (..)
     , BalanceInsufficientError (..)
     , InsufficientMinCoinValueError (..)
@@ -229,6 +230,9 @@ data SelectionConstraints = SelectionConstraints
         :: [(Address, TokenBundle)] -> SelectionLimit
         -- ^ Computes an upper bound for the number of ordinary inputs to
         -- select, given a current set of outputs.
+    , selectionStrategy
+        :: SelectionStrategy
+        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
     }
     deriving Generic
 
@@ -277,6 +281,22 @@ deriving instance
     (Show (outputs (Address, TokenBundle)), Show u) =>
         Show (SelectionParamsOf outputs u)
 
+-- | Indicates a choice of selection strategy.
+--
+-- A 'SelectionStrategy' determines __how much__ of each asset the selection
+-- algorithm will attempt to select from the available UTxO set, relative to
+-- the minimum amount necessary to make the selection balance.
+--
+-- The default 'SelectionStrategy' is 'SelectionStrategyOptimal', which when
+-- specified will cause the selection algorithm to attempt to select around
+-- __/twice/__ the minimum possible amount of each asset from the available
+-- UTxO set, making it possible to generate change outputs that are roughly
+-- the same sizes and shapes as the user-specified outputs.
+--
+data SelectionStrategy
+    = SelectionStrategyOptimal
+    deriving (Eq, Show)
+
 -- | Indicates whether the balance of available UTxO entries is sufficient.
 --
 -- See 'computeUTxOBalanceSufficiency'.
@@ -838,6 +858,7 @@ performSelectionNonEmpty constraints params
             { selectionLimit
             , utxoAvailable
             , minimumBalance = utxoBalanceRequired
+            , selectionStrategy
             }
         case maybeSelection of
             Nothing | utxoAvailable == UTxOSelection.empty ->
@@ -859,6 +880,7 @@ performSelectionNonEmpty constraints params
         , computeMinimumAdaQuantity
         , computeMinimumCost
         , computeSelectionLimit
+        , selectionStrategy
         } = constraints
     SelectionParams
         { outputsToCover
@@ -1080,6 +1102,8 @@ data RunSelectionParams u = RunSelectionParams
         -- ^ UTxO entries available for selection.
     , minimumBalance :: TokenBundle
         -- ^ Minimum balance to cover.
+    , selectionStrategy :: SelectionStrategy
+        -- ^ Specifies which selection strategy to use. See 'SelectionStrategy'.
     }
     deriving (Eq, Generic, Show)
 
@@ -1112,6 +1136,7 @@ runSelection params =
         { selectionLimit
         , utxoAvailable
         , minimumBalance
+        , selectionStrategy
         } = params
 
     -- NOTE: We run the 'coinSelector' last, because we know that every input
@@ -1123,36 +1148,41 @@ runSelection params =
         reverse (coinSelector : fmap assetSelector minimumAssetQuantities)
       where
         assetSelector = runSelectionStep .
-            assetSelectionLens selectionLimit
+            assetSelectionLens selectionLimit selectionStrategy
         coinSelector = runSelectionStep $
-            coinSelectionLens selectionLimit minimumCoinQuantity
+            coinSelectionLens selectionLimit selectionStrategy
+            minimumCoinQuantity
 
     (minimumCoinQuantity, minimumAssetQuantities) =
         TokenBundle.toFlatList minimumBalance
 
 assetSelectionLens
     :: (MonadRandom m, Ord u)
     => SelectionLimit
+    -> SelectionStrategy
     -> (AssetId, TokenQuantity)
     -> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
-assetSelectionLens limit (asset, minimumAssetQuantity) = SelectionLens
+assetSelectionLens limit strategy (asset, minimumAssetQuantity) = SelectionLens
     { currentQuantity = selectedAssetQuantity asset
     , updatedQuantity = selectedAssetQuantity asset
     , minimumQuantity = unTokenQuantity minimumAssetQuantity
     , selectQuantity = selectAssetQuantity asset limit
+    , selectionStrategy = strategy
     }
 
 coinSelectionLens
     :: (MonadRandom m, Ord u)
     => SelectionLimit
+    -> SelectionStrategy
     -> Coin
     -- ^ Minimum coin quantity.
     -> SelectionLens m (UTxOSelection u) (UTxOSelectionNonEmpty u)
-coinSelectionLens limit minimumCoinQuantity = SelectionLens
+coinSelectionLens limit strategy minimumCoinQuantity = SelectionLens
     { currentQuantity = selectedCoinQuantity
     , updatedQuantity = selectedCoinQuantity
     , minimumQuantity = intCast $ unCoin minimumCoinQuantity
     , selectQuantity  = selectCoinQuantity limit
+    , selectionStrategy = strategy
     }
 
 -- | Specializes 'selectMatchingQuantity' to a particular asset.
@@ -1240,6 +1270,8 @@ data SelectionLens m state state' = SelectionLens
         :: state -> m (Maybe state')
     , minimumQuantity
         :: Natural
+    , selectionStrategy
+        :: SelectionStrategy
     }
 
 -- | Runs just a single step of a coin selection.
@@ -1275,6 +1307,7 @@ runSelectionStep lens s
         , updatedQuantity
         , minimumQuantity
         , selectQuantity
+        , selectionStrategy
         } = lens
 
     requireImprovement :: state' -> Maybe state'
@@ -1288,8 +1321,12 @@ runSelectionStep lens s
     updatedDistanceFromTarget :: state' -> Natural
     updatedDistanceFromTarget = distance targetQuantity . updatedQuantity
 
+    targetMultiplier :: Natural
+    targetMultiplier = case selectionStrategy of
+        SelectionStrategyOptimal -> 2
+
     targetQuantity :: Natural
-    targetQuantity = minimumQuantity * 2
+    targetQuantity = minimumQuantity * targetMultiplier
 
 --------------------------------------------------------------------------------
 -- Making change

lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs

@@ -57,6 +57,7 @@ import Cardano.Wallet.CoinSelection.Internal.Balance
     , SelectionResult
     , SelectionResultOf (..)
     , SelectionSkeleton (..)
+    , SelectionStrategy (..)
     , UnableToConstructChangeError (..)
     , addMintValueToChangeMaps
     , addMintValuesToChangeMaps
@@ -1063,6 +1064,7 @@ prop_performSelection mockConstraints params coverage =
                 , computeMinimumAdaQuantity = computeMinimumAdaQuantityZero
                 , computeMinimumCost = computeMinimumCostZero
                 , computeSelectionLimit = const NoLimit
+                , selectionStrategy = SelectionStrategyOptimal
                 }
             performSelection' = performSelection constraints' params
         in
@@ -1252,6 +1254,7 @@ prop_runSelection_UTxO_empty balanceRequested = monadicIO $ do
             { selectionLimit = NoLimit
             , utxoAvailable
             , minimumBalance = balanceRequested
+            , selectionStrategy = SelectionStrategyOptimal
             }
     let balanceSelected = UTxOSelection.selectedBalance result
     let balanceLeftover = UTxOSelection.leftoverBalance result
@@ -1274,6 +1277,7 @@ prop_runSelection_UTxO_notEnough utxoAvailable = monadicIO $ do
             { selectionLimit = NoLimit
             , utxoAvailable
             , minimumBalance = balanceRequested
+            , selectionStrategy = SelectionStrategyOptimal
             }
     let balanceSelected = UTxOSelection.selectedBalance result
     let balanceLeftover = UTxOSelection.leftoverBalance result
@@ -1297,6 +1301,7 @@ prop_runSelection_UTxO_exactlyEnough utxoAvailable = monadicIO $ do
             { selectionLimit = NoLimit
             , utxoAvailable
             , minimumBalance = balanceRequested
+            , selectionStrategy = SelectionStrategyOptimal
             }
     let balanceSelected = UTxOSelection.selectedBalance result
     let balanceLeftover = UTxOSelection.leftoverBalance result
@@ -1324,6 +1329,7 @@ prop_runSelection_UTxO_moreThanEnough utxoAvailable = monadicIO $ do
             { selectionLimit = NoLimit
             , utxoAvailable
             , minimumBalance = balanceRequested
+            , selectionStrategy = SelectionStrategyOptimal
             }
     let balanceSelected = UTxOSelection.selectedBalance result
     let balanceLeftover = UTxOSelection.leftoverBalance result
@@ -1371,6 +1377,7 @@ prop_runSelection_UTxO_muchMoreThanEnough (Blind (Large index)) =
                 { selectionLimit = NoLimit
                 , utxoAvailable
                 , minimumBalance = balanceRequested
+                , selectionStrategy = SelectionStrategyOptimal
                 }
         let balanceSelected = UTxOSelection.selectedBalance result
         let balanceLeftover = UTxOSelection.leftoverBalance result
@@ -1494,6 +1501,7 @@ runMockSelectionStep d =
         , updatedQuantity = id
         , minimumQuantity = mockMinimum d
         , selectQuantity = \s -> pure $ (+ s) <$> mockNext d
+        , selectionStrategy = SelectionStrategyOptimal
         }
 
 prop_runSelectionStep_supplyExhausted
@@ -1611,7 +1619,8 @@ prop_assetSelectionLens_givesPriorityToSingletonAssets (Blind (Small u)) =
     asset = Set.findMin $ UTxOIndex.assets u
     assetCount = Set.size $ UTxOIndex.assets u
     initialState = UTxOSelection.fromIndex u
-    lens = assetSelectionLens NoLimit (asset, minimumAssetQuantity)
+    lens = assetSelectionLens
+        NoLimit SelectionStrategyOptimal (asset, minimumAssetQuantity)
     minimumAssetQuantity = TokenQuantity 1
 
 prop_coinSelectionLens_givesPriorityToCoins
@@ -1641,7 +1650,8 @@ prop_coinSelectionLens_givesPriorityToCoins (Blind (Small u)) =
   where
     entryCount = UTxOIndex.size u
     initialState = UTxOSelection.fromIndex u
-    lens = coinSelectionLens NoLimit minimumCoinQuantity
+    lens = coinSelectionLens
+        NoLimit SelectionStrategyOptimal minimumCoinQuantity
     minimumCoinQuantity = Coin 1
 
 --------------------------------------------------------------------------------
@@ -1691,6 +1701,7 @@ mkBoundaryTestExpectation (BoundaryTestData params expectedResult) = do
         , assessTokenBundleSize = unMockAssessTokenBundleSize $
             boundaryTestBundleSizeAssessor params
         , computeSelectionLimit = const NoLimit
+        , selectionStrategy = SelectionStrategyOptimal
         }
 
 encodeBoundaryTestCriteria :: BoundaryTestCriteria -> SelectionParams InputId
@@ -2107,6 +2118,8 @@ unMockSelectionConstraints m = SelectionConstraints
         unMockComputeMinimumCost $ view #computeMinimumCost m
     , computeSelectionLimit =
         unMockComputeSelectionLimit $ view #computeSelectionLimit m
+    , selectionStrategy =
+        SelectionStrategyOptimal
     }
 
 --------------------------------------------------------------------------------

lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs

@@ -34,7 +34,7 @@ import Cardano.Wallet.CoinSelection.Internal
     , verifySelectionError
     )
 import Cardano.Wallet.CoinSelection.Internal.Balance
-    ( SelectionLimit, SelectionSkeleton )
+    ( SelectionLimit, SelectionSkeleton, SelectionStrategy (..) )
 import Cardano.Wallet.CoinSelection.Internal.Balance.Gen
     ( genSelectionSkeleton, shrinkSelectionSkeleton )
 import Cardano.Wallet.CoinSelection.Internal.BalanceSpec
@@ -577,6 +577,8 @@ unMockSelectionConstraints m = SelectionConstraints
         view #maximumCollateralInputCount m
     , minimumCollateralPercentage =
         view #minimumCollateralPercentage m
+    , selectionStrategy =
+        SelectionStrategyOptimal
     }
 
 --------------------------------------------------------------------------------