Fractran: Difference between revisions

Content added Content deleted

Inline

Revision as of 19:09, 22 January 2014

FRACTRAN is a Turing-complete esoteric programming language invented by the mathematician John Horton Conway.

A FRACTRAN program is an ordered list of positive fractions $P=(f_{1},f_{2},\ldots ,f_{m})$ , together with an initial positive integer input $n$ .

The program is run by updating the integer $n$ as follows:

for the first fraction, $f_{i}$ , in the list for which $nf_{i}$ is an integer, replace $n$ by $nf_{i}$ ;
repeat this rule until no fraction in the list produces an integer when multiplied by $n$ , then halt.

Conway gave a program for primes in FRACTRAN:

17/91

,

78/85

,

19/51

,

23/38

,

29/33

,

77/29

,

95/23

,

77/19

,

1/17

,

11/13

,

13/11

,

15/14

,

15/2

,

55/1

Starting with $n=2$ , this FRACTRAN program will change $n$ in $15=2\times (15/2)$ , then $825=15\times (55/1)$ , generating the following sequence of integers:

2

,

15

,

825

,

725

,

1925

,

2275

,

425

,

390

,

330

,

290

,

770

,

\ldots

After 2, this sequence contains the following powers of 2:

2^{2}=4

,

2^{3}=8

,

2^{5}=32

,

2^{7}=128

,

2^{11}=2048

,

2^{13}=8192

,

2^{17}=131072

,

2^{19}=524288

,

\ldots

which are the prime powers of 2.

More on how to program FRACTRAN as a universal programming language will be find in the references.

Your task is to write a program that reads a list of fractions in a natural format from the keyboard or from a string, to parse it into a sequence of fractions (i.e. two integers), and runs the FRACTRAN starting from a provided integer, writing the result at each step. It a also required that the number of step is limited (by a parameter easy to find).

References

J. H. Conway (1987). Fractran: A Simple Universal Programming Language for Arithmetic. In: Open Problems in Communication and Computation, pages 4–26. Springer.

J. H. Conway (2010). "FRACTRAN: A simple universal programming language for arithmetic". In Jeffrey C. Lagarias. The Ultimate Challenge: the 3x+1 problem. American Mathematical Society. pp. 249–264. ISBN 978-0-8218-4940-8. Zbl 1216.68068.

Number Pathology: Fractran by Mark C. Chu-Carroll; October 27, 2006.

D

Simple Version

Translation of: Java

<lang d>import std.stdio, std.algorithm, std.conv, std.array;

void fractran(in string prog, int val, in uint limit) {

   const fracts = prog.split.map!(p => p.split("/").to!(int[])).array;

   foreach (immutable n; 0 .. limit) {
       writeln(n, ": ", val);
       const found = fracts.find!(p => val % p[1] == 0);
       if (found.empty)
           break;
       val = found.front[0] * val / found.front[1];
   }

}

