10
$\begingroup$

Is there a function in Mathematica that allows me to combine two different lists if the elements in the same position are equal?

For example, imagine I have these lists:

list1 = {a,b,a,f,c,a}
list2 = {c,b,a,f,g}

I am looking for a method that generates:

list3 = {b,a,f}
Improve this question
$\endgroup$
4
  • $\begingroup$ What's the expected output if list2 = {c,b,bbb,f,g}? $\endgroup$
    – xzczd
    Sep 30, 2022 at 17:27
  • 2
    $\begingroup$ Can you give more examples of the desired behavior? As it is, many of the answers below will give different results based on different criteria. For instance, should {a, b, a, f} and {x, r, b, a, f} return {b, a, f} or nothing (because they're not in the same spots). What about {a, b, c, d} and {a, x, c, y}? Should this return {a,c}? Or do the elements need to be consecutive? Etc. A few more test cases would be useful. $\endgroup$
    – march
    Sep 30, 2022 at 19:06
  • 1
    $\begingroup$ I am not sure I understand how the title is related to the request. Perhaps for future users looking for the same question an alternative question would be "How to find a common sequence in two lists at the same position ?" $\endgroup$
    – userrandrand
    Sep 30, 2022 at 20:05
  • 2
    $\begingroup$ What do you expect in this case : list1 = {a,b,e,e,a,f,c,a}; list2={c,b,r,r,a,f,g} ? From the example and question you gave I would guess that you expect {b,a,f} as well but {{b},{a,f}} where each sublist represents a running common sequence would offer more information and would be distinguishable from the example you gave. It might be possible that your task does not require that extra information but I do not know. $\endgroup$
    – userrandrand
    Oct 1, 2022 at 4:18

6 Answers 6

Reset to default
17
$\begingroup$ 
Cases[Flatten[{list1, list2}, {2}], {x_, x_} :> x]
Improve this answer
$\endgroup$
1
  • 5
    $\begingroup$ Very elegant indeed, and I was just about to post an almost identical solution! (A very useful Mathematica 'trick' is that Flatten can be used to Transpose a 'ragged' array. See this answer by Leonid Shrifrin) $\endgroup$
    – user1066
    Sep 30, 2022 at 18:59
6
$\begingroup$ 
list1 = {a, b, a, f, c, a};
list2 = {c, b, a, f, g};

{asc1, asc2} = 
  AssociationThread[Range[Length[#]], #] & /@ {list1, list2};

Values@Merge[{asc1, asc2}, 
  If[Length[#1] > 1 && SameQ @@ #1, #1[[1]], Nothing] &]

(* {b, a, f} *)

First, wrong solution (as pointed out by @march).

list1 = {a, b, a, f, c, a};
list2 = {c, b, a, f, g};

LongestCommonSubsequence[list1, list2]

(* {b, a, f} *)

See also LongestCommonSequence.

Improve this answer
$\endgroup$
5
  • $\begingroup$ But this seems to find the common subsequences even if they're not at the same spots in the list, as the OP mentions. $\endgroup$
    – march
    Sep 30, 2022 at 19:05
  • $\begingroup$ @march Good point, thanks. $\endgroup$
    – Anton Antonov
    Sep 30, 2022 at 19:20
  • $\begingroup$ The question mentioned "if the elements in the same position are equal". From the examples in LongestCommonSubsequence, this function does not seem to check that the positions are the same as well. $\endgroup$
    – userrandrand
    Sep 30, 2022 at 19:45
  • $\begingroup$ @userrandrand Correct -- that is why I put another solution (with Association and Merge.) $\endgroup$
    – Anton Antonov
    Sep 30, 2022 at 20:43
  • $\begingroup$ ohhh sorry. I somehow read the answer the other way around where I taught that the LongestCommonSubsequence was the new added method. I also see that the first comment already mentioned that. Sorry. $\endgroup$
    – userrandrand
    Sep 30, 2022 at 20:46
5
$\begingroup$ 
list1 = {a, b, a, f, c, a}
list2 = {c, b, a, f, g}

Transpose@(PadRight[#, Max[Length@list1, Length@list2], 
      "\[Wolf]"] & /@ {list1, list2}) /. {{a_, a_} :> 
   a, {a_, b_} /; UnsameQ[a, b] :> Nothing}

Explanation:

  1. Make the lists the same length by PadRight up to the length of the larger list.
  2. Transpose to create pairs.
  3. Using a pattern to collapse similar items and remove other items.

Result:

{b, a, f}

Solution using Reap/Sow

Let's say:

alist = {a, b, {c, d}, {e, f, g}, g, k, i, t};
blist = {a, c, {c, k}, {e, f, g}, h, k};

Last@Reap@Do[
   If[alist[[i]] === blist[[i]]
    , Sow[alist[[i]]] 
    (*,Sow["x"]*)
    ]
   , {i, 1, Min[Length@alist, Length@blist]}
   ]

{{a, {e, f, g}, k}}
Improve this answer
$\endgroup$
3
$\begingroup$

Let's try a fancy fold.

FoldPairList[{If[First@#1 === #2, True, False], Rest@#1} &, list1, list2]
(* {False, True, True, True, False} *)

It's important that list2 is no longer than list1. To guard against that, we could try

FoldPairList[Switch[#1, {}, {False, {}}, {__}, {First@#1 === #2, Rest@#1}] &, list1, list2]
(* {False, True, True, True, False} *)

which works in the other order

FoldPairList[Switch[#1, {}, {False, {}}, {__}, {First@#1 === #2, Rest@#1}] &, list2, list1]
(* {False, True, True, True, False, False} *)

We can use this in conjunction with Pick.

Pick[
  list1, 
  FoldPairList[Switch[#1, {}, {False, {}}, {__}, {First@#1 === #2, Rest@#1}] &, list2, list1]]
(* {b, a, f} *)

or

Pick[
  list2, 
  FoldPairList[Switch[#1, {}, {False, {}}, {__}, {First@#1 === #2, Rest@#1}] &, list1, list2]]
(* {b, a, f} *)
Improve this answer
$\endgroup$
2
$\begingroup$

Using TakeLargestBy:

Flatten@TakeLargestBy[Intersection[Subsequences[list1], Subsequences[list2]], Length, 1]
(*{b, a, f}*)

Using MaximalBy:

Flatten@MaximalBy[Intersection[Subsequences[list1], Subsequences[list2]], Length]
(*{b, a, f}*)

Just another way:

DeleteDuplicates[Flatten[Reverse@Intersection[Subsequences[list1, {2}], Subsequences[list2, {2}]]]]
(*{b, a, f}*)
Improve this answer
$\endgroup$
2
  • 3
    $\begingroup$ It seems to me that this code reproduces similar outputs to LongestCommonSubsequence and shares the same issue for the question above that it does not take into account the positions of the subsequences in each list. The original question mentions " if the elements in the same position are equal" and so the subsequences must also be at the same position. However, with the first code I found the same result by changing list2 to {b, a, f, g} where the "b,a,f" was shifted to the left and so the subsequence of list2 is no longer at the same position as the subsequence of list1. $\endgroup$
    – userrandrand
    Oct 1, 2022 at 4:37
  • $\begingroup$ I agree, you're right. $\endgroup$
    – E. Chan-López
    Oct 1, 2022 at 13:13
2
$\begingroup$ 
list1 = {a,b,a,f,c,a};
list2 = {c,b,a,f,g};

Explanation of code below :

The objective of the code below is to find duplicates across the two lists by value and by position (hence the MapIndexed[H] which wraps the position and value in an undefined wrapper H). The duplicates are found using Intersection and then sorted by the positions of the elements in the original lists (they appear as the second argument of H below). The values (first argument of H below) are pulled out for the final result.

  (* H is just a wrapper that can be replaced with another undefined variable *)
First /@ SortBy[Last]@*Intersection @@ MapIndexed[H] /@ {list1, list2}

Note: To avoid accidentally defining H somewhere else, one could use \[FormalCapitalH] (in a notebook it has a dot at the bottom) which can be obtained with the keys Esc + . + H + Esc.

Advantage:

  • Uses only somewhat simple to understand functions.

  • If First/@ is removed then the information on the positions is retained which could be useful for more complicated tasks. That said it probably does not cost much to add the positions with the Case and Flatten method.

Disadvantage:

  • Many functions.

  • The usage of MapIndexed might make it difficult to understand without disassembling the code.

  • I compared this method with the Case and Flatten method on the test lists list1 = RandomChoice[{b, a, f}, 10^5] and list2 = RandomChoice[{b, a, f}, 10^6]; and found that the Case and Flatten method was 4 times faster. Most of the time was spent getting the output from Intersection in the method given here. MapIndexed was a bit slow as well.

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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