What’s in YOUR wallet?

computation notebook

Eric Rowland
https://ericrowland.github.io/papers.html#What's_in_YOUR_wallet

Introduction

This notebook contains the computations performed in the paper “What’s in YOUR wallet?” by Lara Pudwell and Eric Rowland.

To re-run the computations, first you will need to load the PocketChange package.  You can load it directly from the web by evaluating the following cell.

Import["https://ericrowland.github.io/packages/PocketChange.m"]

You can also download it from https://ericrowland.github.io/packages.html#PocketChange and then evaluate the following. (If you need help, see loading a package.)

<<PocketChange`

To check that it loaded correctly, re-evaluate the following.

GreedyPartition[30,{1,5,10,25}]

Computing limiting distributions

The coin keeper

U.S. four-denomination currency

Reverse[Sort[Tally[Join@@Table[GreedyPartition[n],{n,0,99}]]]]

((Last/@%)/(Total[Last/@%]))
N[%]

Distance in (ℝ^4) from the 2014 U.S. mint production ratios:

EuclideanDistance[{.319,.170,.085,.426},Normalize[{568,1676,1024,6015},Total]]

U.S. currency including the half dollar

Reverse[Sort[Tally[Join@@Table[GreedyPartition[n,{1,5,10,25,50}],{n,0,99}]]]]
((Last/@%)/(Total[Last/@%]))
N[%]

Eurozone six-denomination currency

Reverse[Sort[Tally[Join@@Table[GreedyPartition[n,{1,2,5,10,20,50}],{n,0,99}]]]]
((Last/@%)/(Total[Last/@%]))
N[%]

Take[{0.14705882352941177`,0.23529411764705882`,0.11764705882352941`,0.14705882352941177`,0.23529411764705882`,0.11764705882352941`},3]//Total

The minimalist spender

U.S. four-denomination currency

Expected number of coins:

Mean[Length/@GreedyPartition/@Range[0,99]]
N[%]

Expected total value:

Mean[Total/@GreedyPartition/@Range[0,99]]
N[%]

Shallit currency

Make a change table:

changerules=Table[Module[{k=0},While[IntegerPartitions[n,{k},{1,5,18,25}]=={},k++];n->IntegerPartitions[n,{k},{1,5,18,25}]],{n,0,99}]

Expected number of coins:

Mean[Length/@First/@Last/@changerules]
N[%]

Expected total value:

Mean[Total/@First/@Last/@changerules]
N[%]

The big spender

A toy example

State space:

PartitionList[{25,50}]

The paper uses this ordering instead:

{{},{25},{50},{25,25},{25,50},{25,25,25}}

toyMatrix=With[{stateset=Reverse/@{{},{25},{50},{25,25},{25,50},{25,25,25}},prices=Range[0,75,25],currency={25,50}},SparseArray[Join@@Table[({i,First[#1]}->((Last[#1])/(Length[prices]))&)/@Tally[Table[Position[stateset,BigSpenderTransaction[stateset[[i]],price,currency]][[1,1]],{price,prices}]],{i,1,Length[stateset]}]]]

MatrixForm[toyMatrix]

The long-term probability of being in each state:

With[{stateset=Reverse/@{{},{25},{50},{25,25},{25,50},{25,25,25}}},Grid[Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[Transpose[toyMatrix],1]]]}]]]

U.S. four-denomination currency

Size of the state space:

Length[PartitionList[]]

Compute the transition matrix:
(This took 8 hours to run.  It exports the matrix to a file in your home directory.  Alternatively, you can download the matrix from the authors’ web sites.)

Timing[Monitor[With[{stateset=PartitionList[],prices=Range[0,99]},Export[FileNameJoin[{$HomeDirectory,"US.m"}],Join@@Table[({i,First[#1]}->((Last[#1])/(Length[prices]))&)/@Tally[Table[Position[stateset,BigSpenderTransaction[stateset[[i]],price]][[1,1]],{price,prices}]],{i,1,Length[stateset]}]]],i]]

USMatrix=SparseArray[Import[FileNameJoin[{$HomeDirectory,"US.m"}]]]

Eigenvalues[N[USMatrix],5]

50 most likely states:

Grid[Take[Reverse[SortBy[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],Last]],50]]

Expected number of coins in your wallet:

Total[(Times@@MapAt[Length,#1,1]&)/@Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}]]

Expected number of quarters in your wallet:

Total[(Times@@MapAt[Count[#,25]&,#1,1]&)/@Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}]]

Expected number of dimes in your wallet:

Total[(Times@@MapAt[Count[#,10]&,#1,1]&)/@Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}]]

Expected number of nickels in your wallet:

Total[(Times@@MapAt[Count[#,5]&,#1,1]&)/@Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}]]

Expected number of pennies in your wallet:

Total[(Times@@MapAt[Count[#,1]&,#1,1]&)/@Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}]]

Distribution of coins in circulation:

First/@{{6.921940701240068`,1},{0.9115735929319583`,5},{1.1522192528047568`,10},{1.0599199522420897`,25}}/Total[First/@{{6.921940701240068`,1},{0.9115735929319583`,5},{1.1522192528047568`,10},{1.0599199522420897`,25}}]

Distance in (ℝ^4) from the 2014 U.S. mint production ratios:

EuclideanDistance[{.689,.091,.115,.106},Reverse@Normalize[{568,1676,1024,6015},Total]]

Probability of being able to pay with exact change for any price:

AbsoluteTiming[Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{wallet_/;Union[Total/@DistinctSubsets[wallet]]==Range[0,99],p_}:>p]]]

Probability of having at least one quarter in your wallet:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,25,___},p_}:>p]]

At least one dime:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,10,___},p_}:>p]]

At least one nickel:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,5,___},p_}:>p]]

At least one penny:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,1,___},p_}:>p]]

Probability of having only pennies (and a nonempty wallet):

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{1..},p_}:>p]]

Probability of having no silver coins (only pennies or an empty wallet):

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{1...},p_}:>p]]

Probability of having an empty wallet:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{1},p_}:>p]]

At least two quarters:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,25,25,___},p_}:>p]]

At least three quarters:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,25,25,25,___},p_}:>p]]

At least two dimes:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,10,10,___},p_}:>p]]

At least two nickels:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,5,5,___},p_}:>p]]

At least two pennies:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,1,1,___},p_}:>p]]

At least one silver coin:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,25|10|5,___},p_}:>p]]

At least two silver coins:

Total[Cases[Thread[{PartitionList[],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[USMatrix]],1]]]}],{{___,25|10|5,25|10|5,___},p_}:>p]]

Pennyless purchaser

Size of the state space:

Length[PartitionList[{5,10,25}]]

This system is small enough to solve exactly:

Timing[stateprobabilities=With[{stateset=PartitionList[{5,10,25}],prices=Range[0,95,5]},Reverse[SortBy[Thread[{stateset,LinearSolve[Append[Transpose[SparseArray[Join@@Table[({i,First[#1]}->((Last[#1])/(Length[prices]))&)/@Tally[Table[Position[stateset,BigSpenderTransaction[stateset[[i]],price]][[1,1]],{price,prices}]],{i,Length[stateset]}]]]-IdentityMatrix[Length[stateset]],ConstantArray[1,Length[stateset]]],UnitVector[Length[stateset]+1,Length[stateset]+1]]}],Last]]];]

50 most likely states:

Grid[MapAt[N,#,2]&/@Take[stateprobabilities,50]]

50 least likely states:

Grid[MapAt[N,#,2]&/@Take[stateprobabilities,-50]]

Expected number of coins:

Total[(Times@@MapAt[Length,#1,1]&)/@stateprobabilities]
N[%]

Expected number of quarters:

Total[(Times@@MapAt[Count[#,25]&,#1,1]&)/@stateprobabilities]
N[%]

Expected number of dimes:

Total[(Times@@MapAt[Count[#,10]&,#1,1]&)/@stateprobabilities]
N[%]

Expected number of nickels:

Total[(Times@@MapAt[Count[#,5]&,#1,1]&)/@stateprobabilities]
N[%]

Quarter hoarder

Size of the state space:

Length[PartitionList[{1,5,10}]]

Delete quarters after each transaction:
(This took 4.5 hours to run.  It exports the matrix to a file in your home directory.  Alternatively, you can download the matrix from the authors’ web sites.)

Timing[Monitor[With[{stateset=PartitionList[{1,5,10}],prices=Range[0,99]},Export[FileNameJoin[{$HomeDirectory,"quarter_hoarder.m"}],Join@@Table[({i,First[#1]}->((Last[#1])/(Length[prices]))&)/@Tally[Table[Position[stateset,DeleteCases[BigSpenderTransaction[stateset[[i]],price],25]][[1,1]],{price,prices}]],{i,1,Length[stateset]}]]],i]]

quarterHoarderMatrix=SparseArray[Import[FileNameJoin[{$HomeDirectory,"quarter_hoarder.m"}]]]

Eigenvalues[N[quarterHoarderMatrix],5]

50 most likely states:

With[{stateset=PartitionList[{1,5,10}]},Grid[Take[Reverse[SortBy[Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[quarterHoarderMatrix]],1]]]}],Last]],50]]]

Expected number of coins:

Total[(Times@@MapAt[Length,#1,1]&)/@Thread[{PartitionList[{1,5,10}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[quarterHoarderMatrix]],1]]]}]]

Expected number of dimes:

Total[(Times@@MapAt[Count[#,10]&,#1,1]&)/@Thread[{PartitionList[{1,5,10}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[quarterHoarderMatrix]],1]]]}]]

Expected number of nickels:

Total[(Times@@MapAt[Count[#,5]&,#1,1]&)/@Thread[{PartitionList[{1,5,10}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[quarterHoarderMatrix]],1]]]}]]

Expected number of pennies:

Total[(Times@@MapAt[Count[#,1]&,#1,1]&)/@Thread[{PartitionList[{1,5,10}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[quarterHoarderMatrix]],1]]]}]]

Shallit currency

Size of the state space:

Length[PartitionList[{1,5,18,25}]]

The greedy algorithm doesn’t give minimal partitions:

BigSpenderTransaction[{},100-28,{1,5,18,25}]

With[{n=28},Module[{k=0},While[IntegerPartitions[n,{k},{1,5,18,25}]=={},k++];IntegerPartitions[n,{k},{1,5,18,25}]]]

Make a change table:

changerules=Table[Module[{k=0},While[IntegerPartitions[n,{k},{1,5,18,25}]=={},k++];n->IntegerPartitions[n,{k},{1,5,18,25}]],{n,0,99}]

Average number of coins per transaction:

Mean[Length/@First/@Last/@changerules]
N[%]

There is not always a unique way to make change using minimal number of coins:

DeleteCases[changerules,_->{_}]

So BigSpenderBestPartition now also lets us decide between these options (for the spender):

BigSpenderBestPartition[{{25,25,25,1,1},{18,18,18,18,5}}]

BigSpenderBestPartition[{{25,25,25,5,1,1},{18,18,18,18,5,5}}]

BigSpenderBestPartition[{{25,25,25,18,1,1},{18,18,18,18,18,5}}]

It remains to update the use of GreedyPartition to use the change table instead (for the cashier).
Since there are two minimal partitions in some cases, let’s make things interesting by using each half the time.

BigSpenderTransactionList[pocketpartition_,price_,changerules_]:=Module[{exactorgreaterchangepartitions,whatwepay},exactorgreaterchangepartitions=Select[DistinctSubsets[pocketpartition],Total[#1]≥price&];If[exactorgreaterchangepartitions≠{},whatwepay=BigSpenderBestPartition[Select[exactorgreaterchangepartitions,Total[#1]==Min[Total/@exactorgreaterchangepartitions]&]];Reverse[Sort[Join[PocketChange`Private`MultisetComplement[pocketpartition,whatwepay],#]]]&/@Replace[Total[whatwepay]-price,changerules],Reverse[Sort[Join[pocketpartition,#]]]&/@Replace[100-price,changerules]]]

BigSpenderTransactionList[{},23,changerules]

(This took 3 hours to run.  It exports the matrix to a file in your home directory.  Alternatively, you can download the matrix from the authors’ web sites.)

Timing[Monitor[With[{stateset=PartitionList[{1,5,18,25}],prices=Range[0,99]},Export[FileNameJoin[{$HomeDirectory,"Shallit.m"}],Flatten[Table[With[{positions=Position[stateset,Alternatives@@BigSpenderTransactionList[stateset[[i]],price,changerules]]},({i,First[#1]}->(1/(Length[prices] Length[positions]))&)/@positions],{i,1,Length[stateset]},{price,prices}],2]]],i]]

ShallitMatrix=SparseArray[Import[FileNameJoin[{$HomeDirectory,"Shallit.m"}]]]

Eigenvalues[N[ShallitMatrix],5]

50 most likely states:

Grid[Take[Reverse[SortBy[Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}],Last]],50]]

Expected number of coins:

Total[(Times@@MapAt[Length,#1,1]&)/@Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}]]

Expected number of quarters:

Total[(Times@@MapAt[Count[#,25]&,#1,1]&)/@Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}]]

Expected number of 18-cent pieces:

Total[(Times@@MapAt[Count[#,18]&,#1,1]&)/@Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}]]

Expected number of nickels:

Total[(Times@@MapAt[Count[#,5]&,#1,1]&)/@Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}]]

Expected number of pennies:

Total[(Times@@MapAt[Count[#,1]&,#1,1]&)/@Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}]]

Likelihood of having at least one 18-cent piece:

Total[Cases[Thread[{PartitionList[{1,5,18,25}],(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[ShallitMatrix]],1]]]}],{{___,18,___},p_}:>p]]

The pennies-first big spender

U.S. four-denomination currency

Size of the state space:

Length[Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]]

Compute the transition matrix:

Timing[Monitor[With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1],prices=Range[0,99]},Export[FileNameJoin[{$HomeDirectory,"US-pennies-first.m"}],Join@@Table[({i,First[#1]}->((Last[#1])/(Length[prices]))&)/@Tally[Table[Position[stateset,PenniesFirstBigSpenderTransaction[stateset[[i]],price]][[1,1]],{price,prices}]],{i,1,Length[stateset]}]]],i]]

penniesFirstUSMatrix=SparseArray[Import[FileNameJoin[{$HomeDirectory,"pennies-first_US.m"}]]]

Eigenvalues[N[penniesFirstUSMatrix],5]

50 most likely states:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Grid[Take[Reverse[SortBy[Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}],Last]],50]]]

Expected number of coins:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Total[(Times@@MapAt[Length,#1,1]&)/@Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}]]]

Expected number of quarters:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Total[(Times@@MapAt[Count[#,25]&,#1,1]&)/@Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}]]]

Expected number of dimes:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Total[(Times@@MapAt[Count[#,10]&,#1,1]&)/@Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}]]]

Expected number of nickels:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Total[(Times@@MapAt[Count[#,5]&,#1,1]&)/@Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}]]]

Expected number of pennies:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Total[(Times@@MapAt[Count[#,1]&,#1,1]&)/@Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}]]]

Probability of being able to pay with exact change for any price:

With[{stateset=Join@@Outer[Join,PartitionList[{5,10,25}],PartitionList[{1},5],1]},Total[Cases[Thread[{stateset,(((#1)/(Total[#1]))&)[First[Eigenvectors[N[Transpose[penniesFirstUSMatrix]],1]]]}],{wallet_/;Union[Total/@DistinctSubsets[wallet]]==Range[0,99],p_}:>p]]]