Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

(Golf) Nearest Neighbors

by MeowChow (Vicar)
on Apr 04, 2001 at 11:10 UTC ( #69570=obfuscated: print w/replies, xml ) Need Help??

The specification is simple: given a list of numbers, return the two which are nearest to one-another. Assume that the list contains at least two numbers, and the return order is irrelevent. Some foolhardy attempts of my own follow:
# 114 chars sub nn1 { my@p;my$d;for(0..$#_-1){for my$n ($_+1..$#_){my$e=abs$_[$_]-$_[$n];i +f(!defined$d or$e<$d){$d=$e;@p=@_[$_,$n];}}}@p } # 100 chars sub nn2 { my@l=sort@_;$l[$_]=[@l[$_,$_+1]]for 0..$#l;pop@l;@{(sort{abs$$a[0]-$ +$a[1]<=>abs$$b[0]-$$b[1]}@l)[0]} } # 87 chars sub nn3 { @_=sort@_;my%d;$d{abs$_[$_]-$_[$_+1]}=[@_[$_,$_+1]]for 0..$#_-1;@{$d +{(sort keys%d)[0]}} }
Update: regarding the issue of duplicates, assume they are pairs like any other, so you would return duplicate numbers if they were present in the list.
               s aamecha.s a..a\u$&owag.print

Replies are listed 'Best First'.
Re (tilly) 1: (Golf) Nearest Neighbors
by tilly (Archbishop) on Apr 05, 2001 at 00:29 UTC
    Why have a loop?
    sub nn { my@x=@_[0,1];@_=sort{abs$x[0]-$x[1]<abs$a-$b or@x=($a,$b);$a<=>$b}@_;@ +x }

    MeowChow pointed out that the parens for the arguments of abs were not needed. That cut out 3 characters. Plus by reversing the order of the comparison I managed to substitute or for and, saving another. That makes it 71...

    UPDATE 2
    This is sick and slick.

    sub nn { ()=sort{abs$_[0]-$_[1]<abs$a-$b or@_=($a,$b);$a<=>$b}@_;@_ }
    Enjoy verifying that I am perfectly safe in using @_ as my temporary array. I think that 58 is the best I can do...

    UPDATE 3</B
    petral sent me a /msg explaining how to remove 3 chars from that solution. I would like to see him post that since it was his idea, but until he does I want to note that that solution can be beaten.

      OK, a couple of simple typographic manipulations to bring it to 55:
      sub nn { ()=sort{abs$a-$b>abs$_[0]-$_[1]or@_=($a,$b);$a-$b}@_;@_ }
      (There are advantages to being slow (or having no time!)).  I was still up over 80 strokes with my sort-based solution when I looked up and saw this guy casually strolling past Tiger Woods.

      Wow, that really is quite ingenious. At first I thought this might fail on some inputs, if sort doesn't compare two sequential numbers, but then I realized that sort requires that every two sequential elements are compared (in some order). Amazing...
                     s aamecha.s a..a\u$&owag.print

      Excellent solution. The interesting thing about Perl Golf is how different people tackle problems in terms of their favourite tools; map, sort, regex, grep, closures, slices or whatever.

      Just for fun I ran your solutions through Perltidy as a test case. Here is the output:
      sub nn { my @x = @_[0, 1]; @_ = sort { abs $x[0] - $x[1] < abs $a - $b or @x = ($a, $b); $a <=> $b; } @_; @x } sub nn { () = sort { abs $_[0] - $_[1] < abs $a - $b or @_ = ($a, $b); $a <=> $b; } @_; @_ }

      Okay Monks,
      I would like to make my contribution of this golf, but after tilly's one, I can't continue. Maybe I'll find a 120 characters so :) ... that over for me.

      BoBiOne KenoBi ;)
