in reply to (Golf) Warningless Comparison

Ok, first off your solution doesnt work if $hash{foo}{O} is undef and $hash{foo}{C} does not exist (see the key 'ii' in my test code). Also I didn't notice the existance test on my first try so I did one that ignores that aspect and one that doesnt. So without looking at other offerings heres my test: 
use warnings;
use strict;
my $foo = {
     aa => { O => 'zz',  C => 'yy'  }, #
     bb => { O => 'xx',  C => 'xx'  },
     cc => { O => undef, C => 'ww'  }, #
     dd => { O => 'vv',  C => undef }, #
     ee => { O => undef, C => undef },
     ff => {             C => undef },

     gg => { O => 0,     C => 0     },
     hh => { O => undef, C => 0     }, #
     ii => { O => undef             }, #
};

#Only does defined not exists
#98
sub d {$a=pop;grep{$b=$$a{$_};defined$$b{O}!=defined$$b{C}||defined$$b
+{O}&&$$b{O}ne$$b{C}}keys%$a}

#Does defined and exists
#126
sub f {$a=pop;grep{$b=$$a{$_};exists$$b{O}!=exists$$b{C}||defined$$b{O
+}!=defined$$b{C}||defined$$b{O}&&$$b{O}ne$$b{C}}keys%$a}

# [tadman]s original solution compressed
#162
sub t {my($h)=@_;grep{!exists($h->{$_}->{O})||(defined($h->{$_}->{O})?
+(defined($h->{$_}->{C})?($h->{$_}->{O} ne $h->{$_}->{C}):1):defined($
+h->{$_}->{C}))}keys%$h}


print "d():\n",join("\n",sort {$a cmp $b}d($foo)),"\n\n";
print "f():\n",join("\n",sort {$a cmp $b}f($foo)),"\n\n";
print "t():\n",join("\n",sort {$a cmp $b}t($foo)),"\n\n";

__END__
d():
aa
cc
dd
hh

f():
aa
cc
dd
ff
hh
ii

t():
aa
cc
dd
ff
hh

[download]
So my best was 126 Now to see the others....

--- demerphq
my friends call me, usually because I'm late....

Replies are listed 'Best First'.
Re: Re: (Golf) Warningless Comparison
by BrowserUk (Patriarch) on Sep 29, 2002 at 19:40 UTC

    I didn't attempt to cater for your test ii because it was not part of the original specs. tadman said.

    As a note, the 'new' value is always present, even if it is undef.

    If I remove all whitespace and newlines, redundant ;'s etc from my solution above it comes out to 87 

    sub f{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->
+{$_}{C}}keys%$a} #87

    [download]

    Then I noticed that I could save a couple more whilst still retaining a 'safe' function (ie. doesn't stomp on any globals) by switch to mying $a for 85 

    sub g{local$^W=0;my$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$
+_}{C}}keys%$a} #85

    [download]

    but I go the whole hog and abandon safety completely, this can be reduced further (and neatly, below the traditional 80 char line) to 78.... 

    sub h{$^W=0;$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$_}{C}}k
+eys%$a} #78

    [download]
    Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!
[reply]
[d/l]
[select]
      I didn't attempt to cater for your test ii because it was not part of the original specs.

      Hmm, my apologies, I seem to be a bit myopic tonight. I didnt notice that comment. So tadmans solution pases under the rule change.

      Still under my test scenario (the 'ii' case removed) all of your solutions generate warnings and fail. Sorry. 

      use warnings;
use strict;
use Carp;
local $SIG{__WARN__}=sub {die("\t@{[(caller(1))[3]]}() generated warni
+ngs!\n")};

my $foo = {
     aa => { O => 'zz',  C => 'yy'  }, #
     bb => { O => 'xx',  C => 'xx'  },
     cc => { O => undef, C => 'ww'  }, #
     dd => { O => 'vv',  C => undef }, #
     ee => { O => undef, C => undef },
     ff => {             C => undef },
     gg => { O => 0,     C => 0     },
     hh => { O => undef, C => 0     }, #
     #ii => { O => undef             }, # commented out because of rul
+es .
     jj => { O => 0,     C => ' '   }, #
     kk => { O => ' ',   C => 0     }, #
     ll => { O => undef, C => ' '   }, #
     mm => { O => ' ',   C => undef }, #
};

sub BUK{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a}
sub snw{no warnings qw(uninitialized);my$h=pop;grep{$h->{$_}{O}ne$h->{
+$_}{C}}keys %$h}
sub sg_{my$h=pop;grep{!(defined($h->{$_}{O}&&$h->{$_}{C})&&$h->{$_}{O}
+eq$h->{$_}{C}||!defined($h->{$_}{O}||$h->{$_}{C}))}%$h}
sub eg_{my$h=pop;grep{!(($h->{$_}{O}||$;)eq($h->{$_}{C}||$;))}%$h}
sub ddf{$a=pop;grep{$b=$$a{$_};defined$$b{O}!=defined$$b{C}||defined$$
+b{O}&&$$b{O}ne$$b{C}}keys%$a}#98
sub dex{$a=pop;grep{$b=$$a{$_};exists$$b{O}!=exists$$b{C}||defined$$b{
+O}!=defined$$b{C}||defined$$b{O}&&$$b{O}ne$$b{C}}keys%$a}#126
sub tad{my($h)=@_;grep{!exists($h->{$_}->{O})||(defined($h->{$_}->{O})
+?(defined($h->{$_}->{C})?($h->{$_}->{O}ne$h->{$_}->{C}):1):defined($h
+->{$_}->{C}))}keys%$h}#162
sub ukg{local$^W=0;my$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->
+{$_}{C}}keys%$a} #85
sub ukf{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a} #87
sub ukh{$^W=0;$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$_}{C}
+}keys%$a}

