1
$\begingroup$

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.

$\endgroup$
3
$\begingroup$

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]}}

| improve this answer | |
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Mark R Jun 7 '19 at 0:24
1
$\begingroup$

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 *)
```
| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ 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} $\endgroup$ – Mark R Jun 7 '19 at 1:41
1
$\begingroup$

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

| improve this answer | |
$\endgroup$

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.