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.

My original question was this:

So my task is to score all the possible rankings of the 14 SEC football teams and find the best one, using who won in head-to-head games as the sole criterion (so not factoring in strength of schedule or homefield advantage yet).

RandomSample[Range[14]] gives me one random ranking of the 14 teams, then I score that ranking by seeing how many wins and losses it actually predicted. For example, if "1" represents Missouri (miss) and "3" represents Georgia (ga), then if the generated ranking has 1 listed before 3, that ranking gets +1 to its ranking score, since Missouri beat Georgia this season. If 3 is listed before 1, the ranking score receives a -1 to its score, for incorrectly ranking those teams with respect to each other. And so on for every head-to-head SEC match up from last year.

In the code below, the 14x14 matrix is the head-to-head football results in the SEC from last year. For example, since "1" represents Missouri and "3" represents Georgia, the entry (1,3) and (3,1) both represent Missouri vs. Georgia. Since Missouri won, there's a 1 in that spot. The code checks which number is in each entry, then if the generated list has the winning team in front of the loser, the ranking score k receives one point, minus one if not. And it works for one list at a time.

Now I need a way to apply that algorithm to all 14! possible rankings (Permutations[RandomSample[Range[14]]), find the one with the highest ranking score (k) and show that ranking.

(14! is like 90 billion)

Here's the code

x = ({
    {0, 2, 1, 1, 1, 1, 1, 8, 0, 0, 1, 0, 1, 0},
    {2, 0, 3, 2, 2, 6, 2, 0, 0, 0, 0, 2, 0, 2},
    {1, 3, 0, 4, 3, 3, 3, 8, 0, 3, 0, 0, 0, 0},
    {1, 2, 4, 0, 4, 4, 4, 0, 0, 0, 11, 0, 13, 0},
    {1, 2, 3, 4, 0, 5, 5, 0, 0, 10, 0, 0, 0, 5},
    {1, 6, 3, 4, 5, 0, 6, 8, 9, 0, 0, 0, 0, 0},
    {1, 2, 3, 4, 5, 6, 0, 0, 9, 0, 0, 12, 0, 0},
    {8, 0, 8, 0, 0, 8, 0, 0, 8, 10, 8, 8, 8, 8},
    {0, 0, 0, 0, 0, 9, 9, 8, 0, 9, 9, 9, 9, 9},
    {0, 0, 3, 0, 10, 0, 0, 10, 9, 0, 10, 10, 13, 10},
    {1, 0, 0, 11, 0, 0, 0, 8, 9, 10, 0, 11, 11, 11},
    {0, 2, 0, 0, 0, 0, 12, 8, 9, 10, 11, 0, 12, 12},
    {1, 0, 0, 13, 0, 0, 0, 8, 9, 13, 11, 12, 0, 13},
    {0, 2, 0, 0, 5, 0, 0, 8, 9, 10, 11, 12, 13, 0}
   });

list1 = RandomSample[Range[14]];
rank = Ordering@list1;
k = 0;
For[i = 1, i < 15, i++,
 For[j = 1, j < 15, j++,
  Which[x[[i, j]] == i,
   If[rank[[i]] > rank[[j]], k++, k--],
   x[[i, j]] != (i || 0),
   If[rank[[j]] > rank[[i]], k++, k--]]]]; k
share|improve this question
    
Are you absolutely sure you want to iterate over all 90 billion permutations? That's a lot of iterations. If I were you, I'd first ask on math.stackexchange.com whether there exists a more efficient algorithm that doesn't take superexponential time, and then implement that instead. –  Rahul Narain Feb 28 at 4:07
    
The 14! does seem like a lot but my professor seemed confident that it wouldn't be a big deal if I did it correctly. –  Ryan Summers Feb 28 at 4:49
    
I made a semi brute force approach that lead me to {8,9,3,2,10,1,11,12,13,4,5,6,14,7} but I think there must be a way to attack this with dynamic programming –  belisarius Feb 28 at 11:54
    
@RyanSummers I'm still at it. Don't forget to post your professor's answer when you get it ;) –  belisarius Feb 28 at 17:52
    
My professor doesn't have the answer and wouldn't give it to me even if he did. I have to come up with it "on my own." I'm very new to programming so I've had to ask a lot of questions. –  Ryan Summers Feb 28 at 18:25

1 Answer 1

Of course you don't want to evaluate 14! permutations. You could instead build up the top scoring ranking by recursively searching the following best candidate for the first place:

getFirstList[x_List, amng_List] :=
  Module[{among = Flatten@amng, score, labeled, reduced},
   score[el_]:= Module[{elr = Rest@el, 
                el1 = el[[1]]}, (Count[elr, el1] - Count[elr, Except[el1]] + Count[elr, 0])];
   labeled = MapThread[Join, {List /@ Range@Length@x, x}];
   reduced = Transpose[Transpose[labeled[[among]]][[Join[{1}, among + 1]]]];
   Select[reduced, score@# == Max[score /@ reduced] &][[All, 1]]
   ];
getFirstOne[x_List, amng_List] :=If[Length@# > 1, {First@getFirstList[x, #]}, #] &@
                                 getFirstList[x, amng]
getAllOrdered[x_List, {}] := {}
getAllOrdered[x_List, amng_List] := 
     Join[{#}, getAllOrdered[x, DeleteCases[amng, Alternatives @@ (Flatten@#)]]] &@
                                                                getFirstOne[x, amng]

Flatten@getAllOrdered[x, Range@14]
(*
 {8, 9, 1, 3, 2, 10, 11, 12, 13, 4, 5, 6, 7, 14}
*)

The only problem is that the ranking function you provided doesn't generate unique results. So,using the following function for the scoring of the rank:

calScore[x_List, rank_List] :=
 Total[
  Table[
   pre = rank[[;; i]];
   post = rank[[i ;;]];
   Which[
      MemberQ[pre, x[[rank[[i]], #]]], 1,
      MemberQ[post, x[[rank[[i]], #]]], -1,
      True, 0
      ] & /@ rank,
   {i, Length@rank}
   ], 2]

you can see that the ranking

{8,2,1,9,11,13,4,3,10,12,5,6,14,7}

has the same score (104) than our calculated one above

share|improve this answer

Your Answer

 
discard

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.