Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Egyptian fractions

by jimt (Chaplain)
on Aug 24, 2006 at 17:51 UTC ( [id://569404]=obfuscated: print w/replies, xml ) Need Help??

Probably not my best obfuscation, but I'm proud of some parts of it. Takes a fraction as an argument and returns the egyptian fraction for that number.

For example:

clark:~/Desktop jim$ ./egypt.pl 19/20 19/20 = 1/2 + 1/3 + 1/9 + 1/180 clark:~/Desktop jim$ ./egypt.pl 18/20 18/20 = 1/2 + 1/3 + 1/15
sub egypt {my$f=2;do{return(--$f,egypt($_[0]/$f))unless$_[0]%$f++} while$_[0]>1}print"$ARGV[0] = ",join(' + ',pharaoh(hiero(split '/', $ARGV[0]))),"\n";sub hiero{my(%nf,%df);$nf{$_}++for egypt(shift);++ $df{$_}for egypt(shift);do{($df{$_},$nf{$_})=($df{$_}-$nf{$_},$nf{$_} -$df{$_})if$df{$_}}for keys%nf;return(eval join('*',1,(map{($_)x $nf{$_}}keys%nf)),eval join('*',1,(map{($_)x$df{$_}}keys%df)))}sub pharaoh {return$_[0]==1?"$_[0]/$_[1]":("1/".(int($_[1]/$_[0])+1), pharaoh(hiero($_[0]*(int($_[1]/$_[0])+1)-$_[1],$_[1]*(int($_[1]/ $_[0])+1))))}

Replies are listed 'Best First'.
Re: Egyptian fractions (Golf Anyone?)
by Limbic~Region (Chancellor) on Aug 25, 2006 at 15:22 UTC
    jimt,
    Obfu is not my thing, but I do love interesting math problems. The following is more of a golf (156) than an obfu:
    use Math::Pari 'lcm';my($n,$d)=split/\//,shift;sub p{print"1/$_[0] "}w +hile(1){my $u=int$d/$n+1;p$u;my $l=lcm$d,$u;$n=$n*$l/$d-$l/$u;$d=$l;p($d),die$/if +$n==1}
    Golfing with strictures and warnings is a handicap so (146):
    ($n,$d)=split/\//,shift;sub p{print"1/$_[0] "}while(1){use Math::Pari lcm;$u=int$d/$n+1;p$u;$l=lcm$d,$u;$n=$n*$l/$d-$l/$u;$d=$l;p($d),die$/i +f$n==1}
    Since I am not a golfer either, anyone interested in the starting code can use it to improve things.

    Cheers - L~R

      Hi Limbic~Region,

      A couple of small changes will get you down to 142:

      ($n,$d)=split'/',shift;sub p{print"1/$_[0] "}{use Math::Pari lcm;$u=int$d/$n+1;p$u;$l=lcm$d,$u;$n=$n*$l/$d-$l/$u;$d=$l;p($d),die$/i +f$n==1;redo}

      s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
        Refinement of this particular track at 130:
        ($n,$d)=split'/',pop;sub p{print"1/@_ "}{use Math::Pari lcm;p$u=int$d/$n+1;$l=lcm$d,$u;$n=$n*$l/$d-($d=$l)/$u;$n-1?redo: p$d+die$/}
      81 chars:
      $ perl -e '($n,$d)=split"/",pop;{1while++$x<$d/$n;warn"1/$x\n";$n=$n*$ +x-$d;$d*=$x;redo if$n}' 18/20 1/2 1/3 1/15
      Update: changing the entire structure to a C-style for-loop saves 2 chars, so this gives me a 79-char solution:
      for(($n,$d)=split"/",pop;$n;){1while++$x<$d/$n;warn"1/$x\n";$n=$n*$x-$ +d;$d*=$x}
      This uses the greedy heuristic, so it doesn't find the "best" Egyptian fractions. $x keeps increasing until 1/$x is <= our current fraction. Then we print 1/$x and subtract from the current fraction. But there is no need to put this fraction in lowest terms, which saves a lot of strokes.

      If POSIX::ceil were available, 1while++$x<$d/$n is really just $x=ceil($d/$n) ..

      BTW, this 58-char solution would work if it weren't for floating-point error:

      perl -e '$f=eval pop;{1while++$x<1/$f;warn"1/$x\n";redo if$f-=1/$x}' 1 +9/20
      I don't have Math::Pari where I am, but it may be possible to use it in the above approach (it treats rationals with absolute precision).

      blokhead

      Ah, no, Limbic~Region,

      your's ain't golf. No modules, lest I would say

      use Junk;do

      - 11 chars.. but that could be golfed down to use J;d - 7 chars ;-)

      blokhead's solutions look neat, but they hog my cpu... (with 2355/12344 - still not finished in 3/4 hour ;-)

      #!/usr/bin/perl -l pop=~m|/|;($f,$g)=($`,$');sub d{int($_[1]/$_[0]+1)}sub g{($x,$y)=@_;($x,$y)=($y,$x% $y)while$y;$x} sub re{($p ,$e,$r,$l)=@_;($p,$l)=($p*$l-$e*$r,$e*$l);$g=g($p,$l); for($p,$l){$_/=$g};($p,$l)}while($f>1){push@o,"1/".d(# $f,$g);($f,$g)=re($f,$g,1,d($f,$g));}print join' + ',# @o,"$f/$g";# ungolfed and thus not for production use!

      way too long...

      <update> golfed down a bit... (198 chars, counting newlines).

      ($z,$n)=($_=pop)=~/(.+)\/(.+)/;$s='==';for(;;){$m=int($n/$z+1);$_ .=" $s 1/".($z==1?$n:$m);$z<=1&&last;($z,$n)=($z*$m-$n,$m*$n);($x ,$y)=($z,$n);($x,$y)=($y,$x%$y)while$y;$z/=$x;$n/=$x;$s='+'}print
      It computes egyptian fractions like this
      qwurx [shmem] ~> perl -l egy.pl 2355/12344 2355/12344 == 1/6 + 1/42 + 1/3282 + 1/15755059 + 1/744665636525384

      in no time... </update>

      --shmem

      _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                                    /\_¯/(q    /
      ----------------------------  \__(m.====·.(_("always off the crowd"))."·
      ");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
        A modification of blokhead's idea... what golf can go without regular expressions? 72 strokes:
        for($_=pop;/\//,$`;$_=$x*$`-$'.'/'.$'*$x){1while++$x<$'/$`;print"1/$x "}
        I counted the line break as one character, is that kosher?
        Update: I see also shmem had a similar thought, I had missed that before posting somehow.
        Update again: Changed the title of this node to not be dumb. Sorry all, thanks for the feedback those who messaged me!
        ~dewey
Re: Egyptian fractions
by dewey (Pilgrim) on Aug 25, 2006 at 02:30 UTC
    Nice work! A good explanation too, I will need to take this code apart before I really understand it thoroughly. For some reason hiero catches my fancy in particular...
    ~dewey

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: obfuscated [id://569404]
Approved by Limbic~Region
Front-paged by shmem
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (2)
As of 2024-04-20 10:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found