       Re: Add terms surrounded by zero together in matrix

• To: mathgroup at smc.vnet.net
• Subject: [mg59149] 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:29 -0400 (EDT)
• References: <200507290442.AAA03344@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```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:=
SumsOfTermsSurroundedByZero[AA]

Out=
{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

```

• Prev by Date: Re: NIntegrate::inum continued
• Next by Date: Re: Add terms surrounded by zero together in matrix
• Previous by thread: Re: Add terms surrounded by zero together in matrix
• Next by thread: Re: Add terms surrounded by zero together in matrix