I just came across an interesing mathematical widget. 

111,111,111 * 111,111,111 = 12,345,678,987,654,321

So here is the challenge:

1 Write a subroutine that takes one argument. This argument is to be a positive integer.

2 The sub is to find all the symmetrical squares between zero and the supplied argument.

3 Not only must the square be symmetrical, the number itself must also be symmetrical - thus conforming to the original example where both the number and its square exhibit symetry.

4 The sub is to return a reference to a hash which contains only those symetrical numbers that have symmetrical squares as its keys with the matching symmetrical squares as the values.

5 There is no requirement for use strict.

Here is a very straight forward example with the test code and desired output included. 

use strict;

my $ref = symetrical(100);
for my $key (sort {$a <=> $b} keys %$ref) {
   printf "%-10d%d\n",$key,$ref->{$key};
}

sub symetrical {
    my %symet;
    my $max = shift;
    for my $i (0..$max) {
        my $square = $i * $i;
        if (sym($square)) {
            $symet{$i} = $square if sym($i);
        }            
    }
    sub sym {
       $num = shift;
       ($num eq reverse $num) ? $num : '';
    }
    return \%symet;
}


__END__

Sample output

1         1
2         4
3         9
11        121
22        484
101       10201
111       12321
121       14641
202       40804
212       44944

[download]
Official scoring will be done with the "Official GOLF score" (tm) code presented below. It comfoms to the standard set down in RFC foobar with the baz ammendments. In short this standard specifies that we count the chars from (but not including) the subs opening curly up to (but not including) the closing curly. Leading/trailing whitespace and newlines are not counted. The code for this is presented below. 
package GOLF;

use strict;

my $code = <<'CODE';
 
# paste code in here

CODE

$code =~ s/^\s+|\s+$//gm;
$code =~ s/\n//g;
$code =~ s/}$//;
$code =~ s/^sub\s+(\w+)\s*{//;

printf "Length of sub '$1' => %d chars\n", length $code;

[download]

My effort stands at 194 chars, but I think I can do better ;-)

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

Replies are listed 'Best First'.
Re: Symetrical Numbers (GOLF)
by MeowChow (Vicar) on Jul 11, 2001 at 22:54 UTC
    66 chars: 
    sub mc_sym {
  \%{{map{(reverse eq$_&&($x=$_*$_)eq reverse$x)?($_,$x):()}1..pop}}
}

    [download]
    61, borrowing from no_slogan :) 
    sub mc_sym {
  +{map{(reverse==$_&&($x=$_*$_)==reverse$x)?($_,$x):()}1..pop}
}

    [download]
    59 with some bit-twiddling: 
    sub mc_sym {
  +{map{(reverse^$_||($x=$_*$_)^reverse$x)?():($_,$x)}1..pop}
}

    [download]
       MeowChow                                   
               s aamecha.s a..a\u$&owag.print
[reply]
[d/l]
[select]
      You can get that down to 56 by optimizing the parens and switching to bitwise-or: 
      sub symmetrical_squares {
+{map reverse^$_|reverse($x=$_**2)^$x?():($_,$x),0..pop}
}

      [download]
      BTW, I note that the description says to start with 0, but the example output starts with 1... I decided to start with 0. 0*0 = 0, and both 0 and 0 are symmetrical, so 0 should be in the output. :)
[reply]
[d/l]
        I think you may have seen my golf just before I posted a fix. The bitwise OR can't be used here in this way, since it has the same precedence as XOR, and this leads to a rather subtle bug (notice that your sub returns 26 as a symmetrical number). But your idea still applies; here's a working one at 56: 
          +{map$_^reverse||reverse($x=$_**2)^$x?():($_,$x),0..pop}

        [download]
        update: Switching from XOR to subtraction, however, permits the use a bitwise OR, saving a char, at 55: 
          +{map$_-reverse|reverse($x=$_**2)-$x?():($_,$x),0..pop}

        [download]
           MeowChow                                   
               s aamecha.s a..a\u$&owag.print
[reply]
[d/l]
[select]
(tye)Re: Symetrical Numbers (GOLF)
by tye (Sage) on Jul 11, 2001 at 22:47 UTC

    You forgot 010 * 010 = 00100. q-:

            - tye (but my friends call me "Tye")
[reply]
Re: Symetrical Numbers (GOLF)
by particle (Vicar) on Jul 11, 2001 at 23:36 UTC
    okay, this looked like A LOT of fun, so i put my work aside to give this a try. here goes! 
    #!/usr/bin/perl -w

my $ref = sym(10000);
for my $key (sort {$a <=> $b} keys %$ref) {
   printf "%-10d%d\n",$key,$ref->{$key};
}

