Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

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$ ./ 19/20 19/20 = 1/2 + 1/3 + 1/9 + 1/180 clark:~/Desktop jim$ ./ 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
    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}

        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}


      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 2355/12344 2355/12344 == 1/6 + 1/42 + 1/3282 + 1/15755059 + 1/744665636525384

      in no time... </update>


      _($_=" "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!
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...

Log In?

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
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (7)
As of 2017-03-24 19:04 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (306 votes). Check out past polls.