List correction

Question

I have a list of games, locations, and dates in the following format:

lis = {date, firstTeam, firstScore, secondTeam, secondScore, location of secondTeam}

Location can be HOME, AWAY, or NEUTRAL.

The problem is the score list can contain errors. I need to clean the list as follows:

First, duplicate list elements need to be removed, including the following situation: {date1,A,1,B,2,HOME},{date1,B,2,A,1,AWAY} which needs to be recognized as only one game. Then games in which a team appears in more than one game on the same date need to be flagged. Then games with the same date, location, and teams but with different scores need to be flagged. Then games with the same date, teams, scores but different locations need to be flagged.

The flag would be True if there is a conflict, and False if not, the verdict to be appended to each game record.

This code:

awayTeamcleanList = Table[Take[lis[[i]], {2}], {i, Length[lis]}];
homeTeamcleanList = Table[Take[lis[[i]], {4}], {i, Length[lis]}];
homeScorecleanList = Table[Take[lis[[i]], {5}], {i, Length[lis]}];
awayScorecleanList = Table[Take[lis[[i]], {3}], {i, Length[lis]}];
pairs = Partition[Flatten[Riffle[awayTeamcleanList, homeTeamcleanList]], 2];
countz = pairs // Flatten // Counts;
partialPairs = {#1, #2, countz[#1] + countz[#2] =!= 2} & @@@ pairs
verdict = Table[partialPairs[[i, 3]], {i, Length[partialPairs]}];
cleanList = Transpose[Insert[Transpose[cleanList], verdict, 7]];

My code fails because it erroneously flags games played by a given team on different days; also it doesn't recognize the problem listed under "First" above.

Here is an example:

lis = {{DateObject[{2021, 11, 13}],A,1,B,2,"HOME"},{DateObject[{2021, 11, 13}],B,2,A,1,"AWAY"},{DateObject[{2021, 11, 13}],C,3,D,4,"NEUTRAL"},{DateObject[{2021, 11, 13}],C,3,D,4,"NEUTRAL"},{DateObject[{2021, 11, 13}],E,5,F,6,"HOME"},{DateObject[{2021, 11, 13}],E,5,F,7,"HOME"},{DateObject[{2021, 11, 14}],E,7,g,8,"AWAY"}}

which should give:

 res = {{DateObject[{2021, 11, 13}],A,1,B,2,"HOME"},False},{DateObject[{2021, 11, 13}],C,3,D,4,"NEUTRAL",False},{DateObject[{2021, 11, 13}],E,5,F,6,"HOME",True},{DateObject[{2021, 11, 13}],E,5,F,7,"HOME",True},{DateObject[{2021, 11, 14}],E,7,g,8,"AWAY",False}}

Thanks for ideas!

Answer 1

Removing duplicates and same-game duplicates first.

According to the OP's spec, flagging teams which appear in more than one game on a day actually captures all the other flagging criteria.

The following produces the expected output.

flag[lis_] := Module[{lis2, samegame = {}, lis3, bydate,
   flaggames = {}, flagged},

  (* remove duplicates *)

  lis2 = DeleteDuplicates[lis];

  Array[AppendTo[samegame, FirstCase[lis2[[# + 1 ;;]],
       lis2[[#, {1, 4, 5, 2, 3, 6}]] /. {"HOME" -> "AWAY",
         "AWAY" -> "HOME"}, Nothing]] &, Length[lis2] - 1];

  lis3 = Complement[lis2, samegame];

  (* flag multiple appearances on a day *)

  bydate = GatherBy[lis3, First];

  (multiples = First /@ Select[Tally[
         Flatten@#[[All, {2, 4}]]], Last[#] > 1 &];
     AppendTo[flaggames, Select[#, Intersection[#[[{2, 4}]],
          multiples] != {} &]]) & /@ bydate;

  flagged = Catenate[flaggames];

  Append[#, If[MemberQ[flagged, #], True, False]] & /@ lis3]

flag[lis] == res

True

Answer 2

$Version

"11.3.0 for Microsoft Windows (64-bit) (March 7, 2018)"

corrected = Sort[Join @@ Join @@@ Values @ Map[Values] @
   GroupBy[#, {First @ # &, Sort[#[[{2, 4}]]] &}, 
    Map[If[Length@# == 1, Append[False] /@ #, Append[True] /@ #] & @* 
        DeleteDuplicatesBy[Sort @* Most]]]] &;

corrected @ lis == res

True

Update:

$Version (* Wolfram Cloud *)

12.3.1 for Linux x86 (64-bit) (June 24, 2021) 

correctedV1231 = Sort[Join @@ Join @@@ Values @ Map[Values] @
       GroupBy[#, {First@# & , Sort[#[[{2, 4}]]] &}, 
        If[Length@# == 1, Append[False] /@ #, Append[True] /@ #] &@*
         DeleteDuplicatesBy[Sort@*Most]]] &;

correctedV1231 @ lis == res 

True