Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Add terms surrounded by zero together in matrix

• To: mathgroup at smc.vnet.net
• Subject: [mg59137] Re: [mg59123] Add terms surrounded by zero together in matrix
• From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
• Date: Sat, 30 Jul 2005 01:25:09 -0400 (EDT)
• References: <200507290442.AAA03344@smc.vnet.net> <D57F24FF-09B6-45B0-9D84-3F12DC801571@mimuw.edu.pl>
• Sender: owner-wri-mathgroup at wolfram.com

Here is a slightly improved version. (I just removed unnecessary  
inner Blocks and a unnecessary conversion of the final expression to  
List before applying Cases, which of course is never needed).

Andrzej Kozlowski


SumsOfTermsSurroundedByZero[AA_] :=
   Block[{d, MakeNames, A = AA, p = First[Dimensions[
     AA]], q = Last[Dimensions[AA]]},
    MakeNames[1, 1] := A[[1, 1]] = Unique[z]*A[[1, 1]]; MakeNames[1,  
i_] :=
      A[[1, i]] =  If[(d = Variables[A[[1, i - 1]]]) != {}, First[d]*A 
[[1, i]],

         Unique[z]*A[[1, i]]]; MakeNames[i_, 1] :=
      A[[i, 1]] =  Which[(d = Variables[A[[i - 1, 1]]]) != {},
         First[
       d]*A[[i, 1]], (d = Variables[A[[i - 1, 2]]]) != {}, First[d]*A 
[[i, 1]],
         True, Unique[z]*A[[i, 1]]]; MakeNames[i_, q] :=
      A[[i, q]] = Which[(d = Variables[A[[i - 1, q - 1]]]) != {},
         First[d]*A[[i, 5]], (d = Variables[A[[i - 1, q]]]) != {},
       First[d]*A[[i, q]],
         (d = Variables[A[[i, q - 1]]]) != {}, First[d]*A[[i, q]], True,
         Unique[z]*A[[i, q]]]; MakeNames[i_, j_] :=
      A[[i, j]] =  Which[(d = Variables[A[[i - 1, j - 1]]]) != {},
         First[d]*A[[i, j]], (
             d = Variables[A[[i - 1, j]]]) != {}, First[d]*A[[i, j]],
         (d = Variables[A[[i - 1, j + 1]]]) != {}, First[d]*A[[i, j]],
         (d = Variables[A[[i, j - 1]]]) != {}, First[d]*A[[i, j]], True,
         Unique[z]*A[[i, j]]]; Do[MakeNames[i, j], {i, p}, {j, q}];
     Cases[Plus @@ Flatten[A], _?NumericQ, Infinity]]





On 29 Jul 2005, at 20:55, Andrzej Kozlowski wrote:

>
> On 29 Jul 2005, at 06:42, mchangun at gmail.com wrote:
>
>
>> Hi All,
>>
>> I think this is a rather tough problem to solve.  I'm stumped and  
>> would
>> really appreciated it if someone can come up with a solution.
>>
>> What i want to do is this.  Suppose i have the following matrix:
>>
>> 0       0       0       1       0
>> 0       0       1       2       0
>> 0       0       0       2       1
>> 1       3       0       0       0
>> 0       0       0       0       0
>> 0       0       0       0       0
>> 0       0       1       1       0
>> 5       0       3       0       0
>> 0       0       0       0       0
>> 0       0       0       3       1
>>
>> I'd like to go through it and sum the elements which are  
>> surrounded by
>> zeros.  So for the above case, an output:
>>
>> [7 4 5 5 4]
>>
>> is required.  The order in which the groups surrounded by zero is
>> summed does not matter.
>>
>> The elements are always integers greater than 0.
>>
>> Thanks for any help!
>>
>>
>>
>
>
> O.K., Here is a solution. I think the algorithm is rather nice but  
> the implementation certainly isn't, with a nasty procedural Do  
> loop, nested Blocks  etc, but I can't really afford the time to try  
> to make it nicer. Perhaps someone else will.
>
> Here is the function:
>
>
> SumsOfTermsSurroundedByZero[AA_] :=
>   Block[{MakeNames, A = AA, p = First[Dimensions[AA]], q = Last 
> [Dimensions[AA]]},
>    MakeNames[1, 1] := A[[1,1]] = Unique[z]*A[[1,1]]; MakeNames[1,  
> i_] :=
>      A[[1,i]] = Block[{d}, If[(d = Variables[A[[1,i - 1]]]) != {},  
> First[d]*A[[1,i]],
>         Unique[z]*A[[1,i]]]]; MakeNames[i_, 1] :=
>      A[[i,1]] = Block[{d}, Which[(d = Variables[A[[i - 1,1]]]) != {},
>         First[d]*A[[i,1]], (d = Variables[A[[i - 1,2]]]) != {},  
> First[d]*A[[i,1]],
>         True, Unique[z]*A[[i,1]]]]; MakeNames[i_, q] :=
>      A[[i,q]] = Block[{d}, Which[(d = Variables[A[[i - 1,q - 1]]]) ! 
> = {},
>         First[d]*A[[i,5]], (d = Variables[A[[i - 1,q]]]) != {},  
> First[d]*A[[i,q]],
>         (d = Variables[A[[i,q - 1]]]) != {}, First[d]*A[[i,q]], True,
>         Unique[z]*A[[i,q]]]]; MakeNames[i_, j_] :=
>      A[[i,j]] = Block[{d}, Which[(d = Variables[A[[i - 1,j - 1]]]) ! 
> = {},
>         First[d]*A[[i,j]], (d = Variables[A[[i - 1,j]]]) != {},  
> First[d]*A[[i,j]],
>         (d = Variables[A[[i - 1,j + 1]]]) != {}, First[d]*A[[i,j]],
>         (d = Variables[A[[i,j - 1]]]) != {}, First[d]*A[[i,j]], True,
>         Unique[z]*A[[i,j]]]]; Do[MakeNames[i, j], {i, p}, {j, q}];
>     Cases[List @@ Plus @@ Flatten[A], _?NumericQ, Infinity]]
>
> Here is your matrix defined using proper Mathematica syntax:
>
> AA = {{0,0 , 0 , 1, 0}, {0, 0 , 1 , 2, 0}, {0, 0, 0, 2 , 1}, {1, 3,  
> 0 , 0 , 0}, {0,
>     0, 0, 0 , 0}, {0 , 0, 0 , 0, 0}, {0, 0 , 1 , 1, 0}, {5 , 0, 3,  
> 0 , 0}, {0,
>      0, 0, 0, 0}, {0, 0, 0, 3, 1}}
>
> And here is the solution:
>
> In[3]:=
> SumsOfTermsSurroundedByZero[AA]
>
> Out[3]=
> {7,4,5,5,4}
>
>
> I have not tested it on other examples but your own but it should  
> work in all cases.
>
> Andrzej Kozlowski
>
>
>

• References:
  • Add terms surrounded by zero together in matrix
    • From: "mchangun@gmail.com" <mchangun@gmail.com>