Data update

Task/Fractran/ALGOL-68/fractran.alg

@@ -1,6 +1,6 @@
 # as the numbers required for finding the first 20 primes are quite large, #
-# we use Algol 68G's LONG LONG INT with a precision of 100 digits          #
-PR precision 100 PR
+# we use Algol 68G's LONG LONG INT with a precision of 200 digits          #
+PR precision 200 PR
 
 # mode to hold fractions #
 MODE FRACTION = STRUCT( INT numerator, INT denominator );
@@ -9,16 +9,16 @@ MODE FRACTION = STRUCT( INT numerator, INT denominator );
 OP / = ( INT a, b )FRACTION: ( a, b );
 
 # mode to define a FRACTRAN progam #
-MODE FRACTRAN = STRUCT( FLEX[0]FRACTION data
+MODE FRACTRAN = STRUCT( [0]FRACTION data
                       , LONG LONG INT   n
                       , BOOL            halted
                       );
 # prepares a FRACTRAN program for use - sets the initial value of n and halted to FALSE #
 PRIO STARTAT = 1;
-OP   STARTAT = ( REF FRACTRAN f, INT start )REF FRACTRAN:
+OP   STARTAT = ( REF FRACTRAN f, INT start p )REF FRACTRAN:
 BEGIN
     halted OF f := FALSE;
-         n OF f := start;
+         n OF f := start p;
     f
 END;
 
@@ -39,36 +39,39 @@ OP NEXT = ( REF FRACTRAN f )LONG LONG INT:
     FI ;
 
 # generate and print the sequence of numbers from a FRACTRAN pogram #
-PROC print fractran sequence = ( REF FRACTRAN f, INT start, INT limit )VOID:
+PROC print fractran sequence = ( REF FRACTRAN f, INT start p, INT limit )VOID:
 BEGIN
-    VOID( f STARTAT start );
-    print( ( "0: ", whole( start, 0 ) ) );
+    VOID( f STARTAT start p );
+    print( ( "0: ", whole( start p, 0 ) ) );
     FOR i TO limit
     WHILE VOID( NEXT f );
           NOT halted OF f
     DO
-        print( ( " " + whole( i, 0 ) + ": " + whole( n OF f, 0 ) ) )
+        print( ( " ", whole( i, 0 ), ":", whole( n OF f, 0 ) ) )
     OD;
     print( ( newline ) )
 END ;
 
 # print the first 16 elements from the primes FRACTRAN program #
-FRACTRAN pf := ( ( 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, FALSE );
+FRACTRAN pf := ( ( 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, FALSE );
 print fractran sequence( pf, 2, 15 );
 
 # find some primes using the pf FRACTRAN progam - n is prime for the members in the sequence that are 2^n #
-INT primes found := 0;
-VOID( pf STARTAT 2 );
-INT pos := 0;
-print( ( "seq position  prime sequence value", newline ) );
-WHILE primes found < 20 AND NOT halted OF pf DO
-    LONG LONG INT value      := NEXT pf;
-    INT      power of 2 := 0;
-    pos +:= 1;
-    WHILE value MOD 2 = 0 AND value > 0 DO power of 2 PLUSAB 1; value OVERAB 2 OD;
-    IF value = 1 THEN
-        # found a prime #
-        primes found +:= 1;
-        print( ( whole( pos, -12 ) + " " + whole( power of 2, -6 ) + " (" + whole( n OF pf, 0 ) + ")", newline ) )
-    FI
-OD
+BEGIN
+    INT primes found := 0;
+    VOID( pf STARTAT 2 );
+    INT pos := 0;
+    print( ( "seq position  prime sequence value", newline ) );
+    WHILE primes found < 20 AND NOT halted OF pf DO
+        LONG LONG INT value      := NEXT pf;
+        INT           power of 2 := 0;
+        pos +:= 1;
+        WHILE value MOD 2 = 0 AND value > 0 DO power of 2 PLUSAB 1; value OVERAB 2 OD;
+        IF value = 1 THEN
+            primes found +:= 1;
+            print( ( whole( pos, -12 ), " ", whole( power of 2, -6 ) ) );
+            print( ( " (" + whole( n OF pf, 0 ), ")", newline ) )
+        FI
+    OD
+END

Task/Fractran/Miranda/fractran.miranda

@@ -0,0 +1,80 @@
+main :: [sys_message]
+main = [Stdout (lay [show (take 15 (run 2 primeprog)),
+                     show (take 20 fracprimes)])]
+
+primeprog :: [(num,num)]
+primeprog = fromjust (prog ("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"))
+
+fracprimes :: [num]
+fracprimes = [fromjust k | k<-map fracprime (run 2 primeprog); isjust k]
+
+fracprime :: num->maybe num
+fracprime = f 0
+            where f 1 1 = Nothing
+                  f n 1 = Just n
+                  f n x = Nothing, if x mod 2 ~= 0
+                  f n x = f (n+1) (x div 2), otherwise
+
+run :: num->[(num,num)]->[num]
+run n prog = [n], if ~isjust n'
+           = n : run (fromjust n') prog, otherwise
+             where n' = step n prog
+
+step :: num->[(num,num)]->maybe num
+step x []         = Nothing
+step x ((n,d):xs) = Just (x*n div d), if x*n mod d = 0
+                  = step x xs, otherwise
+
+maybe * ::= Nothing | Just *
+
+isjust :: maybe *->bool
+isjust (Just x) = True
+isjust Nothing  = False
+
+fromjust :: maybe *->*
+fromjust (Just x) = x
+
+prog :: [char]->maybe [(num, num)]
+prog xs = Just [], if trim xs = []
+        = Nothing, if ~isjust fp \/ ~isjust rp
+        = Just (fr : fromjust rp), otherwise
+          where fp = frac xs
+                Just (fr, xs') = fp
+                rp = prog xs'
+
+frac :: [char]->maybe ((num,num), [char])
+frac xs = Nothing, if ~isjust np \/ ~isjust sl \/ ~isjust dp
+        = Just ((n, d), xs'''), otherwise
+          where np = numb xs
+                Just (n, xs') = np
+                sl = match '/' (trim xs')
+                Just xs'' = sl
+                dp = numb xs''
+                Just (d, xs''') = dp
+
+numb :: [char]->maybe (num, [char])
+numb xs = Nothing, if n=[]
+        = Just (numval n, r), otherwise
+          where (n, r) = span "0123456789" (trim xs)
+
+match :: *->[*]->maybe [*]
+match m []     = Nothing
+match m (m:xs) = Just xs
+match m (x:xs) = Nothing
+
+span :: [*]->[*]->([*],[*])
+span match []     = ([], [])
+span match (x:xs) = ([], x:xs), if ~(x $in match)
+                  = (x:r, xs'), otherwise
+                    where (r, xs') = span match xs
+
+in :: *->[*]->bool
+in x [] = False
+in x (x:xs) = True
+in x (y:xs) = x $in xs
+
+trim :: [char]->[char]
+trim [] = []
+trim (c:xs) = trim xs, if c='\t' \/ c='\n' \/ c=' '
+trim (c:xs) = c:xs

Task/Fractran/REXX/fractran-3.rexx

@@ -29,7 +29,7 @@ call Time('r')
 say 'First' t 'terms of the sequence:'
 do i = 2 to t
    do j = 1 to w
-      if \ IsWhole(n/d.j) then
+      if \ Whole(n/d.j) then
          iterate
       call CharOut ,Right(n,9)
       if i//10 = 0 then
@@ -57,7 +57,7 @@ say 'Prime numbers:'
 n = 2; p = 0
 do i = 2 to 1300000
    do j = 1 to w
-      if \ IsWhole(n/d.j) then
+      if \ Whole(n/d.j) then
          iterate j
       if p.n then do
          p = p+1

Task/Fractran/Refal/fractran.refal

@@ -0,0 +1,78 @@
+$ENTRY Go {
+    , <Prog <PrimeProgram>>: e.Prog
+    = <Prout <FracRun 15 (2) e.Prog>>
+      <Prout <FracPrimes 20 (2) e.Prog>>;
+};
+
+PrimeProgram {
+    = '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';
+};
+
+FracPrimes {
+    0 e.X = ;
+    s.I (e.N) e.P,
+        <FracStep (e.N) e.P>: Next e.N2,
+        <FracPrime e.N>: {
+            T s.N = s.N <FracPrimes <- s.I 1> (e.N2) e.P>;
+            F = <FracPrimes s.I (e.N2) e.P>;
+        };
+};
+
+FracPrime {
+    (1) 1 = F;
+    (s.N) 1 = T s.N;
+    (s.N) e.X, <Divmod (e.X) 2>: {
+        (e.X2) 0 = <FracPrime (<+ 1 s.N>) e.X2>;
+        e.Z = F;
+    };
+    e.X = <FracPrime (0) e.X>;
+};
+
+FracRun {
+    0 e.X = ;
+    s.I (e.N) e.P, <FracStep (e.N) e.P>: {
+        Halt = e.N;
+        Next e.N2 = e.N <FracRun <- s.I 1> (e.N2) e.P>;
+    };
+};
+
+FracStep {
+    (e.N) = Halt;
+    (e.N) ((e.Num) e.Denom) e.P,
+        <Divmod (<Mul (e.N) e.Num>) e.Denom>: {
+            (e.N2) 0 = Next e.N2;
+            e.X = <FracStep (e.N) e.P>;
+        };
+};
+
+Prog {
+    e.X, <Frac e.X>: T (e.F) e.R = (e.F) <Prog e.R>;
+    e.X = ;
+};
+
+Frac {
+    e.X, <Num e.X>: T (e.N) e.X2,
+         <SkipWs e.X2>: '/' e.X3,
+         <Num e.X3>: T (e.D) e.X4 =
+            T ((e.N) e.D) e.X4;
+    e.X = F e.X;
+};
+
+Num {
+    e.X, <Span ('0123456789') <SkipWs e.X>>: {
+        () e.R = F e.R;
+        (e.N) e.R = T (<Numb e.N>) e.R;
+    };
+};
+
+Span {
+    (e.M) (e.S) s.C e.X, e.S: e.1 s.C e.2 = <Span (e.M s.C) (e.S) e.X>;
+    (e.M) (e.S) e.X = (e.M) e.X;
+    (e.S) e.X = <Span () (e.S) e.X>;
+};
+
+SkipWs {
+    s.C e.X, ' \n\t': e.1 s.C e.2 = <SkipWs e.X>;
+    e.X = e.X;
+};

Task/Fractran/SETL/fractran.setl

@@ -0,0 +1,52 @@
+program fractran;
+    p := parse_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"
+    );
+
+    print(frac_run_steps(p, 2, 15));
+    print(frac_primes(p, 2, 20));
+
+    proc frac_primes(p, n, nprimes);
+        primes := [];
+        loop for i in [1..nprimes] do
+            loop until n bit_and (n-1) = 0 do
+                n := frac_step(p, n);
+            end loop;
+            primes with:= log n/log 2;
+        end loop;
+        return primes;
+    end proc;
+
+    proc frac_run_steps(p, n, steps);
+        return [n] + [n := frac_step(p, n) : i in [2..steps]];
+    end proc;
+
+    proc frac_step(p, n);
+        if exists [num, denom] in p | n * num mod denom = 0 then
+            return n * num div denom;
+        end if;
+        return om;
+    end proc;
+
+    proc rdws(rw s);
+        span(s, " \t\n");
+    end proc;
+
+    proc rdnum(rw s);
+        rdws(s);
+        return val span(s, "0123456789");
+    end proc;
+
+    proc rdfrac(rw s);
+        if (num := rdnum(s)) = om then return om; end if;
+        rdws(s);
+        if match(s, "/") = "" then return om; end if;
+        if (denom := rdnum(s)) = om then return om; end if;
+        return [num, denom];
+    end proc;
+
+    proc parse_fractran(s);
+        return [f := rdfrac(s) : until f=om];
+    end proc;
+end program;