RE: What is a smart way to do this?
- To: mathgroup at smc.vnet.net
- Subject: [mg38903] RE: [mg38881] What is a smart way to do this?
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
- Date: Sat, 18 Jan 2003 00:38:22 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
>-----Original Message----- >From: nobody at this.org [mailto:nobody at this.org] To: mathgroup at smc.vnet.net >Sent: Friday, January 17, 2003 11:39 AM >To: mathgroup at smc.vnet.net >Subject: [mg38903] [mg38881] What is a smart way to do this? > > >Dear Mathematica user, > > >I have a very simple problem to solve, but no elegant solution for it. > >I deal with NxN matrices of integral entries where rows and >columns are all >proportional, e.g. for 3x3: > > ( 4 8 12 ) > ( ) >M = ( 5 10 15 ) > ( ) > ( 6 12 18 ) > >I need to decompose these matrices as a (Times) product: > > M = {{1,2,3},{1,2,3},{1,2,3}} * {{4,4,4},{5,5,5},{6,6,6}} >there is no error: * is Times, not Dot. > >which I shall write M = {1,2,3}<*>{4,5,6} > >Finding the absolute values of components of the product M is >easy, using >Gcd on rows of M then of Transpose[M]. > >I MUST be blind, but what I don't see is how to restore correct signs >efficiently without resorting to ugly code. For instance: > > ( -4 -8 12 ) > ( ) >M = ( 5 10 -15 ) > ( ) > ( 6 12 -18 ) > > M = {{1,2,-3},{1,2,-3},{1,2,-3}} * {{-4,-4,-4},{5,5,5},{6,6,6}} > = {1,2,-3} <*> {-4,5,6} > >There always are two solutions with global sign change, since if >M = u <*> v, then M = (-u) <*> (-v). Any of {u,v} or {-u,-v} will do. > [...] Let's first define your special product: In[34]:= comp[a_, b_] := Thread[Unevaluated[a*b], List, -1] In[35]:= comp[{1, 2, 3}, {4, 5, 6}] Out[35]= {{4, 8, 12}, {5, 10, 15}, {6, 12, 18}} To decompose, my suggestion is: In[36]:= decomp[m_] := Module[{a, b = GCD @@@ m, d}, d = m/b; a = First[d]; Catch[ b = If[And @@ SameQ @@@ #, #[[All, 1]], Throw[$Failed]] &[a/# & /@ d]* b; {a, b}]] Catch and Throw here only is to get a decent error. If you can assert the decomposability you may dispense with that. Let's try: In[37]:= decomp[{{-4, -8, 12}, {5, 10, -15}, {6, 12, -18}}] Out[37]= {{-1, -2, 3}, {4, -5, -6}} verify: In[38]:= comp @@ % Out[38]= {{-4, -8, 12}, {5, 10, -15}, {6, 12, -18}} In[39]:= decomp[{{-4, -8, 12}, {5, 10, 15}, {6, 12, -18}}] Out[39]= $Failed This one was not decomposable. You might like to take the steps: In[40]:= m = {{-4, -8, 12}, {5, 10, -15}, {6, 12, -18}}; In[41]:= b = GCD @@@ m Out[41]= {4, 5, 6} Not quite the second factor, but we get the missing signs if we divide In[42]:= d = m/b Out[42]= {{-1, -2, 3}, {1, 2, -3}, {1, 2, -3}} All elements of this list should be the same except for a sign ±1. We arbitrarily take the first element as the first factor (this gives the "other" solution of your example). In[43]:= a = First[d] Out[43]= {-1, -2, 3} We want to get the signs: In[44]:= a/# & /@ d Out[44]= {{1, 1, 1}, {-1, -1, -1}, {-1, -1, -1}} In each element there should be all 1 or all -1. (This was tested above.) In[45]:= %[[All, 1]] Out[45]= {1, -1, -1} In[46]:= %*b Out[46]= {4, -5, -6} This is now the second factor of your special product. -- Hartmut Wolf