```Date: Jul 31, 2005 1:01 AM
Author: Andrzej Kozlowski
Subject: Add terms surrounded by zero together in matrix

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 KozlowskiSumsOfTermsSurroundedByZero[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@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>>>
```