10
$\begingroup$

Im trying to escape doing double loops given the large number of items in the arrays.

I have two list with a format like this:

list1={{1,2,0},{1,3,0},{4,6,0},{2,3,0}} (*Third element of each item is 0*)

list2={{3,2,1},{1,3,1},{4,5,1}} (*Third element of each item is 1*)  

List might not be of equal length.

If the first two elements of a list match I want to replace that item in list1 with the corresponding item in list2.

result={{1,2,0},{1,3,1},{4,6,0},{2,3,0}}

Since there seems to be confusion I'll provide another example:

test1={{0.5,0.5,0},{1,1,0},{1.5,1.5,0},{2.0,2.0,0}};
test2={{0.5,0.5,1},{2.0,2.0,1}};

The results should then be:

 result={{0.5,0.5,1},{1,1,0},{1.5,1.5,0},{2.0,2.0,1}};

Which includes every item in test1.

I am sorry if its confusing, this is my first post here.

I have this setup but it takes too much time:

densitydata = Reap[Do[If[{cross[[m, 1]],cross[[m, 2]]} == {fullzone0[[n,1]] = fullzone0[[n, 2]]},
Sow[cross[[m]]], Sow[fullzone0[n]]],
{n, 1,Dimensions[fullzone0][[1]]}, {m, 1,Dimensions[cross][[1]]}]][[2]][[1]];
$\endgroup$
  • $\begingroup$ Welcome! To make the most of Mma.SE start by taking the tour now. There are things to do after your question is answered. It's a good idea to stay vigilant for some time, better approaches may come later improving over previous replies. Experienced users may point alternatives, caveats or limitations. New users should test answers before voting and wait 24 hours before accepting the best one. $\endgroup$ – rhermans Jul 12 '17 at 17:05
  • $\begingroup$ Thanks for taking the Tour! Participation is essential for the site, please come back to do your part tomorrow. As you receive give back, vote and answer questions, keep the site useful, be kind, correct mistakes and share what you have learned. $\endgroup$ – rhermans Jul 12 '17 at 17:10
  • $\begingroup$ What should be returned for the lists {{1, 2, 0}} and {{3,2,1}, {1, 2, 1}}? $\endgroup$ – Carl Woll Jul 12 '17 at 17:53
  • $\begingroup$ @CarlWoll It should return every element in list1 with the elements that meet the criteria replaced. so it should be. result={{1,2,0},{1,3,1},{4,6,0},{2,3,0} $\endgroup$ – Giovanni Baez Jul 12 '17 at 18:00
  • $\begingroup$ In addition, what should be returned for the lists {{1, 2, 0}, {3, 2, 0}} and {{3, 2, 1}? $\endgroup$ – Carl Woll Jul 12 '17 at 18:00
9
$\begingroup$

Update after discussions in comments

I've revised my code to use Replace with a level spec, and to create rules only from list2, since the latter list can be much smaller than the first list. This provides a speed boost of about 50%.

update[l1_,l2_] := Module[{p, q, r=l1},
    p = Replace[
        l1[[All,;;2]],
        Dispatch @ Thread @ Rule[l2[[All,;;2]], l2[[All,3]]],
        {1}
    ];
    q = Replace[p[[All,0]], {List->0,_->1}, {1}];
    r[[Pick[Range[Length[l1]], q, 1], 3]] = Pick[p,q,1];
    r
]

For your initial example:

update[list1, list2]

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

For your latest example:

test1={{0.5,0.5,0},{1,1,0},{1.5,1.5,0},{2.0,2.0,0}};
test2={{0.5,0.5,1},{2.0,2.0,1}};

update2[test1,test2]

{{0.5, 0.5, 1}, {1, 1, 0}, {1.5, 1.5, 0}, {2., 2., 1}}

Timing

Since you mention working with large arrays, here's the speed of update on some made up data:

list1=Sort@RandomReal[1,{10^4,3}];
list2=RandomSample[list1,10^3];
list2[[All,3]]=RandomReal[1,10^3];

update[list1,list2];//AbsoluteTiming

{0.01681, Null}

list1=Sort@RandomReal[1,{10^6,3}];
list2=RandomSample[list1,10^5];
list2[[All,3]]=RandomReal[1,10^5];

update[list1,list2];//AbsoluteTiming

{1.99171, Null}

Old code

update2[l1_,l2_] := Module[{r=l1, l=Join[l2,l1]},
    r[[All,3]] = r[[All, ;;2]] /. Dispatch@Thread@Rule[l[[All, ;;2]],l[[All,3]]];
    r
]
$\endgroup$
  • $\begingroup$ +1 for the performance ! $\endgroup$ – Ali Hashmi Jul 13 '17 at 0:09
  • $\begingroup$ Your code now beats mine handily in performance. Nice. +1 $\endgroup$ – Mr.Wizard Jul 14 '17 at 1:40
8
$\begingroup$
f[v1_, v2_] := If[Most[v1] == Most[v2], v2, v1];
MapThread[f, {list1, list2}]

which gives you {{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

Revised to incorporate your unequal length list condition

Map[(match = Cases[list2, Join[Most[#], {_}]]; 
     If[match == {}, #, match[[1]]]) &, list1]
$\endgroup$
  • $\begingroup$ I may have oversimplified the format, the lists are not equal length. So it makes it more tricky. $\endgroup$ – Giovanni Baez Jul 12 '17 at 17:12
7
$\begingroup$
list1 = {{1, 2, 0}, {1, 3, 0}, {4, 6, 0}, {2, 3, 0}};
list2 = {{3, 2, 1}, {1, 3, 1}, {4, 5, 1}, {4, 3, 1}};

If[Most[#] === Most[#2], #2, #] & @@@ Transpose[{list1, list2}]

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

$\endgroup$
6
$\begingroup$
mask = Boole[# == {0, 0}] & /@ Unitize[list1[[;; , ;; 2]] - list2[[;; , ;; 2]]];

list1 mask + (1 - mask) list2

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

Update: For lists with possibly unequal lengths:

ClearAll[f1]
f1 = Module[{ml = Min[Length /@ {##}], mask, l1 = #, l2 = #2}, 
    mask = Boole[# == {0, 0}] & /@ Unitize[l1[[;; ml, ;; 2]] - l2[[;; ml, ;; 2]]];
    l1[[;; ml, -1]] = l1[[;; ml, -1]] mask + (1 - mask) l2[[;; ml, -1]]; l1] &;

Examples:

list1 = {{1, 2, 0}, {1, 3, 0}, {4, 6, 0}, {2, 3, 0}} ;
list2 = {{3, 2, 1}, {1, 3, 1}, {4, 5, 1}, {4, 3, 1}};
f1[list1, list2]

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

SeedRandom[1]
list3 = {#, #2, 2} & @@@ RandomInteger[5, {3, 3}];

f1[Join[list1, list3], list2]

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}, {4, 2, 2}, {0, 1, 2}, {0, 2, 2}}

f1[list1, Join[list2, list3]]

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

test1 = {{0.5, 0.5, 0}, {1, 1, 0}, {1.5, 1.5, 0}, {2.0, 2.0, 0}};
test2 = {{0.5, 0.5, 1}, {2.0, 2.0, 1}};
f1[test1, test2]

{{0.5, 0.5, 1}, {1, 1, 0}, {1.5, 1.5, 0}, {2., 2., 0}}

$\endgroup$
  • $\begingroup$ The first approach is really nice, I never thought of just using matrix algebra for list manipulation like this. $\endgroup$ – Giovanni Baez Jul 12 '17 at 17:07
  • $\begingroup$ f1[{{1, 2, 0}, {1, 3, 0}}, {{1, 3, 1}, {1, 2, 1}}] produces a strange result. I would expect either {{1, 2, 0}, {1, 3, 0}} or {{1, 2, 1}, {1, 3, 1}}, but not {{1, 2, 0}, {1, 3, 1}}. $\endgroup$ – Carl Woll Jul 12 '17 at 20:55
  • $\begingroup$ Thank you @Carl. Fixed it now. I had list1 and list2 leftover from previous versions changed them to l1 and l2. $\endgroup$ – kglr Jul 12 '17 at 21:16
  • $\begingroup$ @kglr This method seems to be the one better suited for very large arrays. If the numbers in the list are not integers would it present a problem in the execution of the code? $\endgroup$ – Giovanni Baez Jul 12 '17 at 21:47
  • $\begingroup$ @kglr The following test cases produce a negative value for the third element in the result. test1= {{0., 0.045105, 0.}, {0., 0.047361, 0.}, {0., 0.049616, 0.}, {0.998047, 1.67229, 0.}},test2={{0.208984, 0.120657, 1}, {0.765625, 1.59448, 1}} give {{0., 0.045105, -1.}, {0., 0.047361, -1.}, {0., 0.049616, 0.}, {0.998047, 1.67229, 0.}} $\endgroup$ – Giovanni Baez Jul 12 '17 at 21:52
5
$\begingroup$

The question was changed after I wrote my first method making it invalid.

For the new question I propose simply using Associations.

test1 = {{0.5, 0.5, 0}, {1, 1, 0}, {1.5, 1.5, 0}, {2.0, 2.0, 0}};
test2 = {{0.5, 0.5, 1}, {2.0, 2.0, 1}};

fn2 =
  KeyValueMap[Append] @*
      (AssociationThread[#[[All, ;; -2]] -> #[[All, -1]]] &) @* Join;

fn2[test1, test2]
{{0.5, 0.5, 1}, {1, 1, 0}, {1.5, 1.5, 0}, {2., 2., 1}}

This is faster than the presently Accepted answer:

list1 = Sort@RandomReal[1, {10^6, 3}];
list2 = RandomSample[list1, 10^5];
list2[[All, 3]] = RandomReal[1, 10^5];

r1 = update2[list1, list2]; // AbsoluteTiming
r2 = fn2[list1, list2];     // AbsoluteTiming

r1 === r2
{3.30789, Null}

{2.30772, Null}

True

Method for original question:

pos[a_, b_][p_, i_] :=
 p[[
   "AdjacencyLists" //
     SparseArray[Unitize[Subtract @@ {a, b}[[All, p, i]]], Automatic, 1]
  ]]

fn[a_, b_] :=
  Module[{x = a, pp},
    pp = Fold[pos[a, b], Range@Length@b, {1, 2}];
    x[[pp]] = b[[pp]];
    x
  ]

fn[list1, list2]
{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

If I have time I'll benchmark this and other answers later unless someone else undertakes that first.

$\endgroup$
  • $\begingroup$ +1 for awesome speed :) your speed beats @Carl by a slight margin :) $\endgroup$ – Ali Hashmi Jul 13 '17 at 0:13
  • $\begingroup$ @AliHashmi Thanks! I just updated my answer to include a single timing point; I get a fairly large improvement with this case on my system. $\endgroup$ – Mr.Wizard Jul 13 '17 at 0:15
5
$\begingroup$
list1 = {{1, 2, 0}, {1, 3, 0}, {4, 6, 0}, {2, 3, 0}, {3, 2, 0}};
list2 = {{3, 2, 1}, {1, 3, 1}, {4, 5, 1}};

replace[list1_, list2_] := 
Module[{temp, pos, val, l = list1}, 
temp = Outer[If[SameQ @@ Map[Most]@{##}, Last[#2]] &, list1, list2, 1];
val = Cases[temp, _?NumericQ, {2}];
pos = Map[First]@Position[temp, _?NumericQ, {2}];
l[[pos, -1]] = val;
l]

replace[list1,list2]

(* {{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}, {3, 2, 1}} *)

one more case:

test1 = {{0.5, 0.5, 0}, {1, 1, 0}, {1.5, 1.5, 0}, {2.0, 2.0, 0}};
test2 = {{0.5, 0.5, 1}, {2.0, 2.0, 1}};

replace[test1, test2]
(* {{0.5, 0.5, 1}, {1, 1, 0}, {1.5, 1.5, 0}, {2., 2., 1}} *)
$\endgroup$
  • $\begingroup$ Your method modifiers list1 (or test1). That means something like replace[{{1, 2, 0}}, {{1, 2, 2}}] won't work. Also, it always updates the result to 1. $\endgroup$ – Carl Woll Jul 12 '17 at 22:54
  • $\begingroup$ @CarlWoll now it does not modify list1 in place. Also now it does not update to 1 always. But your performance is much much superior to this answer $\endgroup$ – Ali Hashmi Jul 13 '17 at 0:02
5
$\begingroup$

Assuming: "for my arrays, all elements present in list2 are in list1"

The code:

GatherBy[Join[list1, list2], Most][[All, -1]]

works if either DuplicateFreeQ[Drop[list1, None, -1]] is True or if it is False you want duplicates of list1 to be deleted.

$\endgroup$
3
$\begingroup$
list1 = {{1, 2, 0}, {1, 3, 0}, {4, 6, 0}, {2, 3, 0}};
list2 = {{3, 2, 1}, {1, 3, 1}, {4, 5, 1}, {4, 3, 1}};

f[{{x__, _}, a : {x__, _}}] := a
f[{a_, _}] := a

f /@ Transpose[{list1, list2}]

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

$\endgroup$
3
$\begingroup$

Another one-liner:

list1[[All, ;; 2]] /. (Join[list2, list1] /. {x_, y_, z_} :>  ({x, y} -> {x, y, z}))

{{1, 2, 0}, {1, 3, 1}, {4, 6, 0}, {2, 3, 0}}

 

For the OP second example:

test1[[All, ;; 2]] /. (Join[test2, test1] /. {x_, y_, z_} :>  ({x, y} -> {x, y, z}))

{{0.5, 0.5, 1}, {1, 1, 0}, {1.5, 1.5, 0}, {2., 2., 1}}

 

(With ReplaceAll, the first rule that matches is applied to each part)

{1, 2, 3, 4, 1} /. {1 -> 10, 1 -> 100}

{10, 2, 3, 4, 10}

Edit

If the third element of list1 is always 0 and the third element of list2 is always 1 the following, I think, should also work:

(list1 /. (list2 /. {x_, y_, 1} :>  ({x, y, 0} -> {x, y, 1})))

and

(test1 /. (test2 /. {x_, y_, 1} :>  ({x, y, 0} -> {x, y, 1})))
$\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.