Fractran
You are encouraged to solve this task according to the task description, using any language you may know.
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 , together with an initial positive integer input .
The program is run by updating the integer as follows:
- for the first fraction, , in the list for which is an integer, replace by ;
- repeat this rule until no fraction in the list produces an integer when multiplied by , then halt.
Conway gave a program for primes in FRACTRAN:
- , , , , , , , , , , , , ,
Starting with , this FRACTRAN program will change in , then , generating the following sequence of integers:
- , , , , , , , , , , ,
After 2, this sequence contains the following powers of 2:
- , , , , , , , ,
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.
C
Using GMP. Powers of two are in brackets. <lang c>#include <stdio.h>
- include <stdlib.h>
- include <gmp.h>
typedef struct frac_s *frac; struct frac_s { int n, d; frac next; };
frac parse(char *s) { int offset = 0; struct frac_s h = {0}, *p = &h;
while (2 == sscanf(s, "%d/%d%n", &h.n, &h.d, &offset)) { s += offset; p = p->next = malloc(sizeof *p); *p = h; p->next = 0; }
return h.next; }
int run(int v, char *s) { frac n, p = parse(s); mpz_t val; mpz_init_set_ui(val, v);
loop: n = p; gmp_printf(mpz_popcount(val) == 1 ? "\n[%Zd]" : " %Zd", val);
for (n = p; n; n = n->next) { // assuming the fractions are not reducible if (mpz_divisible_ui_p(val, n->d)) { mpz_divexact_ui(val, val, n->d); mpz_mul_ui(val, val, n->n); goto loop; } }
gmp_printf("\nhalt: %Zd has no divisors\n", val);
mpz_clear(val); while (p) { n = p->next; free(p); p = n; }
return 0; }
int main(void) { run(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");
return 0; }</lang>
C++
<lang cpp>
- include <iostream>
- include <sstream>
- include <iterator>
- include <vector>
- include <math.h>
using namespace std;
class fractran { public:
void run( std::string p, int s, int l )
{
start = s; limit = l;
istringstream iss( p ); vector<string> tmp;
copy( istream_iterator<string>( iss ), istream_iterator<string>(), back_inserter<vector<string> >( tmp ) );
string item; vector< pair<float, float> > v;
pair<float, float> a; for( vector<string>::iterator i = tmp.begin(); i != tmp.end(); i++ ) { string::size_type pos = ( *i ).find( '/', 0 ); if( pos != std::string::npos ) { a = make_pair( atof( ( ( *i ).substr( 0, pos ) ).c_str() ), atof( ( ( *i ).substr( pos + 1 ) ).c_str() ) ); v.push_back( a ); } }
exec( &v );
}
private:
void exec( vector< pair<float, float> >* v )
{
int cnt = 0; bool found; float r; while( cnt < limit ) { cout << cnt << " : " << start << "\n"; cnt++; vector< pair<float, float> >::iterator it = v->begin(); found = false; while( it != v->end() ) { r = start * ( ( *it ).first / ( *it ).second ); if( r == floor( r ) ) { found = true; break; } ++it; }
if( found ) start = ( int )r; else break; }
} int start, limit;
}; int main( int argc, char* argv[] ) {
fractran f; f.run( "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 ); return system( "pause" );
} </lang>
- Output:
0 : 2 1 : 15 2 : 825 3 : 725 4 : 1925 5 : 2275 6 : 425 7 : 390 8 : 330 9 : 290 10 : 770 11 : 910 12 : 170 13 : 156 14 : 132
Common Lisp
<lang lisp>(defun fractran (n frac-list)
(lambda ()
(let ((f (find-if (lambda (frac)
(integerp (* n frac)))
frac-list)))
(prog1 n (when f (setf n (* f n)))))))
- test
(defvar *primes-ft* '(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))
(loop with fractran-instance = (fractran 2 *primes-ft*)
repeat 20
for next = (funcall fractran-instance)
until (null next)
do (print next))</lang>
Output:
2 15 825 725 1925 2275 425 390 330 290 770 910 170 156 132 116 308 364 68 4
D
Simple Version
<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:
0: 2 1: 15 2: 825 3: 725 4: 1925 5: 2275 6: 425 7: 390 8: 330 9: 290 10: 770 11: 910 12: 170 13: 156 14: 132
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
<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)
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)
end
procedure fractran(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, (writes(" ",d)/f[i].d)*f[i].n) then {}
else break write()
}
write()
end</lang>
Output:
->fractan 2 15 825 725 1925 2275 425 390 330 290 770 910 170 156 132 ->
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. The limit is therefore enforced only by slicing the infinite list. <lang perl6>sub ft (\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
} constant FT = 2, &ft ... 0; say FT[^100];
constant FT2 = FT.grep: { $_ +& ($_ - 1) == 0 } say FT2[$_] for 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 2 4 8 32 128 2048 8192 131072 524288 8388608 536870912 2147483648 ^C
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
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 1000 /*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 terms==|terms==',' then terms=100 /*TERMS specified? 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=space(fracs,0) /* [↑] use default for fractions.*/
do i=1 while f\==; parse var f n.i '/' d.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.*/ say terms ' terms are being shown:' /*display a kind of header/title.*/
do j=1 for terms /*perform loop once for each term*/
do k=1 for #; if N//d.k\==0 then iterate /*not an integer?*/
say right('term' j,35) '──► ' N /*display the Nth term with N. */
N = N * n.k % d.k /*calculate the next term (use %)*/
leave /*go start calculating next term.*/
end /*k*/ /* [↑] if integer, found a new N*/
end /*j*/
/*stick a fork in it, we're done.*/</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 are being shown:
term 1 ──► 2
term 2 ──► 15
term 3 ──► 825
term 4 ──► 725
term 5 ──► 1925
term 6 ──► 2275
term 7 ──► 425
term 8 ──► 390
term 9 ──► 330
term 10 ──► 290
term 11 ──► 770
term 12 ──► 910
term 13 ──► 170
term 14 ──► 156
term 15 ──► 132
term 16 ──► 116
term 17 ──► 308
term 18 ──► 364
term 19 ──► 68
term 20 ──► 4
term 21 ──► 30
term 22 ──► 225
term 23 ──► 12375
term 24 ──► 10875
term 25 ──► 28875
term 26 ──► 25375
term 27 ──► 67375
term 28 ──► 79625
term 29 ──► 14875
term 30 ──► 13650
term 31 ──► 2550
term 32 ──► 2340
term 33 ──► 1980
term 34 ──► 1740
term 35 ──► 4620
term 36 ──► 4060
term 37 ──► 10780
term 38 ──► 12740
term 39 ──► 2380
term 40 ──► 2184
term 41 ──► 408
term 42 ──► 152
term 43 ──► 92
term 44 ──► 380
term 45 ──► 230
term 46 ──► 950
term 47 ──► 575
term 48 ──► 2375
term 49 ──► 9625
term 50 ──► 11375
term 51 ──► 2125
term 52 ──► 1950
term 53 ──► 1650
term 54 ──► 1450
term 55 ──► 3850
term 56 ──► 4550
term 57 ──► 850
term 58 ──► 780
term 59 ──► 660
term 60 ──► 580
term 61 ──► 1540
term 62 ──► 1820
term 63 ──► 340
term 64 ──► 312
term 65 ──► 264
term 66 ──► 232
term 67 ──► 616
term 68 ──► 728
term 69 ──► 136
term 70 ──► 8
term 71 ──► 60
term 72 ──► 450
term 73 ──► 3375
term 74 ──► 185625
term 75 ──► 163125
term 76 ──► 433125
term 77 ──► 380625
term 78 ──► 1010625
term 79 ──► 888125
term 80 ──► 2358125
term 81 ──► 2786875
term 82 ──► 520625
term 83 ──► 477750
term 84 ──► 89250
term 85 ──► 81900
term 86 ──► 15300
term 87 ──► 14040
term 88 ──► 11880
term 89 ──► 10440
term 90 ──► 27720
term 91 ──► 24360
term 92 ──► 64680
term 93 ──► 56840
term 94 ──► 150920
term 95 ──► 178360
term 96 ──► 33320
term 97 ──► 30576
term 98 ──► 5712
term 99 ──► 2128
term 100 ──► 1288
Tcl
<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