import           Control.Monad (guard)
import           Data.List     (intersect, unfoldr, delete, nub, group, sort)
import           Text.Printf   (printf)

type Fraction = (Int, Int)
type Reduction = (Fraction, Fraction, Int)

validIntegers :: [Int] -> [Int]
validIntegers xs = [x | x <- xs, not $ hasZeros x, hasUniqueDigits x]
  where
    hasZeros = elem 0 . digits 10
    hasUniqueDigits n = length ds == length ul
      where
        ds = digits 10 n
        ul = nub ds

possibleFractions :: [Int] -> [Fraction]
possibleFractions = (\ys -> [(n,d) | n <- ys, d <- ys, n < d, gcd n d /= 1]) . validIntegers

digits :: Integral a => a -> a -> [a]
digits b = unfoldr (\n -> guard (n /= 0) >> pure (n `mod` b, n `div` b))

digitsToIntegral :: Integral a => [a] -> a
digitsToIntegral = sum . zipWith (*) (iterate (*10) 1)

findReductions :: Fraction -> [Reduction]
findReductions z@(n1, d1) = [ (z, (n2, d2), x)
                              | x <- digits 10 n1 `intersect` digits 10 d1,
                                let n2 = dropDigit x n1
                                    d2 = dropDigit x d1
                                    decimalWithDrop = realToFrac n2 / realToFrac d2,
                                decimalWithDrop == decimal ]
   where dropDigit d = digitsToIntegral . delete d . digits 10
         decimal = realToFrac n1 / realToFrac d1

findGroupReductions :: [Int] -> [Reduction]
findGroupReductions = (findReductions =<<) . possibleFractions

showReduction :: Reduction -> IO ()
showReduction ((n1,d1),(n2,d2),d) = printf "%d/%d = %d/%d by dropping %d\n" n1 d1 n2 d2 d

showCount :: [Reduction] -> Int -> IO ()
showCount xs n = do
  printf "There are %d %d-digit fractions of which:\n" (length xs) n
  mapM_ (uncurry (printf "%5d have %d's omitted\n")) (countReductions xs) >> printf "\n"
  where
    countReductions = fmap ((,) . length <*> head) . group . sort . fmap (\(_, _, x) -> x)

main :: IO ()
main = do
  mapM_ (\g -> mapM_ showReduction (take 12 g) >> printf "\n") groups
  mapM_ (uncurry showCount) $ zip groups [2..]
  where
    groups = [ findGroupReductions [10^1..99],   findGroupReductions [10^2..999]
             , findGroupReductions [10^3..9999], findGroupReductions [10^4..99999] ]


C:\Nicky\RosettaCode\FRACTRAN\FRACTRAN.for(6) : Warning: This name has not been given an explicit type.   [M]
       INTEGER P(M),Q(M)!The terms of the fractions.


' version 06-07-2015
' compile with: fbc -s console
' uses gmp

#Include Once "gmp.bi"

' in case the two #define's are missing from 'gmp.bi' define them now
#Ifndef mpq_numref
    #Define mpq_numref(Q) (@(Q)->_mp_num)
    #Define mpq_denref(Q) (@(Q)->_mp_den)
#EndIf

Dim As String prog(0 To ...) = {"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"}

Dim As UInteger i, j, c, max = UBound(prog)
Dim As Integer scanbit

Dim As ZString Ptr gmp_str : gmp_str = Allocate(10000)
Dim As Mpq_ptr  in_, out_
in_ = Allocate(Len(__mpq_struct)) : Mpq_init(in_)
out_ = Allocate(Len(__mpq_struct)) : Mpq_init(out_)
Dim As mpz_ptr num, den
num = Allocate(Len(__mpz_struct)) : Mpz_init(num)
den = Allocate(Len(__mpz_struct)) : Mpz_init(den)

Dim As mpq_ptr instruction(max)
For i = 0 To max
    instruction(i) = Allocate(Len(__mpq_struct))
    mpq_init(instruction(i))
    mpq_set_str(instruction(i), prog(i), 10 )
Next

mpq_set_str(in_ ,"2",10)
i = 0 : j = 0
Print "2";
Do
    mpq_mul(out_, instruction(i), in_)
    i = i + 1
    den = mpq_denref(out_)
    If mpz_cmp_ui(den, 1) = 0 Then
        Mpq_get_str(gmp_str, 10, out_)
        Print ", ";*gmp_str;
        mpq_swap(in_, out_)
        i = 0
        j = j + 1
    End If
Loop Until j > 14

' this one only display if the integer is 2^p, p being prime
mpq_set_str(in_ ,"2",10)
i = 0 : j = 0 : c = 0
Print : Print : Print
Print "count          iterations    prime  2^prime"

Do
    mpq_mul(out_, instruction(i), in_)
    i = i + 1
    j = j + 1
    den = mpq_denref(out_)
    If mpz_cmp_ui(den, 1) = 0 Then
        num = mpq_numref(out_)
        scanbit =  mpz_scan1(num, 0)
        ' if scanbit = 0 then number is odd
        If scanbit > 0 Then
            ' return from mpz_scan1(num, scanbit+1) is -1 for power of 2
            If mpz_scan1(num, scanbit +1) = -1 Then
                If c <= 20 Then Mpq_get_str(gmp_str, 10, out_) Else *gmp_str = ""
                c = c + 1
                Print Using "##### ################### ########  "; c; j; scanbit;
                Print *gmp_str
                If InKey <> "" Then Exit Do
            End If
        End If
        mpq_swap(in_, out_)
        i = 0
    End If
Loop

' Loop Until scanbit > 300
' Loop Until InKey <> ""
' Loop Until scanbit > 300 Or InKey <> ""
' stopping conditions will slow down the hole loop
' loop will check for key if it's printing a result

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


Filter=: (#~`)(`:6)
assert 'ac' -: 1 0 1"_ Filter 'abc'

intersect=:-.^:2
assert 'ab' -: 'abc'intersect'razb'

odometer=: (4$.$.)@:($&1)
Note 'odometer 2 3'
0 0
0 1
0 2
1 0
1 1
1 2
)

common=: 0 e. ~:
assert common 1 2 1
assert -. common 1 2 3

