Don, Jan-Pieter - Thanks for the other ideas Raul, I will give that a shot. It looks like a much cleaner approach. Just to prove it to myself that something was possible, I hacked together this awful version. It works reasonably well though. Here's a version on the IRS tax table just for fun.
Input: http://drp.io/files/5304d74f7ba1d.jpg Output: http://drp.io/files/5304d7049f938.jpg Messy script: require 'files' readppm=: monad define dat=. fread y NB. read from file msk=. 1 ,~ (*. 3 >: +/\) (LF&=@}: *. '#'&~:@}.) dat NB. mark field ends 't wbyh maxval dat'=. msk <;._2 dat NB. parse 'wbyh maxval'=. 2 1([ {. [: _99&". (LF,' ')&charsub)&.> wbyh;maxval NB. convert to numeric if. (_99 0 +./@e. wbyh,maxval) +. 'P6' -.@-: 2{.t do. _1 return. end. (a. i. dat) makeRGB |.wbyh NB. convert to basic bitmap format ) writeppm=:dyad define header=. 'P6',LF,(":1 0{$x),LF,'255',LF (header,,x{a.) fwrite y ) makeRGB=: 0&$: : (($,)~ ,&3) fillRGB=: makeRGB }:@$ setPixels=: (1&{::@[)`(<"1@(0&{::@[))`]} getPixels=: <"1@[ { ] NB. viewmat _50 (+ / % #) \ _50 (+ / % #)\"1 x2 z=:readppm 'c:/temp/tt-01.ppm' x2=:+/"1 z xb =: 600 <: x2 NB. viewmat _50 (+ / % #) \ _50 (+ / % #)\"1 (<(1700+i.50);i.5000) { x3 hlines=:(15 (+/)\"1 xb) = 0 vlines=:(15 (+/)\ xb) = 0 H=:{. $ xb W=:}. $ xb hlines2=: (H,W) {. (H,(3-W)) {. hlines vlines2=: (H,W) {. ((4-H),W) {. vlines NB. these shifts depend on the # of consecutive lines... need a better way NB. shift left h1=.}."1 hlines2,.0 h2=.}."1 h1,.0 h3=.}."1 h2,.0 h4=.}."1 h3,.0 h5=.}."1 h4,.0 h6=.}."1 h5,.0 h10=.}."1 h6,.0 h11=.}."1 h10,.0 h12=.}."1 h11,.0 h13=.}."1 h12,.0 NB. shift right h7=. 0,.(}:"1 hlines2) h8=. 0,.(}:"1 h7) h9=. 0,.(}:"1 h8) NB. shift up v1=. (}. vlines2),0 v2=. (}. v1),0 v3=. (}. v2),0 v4=. (}. v3),0 v5=. (}. v4),0 v6=. (}. v5),0 v60=. (}. v6),0 v61=. (}. v60),0 NB. shift down v7=. 0,(}: vlines2) v8=. 0,(}: v7) v9=. 0,(}: v8) v10=. 0,(}: v9) out=:hlines2+.h1+.h2+.h3+.h4+.h5+.h6+.h7+.h8+.h9+.vlines2+.v1+.v2+.v3+.v4+.v7+.v8+.v9+.v10+.v60+.v61+.h10+.h11+.h12+.h13 NB. viewmat out (3 : '> y { (255,255,255);(0,0,0)'"0 out) writeppm 'c:\temp\out.ppm' On Wed, Feb 19, 2014 at 10:18 AM, Raul Miller <[email protected]> wrote: > I'd like to introduce you to ~:/\ > > ~:/\ is an illustration of one of the things I really like about J. It is > equivalent to 2 | +/\ ] but without the possibility of overflow. And it > turns out to be really handy when reasoning about bit operations. > > One way of describing it is as a slightly flawed self inverting edge > detection operation. > > ~:/\ 0 0 1 0 0 0 1 0 0 > > 0 0 1 1 1 1 0 0 0 > > ~:/\ ~:/\ 0 0 1 0 0 0 1 0 0 > > 0 0 1 0 1 0 0 0 0 > > > Notice how the opening 0 1 transition stays anchored in place, but the > closing 1 0 transition drifts just a little bit. > > > Now, if you use Henry's E. suggestion and look for 0 1 1 1 1 1 1 1 1 1 1 E. > and 1 1 1 1 1 1 1 1 1 1 0 E. you will have bits marking the beginning of > your lines and the endings of your lines. Use +. to combine these bit masks > and you have a perfect candidate for ~:/\ > > > Or, almost. You will need to add a leading zero to the beginning of each > line if you want to detect lines on columns which are all 1s (and then drop > that leading zero, later). > > > For rows, I'd probably just transpose the array and use the version of the > code designed for columns. (But you could try doing all the operations at > rank 1, also.) > > > Except that's still not quite right. Consider what happens if you encounter > 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 -- here, you have the same > bit marking an opening and a closing position. So, instead of combining the > E. results using +. I think you should combine them using ~: -- this will > do the right thing both for isolated marking bits and for conflicting > marking bits, assuming you are OK with "almost complete lines" being > classified as "solid". > > > Good enough? > > > Thanks, > > > -- > > Raul > > > > On Wed, Feb 19, 2014 at 9:43 AM, Joe Bogner <[email protected]> wrote: > > > On Wed, Feb 19, 2014 at 7:25 AM, Henry Rich <[email protected]> > wrote: > > > > > Look at > > > > > > (1 10$0) E. image > > > > > > or > > > > > > (10 $ 0) E. line > > > > > > > > Thanks Henry, that worked well. I have a version that seems to work now > > (albeit clunky) > > > > ]lines=: 4 10 $ (0 0), (5 $ 1), (3 $ 0),(5 $ 1), (0 0 0), (1 1), (10 $ 1) > > lineStarts=:(1 5$1) E. lines > > > > markPixel=: 3 : 0 > > shift1=:0,.(}:"1 y) NB. shift the array by 1 to the right > > shift1Marks=: shift1 = 1 > > shift1Marks+. y > > ) > > > > s1=:markPixel lineStarts > > s2=:markPixel s1 > > s3=:markPixel s2 > > s4=:markPixel s3 > > > > viewmat (s4=0) > > viewmat (lines=0) > > > > Basically, I mark the first pixel of the line (having 5 consecutive 1s) > and > > then shift the array 4 more times and mark each one that is a 1 and OR it > > with the input array. > > > > I'm happy to take any feedback from anyone on how to improve it. I know I > > can make makePixel a 1 liner... > > > > markPixel=: 3 : 0 > > y +. (0,.(}:"1 y) = 1) > > ) > > > > NB. from 13 : > > markPixel =: ] +. 0 ,. 1 = }:"1 > > > > I'm more interested in how to avoid the shifting 5 times. The problem is > > that I don't know of anything that can look backwards to match, so I > think > > I need to shift forward. Or, I can use my earlier approach of marking the > > last pixel of the line and then look forward, which shouldn't require > > shifts. > > ---------------------------------------------------------------------- > > 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
