The following solution is better. 

bpr=: [EMAIL PROTECTED] ,:"0 1&.> <@([:((0 1 [EMAIL PROTECTED]) ,.1 0 <:@[EMAIL 
PROTECTED] ]) 0,~0,])"1
        NB. blocks per row; top left in first and bottom right in last
column!

mtch=: 4 : 0
's t'=.<"0 x (](#~; (#~-.)) e.~&:(<@{:"2))&> {.y
t=. t((,&.>{:)`[)@.([EMAIL PROTECTED])y
s=. x([:(<@{:"2 ({:@[EMAIL PROTECTED]:(<0 1)} {.)/.]) ,)&> s
s;t
)

blcks=:[:/:~ [:|:"2 [:,&>/ [:mtch/ bpr
        NB. blocks rowwise

blocks=:[:([EMAIL PROTECTED](>&#))&>/ [:({., |."1&.>@{:) [:blcks &.> (;|:)
        NB. per block top left in first row(!) and bottom right in last

   ;(; blocks)&.>(;|:)tst1
+-----------+----+-----------------------+----+
|0 0 0 1 1 1| 2 0|0 0 1 0 0 1 1 1 1 1 0 0|0  2|
|0 0 0 0 0 0| 2 2|0 0 1 0 0 1 1 1 1 1 0 0|2  2|
|1 1 1 0 0 0|    |0 0 1 0 0 1 1 1 1 1 0 0|    |
|0 0 0 1 1 1| 5 0|1 0 0 1 1 0 0 1 1 1 1 1|0  5|
|0 0 0 1 1 1| 9 2|1 0 0 1 1 0 0 1 1 1 1 1|2  9|
|1 1 1 0 0 0|    |1 0 0 1 1 0 0 1 1 1 1 1|    |
|1 1 1 0 0 0| 0 3|                       |3  0|
|1 1 1 1 1 1| 0 5|                       |5  0|
|1 1 1 1 1 1|    |                       |    |
|1 1 1 1 1 1| 3 3|                       |3  3|
|0 0 0 1 1 1| 4 5|                       |5  4|
|0 0 0 1 1 1|    |                       |    |
|           | 7 3|                       |3  7|
|           |11 5|                       |5 11|
+-----------+----+-----------------------+----+

This solution should also work with "over- or underhanging or regions".

I do think 'blocks' delivers the minimum number of maximal rectangular
blocks, but I don't have a prove of it.


R.E. Boss


> -----Oorspronkelijk bericht-----
> Van: [EMAIL PROTECTED] [mailto:programming-
> [EMAIL PROTECTED] Namens Sherlock, Ric
> Verzonden: zaterdag 14 juni 2008 18:29
> Aan: Programming forum
> Onderwerp: RE: [Jprogramming] Finding blocks in a table/matrix
> 
> Found a bug when the top left atom of the matrix is 1
> rectgrps -.tst1
>  0  0  0  3  3  3
>  0  0  0  9  9  9
>  3  3  3 15 15 15
> 18 18 18  3  3  3
> 18 18 18  3  3  3
>  3  3  3 33 33 33
>  3  3  3 33 33 33
>  3  3  3  3  3  3
>  3  3  3  3  3  3
>  3  3  3  3  3  3
> 60 60 60  3  3  3
> 60 60 60  3  3  3
> 
> The following change seems to fix it.
> rectgrps=: ([EMAIL PROTECTED] ([EMAIL PROTECTED] $ ]) 
> }.@(i.~@(0&,@(,.&,/))))@:rplhv
> rectgrps -.tst1
>  1  1  1  0  0  0
>  1  1  1 10 10 10
>  0  0  0 16 16 16
> 19 19 19  0  0  0
> 19 19 19  0  0  0
>  0  0  0 34 34 34
>  0  0  0 34 34 34
>  0  0  0  0  0  0
>  0  0  0  0  0  0
>  0  0  0  0  0  0
> 61 61 61  0  0  0
> 61 61 61  0  0  0
> 
> ---Sherlock, Ric wrote:
> > I've "tidied up" your algorithm below. Thanks again!
> >
> > NB. running sum of starts of connected 1s in each row
> > incgrp=: [:($$ [:+/\ ,) (1, }:~: }.)"1
> > rpl=: ] - (-/ , 0:)@[ {~ [EMAIL PROTECTED] i. ]    NB. numeric replace 
> > (RMiller)
> >
> > hv=: *"_ _1 incgrp,: incgrp&.|:       NB. hor. & vert. connected 1s.
> > rplhv=: (([:(,:|.) ,"_1) rpl"_1 ]) @: hv
> > rectgrps=: ([EMAIL PROTECTED]([EMAIL PROTECTED] $ ]) i.~@,.&,/) @: rplhv  
> > NB.
> > rectangular groups of 1s
> >
> > NB. topleft and bottomright corners of each group
> > tlbr=: ($#: (](i.}.@,. i:) 0~.@,])@,) @: rectgrps
> > blocks2=: ([,: (-~>:))/"_1 @: tlbr  NB. Topleft and shape of
> > each group
> >
> >    blocks2 tst1
> >  0 3
> >  1 3
> >
> >  2 0
> >  1 3
> >
> >  3 3
> >  2 3
> >
> >  5 0
> >  5 3
> >
> >  7 3
> >  3 3
> >
> > 10 3
> >  2 3
> >
> >
> > ---R.E. Boss wrote:
> > >    T2=: [:($$ [:+/\ ,) (1, }:~: }.)"1
> > >
> > >    [;/'H V'=: (*"_ _1 T2,: T2&.|:) tst1
> > >         NB. hor. & vert. connected 1's
> > > +-----------------+---------------+
> > > | 0  0  0  2  2  2|0 0  0 16 21 26|
> > > | 0  0  0  0  0  0|0 0  0  0  0  0|
> > > | 4  4  4  0  0  0|2 7 12  0  0  0|
> > > | 0  0  0  7  7  7|0 0  0 18 23 28|
> > > | 0  0  0  9  9  9|0 0  0 18 23 28|
> > > |10 10 10  0  0  0|4 9 14  0  0  0|
> > > |12 12 12  0  0  0|4 9 14  0  0  0|
> > > |14 14 14 14 14 14|4 9 14 20 25 30|
> > > |15 15 15 15 15 15|4 9 14 20 25 30|
> > > |16 16 16 16 16 16|4 9 14 20 25 30|
> > > | 0  0  0 18 18 18|0 0  0 20 25 30|
> > > | 0  0  0 20 20 20|0 0  0 20 25 30|
> > > +-----------------+---------------+
> > >
> > >    rpl=:] - (-/ , 0:)@[ {~ [EMAIL PROTECTED] i. ]
> > >         NB. Millers solution in
> > >  NB.
> > > http://www.jsoftware.com/pipermail/programming/2007-July/007303.html
> > >
> > >    V ( [EMAIL PROTECTED] $]) i.~@,.&,/ (([:(,:|.) ,"_1) rpl"_1  ])H,:~V
> > >         NB. indicating blocks of 1's
> > >  0  0  0  3  3  3
> > >  0  0  0  0  0  0
> > > 12 12 12  0  0  0
> > >  0  0  0 21 21 21
> > >  0  0  0 21 21 21
> > > 30 30 30  0  0  0
> > > 30 30 30  0  0  0
> > > 30 30 30 45 45 45
> > > 30 30 30 45 45 45
> > > 30 30 30 45 45 45
> > >  0  0  0 63 63 63
> > >  0  0  0 63 63 63
> > >
> > >    [R=: V ([ (,:&, rpl [) [EMAIL PROTECTED] $]) i.~@,.&,/ (([:(,:|.) ,"_1)
> > > rpl"_1  ])H,:~V
> > >         NB. less blocks, but if H is used as LHS, answer is
> > wrong ...
> > >  0  0  0  3  3  3
> > >  0  0  0  0  0  0
> > > 12 12 12  0  0  0
> > >  0  0  0 21 21 21
> > >  0  0  0 21 21 21
> > > 30 30 30  0  0  0
> > > 30 30 30  0  0  0
> > > 30 30 30 45 45 45
> > > 30 30 30 45 45 45
> > > 30 30 30 45 45 45
> > >  0  0  0 45 45 45
> > >  0  0  0 45 45 45
> > >
> > >    ([:([,: (-~>:))/"_1 $#: (](i.}.@,. i:) 0~.@,])@,) R
> > > 0 3
> > > 1 3
> > >
> > > 2 0
> > > 1 3
> > >
> > > 3 3
> > > 2 3
> > >
> > > 5 0
> > > 5 3
> > >
> > > 7 3
> > > 5 3
> > >
> > >
> > > R.E. Boss
> > >
> > >
> > > > -----Oorspronkelijk bericht-----
> > > > Van: [EMAIL PROTECTED] [mailto:programming-
> > > > [EMAIL PROTECTED] Namens Sherlock, Ric
> > > > Verzonden: woensdag 11 juni 2008 14:45
> > > > Aan: Programming forum
> > > > Onderwerp: [Jprogramming] Finding blocks in a table/matrix
> > > >
> > > > Below is a problem that I have enjoyed working on that
> > stems from an
> > > > attempt to generalise the writing of a boxed table of mixed
> > > type to an
> > > > Excel worksheet.
> > > >
> > > > My attempt at a solution in the script at the bottom gives
> > > a non-optimal
> > > > answer (it only finds blocks within rows) that I'd like to
> > > improve if
> > > > possible/practical.
> > > >
> > > > tsta is a boxed table(matrix) of mixed numeric and literal type
> > > >
> > > > ischar=: 3!:0 e. 2 131072"_
> > > > tst1=: ischar &> tsta  NB. Mask of boxed literals in tsta
> > > >
> > > > NB. Below is an example tst1 for copying into a session.
> > > > tst1=: _99&".;._2 (0 : 0)
> > > > 0 0 0 1 1 1
> > > > 0 0 0 0 0 0
> > > > 1 1 1 0 0 0
> > > > 0 0 0 1 1 1
> > > > 0 0 0 1 1 1
> > > > 1 1 1 0 0 0
> > > > 1 1 1 0 0 0
> > > > 1 1 1 1 1 1
> > > > 1 1 1 1 1 1
> > > > 1 1 1 1 1 1
> > > > 0 0 0 1 1 1
> > > > 0 0 0 1 1 1
> > > > )
> > > >
> > > > The problem is to specify the blocks of ones in the table.
> > > > A block is specified by the position of its top left member
> > > and its shape.
> > > >
> > > > Below is an example desired output of a verb "blocks" for tst1:
> > > >    blocks tst1
> > > > 0 3  NB. topleft of block
> > > > 1 3  NB. shape of block
> > > >
> > > > 2 0
> > > > 1 3
> > > >
> > > > 3 3
> > > > 2 3
> > > >
> > > > 5 0
> > > > 5 3
> > > >
> > > > 7 3
> > > > 5 3
> > > >
> > > >    $blocks tst1
> > > > 5 2 2
> > > >
> > > > Obviously there are other ways to organise the blocks of
> > > ones in tst1. A
> > > > solution is correct as long as all ones in tst1 are
> > > included in one and
> > > > only one block. Solutions that produce fewer blocks are
> > > better provided
> > > > they don't take much longer to find the minimum number of blocks.
> > > >
> > > > tst2=: 5 [EMAIL PROTECTED]  NB. Another example table of 0s & 1s that
> > > blocks should
> > > > work with
> > > >
> > > >
> > > >
> > > > NB.========Start of Script======================================
> > > > ischar   =: 3!:0 e. 2 131072"_
> > > > firstones=: > 0: , }: NB. Mask of first ones
> > > >
> > > > tlcols=: <@[EMAIL PROTECTED]"1        NB. leftmost columns of
> > > blocks of 1s
> > > > toplefts=: i.@:# ,.&.> tlcols    NB. topleft index of blocks of 1s
> > > >
> > > > bytype=: 1 : 'u;.1~ (1, 2~:/\ ])'
> > > > lens=: <@({.bytype # #bytype)"1  NB. lengths of blocks of 1s
> > > > shapes=: 1: ,. &.> lens          NB. shapes of blocks of 1s
> > > >
> > > > blocks=: ;@toplefts ,:"1 ;@shapes NB. blocks of 1s
> > > >
> > > > Note 'testing'
> > > > ;toplefts tst1          NB. list of topleft of blocks of 1s
> > > > ;toplefts -.tst1        NB. list of topleft of blocks of 0s
> > > > (;@toplefts ,:"1 ;@shapes) tst1  NB. List of blocks
> > > > ;(toplefts ,:"1 &.> shapes) tst1 NB. Also list of blocks
> > > >
> > > > (blocks   ischar &> tsta) <;.0 tsta  NB. blocks of char
> > > (you will need to
> > > > create a tsta to run this)
> > > > (blocks -.ischar &> tsta) <;.0 tsta  NB. blocks of non-char
> > > > )
> > > > NB.=======End of Script==========================================
> > > >
> > >
> > ----------------------------------------------------------------------
> > > > For information about J forums see
> > > http://www.jsoftware.com/forums.htm
> > >
> > >
> > ----------------------------------------------------------------------
> > > For information about J forums see
> > http://www.jsoftware.com/forums.htm
> > >
> > ----------------------------------------------------------------------
> > For information about J forums see http://www.jsoftware.com/forums.htm
> >
> ----------------------------------------------------------------------
> For information about J forums see http://www.jsoftware.com/forums.htm

----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm

Reply via email to