Safe Haskell | None |
---|---|
Language | Haskell2010 |
ProductMixAuction.Supply
Contents
Description
Representation of supply specifications (including supply curves and supply orderings) for all kinds of Product-Mix Auction.
- data Step u = Step {
- _step_units :: u
- _step_price :: Price
- data SupplyCurve u = SupplyCurve {
- _sc_steps :: [Step u]
- _sc_final_price :: Maybe Price
- mkEmptySupplyCurve :: SupplyCurve u
- mkFixedSupplyCurve :: (Ord u, Num u) => u -> SupplyCurve u
- mkFiniteSupplyCurve :: (Ord u, Num u) => [Step u] -> SupplyCurve u
- mkInfiniteSupplyCurve :: (Ord u, Num u) => [Step u] -> Price -> SupplyCurve u
- mkSupplyCurve :: (Ord u, Num u) => [Step u] -> Maybe Price -> SupplyCurve u
- unpackSupplyCurve :: SupplyCurve u -> [(Int, Step (Maybe u))]
- totalSupplyCurve :: Num u => SupplyCurve u -> u
- showSupplyCurve :: Show u => SupplyCurve u -> String
- isNondecreasingSupplyCurve :: SupplyCurve u -> Bool
- firstReservePrice :: SupplyCurve u -> Maybe Price
- data Supply u = Supply {}
- data SupplyCurveAndCover u = SupplyCurveAndCover {
- _scac_curve :: SupplyCurve u
- _scac_cover :: [Good]
- data SupplyOrdering
- = Horizontal
- | Vertical
- | Other
- type SupplyDir u = [(G, SupplyCurve u)] -> Supply u
- mkHorizontalSupply :: [(Good, SupplyCurve u)] -> Supply u
- mkVerticalSupply :: [(Good, SupplyCurve u)] -> Supply u
- mkFixedSupply :: (Ord u, Num u) => [(Good, u)] -> Supply u
- mkTabularSupply :: [[(Good, SupplyCurve u)]] -> Supply u
- mkTabularSupplyWithBase :: (Good, SupplyCurve u) -> [[(Good, SupplyCurve u)]] -> Supply u
- lookupSupplyCurve :: Good -> Supply u -> SupplyCurve u
- listSupplyCurves :: Supply u -> [(Good, SupplyCurve u)]
- numSupplyCurves :: Supply u -> Int
- supplyGoods :: Supply u -> [Good]
- supplyGoodsAbove :: Good -> Supply u -> [Good]
- supplyGoodsAboveAll :: Good -> Supply u -> [Good]
- supplyGoodBelow :: Good -> Supply u -> Maybe Good
- firstGoods :: Supply u -> Set Good
- isFirstGood :: Good -> Supply u -> Bool
- isLastGood :: Good -> Supply u -> Bool
- isHorizontalSupply :: Supply u -> Bool
- isVerticalSupply :: Supply u -> Bool
- totalSupply :: Num u => Supply u -> u
- showSupply :: Show u => Supply u -> String
- allocAbove :: Num u => Supply u -> Map Good u -> Good -> u
- relativePrice :: Supply u -> Map Good Price -> Good -> Price
- setSupplyCurve :: Good -> SupplyCurve u -> Supply u -> Supply u
- decreasingSupply :: Supply u -> Maybe Good
- type SupplyScaleFunction = Units -> Supply Units -> Supply Units
- newtype SupplyScaleLambda = SupplyScaleLambda {
- _ssl_lambda :: Ratio
- scaleSupplyCurve :: Ratio -> SupplyCurve Units -> SupplyCurve Units
- scaleSupply :: SupplyScaleLambda -> Units -> Supply Units -> Supply Units
- scaleSupplyRounded :: ScaleFactor -> SupplyScaleLambda -> SupplyScaleFunction
- ceilingSupply :: RealFrac u => ScaleFactor -> Supply u -> Supply u
- ceilingSupplyCurve :: RealFrac u => ScaleFactor -> SupplyCurve u -> SupplyCurve u
- arbitrarySupply :: Num u => [Good] -> Gen Int -> Gen u -> Gen Price -> Gen (Supply u)
- arbitrarySupplyWithDir :: Num u => Gen (SupplyDir u) -> [Good] -> Gen Int -> Gen u -> Gen Price -> Gen (Supply u)
- arbitraryStep :: Gen u -> Gen Price -> Gen (Step u)
- arbitrarySteps :: Num u => Gen Int -> Gen u -> Gen Price -> Gen [Step u]
- arbitrarySupplyCurve :: Num u => Gen Int -> Gen u -> Gen Price -> Gen (SupplyCurve u)
- arbitraryFiniteSupplyCurve :: Num u => Gen Int -> Gen u -> Gen Price -> Gen (SupplyCurve u)
- step_units :: forall u u. Lens (Step u) (Step u) u u
- step_price :: forall u. Lens' (Step u) Price
- sc_steps :: forall u u. Lens (SupplyCurve u) (SupplyCurve u) [Step u] [Step u]
- sc_final_price :: forall u. Lens' (SupplyCurve u) (Maybe Price)
- scac_curve :: forall u u. Lens (SupplyCurveAndCover u) (SupplyCurveAndCover u) (SupplyCurve u) (SupplyCurve u)
- scac_cover :: forall u. Lens' (SupplyCurveAndCover u) [Good]
- supply_ordering :: forall u. Lens' (Supply u) SupplyOrdering
- supply_curves :: forall u u. Lens (Supply u) (Supply u) (Map Good (SupplyCurveAndCover u)) (Map Good (SupplyCurveAndCover u))
Individual supply curves
A single step of a supply curve, parameterised in the representation of quantities of goods. Note that the step length is relative, i.e. the width of this single step rather than the total number of units sold up to this point.
Constructors
Step | |
Fields
|
Instances
Functor Step Source # | |
Eq u => Eq (Step u) Source # | |
Read u => Read (Step u) Source # | |
Show u => Show (Step u) Source # | |
Generic (Step u) Source # | |
ToJSON u => ToJSON (Step u) Source # | |
FromJSON u => FromJSON (Step u) Source # | |
FromField u => FromRecord (Step u) Source # | |
Default u => Default (Step u) Source # | |
type Rep (Step u) Source # | |
data SupplyCurve u Source #
A supply "curve" is in fact a step function, with the price increasing at each step. A final price may optionally be specified, indicating that there is an unlimited quantity available at that price.
Quantities are those for the good to which this supply curve belongs, and all later goods (if any). Prices are expressed relative to the preceding good (or to "no sale", if there is no preceding good).
Constructors
SupplyCurve | |
Fields
|
Instances
Functor SupplyCurve Source # | |
Eq u => Eq (SupplyCurve u) Source # | |
Read u => Read (SupplyCurve u) Source # | |
Show u => Show (SupplyCurve u) Source # | |
Generic (SupplyCurve u) Source # | |
ToJSON u => ToJSON (SupplyCurve u) Source # | |
FromJSON u => FromJSON (SupplyCurve u) Source # | |
Default (SupplyCurve u) Source # | |
type Rep (SupplyCurve u) Source # | |
mkEmptySupplyCurve :: SupplyCurve u Source #
Make a supply curve with no quantity available at all.
mkFixedSupplyCurve :: (Ord u, Num u) => u -> SupplyCurve u Source #
Make a single-step supply curve with a fixed quantity available and no price margin over the previous good.
mkFiniteSupplyCurve :: (Ord u, Num u) => [Step u] -> SupplyCurve u Source #
Make a stepped supply curve with a finite total quantity (i.e. going off vertically to infinity). Steps of width 0 will be ignored.
mkInfiniteSupplyCurve :: (Ord u, Num u) => [Step u] -> Price -> SupplyCurve u Source #
Make a stepped supply curve with an infinite quantity available (i.e. going off horizontally to infinity). Steps of width 0 will be ignored.
This is not fully supported and may be removed.
mkSupplyCurve :: (Ord u, Num u) => [Step u] -> Maybe Price -> SupplyCurve u Source #
Make a supply curve with an optional final price, filtering out any zero-width steps.
unpackSupplyCurve :: SupplyCurve u -> [(Int, Step (Maybe u))] Source #
View a supply curve as a list of indexed steps, satisfying the invariant
that only the final step may have Nothing
for the quantity.
totalSupplyCurve :: Num u => SupplyCurve u -> u Source #
Total quantity available in (the finite part of) the supply curve, i.e. the total width of the steps.
showSupplyCurve :: Show u => SupplyCurve u -> String Source #
Render a supply curve as a list of (quantity, price) pairs.
isNondecreasingSupplyCurve :: SupplyCurve u -> Bool Source #
Check that a supply curve is non-decreasing.
firstReservePrice :: SupplyCurve u -> Maybe Price Source #
Extract the (first) reserve price from a supply curve. Returns Nothing
if the supply curve has no steps.
Sets of supply curves
The supply for an auction consists of:
- a set of goods (represented by the domain of the map);
- a partial order on this set (represented by listing the covers for each good, i.e. its immediate successors);
- a
SupplyCurve
for each good, expressing how the reserve price relative to the previous good increases as the quantity sold of this good and all larger goods increases.
The partial order must be a subset of the total order induced by
the Ord
instance on goods (i.e. if j1
has a cover j2
then we
must have j1 < j2 == True
).
It is not yet clear that arbitrary partial orders make sense economically, but it is a convenient generalisation for implementation purposes. The smart constructors below implement partial orders that lead to sensible results.
Note that the representation of the partial order by its covers does not enforce that it is antisymmetric. Violating this property may create a cyclic graph, leading to nontermination or other nonsense.
Constructors
Supply | |
Fields
|
data SupplyCurveAndCover u Source #
Data stored about each good in a Supply
.
Constructors
SupplyCurveAndCover | |
Fields
|
Instances
Functor SupplyCurveAndCover Source # | |
Eq u => Eq (SupplyCurveAndCover u) Source # | |
Read u => Read (SupplyCurveAndCover u) Source # | |
Show u => Show (SupplyCurveAndCover u) Source # | |
Generic (SupplyCurveAndCover u) Source # | |
ToJSON u => ToJSON (SupplyCurveAndCover u) Source # | |
FromJSON u => FromJSON (SupplyCurveAndCover u) Source # | |
Default (SupplyCurveAndCover u) Source # | |
type Rep (SupplyCurveAndCover u) Source # | |
data SupplyOrdering Source #
Ordering on goods in a Supply
.
Constructors
Horizontal | Horizontal ordering: each good is priced relative to selling nothing at all, using the identity relation as the partial order. |
Vertical | Vertical ordering: each good is priced relative to the previous good and below all succeeding goods. |
Other | An arbitrary partial order. |
Instances
Eq SupplyOrdering Source # | |
Show SupplyOrdering Source # | |
Generic SupplyOrdering Source # | |
ToJSON SupplyOrdering Source # | |
FromJSON SupplyOrdering Source # | |
Default SupplyOrdering Source # | |
type Rep SupplyOrdering Source # | |
mkHorizontalSupply :: [(Good, SupplyCurve u)] -> Supply u Source #
Make a horizontal supply, where all goods are priced relative to selling nothing at all, using the identity relation as the partial order. The order of the list is unimportant.
mkVerticalSupply :: [(Good, SupplyCurve u)] -> Supply u Source #
Make a vertical supply, where each good is priced relative to the previous element of the list and below all the succeeding elements.
mkFixedSupply :: (Ord u, Num u) => [(Good, u)] -> Supply u Source #
Make horizontal supply curves corresponding to a list of fixed total quantities of each good.
mkTabularSupply :: [[(Good, SupplyCurve u)]] -> Supply u Source #
Make a tabular supply, where each element of the outer list of lists gives a vertical column, and the columns themselves are ordered horizontally.
mkTabularSupplyWithBase :: (Good, SupplyCurve u) -> [[(Good, SupplyCurve u)]] -> Supply u Source #
Make a tabular supply, where each element of the outer list of lists gives a vertical column, and the columns themselves are ordered horizontally. A single good is below all the columns.
lookupSupplyCurve :: Good -> Supply u -> SupplyCurve u Source #
Look up the supply curve for a particular good, returning the empty supply curve if the good is not available at all.
listSupplyCurves :: Supply u -> [(Good, SupplyCurve u)] Source #
List all the goods with their corresponding supply curves.
numSupplyCurves :: Supply u -> Int Source #
Number of supply curves in the supply.
supplyGoods :: Supply u -> [Good] Source #
List all the goods from the supply.
supplyGoodsAbove :: Good -> Supply u -> [Good] Source #
List all goods that are immediate successors of the given good.
supplyGoodsAboveAll :: Good -> Supply u -> [Good] Source #
List all goods that are (transitively) non-strictly larger than the given good.
supplyGoodBelow :: Good -> Supply u -> Maybe Good Source #
Find the good that is the immediate predecessor of the given good, if there is one.
firstGoods :: Supply u -> Set Good Source #
Calculate the set of all "bottom" goods in the supply, i.e. those priced relative to selling nothing at all. This will be all the goods for a horizontal supply, or just the first good for a vertical supply.
isHorizontalSupply :: Supply u -> Bool Source #
Is this supply ordered horizontally?
isVerticalSupply :: Supply u -> Bool Source #
Is this supply ordered vertically?
totalSupply :: Num u => Supply u -> u Source #
Calculate the total quantity available from (the finite parts of) the supply curves for the first goods.
showSupply :: Show u => Supply u -> String Source #
Render a set of supply curves in a vaguely human-readable format.
allocAbove :: Num u => Supply u -> Map Good u -> Good -> u Source #
Given a supply and the amounts allocated to each good, calculate the total allocated to a good and all its successors.
relativePrice :: Supply u -> Map Good Price -> Good -> Price Source #
Look up the price of a good relative to the preceding good (or to no sale, if there is no preceding good).
setSupplyCurve :: Good -> SupplyCurve u -> Supply u -> Supply u Source #
Set the supply of a single good within the set of supply curves.
decreasingSupply :: Supply u -> Maybe Good Source #
Find the first good with a decreasing supply curve. For a valid
supply this should return Nothing
.
Scaling/rounding supply curves
type SupplyScaleFunction = Units -> Supply Units -> Supply Units Source #
Function to rescale a set of supply curves, given a new total size of the supply.
newtype SupplyScaleLambda Source #
Parameter to control how supply is scaled when a TQSS is in use.
See scaleSupply
for how this is used.
Constructors
SupplyScaleLambda | |
Fields
|
Instances
Eq SupplyScaleLambda Source # | |
Show SupplyScaleLambda Source # | |
Generic SupplyScaleLambda Source # | |
ToJSON SupplyScaleLambda Source # | |
FromJSON SupplyScaleLambda Source # | |
Default SupplyScaleLambda Source # | |
Arbitrary SupplyScaleLambda Source # | |
type Rep SupplyScaleLambda Source # | |
scaleSupplyCurve :: Ratio -> SupplyCurve Units -> SupplyCurve Units Source #
Multiply all the step lengths in the supply curve by the given scaling factor.
scaleSupply :: SupplyScaleLambda -> Units -> Supply Units -> Supply Units Source #
Scale a supply to the given total size. First goods will be
scaled in proportion to the new total size. Subsequent goods will
be scaled depending on the parameter lambda
, which must be in the
interval [0,1]
:
lambda = 0
scales all goods in proportion to the new total size;lambda = 1
does not scale goods other than the first goods.
scaleSupplyRounded :: ScaleFactor -> SupplyScaleLambda -> SupplyScaleFunction Source #
Scale the supply curves based on the SupplyScaleLambda
, then
round the step widths to the ScaleFactor
.
ceilingSupply :: RealFrac u => ScaleFactor -> Supply u -> Supply u Source #
Round all the supply curves using ceilingSupplyCurve
.
ceilingSupplyCurve :: RealFrac u => ScaleFactor -> SupplyCurve u -> SupplyCurve u Source #
Round the widths of the supply curve steps to a precision given
by the ScaleFactor
. This rounds upwards the cumulative total
width of all the steps.
Arbitrary supply curve generation
arbitrarySupply :: Num u => [Good] -> Gen Int -> Gen u -> Gen Price -> Gen (Supply u) Source #
Generate an arbitrary set of supply curves for the given goods, with either a horizontal or a vertical ordering.
arbitrarySupplyWithDir :: Num u => Gen (SupplyDir u) -> [Good] -> Gen Int -> Gen u -> Gen Price -> Gen (Supply u) Source #
Generate an arbitrary set of supply curves for the given goods, with a supplied generator for supply orderings, as well as generators for the number of steps, step width and step height.
arbitraryStep :: Gen u -> Gen Price -> Gen (Step u) Source #
Generate an arbitrary supply curve step, given generators for the step width (quantity available) and height (price margin).
arbitrarySupplyCurve :: Num u => Gen Int -> Gen u -> Gen Price -> Gen (SupplyCurve u) Source #
Generate an arbitrary supply curve, given generators for the number of supply curve steps, step width and step height.
arbitraryFiniteSupplyCurve :: Num u => Gen Int -> Gen u -> Gen Price -> Gen (SupplyCurve u) Source #
Generate an arbitrary finite supply curve, given generators for the number of supply curve steps, step width and step height.
Lenses
step_units :: forall u u. Lens (Step u) (Step u) u u Source #
step_price :: forall u. Lens' (Step u) Price Source #
sc_steps :: forall u u. Lens (SupplyCurve u) (SupplyCurve u) [Step u] [Step u] Source #
sc_final_price :: forall u. Lens' (SupplyCurve u) (Maybe Price) Source #
scac_curve :: forall u u. Lens (SupplyCurveAndCover u) (SupplyCurveAndCover u) (SupplyCurve u) (SupplyCurve u) Source #
scac_cover :: forall u. Lens' (SupplyCurveAndCover u) [Good] Source #
supply_ordering :: forall u. Lens' (Supply u) SupplyOrdering Source #
supply_curves :: forall u u. Lens (Supply u) (Supply u) (Map Good (SupplyCurveAndCover u)) (Map Good (SupplyCurveAndCover u)) Source #