2
$\begingroup$

I am trying to understand how to sort by multiple columns in Mathematica.

Here is a simple data set consisting of results of sports matches. Each element represents a game, and contains fields for date, first team's name, first team's score, second team's name, second team's score, and game location (home, away, or neutral). Some elements may be duplicates, or they may disagree on who played whom, or where a game was played. (Assumeing one team could only play one game per day.)

I would like to be able to evaluate each game and flag each having a conflict as "FALSE" or not having a conflict as "TRUE".

The score list is called gameList:

{{DateObject[{2020,1,1}],"Alpha",1,"Bravo",2,"away"},
 {DateObject[{2020,1,1}],"Bravo",2,"Alpha",1,"neutral"},
 {DateObject[{2020,1,1}],"Charlie",3,"Delta",4,"home"},
 {DateObject[{2020,1,1}],"Delta",4,"Charlie",3,"away"},
 {DateObject[{2020,1,2}],"Echo",5,"Foxtrot",6,"home"},
 {DateObject[{2020,1,2}],"Foxtrot",5,"Echo",6,"away"},
 {DateObject[{2020,1,2}],"Gulf",7,"Hotel",10,"home"},
 {DateObject[{2020,1,3}],"India",9,"Juliet",2,"home"},
 {DateObject[{2020,1,3}],"Kilo",10,"India",9,"away"},
 {DateObject[{2020,1,3}],"Lima",11,"Mike",12,"neutral"}}

Here is some code that flips (if necessary) team and score pairs so that the team whose name starts earlier in the alphabet comes first in each game record. In the event the names and scores are reordered, the game location is also changed from home to away or vice versa.

alphaSortKey = 
  Table[AlphabeticOrder[gameList[[i, 2]], gameList[[i, 4]]], {i, 
    Length[gameList]}];
gameList = 
  Table[Append[gameList[[i]], alphaSortKey[[i]]], {i, 
    Length[gameList]}];

regular = Cases[gameList, {_, _, _, _, _, _, 1}];
regular = Table[Take[regular[[i]], 6], {i, Length[regular]}];

needTeamsFlip = Cases[gameList, {_, _, _, _, _, _, -1}];
holderLoca = Table[needTeamsFlip[[i, 6]], {i, Length[needTeamsFlip]}];
holderLoca = 
  Table[If[holderLoca[[i]] == "home", holderLoca[[i]] = "away", 
    If[holderLoca[[i]] == "away", holderLoca[[i]] = "home", 
     holderLoca[[i]] = "neutral"]], {i, Length[needTeamsFlip]}];
needTeamsFlip = 
  Table[Take[needTeamsFlip[[i]], 5], {i, Length[needTeamsFlip]}];
needTeamsFlip = 
  Table[Append[needTeamsFlip[[i]], holderLoca[[i]]], {i, 
    Length[needTeamsFlip]}];
holderTeam = Table[needTeamsFlip[[i, 2]], {i, Length[needTeamsFlip]}];
holderScor = Table[needTeamsFlip[[i, 3]], {i, Length[needTeamsFlip]}];
Table[needTeamsFlip[[i, 3]] = needTeamsFlip[[i, 5]], {i, 
   Length[needTeamsFlip]}];
Table[needTeamsFlip[[i, 2]] = needTeamsFlip[[i, 4]], {i, 
   Length[needTeamsFlip]}];
Table[needTeamsFlip[[i, 4]] = holderTeam[[i]], {i, 
   Length[needTeamsFlip]}];
Table[needTeamsFlip[[i, 5]] = holderScor[[i]], {i, 
   Length[needTeamsFlip]}];
needTeamsFlip = 
  Table[Take[needTeamsFlip[[i]], 6], {i, Length[needTeamsFlip]}];


ordered = 
  DeleteDuplicates[Flatten[Join[{needTeamsFlip}, {regular}], 1]];