sub sym {
    for(1..shift) {
        sub s{$_[0]==join"",reverse split//,$_[0]}
        if(&s($_)&&&s($_**2)){$s{$_}=$_**2}
    }
    \%s;
}

    [download]
    which produces: 
    1         1
2         4
3         9
11        121
22        484
101       10201
111       12321
121       14641
202       40804
212       44944
1001      1002001
1111      1234321
2002      4008004

    [download]
    i'm quite pleased, for my first golf attempt, at

    UPDATE

    97 chars!

    ~Particle

    nevermind the xp, remember the experience.

[reply]
[d/l]
[select]

      Well done this is actually only 97 chars!! In golf all that counts is the bit within the curlies of the GOLF sub as noted. There are always inaccuracies in the counts thus the little scoring app: 

      use strict;

my $code = <<'CODE';
 
sub sym {
    for(1..shift) {
        sub s{$_[0]==join"",reverse split//,$_[0]}
        if(&s($_)&&&s($_**2)){$s{$_}=$_**2}
    }
    \%s;
}

CODE

$code =~ s/^\s+|\s+$//gm;
$code =~ s/\n//g;
$code =~ s/^sub\s+(\w+)\s*{//;
$code =~ s/}$//;

printf "Length of sub '$1' => %d chars", length $code;

__END__

      [download]

      cheers

      tachyon

      s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[reply]
[d/l]
      a few changes, and viola! 79 chars. 
      sub sym {
    for(1..pop){
        sub s{$_[0]==reverse$_[0]}
        if(&s($_)&&&s($_**2)){$s{$_}=$_**2}
    }
    \%s;
}

      [download]

      ~Particle

      nevermind the xp, remember the experience.

[reply]
[d/l]
Re: Symetrical Numbers (GOLF)
by no_slogan (Deacon) on Jul 11, 2001 at 22:55 UTC
    I haven't been able to do better than 64, but there's still a lot of redundancy in there. 
    +{map{$_,$_*$_}grep{$_==reverse($_)&&$_*$_==reverse$_*$_}1..pop}

    [download]
    Update:reverse is a tricky little bugger, isn't it? Down to 60, thanks to some ideas from MeowChow. 
    +{map{$_,$_*$_}grep{reverse==$_&&$_*$_==reverse$_*$_}1..pop}

    [download]
[reply]
[d/l]
[select]
Re: Symetrical Numbers (GOLF)
by jmcnamara (Monsignor) on Jul 12, 2001 at 01:17 UTC

    This was an attempt to save space by using only one reverse(). 61 chars: 
    sub sym_num {    
    +{map{(($x=$_.$_*$_.$_)&&$x==reverse$x)?($_,$_*$_):()}1..pop}
}

    [download]

    John.
    --

[reply]
[d/l]
      Nice! This technique is a winner at 53 chars: 
      +{map$x-reverse($x=$_.$_*$_.$_)?():($_,$_*$_),1..pop}

      [download]
         MeowChow                                   
               s aamecha.s a..a\u$&owag.print
[reply]
[d/l]
Re: Symetrical Numbers (GOLF)
by Masem (Monsignor) on Jul 11, 2001 at 23:04 UTC
    81 characters, and note that your counting code will break the count due to the extra sub (I counted the sub X{} characters for that in this case) 
    #234567890123456789012345678901234567890123456789012345678901234567890
sub r{$_[0]eq reverse$_[0]}          #27 and...
sub n{foreach(1..$_[0]){$a{$_}=$_*$_ if r($_)&&r($_*$_)};\%a}  #61 - 7
+ = 54

#81 total

my $res = n(1000);

print $_, "   ", $res->{ $_ }, "\n" foreach ( keys %$res );

    [download]
    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
[reply]
[d/l]
      There's never a reason to use foreach in golf; it can always be replaced with a for. 
         MeowChow                                   
               s aamecha.s a..a\u$&owag.print
[reply]

      Well actually.....it doesn't break the counting code. Only the first instance of sub foo { is removed courtesy of the ^ The \n are gone by the time the sub bit is removed and even if they were not there is no /m. Although the sub removed is sub r the result is correct. To satisfy the spec sub r shoud be contained within sub n as the spec was for a single sub to do the task not a whole app! The code says 82 BTW :-) 

      use strict;

my $code = <<'CODE';
 
sub r{$_[0]eq reverse$_[0]}
sub n{foreach(1..$_[0]){$a{$_}=$_*$_ if r($_)&&r($_*$_)};\%a}  
}

CODE

$code =~ s/^\s+|\s+$//gm;
$code =~ s/\n//g;
$code =~ s/}$//;
$code =~ s/^sub\s+(\w+)\s*{//;

printf "Length of sub '$1' => %d chars", length $code;

print "\n\n$code\n";
__END__

      [download]

      cheers

      tachyon

      s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[reply]
[d/l]

Back to Meditations