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

Egyptian fractions

by jimt (Chaplain)
on Aug 24, 2006 at 17:51 UTC ( #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}

      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
Node Status?
node history
Node Type: obfuscated [id://569404]
Approved by Limbic~Region
Front-paged by shmem
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (6)
As of 2017-04-24 06:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I'm a fool:











    Results (433 votes). Check out past polls.