Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I want to calculate the Shapely Shubik Power Index for larger datasets.

The code I have (from wolfram demonstration project) runs forever on my mac with a dataset of 15 elements, eventually my computer crashes...

Isn't there a smart way to circumvent using permutations in the ordering variable? Or a different way to enhance the performance of the code?

This is the code I use :

(* General variables *)
numberOfPlayers = 6;
playerList = {"A", "B", "C", "D", "E", "F"};
players = Take[playerList, numberOfPlayers];
weightsList = {70, 50, 40, 10, 10, 10};
weights = Take[weightsList, numberOfPlayers];
numberOfVotes = Total[weights];
proportionOfVotes = N[weights/numberOfVotes];
quota = 0;
If[quota < Floor[numberOfVotes/2] + 1 || quota > numberOfVotes, 
quota = Floor[numberOfVotes/2] + 1];
playerWeights = 
Table[{players[[i]], weights[[i]]}, {i, 1, Length[players]}];
coalitions = Subsets[playerWeights];
Length[coalitions];
coalitionWeightFinder = Sum[#[[i, 2]], {i, 1, Length[#]}] &;
takeFirst = Take[#, 1] &;
winningCoalitions = 
Flatten /@ 
Map[takeFirst, 
Select[coalitions, coalitionWeightFinder[#] >= quota &], {2}];
talliesOfWCs = Tally[Flatten[winningCoalitions]];

(* Calculate Shapely Shubik Power Index *)
orderings = Permutations[playerWeights];
takeWeight = Take[#, {2}] &;
accumulatedVotes = 
Accumulate /@ Flatten /@ Map[takeWeight, orderings, {2}];
replacer2 = 
If[# >= quota, Replace[#, # -> True], Replace[#, # -> False]] &;
pickSets2 = Map[replacer2, accumulatedVotes, {2}];
intermediateSet3 = 
Table[{orderings[[i]], pickSets2[[i]]}, {i, 1, Length[orderings]}];
pivotalWithWeights = picker /@ intermediateSet3;
pivotalVoter = 
Flatten[takeFirst /@ 
Flatten /@ Map[takeFirst, pivotalWithWeights, {2}]];
intermediateSet4 = 
Table[{orderings[[i]], pivotalVoter[[i]]}, {i, 1, 
Length[orderings]}];
pivotalNumbers = 
PadRight[Flatten[takeWeight /@ Sort[Tally[pivotalVoter]]], 
numberOfPlayers];
ShapShubPowerIndices = N[pivotalNumbers/numberOfPlayers!, 3];
displayTable2 = 
Table[{players[[i]], proportionOfVotes[[i]], pivotalNumbers[[i]], 
ShapShubPowerIndices[[i]]}, {i, Length[players]}] // TableForm
share|improve this question

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.