Pattern with two lists

Question

I have two lists with multiple array elements:

myList = {{myArray[1, 0, 0], myArray[1, 0, 1], myArray[1, 0, 2], myArray[1, 1, 0], myArray[1, 1, 1], myArray[1, 1, 2], myArray[1, 2, 0], myArray[1, 2, 1], myArray[1, 2, 2]}, {myArray[2, 0, 0], myArray[2, 0, 1], myArray[2, 0, 2], myArray[2, 1, 0], myArray[2, 1, 1], myArray[2, 1, 2], myArray[2, 2, 0], myArray[2, 2, 1], myArray[2, 2, 2]}}

I want to get a combination of the two lists that have all of the first with the same third element and all of the second with a different second element. So for this data input, my desired output is the following:

desiredResult={{myArray[1, 0, 0], myArray[1, 1, 0], myArray[1, 2, 0], myArray[2, 1, 0], myArray[2, 1, 1], myArray[2, 1, 2], myArray[2, 2, 0], myArray[2, 2, 1], myArray[2, 2, 2]}, {myArray[1, 0, 1], myArray[1, 1, 1], myArray[1, 2, 1], myArray[2, 0, 0], myArray[2, 0, 1], myArray[2, 0, 2], myArray[2, 2, 0], myArray[2, 2, 1], myArray[2, 2, 2]}, {myArray[1, 0, 2], myArray[1, 1, 2], myArray[1, 2, 2], myArray[2, 0, 0], myArray[2, 0, 1], myArray[2, 0, 2], myArray[2, 1, 0], myArray[2, 1, 1], myArray[2, 1, 2]}}

I have come up with a way to do this but am wondering if there is a way to have "rules within rules" that would do it more succinctly.

PickExclusiveSets[rowPair_] := Block[{firstRow = rowPair[[1]],secondRow = rowPair[[2]],firstRowByEnd,secondRowByStart},firstRowByEnd = GatherBy[firstRow, #[[3]] &];secondRowByStart = GatherBy[secondRow, #[[2]] &];With[{firstBlockEnd = #[[1, -1]]},Flatten[{#, Select[secondRowByStart, #[[1, 2]] != firstBlockEnd &]}]] & /@ firstRowByEnd];

Side point, is there a way to have code formatted to look better within a code block in a question?

Did some poking around and I think I figured out how to have code better formatted in a post. Such as this:

PickExclusiveSets[rowPair_] :=
    Block[ {
    firstRow = rowPair[[1]],
    secondRow = rowPair[[2]],
    firstRowByEnd,
    secondRowByStart
    },
        firstRowByEnd = GatherBy[firstRow, #[[3]] &];
        secondRowByStart = GatherBy[secondRow, #[[2]] &];
        With[ {firstBlockEnd = #[[1, -1]]},
            Flatten[{#, 
              Select[secondRowByStart, #[[1, 2]] != firstBlockEnd &]}]
        ] & /@ firstRowByEnd
    ];

In my earlier pasting, I didn't have the required indents. Had to paste from a notebook into another text editor and then copy-paste back here.

score 3 · Accepted Answer · answered Jun 06 '19 at 22:50

Here's a possibility using GroupBy instead:

func[{l1_, l2_}]:=With[{g1 = GroupBy[l1, Last], g2 = GroupBy[l2, #[[2]]&]},
    Table[
        Flatten  @ {
            Values @ KeySelect[g1, EqualTo[key]],
            Values @ KeySelect[g2, UnequalTo[key]]
        },
        {key, Keys[g1]}
    ]
]

Your example:

func[myList]

{{myArray[1, 0, 0], myArray[1, 1, 0], myArray[1, 2, 0], myArray[2, 1, 0], myArray[2, 1, 1], myArray[2, 1, 2], myArray[2, 2, 0], myArray[2, 2, 1], myArray[2, 2, 2]}, {myArray[1, 0, 1], myArray[1, 1, 1], myArray[1, 2, 1], myArray[2, 0, 0], myArray[2, 0, 1], myArray[2, 0, 2], myArray[2, 2, 0], myArray[2, 2, 1], myArray[2, 2, 2]}, {myArray[1, 0, 2], myArray[1, 1, 2], myArray[1, 2, 2], myArray[2, 0, 0], myArray[2, 0, 1], myArray[2, 0, 2], myArray[2, 1, 0], myArray[2, 1, 1], myArray[2, 1, 2]}}

Thank you - I like the clarity of your solution and learned a new way of doing this. I expanded the test to have lots more rows and then used RepeatedTiming to evaluate the two solutions. They are comparable in time. — Mark R, Jun 07 '19 at 00:24

score 1 · Answer 2 · answered Jun 07 '19 at 00:01

1

Here's another possibility using array indices temporarily converted to lists.

f[rowPair_] := Module[{h, l1, l2},
  h = Head[rowPair[[1, 1]]];
  {l1, l2} = rowPair /. h -> List;
  h @@@ Join[Cases[l1, {_, _, #}], Cases[l2, {_, Except[#], _}]] & /@ 
   Union[l1[[All, -1]]]
  ]

f[myList] == desiredResult
(* True *)
```

answered Jun 07 '19 at 00:01

MelaGo

8,586
1
11
24

1

Thanks - more education. I did a comparison of the three methods using 1000 rows and get this:RepeatedTiming[answer1 = func[#] & /@ myList2;] RepeatedTiming[answer2 = PickExclusiveSets[#] & /@ myList2;] RepeatedTiming[answer3 = func2[#] & /@ myList2;]
Out[129]= {0.030, Null}

Out[130]= {0.030, Null}

Out[131]= {0.041, Null}
– Mark R Jun 07 '19 at 01:41

kglr · Answer 3 · 2019-06-07T11:13:57.103

A combination of GroupBy and KeyDrop:

ClearAll[f1]
f1 = Module[{g1 = GroupBy[#[[1]], Last],g2 = GroupBy[#[[2]], #[[2]]&]},
      Join[g1 @ #, Join @@ Values @ KeyDrop[g2, #]]& /@ Keys[g1]]&;

and a combination of GatherBy and Pick:

ClearAll[f2]
f2 = Module[{g1 = GatherBy[SortBy[#[[1]], Last], Last], 
     keys1 = Union[#[[1, All, -1]]], keys2 = #[[2, All, 2]]}, 
    Join[g1, Pick[l2, Unitize[keys2 - #], 1] & /@ keys1,  2]] &;

Both give the desiredResult for input myList:

f1[myList] == f2[myList] == desiredResult

True

Pattern with two lists

3 Answers3