1
$\begingroup$

Let I have basis of two linearly independent vectors {d[1,2], d[1,3]}.
Let I need to decompose vector 5 d[1,2] it terms of this basis.

I try to Solve[5 d[1,2]==a d[1,2] +b d[1,3],{a,b}].

I expect solution

{{a->5,b->0}}

but mathematica don't know that d[1,2] and d[1,3]are linearly independent. So I get solution, that I don't need:

{{b -> (5 d[1, 2])/d[1, 3] - (a d[1, 2])/d[1, 3]}}

How to do I need?

(Further I will need to decompose vector like
12 + 2 d[1, 2] + 2 d[1, 3] + 2 d[1, 4] - 2 d[1, 5] + 2 d[2, 3] + 2 d[2, 4] - 2 d[2, 5] + 2 d[3, 4] - 2 d[3, 5] - 2 d[4, 5]
in terms of basis like
{1,
d[1, 2] + d[1, 3] + d[1, 4] + d[2, 3] + d[3, 4],
d[1, 5] + d[2, 5] + d[3, 5] + d[4, 5],
d[1, 2] d[3, 4] + d[1, 3] d[2, 4] + d[1, 4] d[3, 2],
d[1, 5] d[2, 3] + d[1, 5] d[2, 4] + d[1, 3] d[2, 5] + d[1, 4] d[2, 5] + d[1, 5] d[3, 4] + d[2, 5] d[3, 4] + d[1, 2] d[3, 5] + d[1, 4] d[3, 5] + d[2, 4] d[3, 5] + d[1, 2] d[4, 5] + d[1, 3] d[4, 5] + d[2, 3] d[4, 5]}
and I expect something like {12,2,-2,0,0} or any error, if such decomposition is impossible.)

$\endgroup$
  • $\begingroup$ Maybe Coefficient[5 d[1, 2], #] &/@ {d[1, 2], d[1, 3]} $\endgroup$ – Coolwater Feb 17 '18 at 19:18
  • $\begingroup$ How can I get coefficient at 1? Coefficient[1+2x+3y,x,0]-> 1 + 3 y $\endgroup$ – Филя Усков Feb 18 '18 at 11:07
1
$\begingroup$
vec = 12 + 2 d[1, 2] + 2 d[1, 3] + 2 d[1, 4] - 2 d[1, 5] + 2 d[2, 3] - 2 d[2, 5] + 2 d[3, 4] - 2 d[3, 5] - 2 d[4, 5];
basis = {1, d[1, 2] + d[1, 3] + d[1, 4] + d[2, 3] + d[3, 4], d[1, 5] + d[2, 5] + d[3, 5] + d[4, 5], d[1, 2] d[3, 4] + d[1, 3] d[2, 4] + d[1, 4] d[3, 2], d[1, 5] d[2, 3] + d[1, 5] d[2, 4] + d[1, 3] d[2, 5] + d[1, 4] d[2, 5] + d[1, 5] d[3, 4] + d[2, 5] d[3, 4] + d[1, 2] d[3, 5] + d[1, 4] d[3, 5] + d[2, 4] d[3, 5] + d[1, 2] d[4, 5] + d[1, 3] d[4, 5] + d[2, 3] d[4, 5]};

solve[b_, v_] := With[{symbs = Unique[ConstantArray["x", Length[b]]]},
 (Remove @@ symbs; #) &[symbs /. Solve[Union @@ Last[Reap[Collect[b.symbs - v,
                  Reverse[SortBy[Flatten[List @@@ b], Length]], Sow];]] == 0]]]

solve[basis, vec]
{{12, 2, -2, 0, 0}}
| improve this answer | |
$\endgroup$
  • $\begingroup$ be careful: for List @@@ {1, a b, x + y} I expect {1,a b,{x,y}} but it return {1,{a,b},{x,y}} $\endgroup$ – Филя Усков Feb 22 '18 at 20:36
  • $\begingroup$ If 1 is absent in second argument of Collect, one works 10 times more faster. $\endgroup$ – Филя Усков Feb 23 '18 at 11:46
5
$\begingroup$

Use SolveAlways:

SolveAlways[5 d[1, 2] == a d[1, 2] + b d[1, 3], {d[1, 2], d[1, 3]}]

and

vector = 12 + 2 d[1, 2] + 2 d[1, 3] + 2 d[1, 4] - 2 d[1, 5] + 
   2 d[2, 3] - 2 d[2, 5] + 2 d[3, 4] - 2 d[3, 5] - 2 d[4, 5];
basis = {1, d[1, 2] + d[1, 3] + d[1, 4] + d[2, 3] + d[3, 4], 
  d[1, 5] + d[2, 5] + d[3, 5] + d[4, 5], 
  d[1, 2] d[3, 4] + d[1, 3] d[2, 4] + d[1, 4] d[3, 2], 
  d[1, 5] d[2, 3] + d[1, 5] d[2, 4] + d[1, 3] d[2, 5] + 
   d[1, 4] d[2, 5] + d[1, 5] d[3, 4] + d[2, 5] d[3, 4] + 
   d[1, 2] d[3, 5] + d[1, 4] d[3, 5] + d[2, 4] d[3, 5] + 
   d[1, 2] d[4, 5] + d[1, 3] d[4, 5] + d[2, 3] d[4, 5]}
len = Length[basis];
SolveAlways[vector == Array[c, len].basis, Variables[basis]]

{{c[1] -> 12, c[2] -> 2, c[3] -> -2, c[4] -> 0, c[5] -> 0}}

| improve this answer | |
$\endgroup$
  • $\begingroup$ unfortunately when basis//Length =44, number of variables =28, number of terms in Array[c, len].basis =764 SolveAlways use so much memory that my computer freezes $\endgroup$ – Филя Усков Feb 18 '18 at 8:56
  • 1
    $\begingroup$ @ФиляУсков This is a different problem. Your original question has been answered. Please, start a new question stating your problem and providing your data. $\endgroup$ – yarchik Feb 18 '18 at 9:07
  • $\begingroup$ No, your answer is not full, because your method is exponentially hard both in time and in memory. len = 20; MemoryConstrained[Timing[SolveAlways[5 e[3] == Array[c, len].Array[e, len],Array[e, len]]][[1]], 90000000] -> 1.578125 len = 21;MemoryConstrained[Timing[SolveAlways[5 e[3] == Array[c,len].Array[e, len], Array[e, len]]][[1]], 200000000] -> 3.125000 len = 24; MemoryConstrained[Timing[SolveAlways[5 e[3] == Array[c, len].Array[e, len], Array[e, len]]][[1]], 1400000000] -> 25.984375 $\endgroup$ – Филя Усков Feb 18 '18 at 10:51

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.