# Finding the optimal teams ranking based on the table of match results

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
-
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 Feb 28 '14 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 '14 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 – Dr. belisarius Feb 28 '14 at 11:54
@RyanSummers I'm still at it. Don't forget to post your professor's answer when you get it ;) – Dr. belisarius Feb 28 '14 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 '14 at 18:25

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

-