4
$\begingroup$

I have two lists 'ups' and 'downs' where they are composed of positions of an element in a matrix and their weight. For example,

ups = {{{x1,y1},wu1},{{x2,y2},wu2},...}
downs = {{{X1,Y1},wd1},{{X2,Y2},wd2},...}

Now, I want to create a new list called 'full' where it contains both of these information. I want to do the following:

  1. If {x1,y1}=={X1,Y1}, then

    full = {{{x1,y1},wu1,wd1}}...}
    
  2. Otherwise,

    full = {{{x1,y1},wu1,0},{{X1,Y1},0,wd1},...}
    

Here is what I tried:

For[j = 1, j <= Length[downs], j++,
  For[i = 1, i <= Length[ups], i++,
      If[ups[[i]][[1]] == downs[[j]][[1]], 
       AppendTo[listFull, {ups[[i]], downs[j][[2]]}], 
       AppendTo[
        AppendTo[listFull, {ups[[i]], 0}], {downs[[j]][[1]], 0, 
          downs[[j]][[2]]}]];
      i = i++;]
     j = j++;]]

Applying AppendTo twice seems to cause trouble.. Any suggestions?

$\endgroup$
3
  • $\begingroup$ Please provide minimal example and expected result. $\endgroup$
    – Kuba
    Apr 10, 2015 at 13:14
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 0) Browse the common pitfalls question 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ Apr 10, 2015 at 13:20
  • $\begingroup$ Related: (60069) $\endgroup$
    – Mr.Wizard
    Apr 11, 2015 at 5:10

4 Answers 4

2
$\begingroup$

I believe this should be versatile and reasonably efficient:

join[lists_, pad_: 0] :=
  With[{
    rules = AssociationThread @@@ Transpose /@ lists,
    keys = Union @@ lists[[All, All, 1]]
   },
   Join[keys ~Partition~ 1, Lookup[rules, keys, pad]\[Transpose], 2]
  ]

Examples:

join[{ups, dws}]
{{{1, 1}, u1, d1}, {{1, 2}, u2, 0}, {{2, 3}, 0, d2}}
{
 {{"d", 5}, {"a", 1}, {"b", 4}},
 {{"f", 8}, {"c", 5}, {"d", 1}},
 {{"c", 4}, {"e", 1}, {"d", 6}},
 {{"b", 8}, {"d", 6}, {"e", 7}},
 {{"f", 6}, {"c", 5}, {"e", 5}}
} // join
{{"a", 1, 0, 0, 0, 0},
 {"b", 4, 0, 0, 8, 0},
 {"c", 0, 5, 4, 0, 5},
 {"d", 5, 1, 6, 6, 0},
 {"e", 0, 0, 1, 7, 5},
 {"f", 0, 8, 0, 0, 6}}

Padding can be controlled via the second parameter:

join[{ups, dws}, "foo"]
{{{1, 1}, u1, d1}, {{1, 2}, u2, "foo"}, {{2, 3}, "foo", d2}}
$\endgroup$
6
  • $\begingroup$ I am glad I was in right direction...I really like the clarity and imho elegance +1:) $\endgroup$
    – ubpdqn
    Apr 11, 2015 at 6:34
  • $\begingroup$ @ubpdqn Thanks. Unfortunately I think I lost some clarity with the edit but I gained a large measure of performance. $\endgroup$
    – Mr.Wizard
    Apr 11, 2015 at 6:46
  • $\begingroup$ @Mr.Wizard: Since I'm holding off re-installing 10.x until a non foo-bar release, how does the performance of this compare to the MapThread implementation of Pickett (which can be ~doubled with pre-10 functionality)? $\endgroup$
    – ciao
    Apr 11, 2015 at 6:51
  • $\begingroup$ @rasher I don't believe Pickett's answer is general; does it not rely on an incidental quality of the example data? $\endgroup$
    – Mr.Wizard
    Apr 11, 2015 at 6:53
  • $\begingroup$ @Mr.Wizard: Not sure I follow - error aside (should be using Sequence to properly string mismatches vs Flatten), it seems to do what OP is after (the x1/X1... seems to imply positional comparisons). Am I missing something? Nonetheless, curious re: perf. comparison. Oh, and +1 for your usual elegance. $\endgroup$
    – ciao
    Apr 11, 2015 at 7:03
