
Re: Add terms surrounded by zero together in matrix
Posted:
Jul 30, 2005 1:31 AM


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@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 > > >

