in reply to YAPC::EU::2013 reg.ru Go Perl golf contest

I gave a lightning talk about this and heard that someone (falsely rumoured to be BooK) had managed 197, so I've pared this down to 184 by using map{} as suggested by Sergei Mozhaisky.
#!perl $_=++$/x11 .<>;map{$i=$-[0];{map{1while s/w((?<=W.{10})|(?<=W.)|(?=.{9}W|W))/W/s;/W((?<= .{10})|(?<= .)|(?=.{9 +} | ))/s||$i=~/./+print("$& $'\n")+last}"$`W$'"while/w/g}}"$`x$'"whil +e/ /g
#!perl $_= ++$ / x11 . <>; map { $i = $-[0]; { map { 1 while s/w((?<=W.{10})|(?<=W.)|(?=.{9}W|W))/W/s; /W((?<= .{10})|(?<= .)|(?=.{9} | ))/s || $i=~/./ + print("$& $'\n") + last } "$`W$'" while/w/g } } "$`x$'" while/ /g

UPDATE

Having stolen more ideas from Timur Nozadze I am now at 175

#!perl -ln0 map{$i=$-[0]+11;{map{1while s/w((?<=W.{10})|(?<=W.)|(?=.{9}W|W))/W/s;/W((?<= .{10})|(?<= .)|(?=.{9 +} | ))/s||$i=~/./+print("$& $'")+last}"$`W$'"while/w/g}}"$`x$'"while/ + /g
#!perl -ln0 map { $i=$-[0]+11; { map { 1 while s/w((?<=W.{10})|(?<=W.)|(?=.{9}W|W))/W/s; /W((?<= .{10})|(?<= .)|(?=.{9} | ))/s || $i=~/./ + print("$& $'") + last } "$`W$'" while/w/g } } "$`x$'" while/ /g

Replies are listed 'Best First'.
Re^2: YAPC::EU::2013 reg.ru Go Perl golf contest
by Grimy (Pilgrim) on Aug 21, 2013 at 21:09 UTC

    Variable-length negative look-behind can be emulated using \K. The two regexes are almost identical, and can be abstracted in a variable. "@-" is shorter than "$-[0]". If using perl >= 5.14, /./ followed by "$& $'" can be replaced with s/./$& /r.

    All in all, that's 30 characters easily chipped off. Thereís still a lot of room for improvementóthis next is hurting my eyes. Iíll probably look at it some more another day.

    #!perl -ln0 $:='(.{9}|)\Kw|w(?=(.{9}|)'; map{$i="@-"+11;{map{1while s/W$:W)/W/s;/ \U$: )/s||print($i=~s/./$& /r)+next}"$`W$'"while/w/g}}"$ +`x$'"while/ /g
      Another 22 characters shaved off:
      #!perl -ln0 $:='((?=W|.{9}W)|(?<=W.)|(?<=W.{10}))';{1while s/w$:/W/s;/ $:/gs>//gs& +&print+("@-E-1"+1)=~y/./ /r;y/W/x/;s/w/W/&&redo}
      EDIT: Down to 109. Iím starting to like it, but we can likely get this under 100.
      #!perl -ln0 $,='((?=.(.{9})?g)|g(.{9})?\K)'until!s!$,w!g!s;$,=/$, /gs>//gs&&!map!y +!.! !>print,"@-e-1"+1;y&g& &&&redo
      EDIT2: While my first solution was correct, both solutions in this post have the same problem: if playing a single black stone captures multiple white groups, this move is printed multiple times. Hereís a 127 stroker that prints each move only once:
      #!perl -ln0 map{1while$,=s=$,w=g=s?'(g|(?=.g|..{9}g)|g.{9})\K':/g/>/$, /s&&map{y!. +! !;print;redo}/x/+"@+E-1"or y&g&b&}"$`x$'"while/ /g