Perl Golf from REG.RU on YAPC :: Europe 2013

A regular conference of perl-developers YAPC :: Europe 2013 took place from August 12 to 14 in Kiev. Consciousness-expanding reports, insider information from the developers of Perl 5 and Perl 6, living legends from the world of Perl (including Larry Wall himself!) river cruise and wonderful communication in the pubs lobby - everything was. The event deserves the highest praise, and the organizers and speakers (and all the other participants in the conference) - all praise and thanks.

However, it is well known that, apart from ordinary human joys, perl-programmers are inclined to entertain special, normal “homo sapiens” that are not always comprehensible and close.
')
So, how we arranged Perl Golf on YAPC, and what came of it.

REG.RU supported the conference as a sponsor. Our guys at the booth and in the halls did not stint handing out wonderful T-shirts, useful information about the company, smiles and a positive atmosphere, and also held a competition for "the strongest Perl programmer" (a report with all the details and photos on REG.RU ).



But, of course, we could not stop there. "Perl-event - perl-activity, and nothing else!" - We said to ourselves, and then began to think, what does this actually mean?

What is Perl Golf?

In general, Perl Golf is a programming competition (of course, in Perl, although there are attempts to "golf" in other languages), in which the shortest program wins, which correctly solves the problem. It is not allowed to use any additional modules and external tools. Entertainment is one of the favorite among perl programmers, along with JAPH, obfuscation, code poetry, and other exciting, though, perhaps, not always practical, activities. In addition, Perl Golf has absolutely clear evaluation criteria (the minimum number of characters in the program), so it is ideal as a competitive format.


Experienced golfers in the team was not there, so I had to learn the craft almost from scratch. And, I must say, despite the outward exoticism (and even some terrifyingness from the point of view of any programmer who understands how a normal code should look like), Golf turned out to be an interesting and useful occupation, which helps both to learn and understand the profound and non-obvious features and possibilities of the language, and practice the ability to clearly and concisely formulate the problem and its solutions. As a result of much thought and creative torment, the following story was born.

Legend

You are the son of a noble Japanese grandee of the Edo period. You always dreamed of becoming a programmer, but the family traditions turned out to be stronger - you were sent to the training of Master Guo. After a small theoretical introduction, the master began to ask you tasks to capture stones.

The tasks are simple, however, it is obvious that you do not have any abilities for Go. In addition, for each incorrectly solved puzzle, the master hurts you with a bamboo pole, and also makes you have dinner using only one stick. Tired of beatings and chronic malnutrition, you decide to write a program that will solve the problem for you. And since the paper in the Edo period is expensive, the program should be as short as possible.

Fundamentals of the Go Game

Go is the oldest board strategy game that appeared in China several thousand years ago and survived its heyday in Japan. The game involves two players, in turn placing the black and white stones at the points of intersection of the grid boards. A stone (or group of stones) is considered captured and removed from the board if it is surrounded on all sides by the opponent’s stones. For example, in the following diagrams, white stones (“w”) or groups of stones will be removed from the board if black (“b”) makes a move to the point indicated by “x”:




The condition of the problem and a set of tests for verification were published on contest.reg.ru . Passing tests was considered a criterion for the correctness of the decision. However, after the competition, the participants proposed several additional sophisticated test cases, on which some decisions stumbled. So the above solutions, if they do not pass additional test cases, are marked separately.

Despite the active professional and social life of the participants during all the days (as well as evenings and nights) of the conference, we received some very interesting decisions, which I bring further with my own annotations (with a discount on the degree of my understanding, because it’s still ).

Competitive decisions

205 characters - Brian McCauley

The winner of the competition proposed a solution with highlighting of groups of adjacent stones and “running around” regular expressions for checking neighboring points (since ancient times there is a belief that only a solution on regexp can win Perl Golf). In addition, a trick appears in many solutions with the addition of an additional initial row to the input data, due to which the sequential position of a point on the board turns into a combination of its coordinates (row numbers and column numbers).

#!perl $b=++$/x11 .<>;for$i(9..99){if(($x=$b)=~s/^(.{$i}) /$1x/s){while($x=~/w/g){$_="$`W$'";1while s/w((?<=W.{10})|(?<=W.)|(?=.{9}W|W))/W/s;/W((?<= .{10})|(?<= .)|(?=.{9} | ))/s||$i=~/./+(print"$& $'\n")+last}}} 

Brian published his decision and his own annotation on PerlMonks . In addition, he made a report describing this decision in the lightning block.

For winning the competition, Brian received a wonderful mini-golf kit, so boredom at the workplace is no longer a threat.

212 characters - Sergey Mozhaysky (does not pass additional test cases)

Solution with recursive traversal of neighboring points and storing information about checked points to avoid infinite recursion.

 #!perl @g=(d..n,map{/./g,''}<>);sub n{my($i,$j,$r)=@_;map{$_=1and map{$r=n($i,$j+1)+n($i,$j-1)+n($i+1,$j)+n($i-1,$j)==1if/w/;$r=1and$0="$i $j\n"if/ /}$g["$i$j"]if!$_}$s{"$i$j"};$r}map{print$0if$g[$_]eq'w'&&n(/./g)}0..99 

