Richer Knowledgebase Access

Valuate a Bag of Coins

A bag of new US coins is stolen from a bank. Without opening the bag, what can be said about the monetary value of its contents? One obvious and easily measured physical characteristic is the bag's weight. Assuming a one-pound bag of coins, combine the Wolfram Knowledgebase's know-how on currencies and built-in ability to solve linear equations to study the expected value of the plunder.

To begin, return a list of US coins in current circulation by means of an implicitly defined entity class.

In[1]:=
Click for copyable input
EntityClass["CurrencyDenomination", {EntityProperty[ "CurrencyDenomination", "IssuingCountry"] -> Entity["Country", "UnitedStates"], EntityProperty["CurrencyDenomination", "Format"] -> "coin"}]
Out[1]=

Expand the implicitly defined entity class by clicking the [+], find its members, and sort them by value.

In[2]:=
Click for copyable input
coinsUS = EntityList[ EntityClass[ "CurrencyDenomination", { EntityProperty[ "CurrencyDenomination", "IssuingCountry"] -> Entity[ "Country", "UnitedStates"], EntityProperty["CurrencyDenomination", "Format"] -> "coin"}]] // SortBy[#[EntityProperty["CurrencyDenomination", "Value"]] &]
Out[2]=

Make a collage of coin images.

In[3]:=
Click for copyable input
ImageCollage[ EntityValue[coinsUS, EntityProperty["CurrencyDenomination", "Image"]], Background -> White]
Out[3]=

Summarize coin properties in a table.

In[4]:=
Click for copyable input
TextGrid[{ImageResize[#2, 60], #1, Row[Riffle[#3, Style[" | ", Gray]]]} & @@@ EntityValue[ coinsUS, {EntityProperty["CurrencyDenomination", "Entity"], EntityProperty["CurrencyDenomination", "Image"], EntityProperty["CurrencyDenomination", "PeopleOnCurrency"]}], Alignment -> {Left, Center}, Dividers -> All] // TraditionalForm
Out[4]//TraditionalForm=

Get coin denominations (in cents) and masses (in grams) and convert masses to rational numbers.

In[5]:=
Click for copyable input
{values, masses} = Transpose[EntityValue[coinsUS, {"Value", "Weight"}]]
Out[5]=
In[6]:=
Click for copyable input
coinsandweights = Transpose[{ QuantityMagnitude[UnitConvert[values, "USCents"]], Rationalize[QuantityMagnitude[N[UnitConvert[masses, "Grams"]]]] }]
Out[6]=
In[7]:=
Click for copyable input
lcm = LCM @@ Denominator[Rationalize[coinsandweights][[All, 2]]];
In[8]:=
Click for copyable input
rationalcoinweights = lcm #2 & @@@ Rationalize[coinsandweights]
Out[8]=

Find all coin distributions that are compatible with a weight measurement of one pound with an error measurement of ± 0.1% (assuming the bag itself contributes negligibly).

In[9]:=
Click for copyable input
meanWeight = QuantityMagnitude[UnitConvert[Quantity[1, "Pounds"], "Grams"]];
In[10]:=
Click for copyable input
error = Normal[Quantity[0.1, "Percent"]];
In[11]:=
Click for copyable input
{minScaledWeight, maxScaledWeight} = {Floor[lcm meanWeight (1 - error/2)], Ceiling[lcm meanWeight (1 + error/2)]}
Out[11]=

Use FrobeniusSolve to determine all possible coin collections giving the required total weight.

show complete Wolfram Language input
In[12]:=
Click for copyable input
allSolutions = Monitor[ Table[fb = FrobeniusSolve[rationalcoinweights, scaledweight], {scaledweight, minScaledWeight, maxScaledWeight}], Row[{NumberForm[ 100. (scaledweight - minScaledWeight)/(maxScaledWeight - minScaledWeight), {4, 1}, "NumberPadding" -> {" ", "0"}], "%: ", Length[fb], " solutions"}] ];
In[13]:=
Click for copyable input
Flatten[allSolutions, 1] // Length
Out[13]=

Find the minimum, median, mean, and maximum values of the total monetary value of the coins in the bag (assuming all combinations are equally likely).

show complete Wolfram Language input
In[14]:=
Click for copyable input
coins = coinsandweights[[All, 1]];
In[15]:=
Click for copyable input
dollarValues = (coins.#/100.) & /@ Flatten[allSolutions, 1];
In[16]:=
Click for copyable input
TextGrid[With[{stats = {Min, Median, Mean, Max}}, Transpose[{stats, NumberForm[Quantity[#, "USDollars"], {\[Infinity], 2}] & /@ Through[stats[dollarValues]]}]], Alignment -> {{Left, Decimal}}, Dividers -> All, Background -> {Automatic, {{LightBlue, None}}}] // TraditionalForm
Out[16]//TraditionalForm=

Make a histogram of the distribution of total money value.

In[17]:=
Click for copyable input
Histogram[dollarValues, Automatic, "PDF", AxesLabel -> {Quantity[None, "USDollars"], "fraction"}]
Out[17]=

The weight distribution of all sacks is fairly uniform.

show complete Wolfram Language input
In[18]:=
Click for copyable input
weights = coinsandweights[[All, -1]]; lbg = QuantityMagnitude[UnitConvert[Quantity[1, "Pounds"], "Grams"]]; weightvalues = (weights.#)/lbg & /@ Flatten[allSolutions, 1];
In[19]:=
Click for copyable input
Histogram[weightvalues, 50, "PDF", AxesLabel -> {Quantity[None, "USDollars"], "fraction"}]
Out[19]=

Plot the distribution of the number of coins.

In[20]:=
Click for copyable input
Histogram[Total /@ Flatten[allSolutions, 1], {5}]
Out[20]=

The bivariate distribution of the monetary value versus the number of coins in the sack.

In[21]:=
Click for copyable input
Histogram3D[{coins.#/100., Total[#]} & /@ Flatten[allSolutions, 1], AxesLabel -> {Quantity[None, "USDollars"], "coins"}]
Out[21]=

Related Examples

de es fr ja ko pt-br ru zh