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 '15 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 '15 at 13:20
  • $\begingroup$ Related: (60069) $\endgroup$
    – Mr.Wizard
    Apr 11 '15 at 5:10
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 '15 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 '15 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 '15 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 '15 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 '15 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 '15 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 '15 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 '15 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 '15 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 '15 at 13:29
  • $\begingroup$ @user27430 See the docs for ReplaceAll[ ] $\endgroup$ Apr 10 '15 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, privacy policy and cookie policy

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