Unfortunately, on additional tests, the solution has false positives.

279 characters - Nikolay Shulyakovsky

It is also a recursive solution, but with a different logic of protection against infinite recursion and re-output of results.

 #!/usr/bin/perl while(<>){tr/ wb\n/2133/;$str.=$_.'3'}@m=split//,('3'x12).$str;for(@m){%l=();$r=1;z($i);$o{$w[0]}=1if/1/&&$r&&(@w=%l)==2;$i++}printf"%d %d$/",$_/11,$_%11for sort keys%o;sub z{my$c=$_[0];for(qw/11 1 -11 -1/){$x=$c+$_;$n=$m[$x];$l{$x}=1if$n==2;if($n==1){z($x)if!/-/;$r=0if$i>$x}}} 

On additional test cases, a rather significant bug is caught: when there are “exciting” positions in the last line of the field (position in the array of 100 or more), they get into the output in front of the positions going on the board before. It is caused by the fact that sort is used to sort the results, and it by default works in the string comparison mode, i.e. "100" will be less than "99".

370 characters - Mikalai Liohenki + Denis Shirokov

Another variation of the solution with recursion. Another frequently used trick appears here: a copy of the board is made to check each point, a black stone is placed into it, and it is checked whether there are any captured white stones on the board.

 #!perl $s='b'x12; while(<>){s/\n/bb/;s/ /0/g;$s.=$_;}$s.='b'x10;@q=(-1,+1,11,-11);@a=split//,$s; for(@a){++$i;if(!$a[$i]){$res=0;$p=[];for(@q){$c=$_+$i;if($a[$c]eq'w'){$p=[@a];$p->[$i]='b';$res+=b($p,$c);}}if($res){printf"%d %d\n",$i/11,$i%11;}}} sub b{my($e,$w)=@_;$r=1;for(@q){$z=$_+$w;return 0 if!$r||!$e->[$z];if($e->[$z]eq'w'){$t=[@$e];$t->[$w]='b';$r&=b($t,$z)}}return$r} 

390 characters - Dmitri L.

The next recursive solution with a specific aggregation of the result of the verification of neighbors in the form of a counter.

 #!perl push@t,split//,'b'x11;for(<>){chomp;push@t,split//,"b$_"."b"}push@t,@t[0..10];for(;$r++<11;){for($c=0;$c++<11;){$i=$r*11+$c;if($t[$i]eq' '){for($i-11,$i+1,$i+11,$i-1){next unless$t[$_]eq'w';$t[$i]='b';if(f($_)>7){print"$r $c\n";last}$t[$i]=' '}}}}sub f{my($r,$e,$k)=@_;$d{$r}?return$e||$dr:($d{$r}=2);for($r-11,$r+1,$r+11,$r-1){$k+=1+f($_,1)if$t[$_]eq'w';$k+=2if$t[$_]eq'b'}$e?$k>7?$e:0:$k} 

404 characters - Philippe Bruhat (BooK)

Not the shortest, but perhaps the most algorithmically complex, and one of the most confusing and difficult to parse solutions, so do not expect complete clarity from my annotation.

 #!perl #!perl -ln sub M{$k=pop;my%t;$l[$k]=[grep!$t{$_}++,@{$l[$k]},@_]}sub S{($m,$n)=@_;($M,$N)=sort$$m,$$n;M@{delete$l[$N]},$M if$N!=($$m=$$n=$M)}$i=1;for(split//){$b[$c=$..$i]=/w/?++$e:$_;$x=($R=$.-1).$i;$y=$..($C=$i-1);/w/&&do{$b[$_]>0&&S\$b[$c],\$b[$_]for$x,$y;M$b[$x]eq$"?"$R $i":(),$b[$y]eq$"?"$. $C":(),$b[$c]};/ /&&map{$b[$_]>0&&M"$. $i",$b[$_]}$x,$y;$i++}}{print for sort grep!$s{$_}++,map@$_-1?():@$_,@l 

Fortunately, Philip approached the case seriously and supplied the solution with his own detailed description.

500 characters - Savio PImatteo

And one more recursive decision comparing the number of “not free” (black or captured white) stones on the board before and after installing a black stone in each empty cell.

 #!perl my$X=121;my$m;sub z{my($s,$x,$m)=shift;while($x<$X){$m+=f($x++,$s);}$m;}sub f{my($n,$t,$d)=@_;my$c=substr($t,$n,1);return 0 if $c eq ' '||!$d&& $c ne 'w';return 1 if $c eq 'b';substr($t,$n,1)='b';(!(($n+1)%11)||f($n+1,$t,1))*(!(($n-1)%10)||f($n-1,$t,1))*f($n+11,$t,1)*f($n-11,$t,1);}my$y='b'x11;while(<>){$y.="b$_";}$y=~s/\n/b/g;$y.='b'x11;$d=z($y);my$i=0;while($i<$X){my$ch=substr($y,$i,1);if($ch eq ' '){$b=$y;substr($b,$i,1)='b';if(z($b)>$d){my$y=int($i/11);my$x=$i-($y*11);print"$y $x\n";}}$i++;} 