void main() {

   fractran("17/91 78/85 19/51 23/38 29/33 77/29 95/23
             77/19 1/17 11/13 13/11 15/14 15/2 55/1", 2, 15);

}</lang>

Output:

Lazy Version

<lang d>import std.stdio, std.algorithm, std.conv, std.array, std.range;

struct Fractran {

   int front;
   bool empty = false;
   const int[][] fracts;

   this(in string prog, in int val) {
       this.front = val;
       fracts = prog.split.map!(p => p.split("/").to!(int[])).array;
   }

   void popFront() {
       const found = fracts.find!(p => front % p[1] == 0);
       if (found.empty)
           empty = true;
       else
           front = found.front[0] * front / found.front[1];
   }

}

void main() {

   Fractran("17/91 78/85 19/51 23/38 29/33 77/29 95/23
             77/19 1/17 11/13 13/11 15/14 15/2 55/1", 2)
   .take(15).writeln;

}</lang>

Output:

[2, 15, 825, 725, 1925, 2275, 425, 390, 330, 290, 770, 910, 170, 156, 132]

Haskell

This example is incomplete. Natural input format? Please ensure that it meets all task requirements and remove this message.

<lang haskell>import Data.List (find) import Data.Ratio (Ratio, (%), denominator)

fractran :: (Integral a) => [Ratio a] -> a -> [a] fractran fracts n = n :

 case find (\f -> n `mod` denominator f == 0) fracts of
   Nothing -> []
   Just f -> fractran fracts $ truncate (fromIntegral n * f)

main :: IO () main = print $ take 15 $ fractran [17%91, 78%85, 19%51, 23%38, 29%33, 77%29,

        95%23, 77%19, 1%17, 11%13, 13%11, 15%14, 15%2, 55%1] 2</lang>

Output:

[2,15,825,725,1925,2275,425,390,330,290,770,910,170,156,132]

Icon and Unicon

Works in both languages:

<lang unicon>record fract(n,d)

procedure main(A)

   fracton("17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1", 2)

end

procedure fracton(s, n, limit)

   execute(parse(s),n, limit)

end

procedure parse(s)

   f := []
   s ? while not pos(0) do {
           tab(upto(' ')|0) ? put(f,fract(tab(upto('/')), (move(1),tab(0))))
           move(1)
           }
   return f

end

procedure execute(f,d,limit)

    /limit := 15
    every !limit do {
        if d := (d%f[i := !*f].d == 0, (d/f[i].d)*f[i].n) then writes(d," ")
        else break write()
        }
    write()

end</lang>

Output:

->fractan
15 825 725 1925 2275 425 390 330 290 770 910 170 156 132 116 
->

Java

<lang java>import java.util.Vector; import java.util.regex.Matcher; import java.util.regex.Pattern;

public class Fractran{

  public static void main(String []args){

      new Fractran("17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1", 2);
  }
  final int limit = 15;

  Vector<Integer> num = new Vector<>(); 
  Vector<Integer> den = new Vector<>(); 
  public Fractran(String prog, Integer val){
     compile(prog);
     dump();
     exec(2);
   }

  void compile(String prog){
     Pattern regexp = Pattern.compile("\\s*(\\d*)\\s*\\/\\s*(\\d*)\\s*(.*)");
     Matcher matcher = regexp.matcher(prog);
     while(matcher.find()){
        num.add(Integer.parseInt(matcher.group(1)));
        den.add(Integer.parseInt(matcher.group(2)));
        matcher = regexp.matcher(matcher.group(3));
     }
  }

  void exec(Integer val){
      int n = 0;
      while(val != null && n<limit){
          System.out.println(n+": "+val);
          val = step(val);
          n++;
      }
  }
  Integer step(int val){
      int i=0; 
      while(i<den.size() && val%den.get(i) != 0) i++;
      if(i<den.size())
          return num.get(i)*val/den.get(i);
      return null;
  }

  void dump(){
      for(int i=0; i<den.size(); i++)
          System.out.print(num.get(i)+"/"+den.get(i)+" ");
      System.out.println();
  }

}</lang>

JavaScript

<lang javascript> var num = new Array(); var den = new Array(); var val ;

function compile(prog){

 var regex = /\s*(\d*)\s*\/\s*(\d*)\s*(.*)/m;
 while(regex.test(prog)){
   num.push(regex.exec(prog)[1]);
   den.push(regex.exec(prog)[2]);
   prog = regex.exec(prog)[3];
 }

}

function dump(prog){

 for(var i=0; i<num.length; i++)
   document.body.innerHTML += num[i]+"/"+den[i]+" ";
 document.body.innerHTML += "
";

}

function step(val){

 var i=0;
 while(i<den.length && val%den[i] != 0) i++;
 return num[i]*val/den[i];

}

function exec(val){

 var i = 0;
 while(val && i<limit){
   document.body.innerHTML += i+": "+val+"
";
   val = step(val);
   i ++;
 }

}

// Main compile("17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1"); dump(); var limit = 15; exec(2); </lang>

Perl

Instead of printing all steps, I chose to only print those steps which were a power of two. This makes the fact that it's a prime-number-generating program much clearer.

<lang perl>use strict; use warnings; use Math::BigRat;

my ($n, @P) = map Math::BigRat->new($_), qw{ 2 17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1 };

$|=1; MAIN: for( 1 .. 5000 ) { print " " if $_ > 1; my ($pow, $rest) = (0, $n->copy); until( $rest->is_odd ) { ++$pow; $rest->bdiv(2); } if( $rest->is_one ) { print "2**$pow"; } else { #print $n; } for my $f_i (@P) { my $nf_i = $n * $f_i; next unless $nf_i->is_int; $n = $nf_i; next MAIN; } last; }

print "\n"; </lang>

If you uncomment the

#print $n

, it will print all the steps.

Perl 6

A FRACTRAN program potentially returns an infinite list, and infinite lists are a common data structure in Perl 6. Thus we won't try to enforce a limit to the number of steps.

Notice that this code will only work with a fairly recent version of rakudo, for it requires the .narrow method, which was added in early 2014.

<lang perl6>say .[^100] given 2, -> \n {

   first Int, map (* * n).narrow,
   <17/91 78/85 19/51 23/38 29/33 77/29 95/23
   77/19 1/17 11/13 13/11 15/14 15/2 55/1>, 0

} ... 0;</lang>

Output:

2 15 825 725 1925 2275 425 390 330 290 770 910 170 156 132 116 308 364 68 4 30 225 12375 10875 28875 25375 67375 79625 14875 13650 2550 2340 1980 1740 4620 4060 10780 12740 2380 2184 408 152 92 380 230 950 575 2375 9625 11375 2125 1950 1650 1450 3850 4550 850 780 660 580 1540 1820 340 312 264 232 616 728 136 8 60 450 3375 185625 163125 433125 380625 1010625 888125 2358125 2786875 520625 477750 89250 81900 15300 14040 11880 10440 27720 24360 64680 56840 150920 178360 33320 30576 5712 2128 1288

Python

<lang python>from fractions import Fraction

def fractran(n, fstring='17 / 91, 78 / 85, 19 / 51, 23 / 38, 29 / 33,'

                       '77 / 29, 95 / 23, 77 / 19, 1 / 17, 11 / 13,'
                       '13 / 11, 15 / 14, 15 / 2, 55 / 1'):
   flist = [Fraction(f) for f in fstring.replace(' ', ).split(',')]

   yield n
   while True:
       for f in flist:
           if (n * f).denominator == 1:
               break
       else:
           break
       n *= f
       yield n.numerator

if __name__ == '__main__':

   n, m = 2, 15
   print('First %i members of fractran(%i):\n  ' % (m, n) +
         ', '.join(str(f) for f,i in zip(fractran(n), range(m))))</lang>

Output:

First 15 members of fractran(2):
  2, 15, 825, 725, 1925, 2275, 425, 390, 330, 290, 770, 910, 170, 156, 132

Racket

Translation of: D

Simple version, without sequences.

<lang Racket>#lang racket

(define (displaysp x)

 (display x)
 (display " "))

(define (read-string-list str)

 (map string->number
      (string-split (string-replace str " " "") ",")))

(define (eval-fractran n list)

 (for/or ([e (in-list list)])
   (let ([en (* e n)])
     (and (integer? en) en))))

(define (show-fractran fr n s)

 (printf "First ~a members of fractran(~a):\n" s n)
 (displaysp n) 
 (for/fold ([n n]) ([i (in-range (- s 1))])
   (let ([new-n (eval-fractran n fr)])
     (displaysp new-n) 
     new-n))
 (void))

(define fractran

 (read-string-list 
  (string-append "17 / 91, 78 / 85, 19 / 51, 23 / 38, 29 / 33,"
                 "77 / 29, 95 / 23, 77 / 19, 1 / 17, 11 / 13,"
                 "13 / 11, 15 / 14, 15 / 2, 55 / 1")))

(show-fractran fractran 2 15)</lang>

Output:

First 15 members of fractran(2):
2 15 825 725 1925 2275 425 390 330 290 770 910 170 156 132

REXX

Programming note: extra blanks can be inserted in the fractions before and/or after the solidus [/]. <lang rexx>/*REXX pgm runs FRACTAN for a given set of fractions and from a given N.*/ numeric digits 100 /*be able to handle larger nums. */ parse arg N terms fracs /*get optional arguments from CL.*/ if N== | N==',' then N=2 /*N specified? No, use default.*/ if fracs= then fracs= , /*any fractions specified? No···*/ '17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' f=fracs /* [↑] use default for fractions.*/

       do i=1  while f\==;   parse var f @.i ',' f
       end   /*i*/                    /* [↑]   parse all the fractions.*/

=i-1 /*the number of fractions found. */

say # 'fractions:' fracs /*display # and actual fractions.*/ say 'N is starting at:' N /*display the starting number N.*/ if terms== | terms==',' then terms=100 /*¬ specified? Use default.*/ say terms 'terms being shown:' /*display a kind of header/title.*/ say /*show blank line (perusability).*/

      do j=1  for  terms              /*perform loop once for each term*/
         do k=1  for  #;  interpret '_=' N "*" @.k    /* [↓]  integer? */
         if \datatype(_,'W')  then iterate    /*Not integer?   Skip it.*/
         say right(j||th(j),15) 'term: '  N   /*display formatted term.*/
         N=_                          /*set the next  N  to be used.   */
         leave                        /*go start calculating next term.*/
         end   /*k*/                  /* [↑]  if integer, found a new N*/
      end      /*j*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────TH subroutine───────────────────────*/ th: procedure;parse arg x;x=abs(x);return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4))</lang> output using the default input:

14 fractions: 17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1
N is starting at: 2
100 terms being shown:

            1st term:  2
            2nd term:  15
            3rd term:  825
            4th term:  725
            5th term:  1925
            6th term:  2275
            7th term:  425
            8th term:  390
            9th term:  330
           10th term:  290
           11th term:  770
           12th term:  910
           13th term:  170
           14th term:  156
           15th term:  132
           16th term:  116
           17th term:  308
           18th term:  364
           19th term:  68
           20th term:  4
           21st term:  30
           22nd term:  225
           23rd term:  12375
           24th term:  10875
           25th term:  28875
           26th term:  25375
           27th term:  67375
           28th term:  79625
           29th term:  14875
           30th term:  13650
           31st term:  2550
           32nd term:  2340
           33rd term:  1980
           34th term:  1740
           35th term:  4620
           36th term:  4060
           37th term:  10780
           38th term:  12740
           39th term:  2380
           40th term:  2184
           41st term:  408
           42nd term:  152
           43rd term:  92
           44th term:  380
           45th term:  230
           46th term:  950
           47th term:  575
           48th term:  2375
           49th term:  9625
           50th term:  11375
           51st term:  2125
           52nd term:  1950
           53rd term:  1650
           54th term:  1450
           55th term:  3850
           56th term:  4550
           57th term:  850
           58th term:  780
           59th term:  660
           60th term:  580
           61st term:  1540
           62nd term:  1820
           63rd term:  340
           64th term:  312
           65th term:  264
           66th term:  232
           67th term:  616
           68th term:  728
           69th term:  136
           70th term:  8
           71st term:  60
           72nd term:  450
           73rd term:  3375
           74th term:  185625
           75th term:  163125
           76th term:  433125
           77th term:  380625
           78th term:  1010625
           79th term:  888125
           80th term:  2358125
           81st term:  2786875
           82nd term:  520625
           83rd term:  477750
           84th term:  89250
           85th term:  81900
           86th term:  15300
           87th term:  14040
           88th term:  11880
           89th term:  10440
           90th term:  27720
           91st term:  24360
           92nd term:  64680
           93rd term:  56840
           94th term:  150920
           95th term:  178360
           96th term:  33320
           97th term:  30576
           98th term:  5712
           99th term:  2128
          100th term:  1288

Tcl

Works with: Tcl version 8.6

<lang tcl>package require Tcl 8.6

oo::class create Fractran {

   variable fracs nco
   constructor {fractions} {

set fracs {} foreach frac $fractions { if {[regexp {^(\d+)/(\d+),?$} $frac -> num denom]} { lappend fracs $num $denom } else { return -code error "$frac is not a supported fraction" } } if {![llength $fracs]} { return -code error "need at least one fraction" }

   method execute {n {steps 15}} {

set co [coroutine [incr nco] my Generate $n] for {set i 0} {$i < $steps} {incr i} { lappend result [$co] } catch {rename $co ""} return $result

   method Step {n} {

foreach {num den} $fracs { if {$n % $den} continue return [expr {$n * $num / $den}] } return -code break

   }
   method Generate {n} {

yield [info coroutine] while 1 { yield $n set n [my Step $n] } return -code break

}

set ft [Fractran new {

   17/91 78/85 19/51 23/38 29/33 77/29 95/23
   77/19 1/17 11/13 13/11 15/14 15/2 55/1

}] puts [$ft execute 2]</lang>

Output:

2 15 825 725 1925 2275 425 390 330 290 770 910 170 156 132

You can just collect powers of 2 by monkey-patching in something like this: <lang tcl>oo::objdefine $ft method pow2 {n} {

   set co [coroutine [incr nco] my Generate 2]
   set pows {}
   while {[llength $pows] < $n} {

set item [$co] if {($item & ($item-1)) == 0} { lappend pows $item }

   }
   return $pows

} puts [$ft pow2 10]</lang> Which will then produce this additional output:

2 4 8 32 128 2048 8192 131072 524288 8388608