print "      Required: aa cc dd ff hh jj kk ll mm\n";
print "------------------------------------------\n";
eval { print "   tadman golf: @{[sort {$a cmp $b} tad($foo)]}\n"; };
print $@ if $@;

eval { print "BrowserUK golf: @{[sort {$a cmp $b} BUK($foo)]}\n"; };
print $@ if $@;

eval { print "sauoq No warns: @{[sort {$a cmp $b} snw($foo)]}\n"; };
print $@ if $@;

eval { print "    Sauoq golf: @{[sort {$a cmp $b} sg_($foo)]}\n"; };
print $@ if $@;

eval { print "  Elusion golf: @{[sort {$a cmp $b} eg_($foo)]}\n"; };
print $@ if $@;

eval { print " Demerphq defd: @{[sort {$a cmp $b} ddf($foo)]}\n"; };
print $@ if $@;

eval { print "Demerphq exist: @{[sort {$a cmp $b} dex($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk f(): @{[sort {$a cmp $b} ukf($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk g(): @{[sort {$a cmp $b} ukg($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk h(): @{[sort {$a cmp $b} ukh($foo)]}\n"; };
print $@ if $@;

__END__
      Required: aa cc dd ff hh jj kk ll mm
---------------------------------------------
   tadman golf: aa cc dd ff hh jj kk ll mm
    main::BUK() generated warnings!
sauoq No warns: aa cc dd hh jj kk ll mm
    Sauoq golf: aa cc dd hh jj kk ll mm
  Elusion golf: aa cc dd jj kk ll mm
 Demerphq defd: aa cc dd hh jj kk ll mm
Demerphq exist: aa cc dd ff hh jj kk ll mm
    main::ukf() generated warnings!
    main::ukg() generated warnings!
    main::ukh() generated warnings!

      [download]

      ---
      demerphq
      my friends call me, usually because I'm late....

[reply]
[d/l]

        And here's what you get if you comment out your signal handler.

        NOTE: NO WARNINGS from my original entry.

        I hade to comment out your implementation of tadman's solution because if wouldn't compile.

        I think the problem lies in your signal handler rather than my code. I specifically disable the warnings where I accept they will occur using the standard Perl mechanism of local $^W=0;

        Your signal handler converts a SIG_WARN into a SIG_INT (die) which kind of belies the reasons for Perl distinguishing between them.

        If you change the rules of Formula 1 to have a mandatory water section and then enter in a D.U.K.W., you'll likely win every race. 

        use warnings;
use strict;
use Carp;
#local $SIG{__WARN__}=sub {die("\t@{[(caller(1))[3]]}() generated warn
+ings!\n")};

my $foo = {
  aa => { O => 'zz',  C => 'yy'  }, #
  bb => { O => 'xx',  C => 'xx'  },
  cc => { O => undef, C => 'ww'  }, #
  dd => { O => 'vv',  C => undef }, #
  ee => { O => undef, C => undef },
  ff => {       C => undef },
  gg => { O => 0,   C => 0   },
  hh => { O => undef, C => 0   }, #
  #ii => { O => undef       }, # commented out because of rules .
  jj => { O => 0,   C => ' '  }, #
  kk => { O => ' ',  C => 0   }, #
  ll => { O => undef, C => ' '  }, #
  mm => { O => ' ',  C => undef }, #
};

sub BUK{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a}
sub snw{no warnings qw(uninitialized);my$h=pop;grep{$h->{$_}{O}ne$h->{
+$_}{C}}keys %$h}
sub sg_{my$h=pop;grep{!(defined($h->{$_}{O}&&$h->{$_}{C})&&$h->{$_}{O}
+eq$h->{$_}{C}||!defined($h->{$_}{O}|| $h->{$_}{C}))}%$h}
sub eg_{my$h=pop;grep{!(($h->{$_}{O}||$;)eq($h->{$_}{C}||$;))}%$h}
sub ddf{$a=pop;grep{$b=$$a{$_};defined$$b{O}!=defined$$b{C}||defined$$
+b{O}&&$$b{O}ne$$b{C}}keys%$a}#98
sub dex{$a=pop;grep{$b=$$a{$_};exists$$b{O}!=exists$$b{C}||defined$$b{
+O}!=defined$$b{C}|| defined$$b{O}&&$$b{O}ne$$b{C}}keys%$a}#126
#sub tad{my($h)=@_;grep{!exists($h->{$_}->{O})||(defined($h->{$_}->{O}
+)?(defined($h->{$_}->{C})?($h->{$_}- >{O}ne$h->{$_}->{C}):1):defined(
+$h->{$_}->{C}))}keys%$h}#162
sub ukg{local$^W=0;my$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->
+{$_}{C}}keys%$a} #85
sub ukf{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a} #87
sub ukh{$^W=0;$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$_}{C}
+}keys%$a}