581 character - Dimitry Ivanov

The solution is very close to the previous one from Savio Pimatteo.

 #!perl eval{ $a->[10]=$a->[0]=[('b')x11]; while(<STDIN>){chomp;@{$a->[++$i]}=('b',(split''),'b');last if $i>=9} sub f { my($x,$y)=@_; return $o[$j] if $n->[$x][$y]; return $o[$j]||2 if $a->[$x][$y]eq'b'; return 1 if $a->[$x][$y]ne'w'; $n->[$x][$y]=$j; $o[$j]=f($_,$y)for($x-1,$x+1); $o[$j]=f($x,$_)for($y-1,$y+1); return $o[$j]; } sub p { for $x(0..10){for $y(0..10){ f($x,$y,$j++) if $a->[$x][$y]eq'w'&&!$n->[$x][$y]; }} return grep{$_==2}@o; } my $t=p; for $x(0..10){for $y(0..10){ next if $a->[$x][$y]ne' '; $a->[$x][$y]='b'; @o=();$n=[]; print"$x $y\n" if $t<p; $a->[$x][$y]=' '; }} } 

Non-competitive solutions

It would be strange to arrange a competition and not have a solution to the competitive problem. So here is the decision from the organizer, that is me:

192 characters - Timur Nozadze

Rectilinear recursive solution. A good result was achieved due to tight minimization and getting rid of all unnecessary, saving on parsing input data using flags and a fairly effective trick for translating the position of a point into coordinates using regexp and special variables.

 #!perl -ln0aF// sub c{my$s=pop;$s=~/-|9/||$g[$s]eq'b'||$g[$s]=~/w/*!grep{$g[$s]='b';!c($s+$_)}1,-1,10,-10}map{@g=@F;$g[$_]='b';/\d$/,print$`+1,$",$&+1if$F[$_]=~/ /*grep{$g[$_]eq'w'&&c$_}0..$#g}0..$#F 

Despite the algorithmic simplicity of the solution, surprisingly a lot of excess can be removed from the code if you concentrate on the essence of the problem, and not produce new variables and duplicate pieces of code with a generous hand, as we often do. So Golf makes you focus not just on reducing the size of the code, but also on a deeper and cleared of all the superficial understanding of the problem and its solution.

In fact, during the competition this result (192 characters) was not beaten. However, this was not the end, it is time for collaborations and exchange of experience.

197 characters - Sergey Mozhaysky (does not pass the additional test case)

Sergey improved his decision, getting rid of the intermediate variable and inventing a new option for the output of coordinates.

 #!perl @g=(d..n,map{/./g,''}<>);sub n{my($i,$r)=@_;map{do{$_=1and$r=n($i+1)+n($i-1)+n($i+10)+n($i-10)==1if/w/;$_=$r=1and$0=$i if/ /}if/\D/}$g[$i];$r}map{printf"%s %s\n",$0=~/./g if$g[$_]eq'w'&&n($_)}0..99 

189 characters - Timur Nozadze

My solution was reduced to a couple of characters due to Brian's remarks: getting the size of arrays in $ # was replaced by the numeric constant 89, and the regular expression /\d$/ was replaced by /.$/ .

 #!perl -ln0aF// sub c{my$s=pop;$s=~/-|9/||$g[$s]eq'b'||$g[$s]=~/w/*!grep{$g[$s]='b';!c($s+$_)}1,-1,10,-10}map{@g=@F;$g[$_]='b';/.$/,print$`+1,$",$&+1if$F[$_]=~/ /*grep{$g[$_]eq'w'&&c$_}0..89}0..89 

Fundamental improvements in this approach can hardly be expected.

And then we witnessed the battle of the titans at Perlmonks.

175 characters - Brian McCauley

Brian seriously improved his result, taking advantage of Sergey's advice and some ideas from my decision.

 #!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 

127 characters - Grimy

The user of Grimy with PerlMonks has broken away from the idea of ​​Brian and brought the version with regexps to a completely fantastic result of 127 characters !

 #!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 

To tell you the truth, this decision for me still retains some element of mysticism, but I hope my abstract is not too far from the truth.

Well, the common belief in the invincibility of solutions on regexps fully justified itself. This is a terrific result and it will be difficult to beat him. However, knowing the incredible courage and fighting qualities of habrazhitel, we suggest trying their hand. Anyone who offers a better solution (i.e., shorter) than the current leader (127 characters) will receive a domain from REG.RU in .ru or .rf and VPS at any rate for up to 6 months as a gift! Decisions are made at contest@reg.ru . Only decisions that successfully pass the updated test suite are made . Dare!