0
$\begingroup$

list = {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}, {-1, 1, 0}, {1, -1, 0}, {-1, -1, 0}, {-1, 0, 1}, {1, 0,-1}, {-1, 0, -1}, {0, -1, 1}, {0, 1, -1}, {0, -1, -1}};

list2 = {{2, 0, 0}, {0, 2, 0}, {0, 0, 2}, {-2, 0, 0}, {0, -2, 0}, {0, 0, -2}}

@Ulrich Neumann gave the following algorithm which finds the all zero sums (duplication is allowed) where "a" vectors are selected from list and "b" vectors from list2.

slist = Tuples[list, {a}]; listb = Tuples[list2, {b}] Table[{li, Select[slist, Total[#] == -Total[li] &]}, {li, listb}]

For instance, when a=2, and b=1, one part of the result which the above code gives:{{{2, 0, 0}}, {{{-1, 1, 0}, {-1, -1, 0}}, {{-1, -1, 0}, {-1, 1, 0}}, {{-1, 0, 1}, {-1, 0, -1}}, {{-1, 0, -1}, {-1, 0, 1}}}}

My problem is listing the results .I want to assign letters to each vectors in the list and list2, let list = {a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12}; where a1={1, 1, 0}, a2={1, 0, 1}, a3={0, 1, 1}, a4={-1, 1, 0}, a5={1, -1, 0}, a6={-1, -1, 0},a7= {-1,0,1}, a8= {1,0,-1}, a9= {-1,0,-1}, a10={0,-1,1}, a11={0,1,-1}, a12={0,-1,-1},

and list2={b1, b2, b3, b4, b5, b6} where b1={2, 0, 0}, b2={0, 2, 0}, b3={0, 0, 2}, b4={-2, 0, 0}, b5={0, -2, 0}, b6={0, 0, -2}.

I want to have the results in the associated form. So for instance, reconsider the specific part of result: {{{2, 0, 0}}, {{{-1, 1, 0}, {-1, -1, 0}}, {{-1, -1, 0}, {-1, 1, 0}}, {{-1, 0, 1}, {-1, 0, -1}}, {{-1, 0, -1}, {-1, 0, 1}}}}. It needs to be in the form: {{b1}, {{a4, a6}, {a6, a4}, {a7, a9}, {a9, a7}}} and I want the whole output to be in terms of letters rather than explicit vectors. How can we manage this ?

$\endgroup$
2
$\begingroup$

I recommend that you use indexed variables

Clear["Global`*"]

Format[a[n_]] := Subscript[a, n];
Format[b[n_]] := Subscript[b, n];

list[1] = {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}, {-1, 1, 0}, {1, -1, 0}, {-1, -1, 
    0}, {-1, 0, 1}, {1, 0, -1}, {-1, 0, -1}, {0, -1, 1}, {0, 
    1, -1}, {0, -1, -1}};

list[2] = {{2, 0, 0}, {0, 2, 0}, {0, 0, 2}, {-2, 0, 0}, {0, -2, 0}, {0, 
    0, -2}};

Create a replacement Rule for each list element

(repl[#] = 
    Thread[list[#] ->
      Array[{a, b}[[#]], Length[list[#]]]]) & /@ {1, 2}

enter image description here

sol[m_Integer?Positive, n_Integer?Positive] :=
 Module[{
   lista = Tuples[list[1], {m}],
   listb = Tuples[list[2], {n}]},
   Table[
   {li /. repl[2], Select[lista, Total[#] == -Total[li] &] /. repl[1]},
   {li, listb}]]

sol[2, 1]

enter image description here

$\endgroup$
4
  • $\begingroup$ Thanks for the code @Bob Hanlon I would like to reduce the list which we get as a result. I would like to drop the results which contains 2 indexed variables together. For example, consider your example sol[2,1]. I would like to drop the answers which contains a4 and a6 together in the result. So in this case {a4,a6} and {a6,a4} will be eliminated or let consider sol[2,2] I would like the drop the results which contains b1 and b4 together. I know we will use the commands: drop or select commands but I couldnt set up. How can we manage this? – $\endgroup$
    – gunes
    Jul 10 at 11:03
  • $\begingroup$ To ask a new question post a new question. In the new question clarify want you want. For example, when you say "drop the results" do you mean drop the entire entry for b[1] or just its elements that contain both a[4] and a[6]? This is generally clarified by showing one or more examples of specific output expected for given inputs. $\endgroup$
    – Bob Hanlon
    Jul 10 at 14:54
  • $\begingroup$ many thanks for your help so far @Bob Hanlon. My question is about a small update about the code that you wrote. The code does not solve the cases when "m is positive integer but n is zero. For instance, it does not solve sol[3, 0] which has at least has a solution: a[1]+a[7]+a[12]={0,0,0}. I tried to change "Positive" with "NonNegative" in the code, but it did not work. Do you have any advise. If needed I may ask this in a new question. Many thanks before hand. $\endgroup$
    – gunes
    Jul 12 at 20:05
  • 1
    $\begingroup$ Change definition of sol to sol[m_Integer?Positive, n_Integer?NonNegative] := Module[{lista = Tuples[list[1], {m}], listb = Tuples[list[2], {n}]}, Table[{li /. repl[2], Select[lista, Total[#] == If[li === {}, Table[0, {Length[#[[1]]]}], -Total[li]] &] /. repl[1]}, {li, listb}]] $\endgroup$
    – Bob Hanlon
    Jul 12 at 21:55

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.