Re: (Golf) Nearest Neighbors
by danger (Priest) on Apr 04, 2001 at 14:42 UTC

    As Tortue points out, all the ones using lexigraphic sorting fail on some sets of numbers. Stripping leading spaces and newlines, my stab weighs in at 87 characters:

    sub nn { @_=sort{$a<=>$b}@_; $_[1]-$_[0]>$_[$_+1]-$_[$_]and@_[0,1]=@_[$_,$_+1]for 1..@_-2; @_[0,1] }
      Very nice! Sniping one character gives:
      sub nn { @_=sort{$a<=>$b}@_; $_[1]-$_[0]>$_[$_]-$_[$_-1]and@_[0,1]=@_[$_,$_-1]for 2..$#_; @_[0,1] }
      The number to beat is 86...
                     s aamecha.s a..a\u$&owag.print
        This doesn't deal with duplicates. If you want to deal with duplicates, I think you change it to:
        sub nn { @_{@_}=0;@_=sort{$a<=>$b}keys%_; $_[1]-$_[0]>$_[$_]-$_[$_-1]and@_[0,1]=@_[$_,$_-1]for 2..$#_; @_[0,1] }

        That brings the total from 86 to 99. I'm not sure if the spec requires that duplicates be treated as one element or separate elements.

Re: (Golf) Nearest Neighbors
by snowcrash (Friar) on Apr 04, 2001 at 13:27 UTC
    # 79 chars sub nn9 { @_=sort@_;$_{$_[$_]-$_[$_-1]}=[@_[$_-1,$_]]for 1..$#_;@{$_{(sort key +s%_)[0]}} }

    snowcrash //////
Re: sort problem? (Golf) Nearest Neighbors
by Tortue (Scribe) on Apr 04, 2001 at 14:15 UTC
    Ummm.... no doubt I'm missing something here, but when I test these functions on certain sets of values, only the first works, because sort insists on doing a lexical rather than a numeric sort.
    print join(",",nn1(1,5,34,43,123,444)), "\n"; print join(",",nn2(1,5,34,43,123,444)), "\n"; print join(",",nn3(1,5,34,43,123,444)), "\n"; 1,5 34,43 1,123
Re: (Golf) Nearest Neighbors
by MeowChow (Vicar) on Apr 05, 2001 at 00:39 UTC
    A bit late, considering tilly's death-blow, er... swing, but here's one that merlyn might appreciate, weighing in at 84 chars:
    sub nn { my($p,@l)=sort{$a<=>$b}@_;@{(sort{$$a[0]<=>$$b[0]}map[$_-$p,$p+0,$p= +$_],@l)[0]}[1,2] }
                   s aamecha.s a..a\u$&owag.print
      Just saw this thread. Here is a destructive (only works once) solution at 46:

      sub nn{$a|=$"x$_.1for@_;$b.=$"until$a=~/1$b(1)/;@a=@-}

        Ah, I should think a bit more before submitting. Here is a 44 (and I should also mention it only works for smallish natural numbers, all different and at least 2 arguments):

        sub nn{$a|=2x$_.3for@_;$b.=2until$a=~/3$b(3)/;@a=@-}

        The need for the assign is a perlbug, otherwise it would be 41

Re: (Golf) Nearest Neighbors
by jmcnamara (Monsignor) on Apr 04, 2001 at 13:36 UTC
    Omitting leading whitespace this is 97 chars:
    sub nn_single { @_=sort{$a<=>$b}@_; $_{abs$_[$_]-$_[$_-1]}=[$_-1,$_]for 1..$#_; @_[@{$_{(sort{$a<=>$b}keys%_)[0]}}] }
    I worked on this without looking at your solutions but it is very similar to your nn3. Great minds?
    If the list contains duplicates then the following will work. Omitting leading whitespace this is 114 chars.
    sub nn_dup { my$s=sub{sort{$a<=>$b}keys%_}; @_{@_}=0; @_=&$s; %_=(); $_{abs$_[$_]-$_[$_-1]}=[$_-1,$_]for 1..$#_; @_[@{$_{(&$s)[0]}}] }
    Update: I've updated this for a numerical sort and included snowcrash's %_ hack. danger, as usual, looks like the one to beat.


(tye)Re: (Golf) Nearest Neighbors
by tye (Sage) on Apr 04, 2001 at 22:32 UTC
    sub nn{my$x=pop;(sort{$b<=>$a}map{abs($_-$x)}@_)[0,1]}

    I guess that is 46 chars.

    Update: Sorry (oops), make that:

    sub nn{my$x=pop; (map$_->[0],sort{$a->[1]<=>$b->[1]}map[$_,abs$_-$x],@_)[0,1]} # or sub nn2{my$x=pop; my@d=map abs$_-$x,@_;@_[(sort{$d[$a]<=>$d[$b]}0..$#_)[0,1]]}
    for 69 or 68 chars.

    Update: Well, those last two are okay solutions for the wrong problem. *sigh* (:

            - tye (but my friends call me "Tye")
      print nn(1, 4, 7);
      returns 2 elements that are not in the input list.


      print nn(1, 5, 7); print nn2(1, 5, 7); # Hmmmm print nn(1, 5, 11); print nn2(1, 5, 11);
      after your first update all result in 51. Care to try again? :-)

        Just following the (ambiguous) specification. Are you looking for numbers from (5,11) that are close to 1 or numbers from (1,5) that are close to 11? I didn't find an API spec and found others using pop so I went ahead with the 2-character savings.

        Or am I only supposed to return one number if the "two closest" are both on "the same side" of the search-for number? That wasn't clear to me either so I just went with "return the two closest" without trying to assume a bunch of extra subtle meaning to that phrase. No, I'm not going to produce a version that sometimes returns only one number. (:

                - tye (but my friends call me "Tye")
Re: (Golf) Nearest Neighbors
by satchboost (Scribe) on Apr 04, 2001 at 19:14 UTC
    While this may not have many new ideas, it does weigh in at 117 characters and deal with dups:
    sub nn2 { my$s=sub{sort{$a<=>$b}keys%_}; @_{@_}=0;@_=&$s;%_=(); $_{abs($_[$_]-$_[$_+1])}=[@_[$_,$_+1]]for 0..$#_; @{$_{(&$s)[0]}} }

    Neat problem!

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: obfuscated [id://69570]
Approved by root
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (7)
As of 2023-12-07 16:06 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (32 votes). Check out past polls.