4
$\begingroup$

A different solution:

ups = {{{1, 1}, u1}, {{1, 2}, u2}};
dws = {{{1, 1}, d1}, {{2, 3}, d2}};

f[{a_, v1_}, {a_, v2_}] := {{a, v1, v2}}
f[{a_, v1_}, {b_, v2_}] := {{a, v1, 0}, {b, 0, v2}}

Join @@ MapThread[f, {ups, dws}]

{{1, 1}, u1, d1, {{1, 2}, u2, 0}, {{2, 3}, 0, d2}}

Functions in Mathematica are really replacement rules. Therefore this solution can also be implemented with rules.

rules = {
   {{a_, v1_}, {a_, v2_}} :> {{a, v1, v2}},
   {{a_, v1_}, {b_, v2_}} :> {{a, v1, 0}, {b, 0, v2}}
   };

Join @@ MapThread[{##} /. rules &, {ups, dws}]

{{1, 1}, u1, d1, {{1, 2}, u2, 0}, {{2, 3}, 0, d2}}

$\endgroup$
4
  • $\begingroup$ Join @@ MapThread[f, {ups, dws}] is shorter; +1. $\endgroup$
    – Mr.Wizard
    Apr 11, 2015 at 5:35
  • $\begingroup$ Oh, I think you want: f[{a_, v1_}, {a_, v2_}] := {{a, v1, v2}} (extra brackets). Hm... I just realized that this is fragile; it probably does not work in many cases because I believe it relies on an incidental alignment of the two lists. $\endgroup$
    – Mr.Wizard
    Apr 11, 2015 at 5:36
  • $\begingroup$ @Mr.Wizard I don't think the alignment is incidental, or at least that's not how I interpreted it. $\endgroup$
    – C. E.
    Apr 11, 2015 at 9:39
  • $\begingroup$ Yes, I see that interpretation now as I commented to rasher. You've still got my vote. $\endgroup$
    – Mr.Wizard
    Apr 11, 2015 at 15:53
2
$\begingroup$
ups = {{{1, 1}, u1}, {{1, 2}, u2}};
dws = {{{1, 1}, d1}, {{2, 3}, d2}};

dim = Max[ups[[All, 1]], dws[[All, 1]]]
su = SparseArray[Rule @@@ #, {dim, dim}] & /@ {ups, dws}
Flatten[MapIndexed[{#2, Sequence @@ #1} &, MapThread[List, su, 2], {2}], 1]

(*
 {{{1, 1}, u1, d1}, {{1, 2}, u2, 0}, {{1, 3}, 0, 0}, 
  {{2, 1}, 0,   0}, {{2, 2}, 0,  0}, {{2, 3}, 0, d2}, 
  {{3, 1}, 0,   0}, {{3, 2}, 0,  0}, {{3, 3}, 0, 0}}

*)
$\endgroup$
2
  • $\begingroup$ Thank you, belisarius! One more question though, what can I do to just have non-zero weight elements in the list? i.e. {{1, 3},0, 0} is not needed. $\endgroup$
    – user27430
    Apr 10, 2015 at 13:29
  • $\begingroup$ @user27430 See the docs for ReplaceAll[ ] $\endgroup$ Apr 10, 2015 at 13:36
0
$\begingroup$

For something else:

ups = {{{1, 1}, u1}, {{1, 2}, u2}};
dws = {{{1, 1}, d1}, {{2, 3}, d2}};

then,

Module[{
  rl = Thread[{{1, 1}, {1, 2}, {2, 3}} -> CharacterRange["a", "c"]], 
  a1, a2, ku, ds, an},
 a1 = Association[Rule[#1 /. rl, #2] & @@@ ups]; 
 a2 = Association[Rule[#1 /. rl, #2] & @@@ dws];
 ku = KeyUnion[{a1, a2}];
 ds = Dataset[ku];
 an = ({#, Normal[ds[All, #]]} & /@ {"a", "b", "c"} /. 
     Missing[__] :> 0) /. (Reverse /@ rl);
 {#1, Sequence @@ #2} & @@@ an
 ]

yields:

{{{1, 1}, u1, d1}, {{1, 2}, u2, 0}, {{2, 3}, 0, d2}}
$\endgroup$

Your Answer

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

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