Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

Golf: overtone calculator

by Django (Pilgrim)
on Sep 01, 2002 at 18:27 UTC ( #194468=perlmeditation: print w/replies, xml ) Need Help??

Just another simple math challenge:
Write a subroutine that returns a list of all even harmonics (overtones) of a given frequency and their indirect harmonics up to a given factor.

x: basic frequency (Hz) (number > 0) n: maximum harmonic factor (integer > 0)

the returning list must be sorted (min .. max value) and each value (y) must be within the following range:
( x <= y ) &&( y <= n * x )

The values must be unique and rounded to 3 digits after decimal point.

=for Example: sub Harmonics ($$) { ...add your code here... } print join( "\n", Harmonics( 100, 6 ) ); # would print the following (without comments): 100.000 # 100 * 1/1 120.000 # 100 * 6/5 125.000 # 100 * 5/4 133.333 # 100 * 4/3 150.000 # 100 * 3/2 166.667 # 100 * 5/3 200.000 # 100 * 2/1 250.000 # 100 * 5/2 300.000 # 100 * 3/1 400.000 # 100 * 4/1 500.000 # 100 * 5/1 600.000 # 100 * 6/1 =cut

Here's my little program, with a subroutine of 81 chars and warnings enabled:

#!usr/bin/perl -w sub Harmonics ($$) { for$i(1..$_[1]){for$j(1..$i){$y{sprintf"%.3f",$_[0]*$i/$j}=1}}sort{$a< +=>$b}keys%y } print join( "\n", Harmonics( 100, 6 ) );

update: no trailing zero supression was intended (fixed the example).
Thanx to BrowserUK for looking closely.

"Why don't we ever challenge the spherical earth theory?"

Replies are listed 'Best First'.
Re: Golf: overtone calculator
by BrowserUk (Pope) on Sep 01, 2002 at 19:49 UTC

    Yours unseen, this is scarily close, but I pipped you by 1!

    #! perl -w sub H($$){ map int(1e3*$_[0]*$_)/1e3,grep!$^H{$_}++,sort map{$.=$_;map$./$_,1..$_ +}1..$_[1] } $"=$/;print "@{[H(100,6)]}\n"; __END__ C:\test>194468 100 120 125 133.333 150 166.666 200 250 300 400 500 600 C:\test>

    UpdateSlight improvement 77. Nowhere near jynx's, but ...both mine comply with the spec!

    Neither yours nor Jynx's do! You showed trailing zero supression 8^). (That's my nose in the air:)

    sub H($$){ map{int(1e3*$_*$_[0])/1e3}grep!$_{$_}++,sort map{$.=$_;map$./$_,1..$_} +1..pop }

    Well It's better than the Abottoire, but Yorkshire!

      Trailing zero supression wasn't intended (fixed it).
      Would you mind explaining your code? I'm just examining it for the nth time and still can't get no grip on it...

      "Why don't we ever challenge the spherical earth theory?"

        Is it so different from yours?

        Nested map's -v- nested for's

        Instead of using sprintf, I multiply the result by 1e3 int it and divide by 1e3 again.

        Which bit gave you problem's?

        BTW. I noted your comment re: jynx's and lexical sorting when n>10, and realise that mine suffers the same flaw. So, numerisising(is that a word?) the sort, I got

        #! perl -w sub H($$){ #________1_________2_________3_________4_________5_________6_________7 +_________8____ #234567890123456789012345678901234567890123456789012345678901234567890 +12345678901234 map{int(1e3*$_*$_[0])/1e3}grep!$_{$_}++,sort{$a<=>$b}map{$.=$_;map$./$ +_,1..$_}1..pop }

        The extra 9 chars* cost me dear, and you were winning by 3, but I couldn't have that so...for a round of 76:

        sub H($$){ #________1_________2_________3_________4_________5_________6_________7 +______ #234567890123456789012345678901234567890123456789012345678901234567890 +123456 map{$.=$_,map$_{int($_[0]*1e3*$./$_)/1e3}++,1..$_}1..pop;sort{$a<=>$b} +keys%_ }

        but that meant using a map in a void context so for the same 76, but avoiding that pesky map

        sub H($$){ #________1_________2_________3_________4_________5_________6_________7 +______ #234567890123456789012345678901234567890123456789012345678901234567890 +123456 $.=$_,map$_{int($_[0]*1e3*$./$_)/1e3}++,1..$_ for 1..pop;sort{$a<=>$b} +keys%_ }

        By now the light was fading and it was hard to keep my eye on the ball, so bad light stopped play and the tournement can resume tomorrow with jynx first to step up to the tee:)

        Update However, during floodlite play, (and stealing jynx's best bits), and retaining the more aesethically pleasing trailing zero suppression:), I give you this for 71

        sub H($$){ #________1_________2_________3_________4_________5_________6_________7 +_ #234567890123456789012345678901234567890123456789012345678901234567890 +1 for$.(1..pop){$_{int($_[0]*1e3*$./$_)/1e3}++for 1..$.}sort{$a-$b}keys% +_ }

        * I officially motion, on behalf of golfer's everywhere, that Perl6 have a sortn built-in that assumes the $a<=>$b. (Along with rev as an alias for reverse 8^).

        Well It's better than the Abottoire, but Yorkshire!
Re: Golf: overtone calculator
by jynx (Priest) on Sep 01, 2002 at 19:15 UTC

    just quickly,

    Here's a slightly shorter version that still compiles under strict and warnings. i only have tested it under the single test case above, if it fails others please provide them and i'll try to correct it. Anyway, this weighs in at 66 characters:

    sub Harmonics ($$) { #23456789_123456789_123456789_123456789_123456789_123456789_123456789_ for$a(1..pop){$_{sprintf'%.3f',$_[0]*$a/$_}++for 1..$a}sort keys%_ }

      Impressing inner loop, but your sort will fail with $_[1] > 10, because it sorts lexically.

      "Why don't we ever challenge the spherical earth theory?"

        Does this fix the problem? (at 72 chars):
        sub Harmonics ($$) { #23456789_123456789_123456789_123456789_123456789_123456789_123456789_ +12 for$a(1..pop){$_{sprintf'%.3f',$_[0]*$a/$_}++for 1..$a}sort{$a-$b}keys +%_ }
Re: Golf: overtone calculator
by Aristotle (Chancellor) on Sep 02, 2002 at 02:01 UTC
    Not a very golfable task. It is practically chosen such that the algorithm cannot be varied, and picking a better algorithm is what golf is really about. Not surprisingly my best entry is a variation on the initial attempt. Alternative approaches were only longer.
    # 1 2 3 4 5 6 7 + 8 #234567890123456789012345678901234567890123456789012345678901234567890 +1234567890 for$a(1..pop){@_{map{sprintf"%.3f",$_[0]*$a/$_}1..$a}++}sort{$a<=>$b}k +eys%_ grep!$_{$_}++,sort{$a<=>$b}map{$a=$_;map{sprintf"%.3f",$_[0]*$a/$_}1.. +$_}1..pop my%y=map{$_=>[1..$_]}1..pop;@_{map{sprintf"%.3f",$_[0]*$a/$_}@$b}++whi +le($a,$b)=each%y;sort{$a<=>$b}keys%_

    Makeshifts last the longest.

Re: Golf: overtone calculator
by tadman (Prior) on Sep 02, 2002 at 09:04 UTC
    Here's my retooling of BrowserUk/Arien's solution, which falls one character shy of matching:
    It had promise, I swear! I was sure that the old "keys on temporary hash" trick would work, but alas, denied. I futzed with the clever sprintf() replacement, and could not find any slack. Very elegant.

    By the way, I just have to interject that Perl 5 prototypes are evil. I'd suggest not using them.

    Update: Added missing bracket per Django's catch.

      Little optimization:


      There's a closing curly missing at the end. Apart from that: elegant indeed!

      Why do you consider Perl 5 prototypes as evil? I like the ability to use subs like built-ins.

      "Why don't we ever challenge the spherical earth theory?"

        They are poison. You should only use them when you have to, like forcing an array or subroutine reference. Here's two typical examples:
        sub my_grep(&) { ... } sub my_pop(\@) { ... }
        Putting in scalars (i.e. ($$)) is asking for trouble since it converts any arrays to scalars automatically. I found this really quite worrying, and you can see my brief rant in Function Prototypes and Array vs. List (Pt. 2).

        This all comes from a technique of jamming arrays into functions, which I do all the time to be efficient. Things like this:
        my $sth = $dbh->prepare("SELECT id,name,age FROM foo"); $sth->execute(); while (my $row = $sth->fetchrow()) { $self->some_function(@$row); }
        Now, if you've prototyped your function, you're going to get the number 3 every time. This is put in to the 'id' field, so you might actually think it's valid data, too.

        Instead, just leave those things off. That's why merlyn says "...and this is why we tell people DO NOT USE PROTOTYPES".

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://194468]
Approved by TStanley
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (7)
As of 2018-06-23 16:36 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (125 votes). Check out past polls.