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
add comment

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.