o=: '123456789' {~ [: [email protected]:common"1 Filter [email protected]:(#&9) NB. o is y unique digits, all of them

f=: ,:"1/&g~        	     NB. f computes a table of all numerators and denominators pairs

mask=: [: </~&i. #  	     NB. the lower triangle will become proper fractions

av=:  (([: , mask) # ,/)@:f  NB. anti-vulgarization

c=: [: [email protected]:,/"2 Filter av NB. ensure common digit(s)

fac=: [: ([: common ,&:~.&:q:&:"./)"2 Filter c  NB. assure a common factor
NB. This common factor filter might be useful in a future fully tacit version of the program.

cancellation=: monad define
 NDL =. c y   NB. vector of literal numerator and denominator
 NB. retain reducible fractions
 ND =. ". NDL NB. integral version of NDL
 MASK=. ([: common ,&:~.&:q:/)"1 ND        NB. assure a common factor
 FRAC=. _2 x: MASK # ND  NB. division
 CANDIDATES=. MASK # NDL
 rat=. , 'r'&,
 result=. 0 3 $ a:
 for_i. i. # CANDIDATES do.
  fraction =. i { FRAC
  pair=. i { CANDIDATES
  for_d. intersect/ pair do.
   trial=. pair -."1 d
   if. fraction = _2 x: ". trial do.
    result =. result , (rat/pair) ; (rat/trial) ; d
   end.
  end.
 end.
 result
)


import java.util.ArrayList;
import java.util.Collections;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

public class FractionReduction {

    public static void main(String[] args) {
        for ( int size = 2 ; size <= 5 ; size++ ) {
            reduce(size);
        }
    }

    private static void reduce(int numDigits) {
        System.out.printf("Fractions with digits of length %d where cancellation is valid.  Examples:%n", numDigits);

        //  Generate allowed numerator's and denominator's
        int min = (int) Math.pow(10, numDigits-1);
        int max = (int) Math.pow(10, numDigits) - 1;
        List<Integer> values = new ArrayList<>();
        for ( int number = min ; number <= max ; number++ ) {
            if ( isValid(number) ) {
                values.add(number);
            }
        }

        Map<Integer,Integer> cancelCount = new HashMap<>();
        int size = values.size();
        int solutions = 0;
        for ( int nIndex = 0 ; nIndex < size - 1 ; nIndex++ ) {
            int numerator = values.get(nIndex);
            //  Must be proper fraction
            for ( int dIndex = nIndex + 1 ; dIndex < size ; dIndex++ ) {
                int denominator = values.get(dIndex);
                for ( int commonDigit : digitsInCommon(numerator, denominator) ) {
                    int numRemoved = removeDigit(numerator, commonDigit);
                    int denRemoved = removeDigit(denominator, commonDigit);
                    if ( numerator * denRemoved == denominator * numRemoved ) {
                        solutions++;
                        cancelCount.merge(commonDigit, 1, (v1, v2) -> v1 + v2);
                        if ( solutions <= 12 ) {
                            System.out.printf("    When %d is removed, %d/%d = %d/%d%n", commonDigit, numerator, denominator, numRemoved, denRemoved);
                        }
                    }
                }
            }
        }
        System.out.printf("Number of fractions where cancellation is valid = %d.%n", solutions);
        List<Integer> sorted = new ArrayList<>(cancelCount.keySet());
        Collections.sort(sorted);
        for ( int removed : sorted ) {
            System.out.printf("    The digit %d was removed %d times.%n", removed, cancelCount.get(removed));
        }
        System.out.println();
    }

    private static int[] powers = new int[] {1, 10, 100, 1000, 10000, 100000};

    //  Remove the specified digit.
    private static int removeDigit(int n, int removed) {
        int m = 0;
        int pow = 0;
        while ( n > 0 ) {
            int r = n % 10;
            if ( r != removed ) {
                m = m + r*powers[pow];
                pow++;
            }
            n /= 10;
        }
        return m;
    }

    //  Assumes no duplicate digits individually in n1 or n2 - part of task
    private static List<Integer> digitsInCommon(int n1, int n2) {
        int[] count = new int[10];
        List<Integer> common = new ArrayList<>();
        while ( n1 > 0 ) {
            int r = n1 % 10;
            count[r] += 1;
            n1 /= 10;
        }
        while ( n2 > 0 ) {
            int r = n2 % 10;
            if ( count[r] > 0 ) {
                common.add(r);
            }
            n2 /= 10;
        }
        return common;
    }

    //  No repeating digits, no digit is zero.
    private static boolean isValid(int num) {
        int[] count = new int[10];
        while ( num > 0 ) {
            int r = num % 10;
            if ( r == 0 || count[r] == 1 ) {
                return false;
            }
            count[r] = 1;
            num /= 10;
        }
        return true;
    }

}


package main

import (
    "fmt"
    "log"
    "math/big"
    "os"
    "strconv"
    "strings"
)

func compile(src string) ([]big.Rat, bool) {
    s := strings.Fields(src)
    r := make([]big.Rat, len(s))
    for i, s1 := range s {
        if _, ok := r[i].SetString(s1); !ok {
            return nil, false
        }
    }
    return r, true
}

func exec(p []big.Rat, n *big.Int, limit int) {
    var q, r big.Int
rule:
    for i := 0; i < limit; i++ {
        fmt.Printf("%d ", n)
        for j := range p {
            q.QuoRem(n, p[j].Denom(), &r)
            if r.BitLen() == 0 {
                n.Mul(&q, p[j].Num())
                continue rule
            }
        }
        break
    }
    fmt.Println()
}

func usage() {
    log.Fatal("usage: ft <limit> <n> <prog>")
}

func main() {
    if len(os.Args) != 4 {
        usage()
    }
    limit, err := strconv.Atoi(os.Args[1])
    if err != nil {
        usage()
    }
    var n big.Int
    _, ok := n.SetString(os.Args[2], 10)
    if !ok {
        usage()
    }
    p, ok := compile(os.Args[3])
    if !ok {
        usage()
    }
    exec(p, &n, limit)
}


using Combinatorics

toi(set) = parse(Int, join(set, ""))
drop1(c, set) = toi(filter(x -> x != c, set))

function anomalouscancellingfractions(numdigits)
    ret = Vector{Tuple{Int, Int, Int, Int, Int}}()
    for nset in permutations(1:9, numdigits), dset in permutations(1:9, numdigits)
        if nset < dset # only proper fractions
            for c in nset
                if c in dset # a common digit exists
                    n, d, nn, dd = toi(nset), toi(dset), drop1(c, nset), drop1(c, dset)
                    if n // d == nn // dd # anomalous cancellation
                        push!(ret, (n, d, nn, dd, c))
                    end
                end
            end
        end
    end
    ret
end

function testfractionreduction(maxdigits=5)
    for i in 2:maxdigits
        results = anomalouscancellingfractions(i)
        println("\nFor $i digits, there were ", length(results),
            " fractions with anomalous cancellation.")
        numcounts = zeros(Int, 9)
        for r in results
            numcounts[r[5]] += 1
        end
        for (j, count) in enumerate(numcounts)
            count > 0 && println("The digit $j was crossed out $count times.")
        end
        println("Examples:")
        for j in 1:min(length(results), 12)
            r = results[j]
            println(r[1], "/", r[2], " = ", r[3], "/", r[4], "   ($(r[5]) crossed out)")
        end
    end
end

testfractionreduction()


fun indexOf(n: Int, s: IntArray): Int {
    for (i_j in s.withIndex()) {
        if (n == i_j.value) {
            return i_j.index
        }
    }
    return -1
}

fun getDigits(n: Int, le: Int, digits: IntArray): Boolean {
    var mn = n
    var mle = le
    while (mn > 0) {
        val r = mn % 10
        if (r == 0 || indexOf(r, digits) >= 0) {
            return false
        }
        mle--
        digits[mle] = r
        mn /= 10
    }
    return true
}

val pows = intArrayOf(1, 10, 100, 1_000, 10_000)

fun removeDigit(digits: IntArray, le: Int, idx: Int): Int {
    var sum = 0
    var pow = pows[le - 2]
    for (i in 0 until le) {
        if (i == idx) {
            continue
        }
        sum += digits[i] * pow
        pow /= 10
    }
    return sum
}

fun main() {
    val lims = listOf(
        Pair(12, 97),
        Pair(123, 986),
        Pair(1234, 9875),
        Pair(12345, 98764)
    )
    val count = IntArray(5)
    var omitted = arrayOf<Array<Int>>()
    for (i in 0 until 5) {
        var array = arrayOf<Int>()
        for (j in 0 until 10) {
            array += 0
        }
        omitted += array
    }
    for (i_lim in lims.withIndex()) {
        val i = i_lim.index
        val lim = i_lim.value

        val nDigits = IntArray(i + 2)
        val dDigits = IntArray(i + 2)
        val blank = IntArray(i + 2) { 0 }
        for (n in lim.first..lim.second) {
            blank.copyInto(nDigits)
            val nOk = getDigits(n, i + 2, nDigits)
            if (!nOk) {
                continue
            }
            for (d in n + 1..lim.second + 1) {
                blank.copyInto(dDigits)
                val dOk = getDigits(d, i + 2, dDigits)
                if (!dOk) {
                    continue
                }
                for (nix_digit in nDigits.withIndex()) {
                    val dix = indexOf(nix_digit.value, dDigits)
                    if (dix >= 0) {
                        val rn = removeDigit(nDigits, i + 2, nix_digit.index)
                        val rd = removeDigit(dDigits, i + 2, dix)
                        if (n.toDouble() / d.toDouble() == rn.toDouble() / rd.toDouble()) {
                            count[i]++
                            omitted[i][nix_digit.value]++
                            if (count[i] <= 12) {
                                println("$n/$d = $rn/$rd by omitting ${nix_digit.value}'s")
                            }
                        }
                    }
                }
            }
        }
        println()
    }

    for (i in 2..5) {
        println("There are ${count[i - 2]} $i-digit fractions of which:")
        for (j in 1..9) {
            if (omitted[i - 2][j] == 0) {
                continue
            }
            println("%6d have %d's omitted".format(omitted[i - 2][j], j))
        }
        println()
    }
}


function indexOf(haystack, needle)
    for idx,straw in pairs(haystack) do
        if straw == needle then
            return idx
        end
    end

    return -1
end

function getDigits(n, le, digits)
    while n > 0 do
        local r = n % 10
        if r == 0 or indexOf(digits, r) > 0 then
            return false
        end
        le = le - 1
        digits[le + 1] = r
        n = math.floor(n / 10)
    end
    return true
end

function removeDigit(digits, le, idx)
    local pows = { 1, 10, 100, 1000, 10000 }

    local sum = 0
    local pow = pows[le - 2 + 1]
    for i = 1, le do
        if i ~= idx then
            sum = sum + digits[i] * pow
            pow = math.floor(pow / 10)
        end
    end
    return sum
end

function main()
    local lims = { {12, 97}, {123, 986}, {1234, 9875}, {12345, 98764} }
    local count = { 0, 0, 0, 0, 0 }
    local omitted = {
        { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
        { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
        { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
        { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
        { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 },
    }

    for i,_ in pairs(lims) do
        local nDigits = {}
        local dDigits = {}
        for j = 1, i + 2 - 1 do
            nDigits[j] = -1
            dDigits[j] = -1
        end

        for n = lims[i][1], lims[i][2] do
            for j,_ in pairs(nDigits) do
                nDigits[j] = 0
            end
            local nOk = getDigits(n, i + 2 - 1, nDigits)
            if nOk then
                for d = n + 1, lims[i][2] + 1 do
                    for j,_ in pairs(dDigits) do
                        dDigits[j] = 0
                    end
                    local dOk = getDigits(d, i + 2 - 1, dDigits)
                    if dOk then
                        for nix,_ in pairs(nDigits) do
                            local digit = nDigits[nix]
                            local dix = indexOf(dDigits, digit)
                            if dix >= 0 then
                                local rn = removeDigit(nDigits, i + 2 - 1, nix)
                                local rd = removeDigit(dDigits, i + 2 - 1, dix)
                                if (n / d) == (rn / rd) then
                                    count[i] = count[i] + 1
                                    omitted[i][digit + 1] = omitted[i][digit + 1] + 1
                                    if count[i] <= 12 then
                                        print(string.format("%d/%d = %d/%d by omitting %d's", n, d, rn, rd, digit))
                                    end
                                end
                            end
                        end
                    end
                end
            end
        end

        print()
    end

    for i = 2, 5 do
        print("There are "..count[i - 2 + 1].." "..i.."-digit fractions of which:")
        for j = 1, 9 do
            if omitted[i - 2 + 1][j + 1] > 0 then
                print(string.format("%6d have %d's omitted", omitted[i - 2 + 1][j + 1], j))
            end
        end
        print()
    end
end

main()


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)


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


ClearAll[AnomalousCancellationQ2]
AnomalousCancellationQ2[frac : {i_?Positive, j_?Positive}] :=
 Module[{samedigits, idig, jdig, ff, p, q, r, tmp},
  idig = IntegerDigits[i];
  jdig = IntegerDigits[j];
  samedigits = Intersection[idig, jdig];
  ff = i/j;
  If[samedigits != {},
   r = {};
   Do[
    p = Flatten[Position[idig, s]];
    q = Flatten[Position[jdig, s]];
    p = FromDigits[Delete[idig, #]] & /@ p;
    q = FromDigits[Delete[jdig, #]] & /@ q;
    tmp = Select[Tuples[{p, q}], #[[1]]/#[[2]] == ff &];
    If[Length[tmp] > 0,
     r = Join[r, Join[#, {i, j, s}] & /@ tmp];
     ];
    ,
    {s, samedigits}
    ];
   r
   ,
   {}
   ]
  ]
ijs = Select[Select[Range[1, 9999], IntegerDigits /* FreeQ[0]], IntegerDigits /* DuplicateFreeQ];
res = Reap[
    Do[
     Do[
      num = ijs[[i]];
      den = ijs[[j]];
      out = AnomalousCancellationQ2[{num, den}];
      If[Length[out] > 0,
       Sow[out]
       ]
      ,
      {i, 1, j - 1}
      ]
     ,
     {j, Length[ijs]}
     ]
    ][[2, 1]];

tmp = Catenate[res];

sel = [email protected][tmp, IntegerLength[#[[3]]] == IntegerLength[#[[4]]] == 2 &];
Length[sel]
t = Take[sel, UpTo[12]];
Column[Row[{#3, "/", #4, " = ", #1, "/", #2, " by removing ", #5}] & @@@ t]
SortBy[Tally[sel[[All, -1]]], First]

sel = [email protected][tmp, IntegerLength[#[[3]]] == IntegerLength[#[[4]]] == 3 &];
Length[sel]
t = Take[sel, UpTo[12]];
Column[Row[{#3, "/", #4, " = ", #1, "/", #2, " by removing ", #5}] & @@@ t]
SortBy[Tally[sel[[All, -1]]], First]

sel = [email protected][tmp, IntegerLength[#[[3]]] == IntegerLength[#[[4]]] == 4 &];
Length[sel]
t = Take[sel, UpTo[12]];
Column[Row[{#3, "/", #4, " = ", #1, "/", #2, " by removing ", #5}] & @@@ t]
SortBy[Tally[sel[[All, -1]]], First]


%Fraction Reduction. Nigel Galloway, September 5th., 2019
include "alldifferent.mzn"; include "member.mzn";
int: S;
array [1..9] of int: Pn=[1,10,100,1000,10000,100000,1000000,10000000,100000000];
array [1..S] of var 1..9: Nz; constraint alldifferent(Nz);
array [1..S] of var 1..9: Gz; constraint alldifferent(Gz);
var  int: n; constraint n=sum(n in 1..S)(Nz[n]*Pn[n]);
var  int: i; constraint i=sum(n in 1..S)(Gz[n]*Pn[n]); constraint n<i; constraint n*g=i*e;
var  int: g; constraint g=sum(n in 1..S)(if n=a then 0 elseif n>a then Gz[n]*Pn[n-1] else Gz[n]*Pn[n] endif);
var  int: e; constraint e=sum(n in 1..S)(if n=l then 0 elseif n>l then Nz[n]*Pn[n-1] else Nz[n]*Pn[n] endif);
var 1..S: l; constraint Nz[l]=w;
var 1..S: a; constraint Gz[a]=w;
var 1..9: w; constraint member(Nz,w) /\ member(Gz,w);

output [show(n)++"/"++show(i)++" becomes "++show(e)++"/"++show(g)++" when "++show(w)++" is omitted"]


# Fraction reduction.

import strformat
import times

type Result = tuple[n: int, nine: array[1..9, int]]

template find[T; N: static int](a: array[1..N, T]; value: T): int =
  ## Return the one-based index of a value in an array.
  ## This is needed as "system.find" returns a 0-based index even if the
  ## array lower bound is not null.
  system.find(a, value) + 1

func toNumber(digits: seq[int]; removeDigit: int = 0): int =
  ## Convert a list of digits into a number.
  var digits = digits
  if removeDigit != 0:
    let idx = digits.find(removeDigit)
    digits.delete(idx)
  for d in digits:
    result = 10 * result + d

func nDigits(n: int): seq[Result] =
  var digits = newSeq[int](n + 1)   # Allocating one more to work with one-based indexes.
  var used: array[1..9, bool]
  for i in 1..n:
    digits[i] = i
    used[i] = true
  var terminated = false
  while not terminated:
    var nine: array[1..9, int]
    for i in 1..9:
      if used[i]:
        nine[i] = digits.toNumber(i)
    result &= (n: digits.toNumber(), nine: nine)
    block searchLoop:
      terminated = true
      for i in countdown(n, 1):
        let d = digits[i]
        doAssert(used[d], "Encountered an inconsistency with 'used' array")
        used[d] = false
        for j in (d + 1)..9:
          if not used[j]:
            used[j] = true
            digits[i] = j
            for k in (i + 1)..n:
              digits[k] = used.find(false)
              used[digits[k]] = true
            terminated = false
            break searchLoop

let start = gettime()

for n in 2..6:
  let rs = nDigits(n)
  var count = 0
  var omitted: array[1..9, int]
  for i in 1..<rs.high:
    let (xn, rn) = rs[i]
    for j in (i + 1)..rs.high:
      let (xd, rd) = rs[j]
      for k in 1..9:
        let yn = rn[k]
        let yd = rd[k]
        if yn != 0 and yd != 0 and xn * yd == yn * xd:
          inc count
          inc omitted[k]
          if count <= 12:
            echo &"{xn}/{xd} => {yn}/{yd} (removed {k})"

  echo &"{n}-digit fractions found: {count}, omitted {omitted}\n"
echo &"Took {gettime() - start}"


program FracRedu;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$OPTIMIZATION ON,ALL}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  SysUtils;

type
  tdigit = 0..9;
const
  cMaskDgt: array [tdigit] of Uint32 = (1, 2, 4, 8, 16, 32, 64, 128, 256, 512
    {,1024,2048,4096,8193,16384,32768});
  cMaxDigits = High(tdigit);
type
  tPermfield = array[tdigit] of uint32;
  tpPermfield = ^tPermfield;

  tDigitCnt = array[tdigit] of Uint32;

  tErg = record
           numUsedDigits : Uint32;
           numUnusedDigit : array[tdigit] of Uint32;
           numNormal : Uint64;// so sqr of number stays in Uint64
           dummy : array[0..7] of byte;//-> sizeof(tErg) = 64
         end;
  tpErg = ^tErg;
var
  Erg: array of tErg;
  pf_x, pf_y: tPermfield;
  DigitCnt :tDigitCnt;
  permcnt, UsedDigits,Anzahl: NativeUint;

  function Fakultaet(i: integer): integer;
  begin
    Result := 1;
    while i > 1 do
    begin
      Result := Result * i;
      Dec(i);
    end;
  end;

  procedure OutErg(dgt: Uint32;pi,pJ:tpErg);
  begin
    writeln(dgt:3,'  ', pi^.numUnusedDigit[dgt],'/',pj^.numUnusedDigit[dgt]
            ,' = ',pi^.numNormal,'/',pj^.numNormal);
  end;

  function Check(pI,pJ : tpErg;Nud :Word):integer;
  var
    dgt: NativeInt;
  Begin
    result := 0;
    dgt := 1;
    NUD := NUD SHR 1;
    repeat
      IF NUD AND 1 <> 0 then
      Begin
        If  pI^.numNormal*pJ^.numUnusedDigit[dgt] = pJ^.numNormal*pI^.numUnusedDigit[dgt] then
        Begin
          inc(result);
          inc(DigitCnt[dgt]);
          IF Anzahl < 110 then
            OutErg(dgt,pI,pJ);
        end;
      end;
      inc(dgt);
      NUD := NUD SHR 1;
    until NUD = 0;
  end;

  procedure CheckWithOne(pI : tpErg;j,Nud:Uint32);
  var
    pJ : tpErg;
    l : NativeUInt;
  Begin
    pJ := pI;
    if UsedDigits <5 then
    Begin
      for j := j+1 to permcnt do
      begin
        inc(pJ);
        //digits used by both numbers
        l := NUD AND pJ^.numUsedDigits;
        IF l <> 0 then
          inc(Anzahl,Check(pI,pJ,l));
      end;
    end
    else
    Begin
      for j := j+1 to permcnt do
      begin
        inc(pJ);
        l := NUD AND pJ^.numUsedDigits;
        inc(Anzahl,Check(pI,pJ,l));
      end;
    end;
  end;

  procedure SearchMultiple;
  var
    pI : tpErg;
    i : NativeUInt;
  begin
    pI := @Erg[0];
    for i := 0 to permcnt do
    Begin
      CheckWithOne(pI,i,pI^.numUsedDigits);
      inc(pI);
    end;
  end;

  function BinomCoeff(n, k: byte): longint;
  var
    i: longint;
  begin
    {n ueber k  = n ueber (n-k) , also kuerzere Version waehlen}
    if k > n div 2 then
      k := n - k;
    Result := 1;
    if k <= n then
      for i := 1 to k do
        Result := Result * (n - i + 1) div i;{geht immer  ohne Rest }
  end;

  procedure InsertToErg(var E: tErg; const x: tPermfield);
  var
    n : Uint64;
    k,i,j,dgt,nud: NativeInt;
  begin
    // k of PermKoutofN is reduced by one for 9 digits
    k := UsedDigits;
    n := 0;
    nud := 0;
    for i := 1 to k do
    begin
      dgt := x[i];
      nud := nud or cMaskDgt[dgt];
      n := n * 10 + dgt;
    end;
    with E do
    begin
      numUsedDigits := nud;
      numNormal := n;
    end;
    //calc all numbers with one removed digit
    For J := k downto 1 do
    Begin
      n := 0;
      for i := 1 to j-1 do
        n := n * 10 + x[i];
      for i := j+1 to k do
        n := n * 10 + x[i];
      E.numUnusedDigit[x[j]] := n;
    end;
  end;

  procedure PermKoutofN(k, n: nativeInt);
  var
    x, y: tpPermfield;
    i, yi, tmp: NativeInt;
  begin
    //initialise
    x := @pf_x;
    y := @pf_y;
    permcnt := 0;
    if k > n then
      k := n;
    if k = n then
      k := k - 1;
    for i := 1 to n do
      x^[i] := i;
    for i := 1 to k do
      y^[i] := i;

    InserttoErg(Erg[permcnt], x^);
    i := k;
    repeat
      yi := y^[i];
      if yi < n then
      begin
        Inc(permcnt);
        Inc(yi);
        y^[i] := yi;
        tmp := x^[i];
        x^[i] := x^[yi];
        x^[yi] := tmp;
        i := k;
        InserttoErg(Erg[permcnt], x^);
      end
      else
      begin
        repeat
          tmp := x^[i];
          x^[i] := x^[yi];
          x^[yi] := tmp;
          Dec(yi);
        until yi <= i;
        y^[i] := yi;
        Dec(i);
      end;
    until (i = 0);
  end;

  procedure OutDigitCount;
   var
     i : tDigit;
  Begin
    writeln('omitted digits 1 to 9');
    For i := 1 to 9do
      write(DigitCnt[i]:UsedDigits);
    writeln;
  end;

  procedure ClearDigitCount;
   var
     i : tDigit;
  Begin
    For i := low(DigitCnt) to high(DigitCnt) do
      DigitCnt[i] := 0;
  end;

var
  t1, t0: TDateTime;
begin
  For UsedDigits := 8 to 9 do
  Begin
    writeln('Used digits ',UsedDigits);
    T0 := now;
    ClearDigitCount;
    setlength(Erg, Fakultaet(UsedDigits) * BinomCoeff(cMaxDigits, UsedDigits));
    Anzahl := 0;
    permcnt := 0;
    PermKoutOfN(UsedDigits, cMaxDigits);
    SearchMultiple;
    T1 := now;
    writeln('Found solutions ',Anzahl);
    OutDigitCount;
    writeln('time taken ',FormatDateTime('HH:NN:SS.zzz', T1 - T0));
    setlength(Erg, 0);
    writeln;
  end;
end.


toFrac=: '/r' 0&"[email protected] ]                           NB. read fractions from string
fractran15=: ({~ (= <.) i. 1:)@([email protected][ * ]) ^:(<15)  NB. return first 15 Fractran results


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();
   }
}


use strict;
use warnings;
use feature 'say';
use List::Util qw<sum uniq uniqnum head tail>;

for my $exp (map { $_ - 1 } <2 3 4>) {
    my %reduced;
    my $start = sum map { 10 ** $_ * ($exp - $_ + 1) } 0..$exp;
    my $end   = 10**($exp+1) - -1 + sum map { 10 ** $_ * ($exp - $_) } 0..$exp-1;

    for my $den ($start .. $end-1) {
        next if $den =~ /0/ or (uniqnum split '', $den) <= $exp;
        for my $num ($start .. $den-1) {
            next if $num =~ /0/ or (uniqnum split '', $num) <= $exp;
            my %i;
            map { $i{$_}++ } (uniq head -1, split '',$den), uniq tail -1, split '',$num;
            my @set = grep { $_ if $i{$_} > 1 } keys %i;
            next if @set < 1;
            for (@set) {
                (my $ne = $num) =~ s/$_//;
                (my $de = $den) =~ s/$_//;
                if ($ne/$de == $num/$den) {
                    $reduced{"$num/$den:$_"} = "$ne/$de";
                }
            }
        }
    }
    my $digit = $exp + 1;
    say "\n" . +%reduced . " $digit-digit reducible fractions:";
    for my $n (1..9) {
        my $cnt = scalar grep { /:$n/ } keys %reduced;
        say "$cnt with removed $n" if $cnt;
    }
    say "\n  12 (or all, if less) $digit-digit reducible fractions:";
    for my $f (head 12, sort keys %reduced) {
        printf "    %s => %s removed %s\n", substr($f,0,$digit*2+1), $reduced{$f}, substr($f,-1)
    }
}


// Parses the input string for the numerators and denominators
function compile(prog, numArr, denArr) {
    let regex = /\s*(\d*)\s*\/\s*(\d*)\s*(.*)/m;
    let result;
    while (result = regex.exec(prog)) {
        numArr.push(result[1]);
        denArr.push(result[2]);
        prog = result[3];
    }
    return [numArr, denArr];
}

// Outputs the result of the compile stage
function dump(numArr, denArr) {
    let output = "";
    for (let i in numArr) {
        output += `${numArr[i]}/${denArr[i]} `;
    }
    return `${output}<br>`;
}

// Step
function step(val, numArr, denArr) {
    let i = 0;
    while (i < denArr.length && val % denArr[i] != 0) i++;
    return numArr[i] * val / denArr[i];
}

// Executes Fractran
function exec(val, i, limit, numArr, denArr) {
    let output = "";
    while (val && i < limit) {
        output += `${i}: ${val}<br>`;
        val = step(val, numArr, denArr);
        i++;
    }
    return output;
}

// Main
// Outputs to DOM (clears and writes at the body tag)
let body = document.body;
let [num, den] = 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", [], []);
body.innerHTML = dump(num, den);
body.innerHTML += exec(2, 0, 15, num, den);


with javascript_semantics
function to_n(sequence digits, integer remove_digit=0)
    if remove_digit!=0 then
        digits = deep_copy(digits)
        integer d = find(remove_digit,digits)
        digits[d..d] = {}
    end if
    integer res = digits[1]
    for i=2 to length(digits) do
        res = res*10+digits[i]
    end for
    return res
end function

function ndigits(integer n)
-- generate numbers with unique digits efficiently
-- and store them in an array for multiple re-use,
-- along with an array of the removed-digit values.
    sequence res = {},
             digits = tagset(n),
             used = repeat(1,n)&repeat(0,9-n)
    while true do
        sequence nine = repeat(0,9)
        for i=1 to length(used) do
            if used[i] then
                nine[i] = to_n(digits,i)
            end if
        end for
        res = append(res,{to_n(digits),nine})
        bool found = false
        for i=n to 1 by -1 do
            integer d = digits[i]
            if not used[d] then ?9/0 end if
            used[d] = 0
            for j=d+1 to 9 do
                if not used[j] then
                    used[j] = 1
                    digits[i] = j
                    for k=i+1 to n do
                        digits[k] = find(0,used)
                        used[digits[k]] = 1
                    end for
                    found = true
                    exit
                end if
            end for
            if found then exit end if
        end for
        if not found then exit end if
    end while
    return res
end function

atom t0 = time(),
     t1 = time()+1
--for n=2 to 6 do
for n=2 to 4 do
    sequence d = ndigits(n)
    integer count = 0
    sequence omitted = repeat(0,9)
    for i=1 to length(d)-1 do
        {integer xn, sequence rn} = d[i]
        for j=i+1 to length(d) do
            {integer xd, sequence rd} = d[j]
            for k=1 to 9 do
                integer yn = rn[k], yd = rd[k]
                if yn!=0 and yd!=0 and xn/xd = yn/yd then
                    count += 1
                    omitted[k] += 1
                    if count<=12 then
                        printf(1,"%d/%d => %d/%d (removed %d)\n",{xn,xd,yn,yd,k})
                    elsif time()>t1 and platform()!=JS then
                        printf(1,"working (%d/%d)...\r",{i,length(d)})
                        t1 = time()+1
                    end if
                end if
            end for
        end for
    end for
    printf(1,"%d-digit fractions found:%d, omitted %v\n\n",{n,count,omitted})
end for
?elapsed(time()-t0)


function fractran(n::Integer, ratios::Vector{<:Rational}, steplim::Integer)
    rst = zeros(BigInt, steplim)
    for i in 1:steplim
        rst[i] = n
        if (pos = findfirst(x -> isinteger(n * x), ratios)) > 0
            n *= ratios[pos]
        else
            break
        end
    end
    return rst
end

using IterTools
macro ratio_str(s)
    a = split(s, r"[\s,/]+")
    return collect(parse(BigInt, n) // parse(BigInt, d) for (n, d) in partition(a, 2))
end

fracs = ratio"""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"""
println("The first 20 in the series are ", fractran(2, fracs, 20))

prmfound = 0
n = big(2)
while prmfound < 20
    global n
    global prmfound
    if isinteger(log2(n))
        prmfound += 1
        println("Prime $prmfound found: $n is 2 ^ $(Int(log2(n)))")
    end
    n = fractran(n, fracs, 2)[2]
end


// version 1.1.3

import java.math.BigInteger

class Fraction(val num: BigInteger, val denom: BigInteger) {
    operator fun times(n: BigInteger) = Fraction (n * num, denom)

    fun isIntegral() = num % denom == BigInteger.ZERO
}

fun String.toFraction(): Fraction {
    val split = this.split('/')
    return Fraction(BigInteger(split[0]), BigInteger(split[1]))
}

val BigInteger.isPowerOfTwo get() = this.and(this - BigInteger.ONE) == BigInteger.ZERO

val log2 = Math.log(2.0)

fun fractran(program: String, n: Int, limit: Int, primesOnly: Boolean): List<Int> {
    val fractions = program.split(' ').map { it.toFraction() }
    val results = mutableListOf<Int>()
    if (!primesOnly) results.add(n)
    var nn = BigInteger.valueOf(n.toLong())
    while (results.size < limit) {
        val frac = fractions.find { (it * nn).isIntegral() } ?: break
        nn = nn * frac.num / frac.denom
        if (!primesOnly) {
           results.add(nn.toInt())
        }
        else if (primesOnly && nn.isPowerOfTwo) {
           val prime = (Math.log(nn.toDouble()) / log2).toInt()
           results.add(prime)
        }
    }
    return results
}

fun main(args: Array<String>) {
    val program = "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"
    println("First twenty numbers:")
    println(fractran(program, 2, 20, false))
    println("\nFirst twenty primes:")
    println(fractran(program, 2, 20, true))
}


def indexOf(haystack, needle):
    idx = 0
    for straw in haystack:
        if straw == needle:
            return idx
        else:
            idx += 1
    return -1

def getDigits(n, le, digits):
    while n > 0:
        r = n % 10
        if r == 0 or indexOf(digits, r) >= 0:
            return False
        le -= 1
        digits[le] = r
        n = int(n / 10)
    return True

def removeDigit(digits, le, idx):
    pows = [1, 10, 100, 1000, 10000]
    sum = 0
    pow = pows[le - 2]
    i = 0
    while i < le:
        if i == idx:
            i += 1
            continue
        sum = sum + digits[i] * pow
        pow = int(pow / 10)
        i += 1
    return sum

def main():
    lims = [ [ 12, 97 ], [ 123, 986 ], [ 1234, 9875 ], [ 12345, 98764 ] ]
    count = [0 for i in range(5)]
    omitted = [[0 for i in range(10)] for j in range(5)]

    i = 0
    while i < len(lims):
        n = lims[i][0]
        while n < lims[i][1]:
            nDigits = [0 for k in range(i + 2)]
            nOk = getDigits(n, i + 2, nDigits)
            if not nOk:
                n += 1
                continue
            d = n + 1
            while d <= lims[i][1] + 1:
                dDigits = [0 for k in range(i + 2)]
                dOk = getDigits(d, i + 2, dDigits)
                if not dOk:
                    d += 1
                    continue
                nix = 0
                while nix < len(nDigits):
                    digit = nDigits[nix]
                    dix = indexOf(dDigits, digit)
                    if dix >= 0:
                        rn = removeDigit(nDigits, i + 2, nix)
                        rd = removeDigit(dDigits, i + 2, dix)
                        if (1.0 * n / d) == (1.0 * rn / rd):
                            count[i] += 1
                            omitted[i][digit] += 1
                            if count[i] <= 12:
                                print "%d/%d = %d/%d by omitting %d's" % (n, d, rn, rd, digit)
                    nix += 1
                d += 1
            n += 1
        print
        i += 1

    i = 2
    while i <= 5:
        print "There are %d %d-digit fractions of which:" % (count[i - 2], i)
        j = 1
        while j <= 9:
            if omitted[i - 2][j] == 0:
                j += 1
                continue
            print "%6s have %d's omitted" % (omitted[i - 2][j], j)
            j += 1
        print
        i += 1
    return None

main()


fractionlist = {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 = 2;
steplimit = 20;
j = 0;
break = False;
While[break == False && j <= steplimit,
 newlist = n fractionlist;
 isintegerlist = IntegerQ[#] & /@ newlist;
 truepositions = Position[isintegerlist, True];
 If[Length[truepositions] == 0,
  break = True,
  Print[ToString[j] <> ": " <> ToString[n]];
  n = newlist[[truepositions[[1, 1]]]]; j++;
  ]
 ]


import strutils
import bignum

const PrimeProg = "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"

iterator values(prog: openArray[Rat]; init: Natural): Int =
  ## Run the program "prog" with initial value "init" and yield the values.
  var n = newInt(init)
  var next: Rat
  while true:
    for fraction in prog:
      next = n * fraction
      if next.denom == 1:
        break
    n = next.num
    yield n

func toFractions(fractList: string): seq[Rat] =
  ## Convert a string to a list of fractions.
  for f in fractList.split():
    result.add(newRat(f))

proc run(progStr: string; init, maxSteps: Natural = 0) =
  ## Run the program described by string "progStr" with initial value "init",
  ## stopping after "maxSteps" (0 means for ever).
  ## Display the value after each step.
  let prog = progStr.toFractions()
  var stepCount = 0
  for val in prog.values(init):
    inc stepCount
    echo stepCount, ": ", val
    if stepCount == maxSteps:
      break

iterator primes(n: Natural): int =
  # Yield the list of first "n" primes.
  let prog = PrimeProg.toFractions()
  var count = 0
  for val in prog.values(2):
    if isZero(val and (val - 1)):
      # This is a power of two.
      yield val.digits(2) - 1   # Compute the exponent as number of binary digits minus one.
      inc count
      if count == n:
        break

# Run the program to compute primes displaying values at each step and stopping after 10 steps.
echo "First ten steps for program to find primes:"
PrimeProg.run(2, 10)

# Find the first 20 primes.
echo "\nFirst twenty prime numbers:"
for val in primes(20):
  echo val


#lang racket

(require racket/generator
         syntax/parse/define)

(define-syntax-parser for**
  [(_ [x:id {~datum <-} (e ...)] rst ...) #'(e ... (λ (x) (for** rst ...)))]
  [(_ e ...) #'(begin e ...)])

(define (permutations xs n yield #:lower [lower #f])
  (let loop ([xs xs] [n n] [acc '()] [lower lower])
    (cond
      [(= n 0) (yield (reverse acc))]
      [else (for ([x (in-list xs)] #:when (or (not lower) (>= x (first lower))))
              (loop (remove x xs)
                    (sub1 n)
                    (cons x acc)
                    (and lower (= x (first lower)) (rest lower))))])))

(define (list->number xs) (foldl (λ (e acc) (+ (* 10 acc) e)) 0 xs))

(define (calc n)
  (define rng (range 1 10))
  (in-generator
   (for** [numer <- (permutations rng n)]
          [denom <- (permutations rng n #:lower numer)]
          (for* (#:when (not (equal? numer denom))
                 [crossed (in-list numer)]
                 #:when (member crossed denom)
                 [numer* (in-value (list->number (remove crossed numer)))]
                 [denom* (in-value (list->number (remove crossed denom)))]
                 [numer** (in-value (list->number numer))]
                 [denom** (in-value (list->number denom))]
                 #:when (= (* numer** denom*) (* numer* denom**)))
            (yield (list numer** denom** numer* denom* crossed))))))

(define (enumerate n)
  (for ([x (calc n)] [i (in-range 12)])
    (apply printf "~a/~a = ~a/~a (~a crossed out)\n" x))
  (newline))

(define (stats n)
  (define digits (make-hash))
  (for ([x (calc n)]) (hash-update! digits (last x) add1 0))
  (printf "There are ~a ~a-digit fractions of which:\n" (for/sum ([(k v) (in-hash digits)]) v) n)
  (for ([digit (in-list (sort (hash->list digits) < #:key car))])
    (printf "  The digit ~a was crossed out ~a times\n" (car digit) (cdr digit)))
  (newline))

(define (main)
  (enumerate 2)
  (enumerate 3)
  (enumerate 4)
  (enumerate 5)
  (stats 2)
  (stats 3)
  (stats 4)
  (stats 5))

(main)


my %reduced;
my $digits = 2..4;

for $digits.map: * - 1 -> $exp {
    my $start = sum (0..$exp).map( { 10 ** $_ * ($exp - $_ + 1) });
    my $end   = 10**($exp+1) - sum (^$exp).map( { 10 ** $_ * ($exp - $_) } ) - 1;

    ($start ..^ $end).race(:8degree, :3batch).map: -> $den {
        next if $den.contains: '0';
        next if $den.comb.unique <= $exp;

        for $start ..^ $den -> $num {
            next if $num.contains: '0';
            next if $num.comb.unique <= $exp;

            my $set = ($den.comb.head(* - 1).Set ∩ $num.comb.skip(1).Set);
            next if $set.elems < 1;

            for $set.keys {
                my $ne = $num.trans: $_ => '', :delete;
                my $de = $den.trans: $_ => '', :delete;
                if $ne / $de == $num / $den {
                    print "\b" x 40, "$num/$den:$_ => $ne/$de";
                    %reduced{"$num/$den:$_"} = "$ne/$de";
                }
            }
        }
    }

    print "\b" x 40, ' ' x 40, "\b" x 40;

    my $digit = $exp +1;
    my %d = %reduced.pairs.grep: { .key.chars == ($digit * 2 + 3) };
    say "\n({+%d}) $digit digit reduceable fractions:";
    for 1..9 {
        my $cnt = +%d.pairs.grep( *.key.contains: ":$_" );
        next unless $cnt;
        say "  $cnt with removed $_";
    }
    say "\n  12 Random (or all, if less) $digit digit reduceable fractions:";
    say "    {.key.substr(0, $digit * 2 + 1)} => {.value} removed {.key.substr(* - 1)}"
      for %d.pairs.pick(12).sort;
}


open Num

let get_input () =
   num_of_int (
     try int_of_string Sys.argv.(1)
     with _ -> 10)

let get_max_steps () =
   try int_of_string Sys.argv.(2)
   with _ -> 50

let read_program () =
   let line = read_line () in
   let words = Str.split (Str.regexp " +") line in
   List.map num_of_string words

let is_int n = n =/ (integer_num n)

let run_program num prog =

   let replace n =
      let rec step = function
      | [] -> None
      | h :: t ->
            let n' = h */ n in
            if is_int n' then Some n' else step t in
      step prog in

   let rec repeat m lim =
      Printf.printf "  %s\n" (string_of_num m);
      if lim = 0 then print_endline "Reached max step limit" else
         match replace m with
         | None -> print_endline "Finished"
         | Some x -> repeat x (lim-1)
   in

   let max_steps = get_max_steps () in
   repeat num max_steps

let () =
   let num = get_input () in
   let prog = read_program () in
   run_program num prog


/*REXX pgm reduces fractions by "crossing out" matching digits in nominator&denominator.*/
parse arg high show .                            /*obtain optional arguments from the CL*/
if high=='' | high==","  then high=  4           /*Not specified?  Then use the default.*/
if show=='' | show==","  then show= 12           /* "      "         "   "   "     "    */
say center(' some samples of reduced fractions by crossing out digits ', 79, "═")
$.=0                                             /*placeholder array for counts; init. 0*/
      do L=2  to high;      say                  /*do 2-dig fractions to HIGH-dig fract.*/
                            lim= 10**L - 1       /*calculate the upper limit just once. */
         do n=10**(L-1)  to lim                  /*generate some  N  digit  fractions.  */
         if pos(0, n) \==0  then iterate         /*Does  it  have a zero?  Then skip it.*/
         if hasDup(n)       then iterate         /*  "    "    "  " dup?     "    "   " */

            do d=n+1     to lim                           /*only process like-sized #'s */
            if pos(0, d)\==0         then iterate         /*Have a zero? Then skip it.  */
            if verify(d, n, 'M')==0  then iterate         /*No digs in common?  Skip it.*/
            if hasDup(d)             then iterate         /*Any digs are dups?    "   " */
            q= n/d                                        /*compute quotient just once. */
                  do e=1  for L;     xo= substr(n, e, 1)  /*try crossing out each digit.*/
                  nn= space( translate(n, , xo), 0)       /*elide from the numerator.   */
                  dd= space( translate(d, , xo), 0)       /*  "     "   "  denominator. */
                  if nn/dd \== q  then iterate            /*Not the same quotient? Skip.*/
                  $.L=    $.L    + 1                      /*Eureka!   We found one.     */
                  $.L.xo= $.L.xo + 1                      /*count the silly reduction.  */
                  if $.L>show  then iterate               /*Too many found?  Don't show.*/
                  say center(n'/'d   " = "   nn'/'dd  "  by crossing out the" xo"'s.", 79)
                  end   /*e*/
            end         /*d*/
         end            /*n*/
      end               /*L*/
say;                  @with= ' with crossed-out' /* [↓]  show counts for any reductions.*/
      do k=1  for 9                              /*traipse through each cross─out digit.*/
      if $.k==0  then iterate                    /*Is this a zero count?  Then skip it. */
      say;    say center('There are '     $.k     " "k'-digit fractions.', 79, "═")
                          @for= '          For ' /*literal for SAY indentation (below). */
         do #=1  for 9;   if $.k.#==0  then iterate
         say @for    k"-digit fractions, there are "    right($.k.#, k-1)   @with   #"'s."
         end   /*#*/
      end      /*k*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hasDup: parse arg x;          /* if L<2  then return 0 */           /*L will never be 1.*/
           do i=1  for L-1;      if pos(substr(x,i,1), substr(x,i+1)) \== 0  then return 1
           end   /*i*/;                                                           return 0


def indexOf(haystack, needle)
    idx = 0
    for straw in haystack
        if straw == needle then
            return idx
        else
            idx = idx + 1
        end
    end
    return -1
end

def getDigits(n, le, digits)
    while n > 0
        r = n % 10
        if r == 0 or indexOf(digits, r) >= 0 then
            return false
        end
        le = le - 1
        digits[le] = r
        n = (n / 10).floor
    end
    return true
end

POWS = [1, 10, 100, 1000, 10000]
def removeDigit(digits, le, idx)
    sum = 0
    pow = POWS[le - 2]
    i = 0
    while i < le
        if i == idx then
            i = i + 1
            next
        end
        sum = sum + digits[i] * pow
        pow = (pow / 10).floor
        i = i + 1
    end
    return sum
end

def main
    lims = [ [ 12, 97 ], [ 123, 986 ], [ 1234, 9875 ], [ 12345, 98764 ] ]
    count = Array.new(5, 0)
    omitted = Array.new(5) { Array.new(10, 0) }

    i = 0
    for lim in lims
        n = lim[0]
        while n < lim[1]
            nDigits = [0] * (i + 2)
            nOk = getDigits(n, i + 2, nDigits)
            if not nOk then
                n = n + 1
                next
            end
            d = n + 1
            while d <= lim[1] + 1
                dDigits = [0] * (i + 2)
                dOk = getDigits(d, i + 2, dDigits)
                if not dOk then
                    d = d + 1
                    next
                end
                nix = 0
                while nix < nDigits.length
                    digit = nDigits[nix]
                    dix = indexOf(dDigits, digit)
                    if dix >= 0 then
                        rn = removeDigit(nDigits, i + 2, nix)
                        rd = removeDigit(dDigits, i + 2, dix)
                        if (1.0 * n / d) == (1.0 * rn / rd) then
                            count[i] = count[i] + 1
                            omitted[i][digit] = omitted[i][digit] + 1
                            if count[i] <= 12 then
                                print "%d/%d = %d/%d by omitting %d's\n" % [n, d, rn, rd, digit]
                            end
                        end
                    end
                    nix = nix + 1
                end
                d = d + 1
            end
            n = n + 1
        end
        print "\n"
        i = i + 1
    end

    i = 2
    while i <= 5
        print "There are %d %d-digit fractions of which:\n" % [count[i - 2], i]
        j = 1
        while j <= 9
            if omitted[i - 2][j] == 0 then
                j = j + 1
                next
            end
            print "%6s have %d's omitted\n" % [omitted[i - 2][j], j]
            j = j + 1
        end
        print "\n"
        i = i + 1
    end
end

main()


without js -- 8s
--with javascript_semantics -- 52s!! (see note)
constant steps = 20,
         primes = 45

sequence known_factors = {} -- nb: no specific order

function combine_factors(sequence n)
-- (inverse of as_primes)
    atom res = 1
    for i=1 to length(n) do
        if n[i]!=0 then
            res *= power(known_factors[i],n[i])
        end if
    end for
    return res
end function

function as_primes(integer n)
-- eg as_primes(55) -> {5,11} -> indexes to known_factors
    if n=1 then return {} end if
    sequence pf = prime_factors(n,duplicates:=true)
    sequence res = repeat(0,length(known_factors))
    for i=1 to length(pf) do
        integer k = find(pf[i],known_factors)
        if k=0 then
            known_factors = append(known_factors,pf[i])
            res = append(res,1)
        else
            res[k] += 1
        end if
    end for
--  atom chk = combine_factors(res)
--  if chk!=n then ?9/0 end if
    return res
end function

function parse(string s)
    sequence res = split(s)
    for i=1 to length(res) do
        sequence sri = scanf(res[i],"%d/%d")
        if length(sri)!=1 then ?9/0 end if  -- oops!
        integer {{n,d}} = sri
        res[i] = {as_primes(n),as_primes(d)}
    end for
    return res
end function

function step(sequence pgm, sequence n)
    for pc=1 to length(pgm) do
        sequence d = pgm[pc][2], res = n
--      sequence d = pgm[pc][2], res = deep_copy(n) -- (see timing note)
        bool ok = true
        for f=1 to length(d) do
            integer df = d[f]
            if df!=0 then
                if f>length(n) or df>n[f] then
                    ok = false
                    exit
                end if
                res[f] -= df
            end if
        end for
        if ok then
            n = pgm[pc][1]
            integer zf = length(n)-length(res)
            if zf>0 then res &= repeat(0,zf) end if
            for i=1 to length(n) do
                res[i] += n[i]
            end for
            return res
        end if
    end for
    return 0
end function

constant src = "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"
sequence pgm = parse(src)
object n = as_primes(2)
sequence res = {}
for i=1 to steps do
    n = step(pgm,n)
    if n=0 then exit end if
    res = append(res,combine_factors(n))
end for
printf(1,"first %d results: %v\n",{steps,res})

n = as_primes(2)
integer k2 = find(2,known_factors)
sequence n0 = repeat(0,length(known_factors))
res = {}
integer iteration = 1
atom t0 = time()
while length(res)<primes do
    n = step(pgm,n)
    if n=0 then exit end if
    n0[k2] = n[k2]
    if n=n0 then -- (ie all non-2 are 0)
        -- and the prime itself is ready and waiting...
        res = append(res,n[k2])
    end if
    iteration += 1
end while
printf(1,"first %d primes: %v\n",{primes,res})
printf(1,"%,d iterations in %s\n",{iteration,elapsed(time()-t0)})


Module Module1

    Function IndexOf(n As Integer, s As Integer()) As Integer
        For ii = 1 To s.Length
            Dim i = ii - 1
            If s(i) = n Then
                Return i
            End If
        Next
        Return -1
    End Function

    Function GetDigits(n As Integer, le As Integer, digits As Integer()) As Boolean
        While n > 0
            Dim r = n Mod 10
            If r = 0 OrElse IndexOf(r, digits) >= 0 Then
                Return False
            End If
            le -= 1
            digits(le) = r
            n \= 10
        End While
        Return True
    End Function

    Function RemoveDigit(digits As Integer(), le As Integer, idx As Integer) As Integer
        Dim pows = {1, 10, 100, 1000, 10000}
        Dim sum = 0
        Dim pow = pows(le - 2)
        For ii = 1 To le
            Dim i = ii - 1
            If i = idx Then
                Continue For
            End If
            sum += digits(i) * pow
            pow \= 10
        Next
        Return sum
    End Function

    Sub Main()
        Dim lims = {{12, 97}, {123, 986}, {1234, 9875}, {12345, 98764}}
        Dim count(5) As Integer
        Dim omitted(5, 10) As Integer
        Dim upperBound = lims.GetLength(0)
        For ii = 1 To upperBound
            Dim i = ii - 1
            Dim nDigits(i + 2 - 1) As Integer
            Dim dDigits(i + 2 - 1) As Integer
            Dim blank(i + 2 - 1) As Integer
            For n = lims(i, 0) To lims(i, 1)
                blank.CopyTo(nDigits, 0)
                Dim nOk = GetDigits(n, i + 2, nDigits)
                If Not nOk Then
                    Continue For
                End If
                For d = n + 1 To lims(i, 1) + 1
                    blank.CopyTo(dDigits, 0)
                    Dim dOk = GetDigits(d, i + 2, dDigits)
                    If Not dOk Then
                        Continue For
                    End If
                    For nixt = 1 To nDigits.Length
                        Dim nix = nixt - 1
                        Dim digit = nDigits(nix)
                        Dim dix = IndexOf(digit, dDigits)
                        If dix >= 0 Then
                            Dim rn = RemoveDigit(nDigits, i + 2, nix)
                            Dim rd = RemoveDigit(dDigits, i + 2, dix)
                            If (n / d) = (rn / rd) Then
                                count(i) += 1
                                omitted(i, digit) += 1
                                If count(i) <= 12 Then
                                    Console.WriteLine("{0}/{1} = {2}/{3} by omitting {4}'s", n, d, rn, rd, digit)
                                End If
                            End If
                        End If
                    Next
                Next
            Next
            Console.WriteLine()
        Next

        For i = 2 To 5
            Console.WriteLine("There are {0} {1}-digit fractions of which:", count(i - 2), i)
            For j = 1 To 9
                If omitted(i - 2, j) = 0 Then
                    Continue For
                End If
                Console.WriteLine("{0,6} have {1}'s omitted", omitted(i - 2, j), j)
            Next
            Console.WriteLine()
        Next
    End Sub

End Module


load(Program, Fractions) :-
    re_split("[ ]+", Program, Split), odd_items(Split, TextualFractions),
    maplist(convert_frac, TextualFractions, Fractions).

odd_items(L, L) :- L = [_], !.  % remove the even elements from a list.
odd_items([X,_|L], [X|R]) :- odd_items(L, R).

convert_frac(Text, Frac) :-
    re_matchsub("([0-9]+)/([0-9]+)"/t, Text, Match, []),
    Frac is Match.1 rdiv Match.2.

step(_, [], stop) :- !.
step(N, [F|Fs], R) :-
    A is N*F,
    (integer(A) -> R = A; step(N, Fs, R)).

exec(Prg, Start, Lz) :-
    lazy_list(transition, Prg/Start, Lz).

transition(Prg/N0, Prg/N1, N1) :-
    step(N0, Prg, N1).

steps(K, Start, Prg, Seq) :-
    exec(Prg, Start, Values),
    length(Seq, K), Seq = [Start|Rest], prefix(Rest, Values), !.

% The actual PRIMEGEN program follows...

primegen(Prg) :-
    load("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", Prg).

primes(N, Primes) :-
    primegen(Prg), exec(Prg, 2, Steps),
    length(Primes, N), capture_primes(Primes, Steps).

capture_primes([], _) :- !.
capture_primes([P|Ps], [Q|Qs]) :- pow2(Q), !, P is lsb(Q), capture_primes(Ps, Qs).
capture_primes(Ps, [_|Qs]) :- capture_primes(Ps, Qs).

pow2(X) :- X /\ (X-1) =:= 0.

main :-
    primegen(Prg), steps(15, 2, Prg, Steps),
    format("The first 15 steps from PRIMEGEN are: ~w~n", [Steps]),
    primes(20, Primes),
    format("By running PRIMEGEN we found these primes: ~w~n", [Primes]),
    halt.

?- main.


import "/dynamic" for Struct
import "/fmt" for Fmt

var Result = Struct.create("Result", ["n", "nine"])

var toNumber = Fn.new { |digits, removeDigit|
    var digits2 = digits.toList
    if (removeDigit != 0) {
        var d = digits2.indexOf(removeDigit)
        digits2.removeAt(d)
    }
    var res = digits2[0]
    var i = 1
    while (i < digits2.count) {
        res = res * 10 + digits2[i]
        i = i + 1
    }
    return res
}

var nDigits = Fn.new { |n|
    var res = []
    var digits = List.filled(n, 0)
    var used = List.filled(9, false)
    for (i in 0...n) {
        digits[i] = i + 1
        used[i] = true
    }
    while (true) {
        var nine = List.filled(9, 0)
        for (i in 0...used.count) {
            if (used[i]) nine[i] = toNumber.call(digits, i+1)
        }
        res.add(Result.new(toNumber.call(digits, 0), nine))
        var found = false
        for (i in n-1..0) {
            var d = digits[i]
            if (!used[d-1]) {
                Fiber.abort("something went wrong with 'used' array")
            }
            used[d-1] = false
            var j = d
            while (j < 9) {
                if (!used[j]) {
                    used[j] = true
                    digits[i] = j + 1
                    for (k in i + 1...n) {
                        digits[k] = used.indexOf(false) + 1
                        used[digits[k]-1] = true
                    }
                    found = true
                    break
                }
                j = j + 1
            }
            if (found) break
        }
        if (!found) break
    }
    return res
}

for (n in 2..5) {
    var rs = nDigits.call(n)
    var count = 0
    var omitted = List.filled(9, 0)
    for (i in 0...rs.count-1) {
        var xn = rs[i].n
        var rn = rs[i].nine
        for (j in i + 1...rs.count) {
            var xd = rs[j].n
            var rd = rs[j].nine
            for (k in 0..8) {
                var yn = rn[k]
                var yd = rd[k]
                if (yn != 0 && yd != 0 && xn/xd == yn/yd) {
                    count = count + 1
                    omitted[k] = omitted[k] + 1
                    if (count <= 12) {
                        Fmt.print("$d/$d => $d/$d (removed $d)", xn, xd, yn, yd, k+1)
                    }
                }
            }
        }
    }
    Fmt.print("$d-digit fractions found:$d, omitted $s\n", n, count, omitted)
}


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(',')]

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

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))))


  [ $ "bigrat.qky" loadfile ] now!

  [ 1 & not ]                  is even     (     n --> b     )

  [ nip 1 = ]                  is vint     (   n/d --> b     )

  [ [ dup even while
      1 >> again ]
    1 = ]                      is powerof2 (     n --> b     )

  [ 0 swap
    [ dup even while
      dip 1+
      1 >> again ]
    drop ]                     is lowbit   (     n --> n     )

  [ [] swap nest$
    witheach
      [ char / over find
        space unrot poke
        build nested join ] ]  is parse$   (     $ --> [     )

  [ stack ]                    is program  (     s -->       )

  [ true temp put
    witheach
      [ do 2over v*
        2dup vint iff
          [ false temp replace
            conclude ]
         else 2drop ]
      2swap 2drop
      temp take ]              is run      ( n/d [ --> n/d b )

  [ stack ]                    is primes   (       --> s     )

  $ "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" join
  parse$ program put

  2 n->v
  15 times
    [ program share run
      drop over echo sp ]
  cr
  2drop
  2 n->v
  [] primes put
  [ program share run
    drop over dup powerof2 iff
      [ lowbit primes take
        swap join primes put ]
    else drop
    primes share size 20 = until ]
  2drop
  primes take echo

  program release


fcn toInt(digits,remove_digit=0){
   if(remove_digit!=0) digits=digits.copy().del(digits.index(remove_digit));
   digits.reduce(fcn(s,d){ s*10 + d });
}
fcn nDigits(n){
    //-- generate numbers with unique digits efficiently
    //-- and store them in an array for multiple re-use,
    //-- along with an array of the removed-digit values.
    res,digits := List(), n.pump(List(),'+(1));  // 1,2,3,4..n
    used       := List.createLong(n,1).extend(List.createLong(9-n,0));
    while(True){
       nine:=List.createLong(9,0);
       foreach i in (used.len()){ if(used[i]) nine[i]=toInt(digits,i+1) }
       res.append(T(toInt(digits),nine));
       found:=False;
       foreach i in ([n-1..0, -1]){
          d:=digits[i];
	  if(not used[d-1]) println("ack!");
	  used[d-1]=0;
	  foreach j in ([d..8]){
	     if(not used[j]){
		used[j]=1;
		digits[i]=j+1;
		foreach k in ([i+1..n-1]){
		   digits[k] = used.find(0) + 1;
		   used[digits[k] - 1]=1;
		}
		found=True;
		break;
	     }
	  }
	  if(found) break;
       }//foreach i
       if(not found) break;
    }//while
    res
}

foreach n in ([2..5]){
   rs,rsz,count,omitted := nDigits(n),rs.len()-1, 0, List.createLong(9,0);
   foreach i in (rsz){
      xn,rn := rs[i];
      foreach j in ([i+1..rsz]){
         xd,rd := rs[j];
	 foreach k in ([0..8]){
	    yn,yd := rn[k],rd[k];
	    if(yn!=0 and yd!=0 and
	         xn.toFloat()/xd.toFloat() == yn.toFloat()/yd.toFloat()){
	       count+=1;
	       omitted[k]+=1;
	       if(count<=12)
		  println("%d/%d --> %d/%d (removed %d)".fmt(xn,xd,yn,yd,k+1));
	    }
	 }
      }
   }
   println("%d-digit fractions found: %d, omitted %s\n"
      .fmt(n,count,omitted.concat(",")));
}


#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)


Red ["Fractran"]

inp: ask "please enter list of fractions, or input file name: "
if exists? inpf: to-file inp [inp: read inpf]

digit: charset "0123456789"
frac: [copy p [some digit] #"/" copy q [some digit]
		keep (as-pair to-integer p to-integer q)]
code: parse inp [collect [frac some [[some " "] frac]]]

n: to-integer ask "please enter starting number n: "
x: to-integer ask "please enter the number of terms, hit return for no limit: "
l: length? code
loop x [
	forall code [
		c: code/1
		if n % c/y = 0 [
			print n: n / c/y * c/x
			code: head code
			break
		]
		if l = index? code [halt]
	]
]


/*REXX program runs  FRACTRAN  for a given set of  fractions  and  from a specified  N. */
numeric digits 2000                              /*be able to handle larger numbers.    */
parse arg N terms fracs                          /*obtain optional arguments from the CL*/
if     N=='' |     N==","  then     N=   2       /*Not specified?  Then use the default.*/
if terms=='' | terms==","  then terms= 100       /* "      "         "   "   "      "   */
if fracs=''                then fracs= "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'
                                                 /* [↑]  The default for the fractions. */
f= space(fracs, 0)                               /*remove all blanks from the FRACS list*/
                    do #=1  while f\=='';    parse var  f   n.#   "/"   d.#   ','   f
                    end   /*#*/                  /* [↑]  parse all the fractions in list*/
#= # - 1                                         /*the number of fractions just found.  */
say #   'fractions:'   fracs                     /*display number 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 the DO loop for each   term. */
       do k=1  for  #                            /*   "     "   "   "   "    "  fraction*/
       if N // d.k \== 0  then iterate           /*Not an integer?  Then ignore it.     */
       cN= commas(N);     L= length(cN)          /*maybe insert commas into N;  get len.*/
       say right('term' commas(j), 44) "──► " right(cN, max(15, L))  /*show Nth term & N*/
       N= N  %  d.k  *  n.k                      /*calculate next term (use %≡integer ÷)*/
       leave                                     /*go start calculating the next term.  */
       end   /*k*/                               /* [↑]  if an integer, we found a new N*/
    end      /*j*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?


ar = %w[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]
FractalProgram = ar.map(&:to_r)                                #=> array of rationals

Runner = Enumerator.new do |y|
  num = 2
  loop{ y << num *= FractalProgram.detect{|f| (num*f).denominator == 1} }
end

prime_generator = Enumerator.new do |y|
  Runner.each do |num|
    l = Math.log2(num)
    y << l.to_i if l.floor == l
  end
end

# demo
p Runner.take(20).map(&:numerator)
p prime_generator.take(20)


class TestFractran extends FunSuite {
  val program = 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")
  val expect = List(2, 15, 825, 725, 1925, 2275, 425, 390, 330, 290, 770, 910, 170, 156, 132)

  test("find first fifteen fractran figures") {
    assert((program .execute(2) take 15 toList) === expect)
  }
}

object Fractran {
  val pattern = """\s*(\d+)\s*/\s*(\d+)\s*""".r
  def parse(m: Match) = ((m group 1).toInt, (m group 2).toInt)
  def apply(program: String) =  new Fractran(
    pattern.findAllMatchIn(program).map(parse).toList)
}

class Fractran(val numDem: List[(Int,Int)]) {
  def execute(value: Int) = unfold(value) { v =>
    numDem indexWhere(v % _._2 == 0) match {
      case i if i > -1 => Some(v, numDem(i)._1 * v / numDem(i)._2)
      case _ => None
    }
  }
}


(import (scheme base)
        (scheme inexact)
        (scheme read)
        (scheme write)
        (srfi 13))   ;; for string-length and string-ref

(define *string-fractions* ; string input of 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")

(define *fractions* ; create vector of fractions from string input
  (list->vector ; convert result to a vector, for constant access times
    (read (open-input-string ; read from the string of fractions, as a list
            (string-append "(" *string-fractions* ")")))))

;; run a fractran interpreter, returning the next number for n
;; or #f if no next number available
;; assume fractions: ordered vector of positive fractions
;;                n: a positive integer
(define (fractran fractions n)
  (let ((max-n (vector-length fractions)))
    (let loop ((i 0))
      (cond ((= i max-n)
             #f)
            ((integer? (* n (vector-ref fractions i)))
             (* n (vector-ref fractions i)))
            (else
              (loop (+ 1 i)))))))

;; Task
(define (display-result max-n)
  (do ((i 0 (+ 1 i))
       (n 2 (fractran *fractions* n)))
    ((= i max-n) (newline))
    (display n) (display " ")))

(display "Task: ")
(display-result 20) ; show first 20 numbers

;; Extra Credit: derive first 20 prime numbers
(define (generate-primes target-number initial-n)
  (define (is-power-of-two? n) ; a binary with only 1 "1" bit is a power of 2
    (cond ((<= n 2) ; exclude 2 and 1
           #f)
          (else
            (let loop ((i 0) (acc 0) (binary-str (number->string n 2)))
              (cond ((= i (string-length binary-str))
                     #t)
                    ((and (eq? (string-ref binary-str i) #\1) (= 1 acc))
                     #f)
                    ((eq? (string-ref binary-str i) #\1)
                     (loop (+ 1 i) (+ 1 acc) binary-str))
                    (else
                      (loop (+ 1 i) acc binary-str)))))))
  (define (extract-prime n) ; just gets the number of zeroes in binary
    (let ((binary-str (number->string n 2)))
      (- (string-length binary-str) 1)))
  ;
  (let loop ((count 0)
             (n initial-n))
    (when (< count target-number)
      (cond ((eq? n #f)
             (display "-- FAILED TO COMPUTE N --\n"))
            ((is-power-of-two? n)
             (display (extract-prime n)) (display " ")
             (loop (+ 1 count)
                   (fractran *fractions* n)))
            (else
              (loop count
                    (fractran *fractions* n))))))
  (newline))

(display "Primes:\n")
(generate-primes 20 2) ; create first 20 primes


$ include "seed7_05.s7i";
  include "rational.s7i";

const func array integer: fractran (in integer: limit, in var integer: number, in array rational: program) is func
  result
    var array integer: output is 0 times 0;
  local
    var integer: index is 1;
    var rational: newNumber is 0/1;
  begin
    output := [] (number);
    while index <= length(program) and length(output) <= limit do
      newNumber := rat(number) * program[index];
      if newNumber = rat(trunc(newNumber)) then
        number := trunc(newNumber);
        output &:= number;
        index := 1;
      else
        incr(index);
      end if;
    end while;
  end func;

const proc: main is func
  local
    const array rational: program is []
        (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);
    var array integer: output is 0 times 0;
    var integer: number is 0;
  begin
    output := fractran(15, 2, program);
    for number range output do
      write(number <& " ");
    end for;
    writeln;
  end func;


var str ="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"
const FractalProgram = str.split(',').map{.num}      #=> array of rationals

func runner(n, callback) {
    var num = 2
    n.times {
        callback(num *= FractalProgram.find { |f| f * num -> is_int })
    }
}

func prime_generator(n, callback) {
    var x = 0;
    runner(Inf, { |num|
        var l = num.log2
        if (l.floor == l) {
            callback(l.int)
            ++x == n && return nil
        }
    })
}

STDOUT.autoflush(true)

runner(20, {|n| print (n, ' ') })
print "\n"

prime_generator(20, {|n| print (n, ' ') })
print "\n"


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]


Option Base 1
Public prime As Variant
Public nf As New Collection
Public df As New Collection
Const halt = 20
Private Sub init()
    prime = [{2,3,5,7,11,13,17,19,23,29,31}]
End Sub
Private Function factor(f As Long) As Variant
    Dim result(10) As Integer
    Dim i As Integer: i = 1
    Do While f > 1
        Do While f Mod prime(i) = 0
            f = f \ prime(i)
            result(i) = result(i) + 1
        Loop
        i = i + 1
    Loop
    factor = result
End Function
Private Function decrement(ByVal a As Variant, b As Variant) As Variant
    For i = LBound(a) To UBound(a)
        a(i) = a(i) - b(i)
    Next i
    decrement = a
End Function
Private Function increment(ByVal a As Variant, b As Variant) As Variant
    For i = LBound(a) To UBound(a)
        a(i) = a(i) + b(i)
    Next i
    increment = a
End Function
Private Function test(a As Variant, b As Variant)
    flag = True
    For i = LBound(a) To UBound(a)
        If a(i) < b(i) Then
            flag = False
            Exit For
        End If
    Next i
    test = flag
End Function
Private Function unfactor(x As Variant) As Long
    result = 1
    For i = LBound(x) To UBound(x)
        result = result * prime(i) ^ x(i)
    Next i
    unfactor = result
End Function
Private Sub compile(program As String)
    program = Replace(program, " ", "")
    programlist = Split(program, ",")
    For Each instruction In programlist
        parts = Split(instruction, "/")
        nf.Add factor(Val(parts(0)))
        df.Add factor(Val(parts(1)))
    Next instruction
End Sub
Private Function run(x As Long) As Variant
    n = factor(x)
    counter = 0
    Do While True
        For i = 1 To df.Count
            If test(n, df(i)) Then
                n = increment(decrement(n, df(i)), nf(i))
                Exit For
            End If
        Next i
        Debug.Print unfactor(n);
        counter = counter + 1
        If num = 31 Or counter >= halt Then Exit Do
    Loop
    Debug.Print
    run = n
End Function
Private Function steps(x As Variant) As Variant
    'expects x=factor(n)
    For i = 1 To df.Count
        If test(x, df(i)) Then
            x = increment(decrement(x, df(i)), nf(i))
            Exit For
        End If
    Next i
    steps = x
End Function
Private Function is_power_of_2(x As Variant) As Boolean
    flag = True
    For i = LBound(x) + 1 To UBound(x)
        If x(i) > 0 Then
            flag = False
            Exit For
        End If
    Next i
    is_power_of_2 = flag
End Function
Private Function filter_primes(x As Long, max As Integer) As Long
    n = factor(x)
    i = 0: iterations = 0
    Do While i < max
        If is_power_of_2(steps(n)) Then
            Debug.Print n(1);
            i = i + 1
        End If
        iterations = iterations + 1
    Loop
    Debug.Print
    filter_primes = iterations
End Function
Public Sub main()
    init
    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")
    Debug.Print "First 20 results:"
    output = run(2)
    Debug.Print "First 30 primes:"
    Debug.Print "after"; filter_primes(2, 30); "iterations."
End Sub


import "/big" for BigInt, BigRat

var isPowerOfTwo = Fn.new { |bi| bi & (bi - BigInt.one) == BigInt.zero }

var fractran = Fn.new { |program, n, limit, primesOnly|
    var fractions = program.split(" ").where { |s| s != "" }
                                      .map { |s| BigRat.fromRationalString(s) }
                                      .toList
    var results = []
    if (!primesOnly) results.add(n)
    var nn = BigInt.new(n)
    while (results.count < limit) {
        var fracs = fractions.where { |f| (f * nn).isInteger }.toList
        if (fracs.count == 0) break
        var frac = fracs[0]
        nn = nn * frac.num / frac.den
        if (!primesOnly) {
            results.add(nn.toSmall)
        } else if (primesOnly && isPowerOfTwo.call(nn)) {
            var prime = (nn.toNum.log / 2.log).floor
            results.add(prime)
        }
    }
    return results
}

var program = "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"
System.print("First twenty numbers:")
System.print(fractran.call(program, 2, 20, false))
System.print("\nFirst ten primes:")
System.print(fractran.call(program, 2, 10, true))


var fracs="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";
fcn fractranW(n,fracsAsOneBigString){ //-->Walker (iterator)
  fracs:=(fracsAsOneBigString-" ").split(",").apply(
	 fcn(frac){ frac.split("/").apply("toInt") }); //( (n,d), (n,d), ...)
   Walker(fcn(rn,fracs){
      n:=rn.value;
      foreach a,b in (fracs){
	 if(n*a%b == 0){
	    rn.set(n*a/b);
	    return(n);
	 }
      }
   }.fp(Ref(n),fracs))
}


F isProbablePrime(n, k = 10)
   I n < 2 | n % 2 == 0
      R n == 2

   V d = n - 1
   V s = 0
   L d % 2 == 0
      d I/= 2
      s++

   assert(2 ^ s * d == n - 1)

   Int nn
   I n < 7FFF'FFFF
      nn = Int(n)
   E
      nn = 7FFF'FFFF

   L(_) 0 .< k
      V a = random:(2 .< nn)
      V x = pow(a, d, n)
      I x == 1 | x == n - 1
         L.continue
      L(_) 0 .< s - 1
         x = pow(x, 2, n)
         I x == 1
            R 0B
         I x == n - 1
            L.break
      L.was_no_break
         R 0B

   R 1B

F is_prime(a)
   I a == 2
      R 1B
   I a < 2 | a % 2 == 0
      R 0B
   L(i) (3 .. Int(sqrt(a))).step(2)
      I a % i == 0
         R 0B
   R 1B

V primorial = BigInt(1)

V nn = 50
V lim = 75
V s = Set[Int]()
L(n) 1..
   I is_prime(n)
      primorial *= n
      V m = 3
      L
         I isProbablePrime(primorial + m, 25)
            s.add(m)
            L.break
         m += 2
      I --lim == 0
         L.break

print(‘First ’nn‘ fortunate numbers:’)
L(m) sorted(Array(s))[0 .< nn]
   V i = L.index
   print(‘#3’.format(m), end' I (i + 1) % 10 == 0 {"\n"} E ‘ ’)


firstPrimes: select 1..100 => prime?
primorial: function [n][
    product first.n: n firstPrimes
]

fortunates: []
i: 1

while [8 > size fortunates][
    m: 3
    pmi: primorial i
    while -> not? prime? m + pmi
          -> m: m+2
    fortunates: unique fortunates ++ m
    i: i + 1
]

print sort fortunates


USING: grouping io kernel math math.factorials math.primes
math.ranges prettyprint sequences sets sorting ;

"First 50 distinct fortunate numbers:" print
75 [1,b] [
    primorial dup next-prime 2dup - abs 1 =
    [ next-prime ] when - abs
] map members natural-sort 50 head 10 group simple-table.


#include "isprime.bas"
#include "sets.bas"
#include "bubblesort.bas"

function prime(n as uinteger) as uinteger
    if n = 1 then return 2
    dim as integer c=1, p=3
    while c<n
        if isprime(p) then c+=1
        p += 2
    wend
    return p
end function

function primorial( n as uinteger ) as ulongint
    dim as ulongint ret = 1
    for i as uinteger = 1 to n
        ret *= prime(i)
    next i
    return ret
end function

function fortunate(n as uinteger) as uinteger
    dim as uinteger m = 3
    dim as ulongint pp = primorial(n)
    while not isprime(m+pp)
        m+=2
    wend
    return m
end function

redim as integer forts(-1)
dim as integer n = 0, m
while ubound(forts) < 6
    n += 1
    m = fortunate(n)
    if not is_in(m, forts()) then
        add_to_set(m, forts())
    end if
wend

bubblesort(forts())
for n=0 to 6
    print forts(n)
next n


package main

import (
    "fmt"
    "math/big"
    "rcu"
    "sort"
)

func main() {
    primes := rcu.Primes(379)
    primorial := big.NewInt(1)
    var fortunates []int
    bPrime := new(big.Int)
    for _, prime := range primes {
        bPrime.SetUint64(uint64(prime))
        primorial.Mul(primorial, bPrime)
        for j := 3; ; j += 2 {
            jj := big.NewInt(int64(j))
            bPrime.Add(primorial, jj)
            if bPrime.ProbablyPrime(5) {
                fortunates = append(fortunates, j)
                break
            }
        }
    }
    m := make(map[int]bool)
    for _, f := range fortunates {
        m[f] = true
    }
    fortunates = fortunates[:0]
    for k := range m {
        fortunates = append(fortunates, k)
    }
    sort.Ints(fortunates)
    fmt.Println("After sorting, the first 50 distinct fortunate numbers are:")
    for i, f := range fortunates[0:50] {
        fmt.Printf("%3d ", f)
        if (i+1)%10 == 0 {
            fmt.Println()
        }
    }
    fmt.Println()
}


import Data.Numbers.Primes (primes)
import Math.NumberTheory.Primes.Testing (isPrime)
import Data.List (nub)

primorials :: [Integer]
primorials = 1 : scanl1 (*) primes

nextPrime :: Integer -> Integer
nextPrime n
  | even n = head $ dropWhile (not . isPrime) [n+1, n+3..]
  | even n = nextPrime (n+1)

fortunateNumbers :: [Integer]
fortunateNumbers = (\p -> nextPrime (p + 2) - p) <$> tail primorials


def primes:
  2, range(3; infinite; 2) | select(is_prime);

# generate an infinite stream of primorials
def primorials:
  foreach primes as $p (1; .*$p; .);

# Emit a sorted array of the first $limit distinct fortunate numbers
# generated in order of the primoridials
def fortunates($limit):
  label $out
  | foreach primorials as $p ([];
      first( range(3; infinite; 2) | select($p + . | is_prime)) as $q
      | . + [$q] | unique;
      if length >= $limit then ., break $out else empty end);

fortunates(10)


using Primes

primorials(N) = accumulate(*, primes(N), init = big"1")

primorial = primorials(800)

fortunate(n) = nextprime(primorial[n] + 2) - primorial[n]

println("After sorting, the first 50 distinct fortunate numbers are:")
foreach(p -> print(rpad(last(p), 5), first(p) % 10 == 0 ? "\n" : ""),
    (map(fortunate, 1:100) |> unique |> sort!)[begin:50] |> enumerate)


ClearAll[primorials]
primorials[n_] := Times @@ Prime[Range[n]]
vals = Table[
   primor = primorials[i];
   s = NextPrime[primor];
   t = NextPrime[s];
   Min[DeleteCases[{s - primor, t - primor}, 1]]
   ,
   {i, 100}
   ];
TakeSmallest[DeleteDuplicates[vals], 50]


import algorithm, sequtils, strutils
import bignum

const
  N = 50      # Number of fortunate numbers.
  Lim = 75    # Number of primorials to compute.

iterator primorials(lim: Positive): Int =
  var prime = newInt(2)
  var primorial = newInt(1)
  for _ in 1..lim:
    primorial *= prime
    prime = prime.nextPrime()
    yield primorial

var list: seq[int]
for p in primorials(Lim):
  var m = 3
  while true:
    if probablyPrime(p + m, 25) != 0:
      list.add m
      break
    inc m, 2

list.sort()
list = list.deduplicate(true)
if list.len < N:
  quit "Not enough values. Wanted $1, got $2.".format(N, list.len), QuitFailure
list.setLen(N)
echo "First $# fortunate numbers:".format(N)
for i, m in list:
  stdout.write ($m).align(3), if (i + 1) mod 10 == 0: '\n' else: ' '


use strict;
use warnings;
use List::Util <first uniq>;
use ntheory qw<pn_primorial is_prime>;

my $upto = 50;
my @candidates;
for my $p ( map { pn_primorial($_) } 1..2*$upto ) {
    push @candidates, first { is_prime($_ + $p) } 2..100*$upto;
}

my @fortunate = sort { $a <=> $b } uniq grep { is_prime $_ } @candidates;

print "First $upto distinct fortunate numbers:\n" .
    (sprintf "@{['%6d' x $upto]}", @fortunate) =~ s/(.{60})/$1\n/gr;


with javascript_semantics
include mpfr.e
mpz primorial = mpz_init(1),
    pj = mpz_init()
sequence fortunates = {}
for p=1 to 75 do
    mpz_mul_si(primorial,primorial,get_prime(p))
    integer j = 3
    mpz_add_si(pj,primorial,3)
    while not mpz_prime(pj) do
        mpz_add_si(pj,pj,2)
        j = j + 2
    end while
    fortunates &= j
end for
fortunates = unique(deep_copy(fortunates))[1..50]
fortunates = join_by(apply(true,sprintf,{{"%3d"},fortunates}),1,10)
printf(1,"The first 50 distinct fortunate numbers are:\n%s\n",{fortunates})


from sympy.ntheory.generate import primorial
from sympy.ntheory import isprime

def fortunate_number(n):
    '''Return the fortunate number for positive integer n.'''
    # Since primorial(n) is even for all positive integers n,
    # it suffices to search for the fortunate numbers among odd integers.
    i = 3
    primorial_ = primorial(n)
    while True:
        if isprime(primorial_ + i):
            return i
        i += 2

fortunate_numbers = set()
for i in range(1, 76):
    fortunate_numbers.add(fortunate_number(i))

# Extract the first 50 numbers.
first50 = sorted(list(fortunate_numbers))[:50]

print('The first 50 fortunate numbers:')
print(('{:<3} ' * 10).format(*(first50[:10])))
print(('{:<3} ' * 10).format(*(first50[10:20])))
print(('{:<3} ' * 10).format(*(first50[20:30])))
print(('{:<3} ' * 10).format(*(first50[30:40])))
print(('{:<3} ' * 10).format(*(first50[40:])))


my @primorials = [\*] grep *.is-prime, ^∞;

say display :title("First 50 distinct fortunate numbers:\n"),
   (squish sort @primorials[^75].hyper.map: -> $primorial {
       (2..∞).first: (* + $primorial).is-prime
   })[^50];

sub display ($list, :$cols = 10, :$fmt = '%6d', :$title = "{+$list} matching:\n") {
    cache $list;
    $title ~ $list.batch($cols)».fmt($fmt).join: "\n"
}


/*REXX program finds/displays fortunate numbers  N,  where  N  is specified (default=8).*/
numeric digits 12
parse arg n cols .                               /*obtain optional argument from the CL.*/
if    n=='' |    n==","  then    n=  8           /*Not specified?  Then use the default.*/
if cols=='' | cols==","  then cols= 10           /* "      "         "   "   "     "    */
call genP n**2                                   /*build array of semaphores for primes.*/
pp.= 1
      do i=1  for n+1;   im= i - 1;    pp.i= pp.im * @.i   /*calculate primorial numbers*/
      end   /*i*/
i=i-1;  call genp pp.i + 1000
                     title= ' fortunate numbers'
w= 10                                            /*maximum width of a number in any col.*/
say ' index │'center(title, 1 + cols*(w+1)     )
say '───────┼'center(""   , 1 + cols*(w+1), '─')
found= 0;                           idx= 1       /*number of fortunate (so far) & index.*/
!!.= 0;                             maxFN= 0     /*(stemmed)  array of fortunate numbers*/
        do j=1  until found==n;     pt= pp.j     /*search for fortunate numbers in range*/
        pt= pp.j                                 /*get the precalculated primorial prime*/
                     do m=3  by 2;  t= pt + m    /*find  M  that satisfies requirement. */
                     if !.t==''  then leave      /*Is !.t prime?  Then we found a good M*/
                     end   /*m*/
        if !!.m  then iterate                    /*Fortunate # already found?  Then skip*/
        !!.m= 1;      found= found + 1           /*assign fortunate number;  bump count.*/
        maxFN= max(maxFN, t)                     /*obtain max fortunate # for displaying*/
        end   /*j*/
$=;                                 finds= 0     /*$:  line of output;    FINDS:  count.*/
      do k=1  for maxFN;  if \!!.k  then iterate /*show the fortunate numbers we found. */
      finds= finds + 1                           /*bump the  count of numbers (for $).  */
      c= commas(k)                               /*maybe add commas to the number.      */
      $= $  right(c, max(w, length(c) ) )        /*add a nice prime ──► list, allow big#*/
      if found//cols\==0  then iterate           /*have we populated a line of output?  */
      say center(idx, 7)'│'  substr($, 2);   $=  /*display what we have so far  (cols). */
      idx= idx + cols                            /*bump the  index  count for the output*/
      end   /*k*/

if $\==''  then say center(idx, 7)"│"  substr($, 2)  /*possible display residual output.*/
say '───────┴'center(""   , 1 + cols*(w+1), '─')     /*display the foot separator.      */
say
say 'Found '       commas(found)      title
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
/*──────────────────────────────────────────────────────────────────────────────────────*/
genP:        @.1=2; @.2=3; @.3=5; @.4=7;  @.5=11 /*define some low primes.              */
      !.=0;  !.2=;  !.3=;  !.5=;  !.7=;   !.11=  /*   "     "   "    "     semaphores.  */
                           #= 5;  sq.#= @.#**2   /*squares of low primes.*/
        do [email protected].#+2  by 2  to arg(1)              /*find odd primes from here on.        */
        parse var j '' -1 _;     if _==5  then iterate       /*J ÷ by 5 ?               */
        if j//3==0  then iterate;  if j//7==0  then iterate  /*" "  " 3?;    J ÷ by 7 ? */
               do k=5  while sq.k<=j             /* [↓]  divide by the known odd primes.*/
               if j // @.k == 0  then iterate j  /*Is  J ÷ X?  Then not prime.     ___  */
               end   /*k*/                       /* [↑]  only process numbers  ≤  √ J   */
        #= #+1;    @.#= j;    sq.#= j*j;  !.j=   /*bump # of Ps; assign next P;  P²; P# */
        end          /*j*/;               return


require "gmp"

primorials = Enumerator.new do |y|
  cur = prod = 1
  loop {y << prod *= (cur = GMP::Z(cur).nextprime)}
end

limit = 50
fortunates = []
while fortunates.size < limit*2 do
  prim = primorials.next
  fortunates << (GMP::Z(prim+2).nextprime - prim)
  fortunates = fortunates.uniq.sort
end

p fortunates[0, limit]


func fortunate(n) {
    var P = n.pn_primorial
    2..Inf -> first {|m| P+m -> is_prob_prime }
}

var limit = 50
var uniq = Set()
var all = []

for (var n = 1; uniq.len < 2*limit; ++n) {
    var m = fortunate(n)
    all << m
    uniq << m
}

say "Fortunate numbers for n = 1..#{limit}:"
say all.first(limit)

say "\n#{limit} Fortunate numbers, sorted with duplicates removed:"
say uniq.sort.first(limit)


import "/math" for Int
import "/big" for BigInt
import "/sort" for Sort
import "/seq" for Lst
import "/fmt" for Fmt

var primes = Int.primeSieve(379)
var primorial = BigInt.one
var fortunates = []
for (prime in primes) {
    primorial = primorial * prime
    var j = 3
    while (true) {
        if ((primorial + j).isProbablePrime(5)) {
            fortunates.add(j)
            break
        }
        j = j + 2
    }
}
fortunates = Lst.distinct(fortunates)
Sort.quick(fortunates)
System.print("After sorting, the first 50 distinct fortunate numbers are:")
for (chunk in Lst.chunks(fortunates[0..49], 10)) Fmt.print("$3d", chunk)


with Ada.Text_Io;
with Ada.Float_Text_Io; use Ada.Float_Text_Io;
with Ada.containers.Vectors;

procedure Forward_Difference is
   package Flt_Vect is new Ada.Containers.Vectors(Positive, Float);
   use Flt_Vect;
   procedure Print(Item : Vector) is
   begin
      if not Item.Is_Empty then
         Ada.Text_IO.Put('[');
         for I in 1..Item.Length loop
            Put(Item => Item.Element(Positive(I)), Fore => 1, Aft => 1, Exp => 0);
             if Positive(I) < Positive(Item.Length) then
               Ada.Text_Io.Put(", ");
            end if;
         end loop;
         Ada.Text_Io.Put_line("]");
      else
         Ada.Text_IO.Put_Line("Empty List");
      end if;

   end Print;

  function Diff(Item : Vector; Num_Passes : Natural) return Vector is
      A : Vector := Item;
      B : Vector := Empty_Vector;
   begin
      if not A.Is_Empty then
         for I in 1..Num_Passes loop
            for I in 1..Natural(A.Length) - 1 loop
                  B.Append(A.Element(I + 1) - A.Element(I));
            end loop;
            Move(Target => A, Source => B);
         end loop;
      end if;
      return A;
   end Diff;
   Values : array(1..10) of Float := (90.0, 47.0, 58.0, 29.0, 22.0, 32.0, 55.0, 5.0, 55.0, 73.0);
   A : Vector;
begin
   for I in Values'range loop
      A.Append(Values(I)); -- Fill the vector
   end loop;
   Print(Diff(A, 1));
   Print(Diff(A, 2));
   Print(Diff(A, 9));
   Print(Diff(A, 10));
   print(Diff(A, 0));
end Forward_Difference;


main:(
  MODE LISTREAL = [1:0]REAL;

  OP - = (LISTREAL a,b)LISTREAL: (
    [UPB a]REAL out;
    FOR i TO UPB out DO out[i]:=a[i]-b[i] OD;
    out
  );

  FORMAT real fmt=$zzz-d.d$;
  FORMAT repeat fmt = $n(UPB s-1)(f(real fmt)",")f(real fmt)$;
  FORMAT list fmt = $"("f(UPB s=1|real fmt|repeat fmt)")"$;

  FLEX [1:0] REAL s := (90, 47, 58, 29, 22, 32, 55, 5, 55, 73);

  printf((list fmt,s,$";"l$));
  TO UPB s-1 DO
    s := s[2:] - s[:UPB s-1];
    printf((list fmt,s,$";"l$))
  OD
)


begin
    % calculate forward differences                                  %

    % sets elements of B to the first order forward differences of A %
    % A should have bounds 1 :: n, B should have bounds 1 :: n - 1   %
    procedure FirstOrderFDifference ( integer array A( * )
                                    ; integer array B( * )
                                    ; integer value n
                                    ) ;
        for i := 2 until n do B( i - 1 ) := A( i ) - A( i - 1 );

    integer array v   ( 1 :: 10 );
    integer array diff( 1 ::  9 );
    integer vPos, length;

    % construct the initial values array                              %
    vPos := 1;
    for i := 90, 47, 58, 29, 22, 32, 55, 5, 55, 73 do begin
        v( vPos ) := i;
        vPos := vPos + 1
    end for_i ;
    % calculate and show the differences                              %
    i_w    := 5; % set output format %
    length := 10;
    for order := 1 until length - 1 do begin
        FirstOrderFDifference( v, diff, length );
        length := length - 1;
        write( order, ": " ); for i := 1 until length do writeon( diff( i ) );
        for i := 1 until length do v( i ) := diff( i )
    end for_order
end.