Column[ordered = SortBy[ordered, {#[[1]] &, #[[2]] &}]]

ordered = 
  DeleteDuplicates[Flatten[Join[{needTeamsFlip}, {regular}], 1]];

But

 SortBy[ordered, {#[[1]] &, #[[2]] &, #[[4]] &}]

returns an error.

The desired output would be:

{{DateObject[{2020,1,1}],"Alpha",1,"Bravo",2,"neutral",FALSE},
{DateObject[{2020,1,1}],"Alpha",1,"Bravo",2,"away",FALSE},
{DateObject[{2020,1,1}],"Charlie",3,"Delta",4,"home",TRUE},
{DateObject[{2020,1,2}],"Echo",6,"Foxtrot",5,"home",FALSE},
{DateObject[{2020,1,2}],"Echo",5,"Foxtrot",6,"home",FALSE},
{DateObject[{2020,1,2}],"Gulf",7,"Hotel",8,"home",TRUE},
{DateObject[{2020,1,3}],"India",9,"Kilo",10,"home",FALSE},
{DateObject[{2020,1,3}],"India",9,"Juliet",10,"home",FALSE},
{DateObject[{2020,1,3}],"Lima",11,"Mike",12,"neutral",TRUE}}

Thanks in advance for suggestions!

$\endgroup$
  • $\begingroup$ the dates in gameList need to be edited (they do not match the dates in desired output). $\endgroup$ – kglr Jan 24 at 7:13
  • $\begingroup$ Thanks for catching that. Fixed. $\endgroup$ – Suite401 Jan 25 at 3:27
6
$\begingroup$
sorted = gameList;
orderings = Ordering /@ gameList[[All, {2, 4}]];
sorted[[All, {2, 4}]] = Sort /@ sorted[[All, {2, 4}]];
sorted[[All, {3, 5}]] = MapThread[#[[#2]] &, {sorted[[All, {3, 5}]], orderings}];
sorted[[All, 6]] = MapThread[If[#2 == {1, 2}, #, # /. {"home" -> "away", 
       "away" -> "home"}] &, {sorted[[All, 6]], orderings}];
sorted = DeleteDuplicates@sorted;

dateteamcounts = Counts[Join @@ (sorted[[All, {1, #}]] & /@ {2, 4})]; 

desired = Join[sorted, 
    {Max[dateteamcounts /@ {#[[{1, 2}]], #[[{1, 4}]]}] == 1} & /@ sorted, 2];

Grid[desired, Dividers -> All]

enter image description here

Update:

An alternative approach:

ClearAll[sORT, dESIRED]
sORT = DeleteDuplicates[# /. {a_, b_, c_, d_, e_, f_} /; OrderedQ[{d, b}] :>
   {a, d, e, b, c, f /. {"home" -> "away", "away" -> "home"}}] &; 

dESIRED = Module[{s = sORT @ #,  k = Function[x, x[[{1, #}]] & /@ {2, 4}]},
   Join[s, {Max[Counts[Join @@ k /@ s] /@ k[#]] == 1} & /@ s, 2]] &;

dESIRED @ gameList == desired

True

$\endgroup$
  • $\begingroup$ Thanks @kglr for the succinct improvement in code! Still would like the last field indicating conflict/no conflict with the other elements... $\endgroup$ – Suite401 Jan 24 at 6:47
  • $\begingroup$ @Suite401, please see the update. $\endgroup$ – kglr Jan 24 at 7:39
  • $\begingroup$ many runes to chew on :) Thank you very much indeed! $\endgroup$ – Suite401 Jan 24 at 15:36
  • $\begingroup$ is there a way to use IgnoreCase in either solution? They undesireably invert the positions of teams whose names begin with two capital letters, e.g. $\endgroup$ – Suite401 Jan 25 at 3:33
  • $\begingroup$ {1-Jan,AB,1,Ac,2,AWAY} into {1-Jan,Ac,2,AB,1,AWAY}. ascii numbers for caps are different from lower cases...thoughts? $\endgroup$ – Suite401 Jan 25 at 3:45

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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