print "    Required: aa cc dd ff hh jj kk ll mm\n";
print "------------------------------------------\n";
eval { print "  tadman golf: @{[sort {$a cmp $b} tad($foo)]}\n"; };
print $@ if $@;

eval { print "BrowserUK golf: @{[sort {$a cmp $b} BUK($foo)]}\n"; };
print $@ if $@;

eval { print "sauoq No warns: @{[sort {$a cmp $b} snw($foo)]}\n"; };
print $@ if $@;

eval { print "   Sauoq golf: @{[sort {$a cmp $b} sg_($foo)]}\n"; };
print $@ if $@;

eval { print "  Elusion golf: @{[sort {$a cmp $b} eg_($foo)]}\n"; };
print $@ if $@;

eval { print " Demerphq defd: @{[sort {$a cmp $b} ddf($foo)]}\n"; };
print $@ if $@;

eval { print "Demerphq exist: @{[sort {$a cmp $b} dex($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk f(): @{[sort {$a cmp $b} ukf($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk g(): @{[sort {$a cmp $b} ukg($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk h(): @{[sort {$a cmp $b} ukh($foo)]}\n"; };
print $@ if $@;

__END__
21:07:50.19 C:\test>201598
    Required: aa cc dd ff hh jj kk ll mm
------------------------------------------
Undefined subroutine &main::tad called at C:\test\201598.pl line 35.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
Use of uninitialized value in string ne at C:\test\201598.pl line 22.
BrowserUK golf: aa cc dd ff hh jj kk ll mm
sauoq No warns: aa cc dd hh jj kk ll mm
   Sauoq golf: aa cc dd hh jj kk ll mm
  Elusion golf: aa cc dd jj kk ll mm
 Demerphq defd: aa cc dd hh jj kk ll mm
Demerphq exist: aa cc dd ff hh jj kk ll mm
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
Use of uninitialized value in string ne at C:\test\201598.pl line 30.
 browserUk f(): HASH(0x1bd5534) HASH(0x1bd5594) HASH(0x1bd55f4) HASH(0
+x1bd5654) HASH(0x1bd569c) HASH(0x1bd56fc) HASH(0x1bd575c) HASH
(0x1bdf0dc) HASH(0x1bdf1c0) HASH(0x1d1f664) HASH(0x1d1f6ac) HASH(0x1d1
+f6f4) HASH(0x1d1f73c) HASH(0x1d1f784) HASH(0x1d1f7cc) HASH(0x1
d1f814) HASH(0x1d231cc) HASH(0x1d23214) HASH(0x1d2325c) HASH(0x1d2328c
+) HASH(0x1d232d4) HASH(0x1d241e8) HASH(0x1d243c8) HASH(0x1d244
c4) aa cc dd ff hh jj kk ll mm
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
Use of uninitialized value in string ne at C:\test\201598.pl line 29.
 browserUk g(): HASH(0x1bd5534) HASH(0x1bd5594) HASH(0x1bd55f4) HASH(0
+x1bd5654) HASH(0x1bd569c) HASH(0x1bd56fc) HASH(0x1bd575c) HASH
(0x1bdf0dc) HASH(0x1bdf1c0) HASH(0x1d1f664) HASH(0x1d1f6ac) HASH(0x1d1
+f6f4) HASH(0x1d1f73c) HASH(0x1d1f784) HASH(0x1d1f7cc) HASH(0x1
d1f814) HASH(0x1d231cc) HASH(0x1d23214) HASH(0x1d2325c) HASH(0x1d2328c
+) HASH(0x1d232d4) HASH(0x1d241e8) HASH(0x1d243c8) HASH(0x1d244
c4) aa cc dd ff hh jj kk ll mm
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
Use of uninitialized value in string ne at C:\test\201598.pl line 31.
 browserUk h(): HASH(0x1bd5534) HASH(0x1bd5594) HASH(0x1bd55f4) HASH(0
+x1bd5654) HASH(0x1bd569c) HASH(0x1bd56fc) HASH(0x1bd575c) HASH
(0x1bdf0dc) HASH(0x1bdf1c0) HASH(0x1d1f664) HASH(0x1d1f6ac) HASH(0x1d1
+f6f4) HASH(0x1d1f73c) HASH(0x1d1f784) HASH(0x1d1f7cc) HASH(0x1
d1f814) HASH(0x1d231cc) HASH(0x1d23214) HASH(0x1d2325c) HASH(0x1d2328c
+) HASH(0x1d232d4) HASH(0x1d241e8) HASH(0x1d243c8) HASH(0x1d244
c4) aa cc dd ff hh jj kk ll mm

        [download]
        Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!
[reply]
[d/l]

In Section Meditations