use std::env;

fn main() {
    let args: Vec<_> = env::args().collect();
    let n = if args.len() > 1 {
        args[1].parse().expect("Not a valid number to count to")
    }
    else {
        20
    };
    count_in_factors_to(n);
}

fn count_in_factors_to(n: u64) {
    println!("1");
    let mut primes = vec![];
    for i in 2..=n {
        let fs = factors(&primes, i);
        if fs.len() <= 1 {
            primes.push(i);
            println!("{}", i);
        }
        else {
            println!("{} = {}", i, fs.iter().map(|f| f.to_string()).collect::<Vec<String>>().join(" x "));
        }
    }
}

fn factors(primes: &[u64], mut n: u64) -> Vec<u64> {
    let mut result = Vec::new();
    for p in primes {
        while n % p == 0 {
            result.push(*p);
            n /= p;
        }
        if n == 1 {
            return result;
        }
    }
    vec![n]
}


def count_in_factors(n):
    if is_prime(n) or n == 1:
        print(n,end="")
        return
    while n != 1:
        p = next_prime(1)
        while n % p != 0:
            p = next_prime(p)
        print(p,end="")
        n = n / p
        if n != 1: print(" x",end=" ")

for i in range(1, 101):
    print(i,"=",end=" ")
    count_in_factors(i)
    print("")


object CountInFactors extends App {

  def primeFactors(n: Int): List[Int] = {

    def primeStream(s: LazyList[Int]): LazyList[Int] = {
      s.head #:: primeStream(s.tail filter {
        _ % s.head != 0
      })
    }

    val primes = primeStream(LazyList.from(2))

    def factors(n: Int): List[Int] = primes.takeWhile(_ <= n).find(n % _ == 0) match {
      case None => Nil
      case Some(p) => p :: factors(n / p)
    }

    if (n == 1) List(1) else factors(n)
  }

  // A little test...
  {
    val nums = (1 to 12).toList :+ 2144 :+ 6358
    nums.foreach(n => println("%6d : %s".format(n, primeFactors(n).mkString(" * "))))
  }

}


(define (factors n)
  (let facs ((l '()) (d 2) (x n))
    (cond ((= x 1) (if (null? l) '(1) l))
	  ((< x (* d d)) (cons x l))
	  (else (if (= 0 (modulo x d))
		  (facs (cons d l) d (/ x d))
		  (facs l (+ 1 d) x))))))

(define (show l)
  (display (car l))
  (if (not (null? (cdr l)))
    (begin
      (display " × ")
      (show (cdr l)))
    (display "\n")))

(do ((i 1 (+ i 1))) (#f)
  (display i)
  (display " = ")
  (show (reverse (factors i))))


$ include "seed7_05.s7i";

const proc: writePrimeFactors (in var integer: number) is func
  local
    var boolean: laterElement is FALSE;
    var integer: checker is 2;
  begin
    while checker * checker <= number do
      if number rem checker = 0 then
        if laterElement then
          write(" * ");
        end if;
        laterElement := TRUE;
        write(checker);
        number := number div checker;
      else
        incr(checker);
      end if;
    end while;
    if number <> 1 then
      if laterElement then
        write(" * ");
      end if;
      laterElement := TRUE;
      write(number);
    end if;
  end func;

const proc: main is func
  local
    var integer: number is 0;
  begin
    writeln("1: 1");
    for number range 2 to 2147483647 do
      write(number <& ": ");
      writePrimeFactors(number);
      writeln;
    end for;
  end func;


class Counter {
    method factors(n, p=2) {
        var a = gather {
            while (n >= p*p) {
                while (p `divides` n) {
                    take(p)
                    n //= p
                }
                p = self.next_prime(p)
            }
        }
        (n > 1 || a.is_empty) ? (a << n) : a
    }

    method is_prime(n) {
        self.factors(n).len == 1
    }

    method next_prime(p) {
        do {
            p == 2 ? (p = 3) : (p+=2)
        } while (!self.is_prime(p))
        return p
    }
}

for i in (1..100) {
    say "#{i} = #{Counter().factors(i).join(' × ')}"
}


extension BinaryInteger {
  @inlinable
  public func primeDecomposition() -> [Self] {
    guard self > 1 else { return [] }

    func step(_ x: Self) -> Self {
      return 1 + (x << 2) - ((x >> 1) << 1)
    }

    let maxQ = Self(Double(self).squareRoot())
    var d: Self = 1
    var q: Self = self & 1 == 0 ? 2 : 3

    while q <= maxQ && self % q != 0 {
      q = step(d)
      d += 1
    }

    return q <= maxQ ? [q] + (self / q).primeDecomposition() : [self]
  }
}

for i in 1...20 {
  if i == 1 {
    print("1 = 1")
  } else {
    print("\(i) = \(i.primeDecomposition().map(String.init).joined(separator: " x "))")
  }
}


package require Tcl 8.5

namespace eval prime {
    variable primes [list 2 3 5 7 11]
    proc restart {} {
	variable index -1
	variable primes
	variable current [lindex $primes end]
    }

    proc get_next_prime {} {
	variable primes
	variable index
	if {$index < [llength $primes]-1} {
	    return [lindex $primes [incr index]]
	}
	variable current
	while 1 {
	    incr current 2
	    set p 1
	    foreach prime $primes {
		if {$current % $prime} {} else {
		    set p 0
		    break
		}
	    }
	    if {$p} {
		return [lindex [lappend primes $current] [incr index]]
	    }
	}
    }

    proc factors {num} {
	restart
	set factors [dict create]
	for {set i [get_next_prime]} {$i <= $num} {} {
	    if {$num % $i == 0} {
		dict incr factors $i
		set num [expr {$num / $i}]
		continue
	    } elseif {$i*$i > $num} {
		dict incr factors $num
		break
	    } else {
		set i [get_next_prime]
	    }
	}
	return $factors
    }

    # Produce the factors in rendered form
    proc factors.rendered {num} {
	set factorDict [factors $num]
	if {[dict size $factorDict] == 0} {
	    return 1
	}
	dict for {factor times} $factorDict {
	    lappend v {*}[lrepeat $times $factor]
	}
	return [join $v "*"]
    }
}


Function CountFactors(n)
	If n = 1 Then
		CountFactors = 1
	Else
		arrP = Split(ListPrimes(n)," ")
		Set arrList = CreateObject("System.Collections.ArrayList")
		divnum = n
		Do Until divnum = 1
			'The -1 is to account for the null element of arrP
			For i = 0 To UBound(arrP)-1
				If divnum = 1 Then
					Exit For
				ElseIf divnum Mod arrP(i) = 0 Then
					divnum = divnum/arrP(i)
					arrList.Add arrP(i)
				End If
			Next
		Loop
		arrList.Sort
		For i = 0 To arrList.Count - 1
			If i = arrList.Count - 1 Then
				CountFactors = CountFactors & arrList(i)
			Else
				CountFactors = CountFactors & arrList(i) & " * "
			End If
		Next
	End If
End Function

Function IsPrime(n)
	If n = 2 Then
		IsPrime = True
	ElseIf n <= 1 Or n Mod 2 = 0 Then
		IsPrime = False
	Else
		IsPrime = True
		For i = 3 To Int(Sqr(n)) Step 2
			If n Mod i = 0 Then
				IsPrime = False
				Exit For
			End If
		Next
	End If
End Function

Function ListPrimes(n)
	ListPrimes = ""
	For i = 1 To n
		If IsPrime(i) Then
			ListPrimes = ListPrimes & i & " "
		End If
	Next
End Function

'Testing the fucntions.
WScript.StdOut.Write "2 = " & CountFactors(2)
WScript.StdOut.WriteLine
WScript.StdOut.Write "2144 = " & CountFactors(2144)
WScript.StdOut.WriteLine


Module CountingInFactors

    Sub Main()
        For i As Integer = 1 To 10
            Console.WriteLine("{0} = {1}", i, CountingInFactors(i))
        Next

        For i As Integer = 9991 To 10000
            Console.WriteLine("{0} = {1}", i, CountingInFactors(i))
        Next
    End Sub

    Private Function CountingInFactors(ByVal n As Integer) As String
        If n = 1 Then Return "1"

        Dim sb As New Text.StringBuilder()

        CheckFactor(2, n, sb)
        If n = 1 Then Return sb.ToString()

        CheckFactor(3, n, sb)
        If n = 1 Then Return sb.ToString()

        For i As Integer = 5 To n Step 2
            If i Mod 3 = 0 Then Continue For

            CheckFactor(i, n, sb)
            If n = 1 Then Exit For
        Next

        Return sb.ToString()
    End Function

    Private Sub CheckFactor(ByVal mult As Integer, ByRef n As Integer, ByRef sb As Text.StringBuilder)
        Do While n Mod mult = 0
            If sb.Length > 0 Then sb.Append(" x ")
            sb.Append(mult)
            n = n / mult
        Loop
    End Sub

End Module


fn main() {
    println("1: 1")
    for i := 2; ; i++ {
        print("$i: ")
        mut x := ''
        for n, f := i, 2; n != 1; f++ {
            for m := n % f; m == 0; m = n % f {
                print('$x$f')
                x = "×"
                n /= f
            }
        }
        println('')
    }
}


include c:\cxpl\codes;
int     N0, N, F;
[N0:= 1;
repeat  IntOut(0, N0);  Text(0, " = ");
        F:= 2;  N:= N0;
        repeat  if rem(N/F) = 0 then
                        [if N # N0 then Text(0, " * ");
                        IntOut(0, F);
                        N:= N/F;
                        ]
                else F:= F+1;
        until F>N;
        if N0=1 then IntOut(0, 1);      \1 = 1
        CrLf(0);
        N0:= N0+1;
until KeyHit;
]


import "/math" for Int

for (r in [1..9, 2144..2154, 9987..9999]) {
    for (i in r) {
        var factors = (i > 1) ? Int.primeFactors(i) : [1]
        System.print("%(i): %(factors.join(" x "))")
    }
    System.print()
}


foreach n in ([1..*]){ println(n,": ",primeFactors(n).concat("\U2715;")) }


10 FOR i=1 TO 20
20 PRINT i;" = ";
30 IF i=1 THEN PRINT 1: GO TO 90
40 LET p=2: LET n=i: LET f$=""
50 IF p>n THEN GO TO 80
60 IF NOT FN m(n,p) THEN LET f$=f$+STR$ p+" x ": LET n=INT (n/p): GO TO 50
70 LET p=p+1: GO TO 50
80 PRINT f$( TO LEN f$-3)
90 NEXT i
100 STOP
110 DEF FN m(a,b)=a-INT (a/b)*b


T Rational
   Int numerator
   Int denominator

   F (numerator, denominator)
      .numerator = numerator
      .denominator = denominator

   F String()
      I .denominator == 1
         R String(.numerator)
      E
         R .numerator‘//’(.denominator)

F rationalize(x, tol = 1e-12)
   V xx = x
   V flagNeg = xx < 0.0
   I flagNeg
      xx = -xx
   I xx < 1e-10
      R Rational(0, 1)
   I abs(xx - round(xx)) < tol
      R Rational(Int(xx), 1)
   V a = 0
   V b = 1
   V c = Int(ceil(xx))
   V d = 1
   V aux1 = 7FFF'FFFF I/ 2
   L c < aux1 & d < aux1
      V aux2 = (Float(a) + Float(c)) / (Float(b) + Float(d))
      I abs(xx - aux2) < tol
         L.break
      I xx > aux2
         a += c
         b += d
      E
         c += a
         d += b
   V g = gcd(a + c, b + d)
   I flagNeg
      R Rational(-(a + c) I/ g, (b + d) I/ g)
   E
      R Rational((a + c) I/ g, (b + d) I/ g)

print(rationalize(0.9054054054))
print(rationalize(0.9054054054, 0.0001))
print(rationalize(0.5185185185))
print(rationalize(0.5185185185, 0.0001))
print(rationalize(0.75))
print(rationalize(0.1428571428, 0.001))
print(rationalize(35.000))
print(rationalize(35.001))
print(rationalize(0.9))
print(rationalize(0.99))
print(rationalize(0.909))
print(rationalize(0.909, 0.001))


generic
   type Real is digits <>;
procedure Real_To_Rational(R: Real;
                           Bound: Positive;
                           Nominator: out Integer;
                           Denominator: out Positive);


--------- RATIONAL APPROXIMATION TO DECIMAL NUMBER -------

-- approxRatio :: Real -> Real -> Ratio
on approxRatio(epsilon, n)
    if {real, integer} contains (class of epsilon) and 0 < epsilon then
        -- Given
        set e to epsilon
    else
        -- Default
        set e to 1 / 10000
    end if

    script gcde
        on |λ|(e, x, y)
            script _gcd
                on |λ|(a, b)
                    if b < e then
                        a
                    else
                        |λ|(b, a mod b)
                    end if
                end |λ|
            end script
            |λ|(abs(x), abs(y)) of _gcd
        end |λ|
    end script

    set c to |λ|(e, 1, n) of gcde
    Ratio((n div c), (1 div c))
end approxRatio

-- Ratio :: Int -> Int -> Ratio
on Ratio(n, d)
    {type:"Ratio", n:n, d:d}
end Ratio

-- showRatio :: Ratio -> String
on showRatio(r)
    (n of r as string) & "/" & (d of r as string)
end showRatio

--------------------------- TEST -------------------------
on run
    script ratioString
        -- Using a tolerance epsilon of 1/10000
        on |λ|(x)
            (x as string) & " -> " & showRatio(approxRatio(1.0E-4, x))
        end |λ|
    end script

    unlines(map(ratioString, ¬
        {0.9054054, 0.518518, 0.75}))

    -- 0.9054054 -> 67/74
    -- 0.518518 -> 14/27
    -- 0.75 -> 3/4
end run

-------------------- GENERIC FUNCTIONS -------------------

-- abs :: Num -> Num
on abs(x)
    if 0 > x then
        -x
    else
        x
    end if
end abs

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines


    Array := []
    inputbox, string, Enter Number
    stringsplit, string, string, .
    if ( string1 = 0 )
            string1 =
    loop, parse, string, .
            if A_index = 2
                    loop, parse, A_loopfield
                                                    Array[A_index] := A_loopfield,          k := A_index
    if (k = 1)
     {
    numerator := Array[1]
    Denominator := 10
    goto label
    }
    Original1 := K
    To_rn := floor(k/2)
    M_M := k - To_rn
    Original2 := k - To_rn
    loop
    {
    loop, % To_rn

    {
    Check1 .= Array[k]
    Check2 .= Array[M_M]
    k--
    m_M--
    }
    if ( check1 = check2 )
    {
            ;~ process beginsTO check;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      loop, % To_rn
        nines .= 9
    loop, % k - TO_rn
        Zeroes .= 0
    loop % k - TO_rn
            Minus .= Array[A_index]
    loop % k
            Plus .= Array[A_index]
    if ( minus = "" )
            minus := 0
    Numerator := Plus - minus
    Denominator := Nines . Zeroes
    ;;;;;;;;;;;;;HCF
    goto, label
    }
    Check1 =
    check2 =
    k := Original1
    m_M := original2 + A_index
    TO_rn--
    if ( to_rn = 0 )
    {
            zeroes =
            loop % original1
                    zeroes .= 0
    Denominator := 1 . zeroes
    numerator := string2
    goto, label
    }
    }
    esc::Exitapp
    label:
    Index := 2
    loop
    {

            if (mod(denominator, numerator) = 0 )
                    HCF := numerator
            if ( index = floor(numerator/2) )
            break
    if  ( mod(numerator, index) = 0 ) && ( mod(denominator, index) = 0 )
    {
            HCF = %index%
            index++
    }
    else
            index++
    }
    if ( HCF = "" )
            Ans := numerator "/" Denominator
    else
    Ans := floor(numerator/HCF) "/" floor(Denominator/HCF)
    MsgBox % String . "  ->  " . String1 . " " . Ans
    reload


( ( exact
  =   integerPart decimalPart z
    .     @(!arg:?integerPart "." ?decimalPart)
        &   !integerPart
          + (   @( !decimalPart
                 : (? ((%@:~0) ?:?decimalPart)) [?z
                 )
              & !decimalPart*10^(-1*!z)
            | 0
            )
      | !arg
  )
& ( approximation
  =     integerPart firstDecimals repeatingDecimals
      , x y z z-y x-y numerator denominator
    .   @( !arg
         :   ?integerPart
             "."
             [?x
             ?firstDecimals
             ?repeatingDecimals
             [?y
             !repeatingDecimals
             [?z
         )
      & !z+-1*!y:?z-y
      & !x+-1*!y:?x-y
      & 10:?numerator:?denominator
      & ( !z-y:0&0:?repeatingDecimals
        |   9:?denominator
          &   whl
            ' ( !z+-1:>!y:?z
              & !numerator*10:?numerator
              & !denominator*10+9:?denominator
              )
          & @(!repeatingDecimals:? #?repeatingDecimals)
        )
      & ( @(!firstDecimals:? #?firstDecimals)
        | 0:?firstDecimals
        )
      &   !integerPart
        + !firstDecimals*10^(!x-y+!z-y)
        + !numerator*!denominator^-1*!repeatingDecimals*10^!x-y
  )
&     "0.9054054054"
      "0.5185185185"
      "0.75"
      "0.905405400"
      "0.1428571428"
      "35.000"
      "35.001"
      "0.00000000001"
      "0.000001000001"
      "0.9"
      "0.99"
      "0.909"
      "0.9090"
      "0.90909"
  : ?decs
&   whl
  ' ( !decs:%?dec ?decs
    & approximation$!dec:?approx
    &   out
      $ ( !dec
          "="
          (exact$!dec:?precise)
          ( !approx:!precise&
          | str$("(approx. " !approx ")")
          )
        )
    )
);


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <stdint.h>

/* f : number to convert.
 * num, denom: returned parts of the rational.
 * md: max denominator value.  Note that machine floating point number
 *     has a finite resolution (10e-16 ish for 64 bit double), so specifying
 *     a "best match with minimal error" is often wrong, because one can
 *     always just retrieve the significand and return that divided by
 *     2**52, which is in a sense accurate, but generally not very useful:
 *     1.0/7.0 would be "2573485501354569/18014398509481984", for example.
 */
void rat_approx(double f, int64_t md, int64_t *num, int64_t *denom)
{
	/*  a: continued fraction coefficients. */
	int64_t a, h[3] = { 0, 1, 0 }, k[3] = { 1, 0, 0 };
	int64_t x, d, n = 1;
	int i, neg = 0;

	if (md <= 1) { *denom = 1; *num = (int64_t) f; return; }

	if (f < 0) { neg = 1; f = -f; }

	while (f != floor(f)) { n <<= 1; f *= 2; }
	d = f;

	/* continued fraction and check denominator each step */
	for (i = 0; i < 64; i++) {
		a = n ? d / n : 0;
		if (i && !a) break;

		x = d; d = n; n = x % n;

		x = a;
		if (k[1] * a + k[0] >= md) {
			x = (md - k[0]) / k[1];
			if (x * 2 >= a || k[1] >= md)
				i = 65;
			else
				break;
		}

		h[2] = x * h[1] + h[0]; h[0] = h[1]; h[1] = h[2];
		k[2] = x * k[1] + k[0]; k[0] = k[1]; k[1] = k[2];
	}
	*denom = k[1];
	*num = neg ? -h[1] : h[1];
}

int main()
{
	int i;
	int64_t d, n;
	double f;

	printf("f = %16.14f\n", f = 1.0/7);
	for (i = 1; i <= 20000000; i *= 16) {
		printf("denom <= %d: ", i);
		rat_approx(f, i, &n, &d);
		printf("%lld/%lld\n", n, d);
	}

	printf("\nf = %16.14f\n", f = atan2(1,1) * 4);
	for (i = 1; i <= 20000000; i *= 16) {
		printf("denom <= %d: ", i);
		rat_approx(f, i, &n, &d);
		printf("%lld/%lld\n", n, d);
	}

	return 0;
}


using System;
using System.Text;

namespace RosettaDecimalToFraction
{
    public class Fraction
    {
        public Int64 Numerator;
        public Int64 Denominator;
        public Fraction(double f, Int64 MaximumDenominator = 4096)
        {
            /* Translated from the C version. */
            /*  a: continued fraction coefficients. */
            Int64 a;
            var h = new Int64[3] { 0, 1, 0 };
            var k = new Int64[3] { 1, 0, 0 };
            Int64 x, d, n = 1;
            int i, neg = 0;

            if (MaximumDenominator <= 1)
            {
                Denominator = 1;
                Numerator = (Int64)f;
                return;
            }

            if (f < 0) { neg = 1; f = -f; }

            while (f != Math.Floor(f)) { n <<= 1; f *= 2; }
            d = (Int64)f;

            /* continued fraction and check denominator each step */
            for (i = 0; i < 64; i++)
            {
                a = (n != 0) ? d / n : 0;
                if ((i != 0) && (a == 0)) break;

                x = d; d = n; n = x % n;

                x = a;
                if (k[1] * a + k[0] >= MaximumDenominator)
                {
                    x = (MaximumDenominator - k[0]) / k[1];
                    if (x * 2 >= a || k[1] >= MaximumDenominator)
                        i = 65;
                    else
                        break;
                }

                h[2] = x * h[1] + h[0]; h[0] = h[1]; h[1] = h[2];
                k[2] = x * k[1] + k[0]; k[0] = k[1]; k[1] = k[2];
            }
            Denominator = k[1];
            Numerator = neg != 0 ? -h[1] : h[1];
        }
        public override string ToString()
        {
            return string.Format("{0} / {1}", Numerator, Denominator);
        }
    }
    class Program
    {
        static void Main(string[] args)
        {
            Console.OutputEncoding = UTF8Encoding.UTF8;
            foreach (double d in new double[] { 0.9054054, 0.518518, 0.75, 0.4285714, 0.833333,
                0.90909, 3.14159265358979, 2.7182818284590451 })
            {
                var f = new Fraction(d, d >= 2 ? 65536 : 4096);
                Console.WriteLine("{0,20} → {1}", d, f);

            }
        }
    }
}


import std.stdio, std.math, std.string, std.typecons;

alias Fraction = Tuple!(int,"nominator", uint,"denominator");

Fraction real2Rational(in real r, in uint bound) /*pure*/ nothrow {
    if (r == 0.0) {
        return Fraction(0, 1);
    } else if (r < 0.0) {
        auto result = real2Rational(-r, bound);
        result.nominator = -result.nominator;
        return result;
    } else {
        uint best = 1;
        real bestError = real.max;

        foreach (i; 1 .. bound + 1) {
            // round is not pure.
            immutable real error = abs(i * r - round(i * r));
            if (error < bestError) {
                best = i;
                bestError = error;
            }
        }

        return Fraction(cast(int)round(best * r), best);
    }
}

void main() {
    immutable tests = [ 0.750000000,  0.518518000, 0.905405400,
                        0.142857143,  3.141592654, 2.718281828,
                       -0.423310825, 31.415926536];

    foreach (r; tests) {
        writef("%8.9f  ", r);
        foreach (i; 0 .. 5)
            writef("  %d/%d", real2Rational(r, 10 ^^ i).tupleof);
        writeln();
    }
}


program Convert_decimal_number_to_rational;

{$APPTYPE CONSOLE}

uses
  Velthuis.BigRationals,
  Velthuis.BigDecimals;

const
  Tests: TArray<string> = ['0.9054054', '0.518518', '0.75'];

var
  Rational: BigRational;
  Decimal: BigDecimal;

begin
  for var test in Tests do
  begin
    Decimal := test;
    Rational := Decimal;
    Writeln(test, ' = ', Rational.ToString);
  end;
  Readln;
end.


USING: kernel math.floating-point prettyprint ;

0.9054054 0.518518 0.75 [ double>ratio . ] [email protected]


\ Brute force search, optimized to search only within integer bounds surrounding target
\ Forth 200x compliant

: RealToRational  ( float_target int_denominator_limit -- numerator denominator )
    {:  f: thereal denlimit | realscale  numtor denom neg? f: besterror f: temperror :}
    0 to numtor
    0 to denom
    9999999e to besterror                 \ very large error that will surely be improved upon
    thereal F0< to neg?                   \ save sign for later
    thereal FABS to thereal

    thereal FTRUNC f>s 1+ to realscale      \ realscale helps set integer bounds around target

    denlimit 1+ 1 ?DO                    \ search through possible denominators ( 1 to denlimit)

        I realscale *  I realscale 1- *  ?DO    \ search within integer limits bounding the real
            I s>f  J s>f  F/                    \ e.g. for 3.1419e search only between 3 and 4
            thereal F- FABS to temperror

            temperror besterror F< IF
                temperror to besterror I to numtor J to denom
            THEN
        LOOP

    LOOP

    neg? IF numtor NEGATE to numtor THEN

    numtor denom
;
(run)
1.618033988e 100 RealToRational  swap . . 144 89
3.14159e 1000 RealToRational swap . . 355 113
2.71828e 1000 RealToRational swap . . 1264 465
0.9054054e 100 RealToRational swap . . 67  74


      MODULE PQ	!Plays with some integer arithmetic.
       INTEGER MSG	!Output unit number.
       CONTAINS		!One good routine.
        INTEGER FUNCTION GCD(I,J)	!Greatest common divisor.
         INTEGER I,J	!Of these two integers.
         INTEGER N,M,R	!Workers.
          N = MAX(I,J)	!Since I don't want to damage I or J,
          M = MIN(I,J)	!These copies might as well be the right way around.
    1     R = MOD(N,M)		!Divide N by M to get the remainder R.
          IF (R.GT.0) THEN	!Remainder zero?
            N = M			!No. Descend a level.
            M = R			!M-multiplicity has been removed from N.
            IF (R .GT. 1) GO TO 1	!No point dividing by one.
          END IF			!If R = 0, M divides N.
          GCD = M			!There we are.
        END FUNCTION GCD	!Euclid lives on!

        SUBROUTINE RATIONAL10(X)!By contrast, this is rather crude.
         DOUBLE PRECISION X	!The number.
         DOUBLE PRECISION R	!Its latest rational approach.
         INTEGER P,Q		!For R = P/Q.
         INTEGER F,WHACK	!Assistants.
         PARAMETER (WHACK = 10**8)	!The rescale...
          P = X*WHACK + 0.5	!Multiply by WHACK/WHACK = 1 and round to integer.
          Q = WHACK		!Thus compute X/1, sortof.
          F = GCD(P,Q)		!Perhaps there is a common factor.
          P = P/F		!Divide it out.
          Q = Q/F		!For a proper rational number.
          R = DBLE(P)/DBLE(Q)	!So, where did we end up?
          WRITE (MSG,1) P,Q,X - R,WHACK	!Details.
    1     FORMAT ("x - ",I0,"/",I0,T28," = ",F18.14,
     1     " via multiplication by ",I0)
        END SUBROUTINE RATIONAL10	!Enough of this.

        SUBROUTINE RATIONAL(X)	!Use brute force in a different way.
         DOUBLE PRECISION X	!The number.
         DOUBLE PRECISION R,E,BEST	!Assistants.
         INTEGER P,Q		!For R = P/Q.
         INTEGER TRY,F		!Floundering.
          P = 1 + X	!Prevent P = 0.
          Q = 1		!So, X/1, sortof.
          BEST = X*6	!A largeish value for the first try.
          DO TRY = 1,10000000	!Pound away.
            R = DBLE(P)/DBLE(Q)		!The current approximation.
            E = X - R			!Deviation.
            IF (ABS(E) .LE. BEST) THEN	!Significantly better than before?
              BEST = ABS(E)*0.125		!Yes. Demand eightfold improvement to notice.
              F = GCD(P,Q)			!We may land on a multiple.
              IF (BEST.LT.0.1D0) WRITE (MSG,1) P/F,Q/F,E	!Skip early floundering.
    1         FORMAT ("x - ",I0,"/",I0,T28," = ",F18.14)	!Try to align columns.
              IF (F.NE.1) WRITE (MSG,*) "Common factor!",F	!A surprise!
              IF (E.EQ.0) EXIT			!Perhaps we landed a direct hit?
            END IF			!So much for possible announcements.
            IF (E.GT.0) THEN	!Is R too small?
              P = P + CEILING(E*Q)	!Yes. Make P bigger by the shortfall.
            ELSE IF (E .LT. 0) THEN	!But perhaps R is too big?
              Q = Q + 1			!If so, use a smaller interval.
            END IF		!So much for adjustments.
          END DO		!Try again.
        END SUBROUTINE RATIONAL	!Limited integers, limited sense.

        SUBROUTINE RATIONALISE(X,WOT)	!Run the tests.
         DOUBLE PRECISION X	!The value.
         CHARACTER*(*) WOT	!Some blather.
          WRITE (MSG,*) X,WOT	!Explanations can help.
          CALL RATIONAL10(X)	!Try a crude method.
          CALL RATIONAL(X)	!Try a laborious method.
          WRITE (MSG,*)		!Space off.
        END SUBROUTINE RATIONALISE	!That wasn't much fun.
      END MODULE PQ	!But computer time is cheap.

      PROGRAM APPROX
      USE PQ
      DOUBLE PRECISION PI,E
      MSG = 6
      WRITE (MSG,*) "Rational numbers near to decimal values."
      WRITE (MSG,*)
      PI = 1		!Thus get a double precision conatant.
      PI = 4*ATAN(PI)	!That will determine the precision of ATAN.
      E = DEXP(1.0D0)	!Rather than blabber on about 1 in double precision.
      CALL RATIONALISE(0.1D0,"1/10 Repeating in binary..")
      CALL RATIONALISE(3.14159D0,"Pi approx.")
      CALL RATIONALISE(PI,"Pi approximated better.")
      CALL RATIONALISE(E,"e: rational approximations aren't much use.")
      CALL RATIONALISE(10.15D0,"Exact in decimal, recurring in binary.")
      WRITE (MSG,*)
      WRITE (MSG,*) "Variations on 67/74"
      CALL RATIONALISE(0.9054D0,"67/74 = 0·9(054) repeating in base 10")
      CALL RATIONALISE(0.9054054D0,"Two repeats.")
      CALL RATIONALISE(0.9054054054D0,"Three repeats.")
      WRITE (MSG,*)
      WRITE (MSG,*) "Variations on 14/27"
      CALL RATIONALISE(0.518D0,"14/27 = 0·(518) repeating in decimal.")
      CALL RATIONALISE(0.519D0,"Rounded.")
      CALL RATIONALISE(0.518518D0,"Two repeats, truncated.")
      CALL RATIONALISE(0.518519D0,"Two repeats, rounded.")
      END


'' Written in FreeBASIC
'' (no error checking, limited to 64-bit signed math)
type number as longint
#define str2num vallng
#define pow10(n) clngint(10 ^ (n))

function gcd(a as number, b as number) as number
    if a = 0 then return b
    return gcd(b mod a, a)
end function

function parserational(n as const string) as string
    dim as string whole, dec, num, denom
    dim as number iwhole, idec, inum, idenom, igcd

    '' find positions of '.', '(' and ')' in code
    dim as integer dpos, r1pos, r2pos
    dpos = instr(n & ".", ".")
    r1pos = instr(n & "(", "(")
    r2pos = instr(n & ")", ")")

    '' extract sections of number (whole, decimal, repeated numerator), generate '999' denominator
    whole = left(n, dpos - 1)
    dec = mid(n, dpos + 1, r1pos - dpos - 1)
    num = mid(n, r1pos + 1, r2pos - r1pos - 1)
    denom = string(len(num), "9"): if denom = "" then denom = "1"

    '' parse sections to integer
    iwhole = str2num(whole)
    idec = str2num(dec)
    inum = str2num(num)
    idenom = str2num(denom)

    '' if whole was negative, decimal and repeated sections need to be negative too
    if left(ltrim(whole), 1) = "-" then idec = -idec: inum = -inum

    '' add decimal part to repeated fraction, and scale down
    inum += idec * idenom
    idenom *= pow10(len(dec))

    '' add integer part to fraction
    inum += iwhole * idenom

    '' simplify fraction
    igcd = abs(gcd(inum, idenom))
    if igcd <> 0 then
        inum \= igcd
        idenom \= igcd
    end if

    return inum & " / " & idenom & " = " & (inum / idenom)

end function

data "0.9(054)", "0.(518)", "-.12(345)", ""
do
    dim as string n
    read n
    if n = "" then exit do
    print n & ":", parserational(n)
loop


package main

import (
    "fmt"
    "math/big"
)

func main() {
    for _, d := range []string{"0.9054054", "0.518518", "0.75"} {
        if r, ok := new(big.Rat).SetString(d); ok {
            fmt.Println(d, "=", r)
        } else {
            fmt.Println(d, "invalid decimal number")
        }
    }
}


(() => {
    'use strict';

    const main = () =>
        showJSON(
            map( // Using a tolerance epsilon of 1/10000
                n => showRatio(approxRatio(0.0001)(n)),
                [0.9054054, 0.518518, 0.75]
            )
        );

    // Epsilon -> Real -> Ratio

    // approxRatio :: Real -> Real -> Ratio
    const approxRatio = eps => n => {
        const
            gcde = (e, x, y) => {
                const _gcd = (a, b) => (b < e ? a : _gcd(b, a % b));
                return _gcd(Math.abs(x), Math.abs(y));
            },
            c = gcde(Boolean(eps) ? eps : (1 / 10000), 1, n);
        return Ratio(
            Math.floor(n / c), // numerator
            Math.floor(1 / c) // denominator
        );
    };

    // GENERIC FUNCTIONS ----------------------------------

    // Ratio :: Int -> Int -> Ratio
    const Ratio = (n, d) => ({
        type: 'Ratio',
        'n': n, // numerator
        'd': d // denominator
    });

    // map :: (a -> b) -> [a] -> [b]
    const map = (f, xs) => xs.map(f);

    // showJSON :: a -> String
    const showJSON = x => JSON.stringify(x, null, 2);

    // showRatio :: Ratio -> String
    const showRatio = nd =>
        nd.n.toString() + '/' + nd.d.toString();

    // MAIN ---
    return main();
})();


# include "rational"; # a reminder that r/2 and power/1 are required

# Input: any JSON number, not only a decimal
# Output: a rational, constructed using r/2
# Requires power/1 (to take advantage of gojq's support for integer arithmetic)
# and r/2 (for rational number constructor)
def number_to_r:

  # input: a decimal string
  # $in - either null or the original input
  # $e  - the integer exponent of the original number, or 0
  def dtor($in; $e):
    index(".") as $ix
    | if $in and ($ix == null) then $in
      else (if $ix then sub("[.]"; "") else . end | tonumber) as $n
      | (if $ix then ((length - ($ix+1)) - $e) else - $e end) as $p
      | if $p >= 0
        then r( $n;   10|power($p))
        else r( $n * (10|power(-$p)); 1)
        end
     end;

    . as $in
    | tostring
    | if (test("[Ee]")|not) then dtor($in; 0)
      else capture("^(?<s>[^eE]*)[Ee](?<e>.*$)")
      | (.e | if length > 0 then tonumber else 0 end) as $e
      | .s | dtor(null; $e)
    end ;


// version 1.1.2

class Rational(val num: Long, val den: Long) {
    override fun toString() = "$num/$den"
}

fun decimalToRational(d: Double): Rational {
    val ds = d.toString().trimEnd('0').trimEnd('.')
    val index = ds.indexOf('.')
    if (index == -1) return Rational(ds.toLong(), 1L)
    var num = ds.replace(".", "").toLong()
    var den = 1L
    for (n in 1..(ds.length - index - 1)) den *= 10L
    while (num % 2L == 0L && den % 2L == 0L) {
        num /= 2L
        den /= 2L
    }
    while (num % 5L == 0L && den % 5L == 0L) {
        num /= 5L
        den /= 5L
    }
    return Rational(num, den)
}

fun main(args: Array<String>) {
    val decimals = doubleArrayOf(0.9054054, 0.518518, 2.405308, .75, 0.0, -0.64, 123.0, -14.6)
    for (decimal in decimals)
        println("${decimal.toString().padEnd(9)} = ${decimalToRational(decimal)}")
}


'   Uses convention that one repeating sequence implies infinitely repeating sequence..
'   Non-recurring fractions are limited to nd number of digits in nuerator & denominator

nd =3   '   suggest 3. 4 is slow. >4 is .......
do
    read x$
    data "0.5", "0.1", "0.333", "1 /3", "0.33", "0.14159265", "2^-0.5", "0.1 +0.9*rnd(1)"
    data "0.142857142857", "int( 1000*rnd(1))/int( 1000*rnd(1))","end"   '   always between 0 and 0.999999...
    if x$ ="end" then exit do
    print x$; " is ";
    type$ =check$( x$)
    print type$;

    if type$ ="recurring" then
        x   =val( mid$( x$, 3, ( len( x$) -2) /2))
        rep =( len( x$) -2) /2
        num =x
        den =10^rep -1
        gcd =gcd( num, den)
        print
        print " Calculating exact fraction for ", recurring$( x); " recurring & found";
        print num /gcd; " /"; den /gcd
        print
    else    '   non-recurring. Check numerators & denominators <1000
        x =eval( x$)
        print
        print " Looking for fractions that are close to "; using( "#.############", x); " & found ";
        eps =10^nd
        for n = 1 to nd
            for i =1 to 10^n -1
                for j =i to 10^n -1
                    fr =i /j
                    if abs( x -fr) <eps then
                        eps =abs( x -fr)
                        'print i; " /"; j; " = ", using( "##.############", fr), "with error +/-"; using( "###.#########", eps /x *100); " %"
                        ii =i: jj =j
                        if eps =0 then exit for
                    end if
                next j
                scan
                if eps =0 then exit for
            next i
            if eps =0 then exit for
        next n
        print ii; " /"; jj
        print
    end if
loop until 0

print
print "END."

end

function recurring$( x)
    recurring$ ="0."
    do
        recurring$ =recurring$ +str$( x)
    loop until len( recurring$) >=14
end function

function gcd( a, b)  '   thanks Uncle Ben..
    while b <>0
       t =b
       b =a mod b
       a =t
    wend
    gcd =a
end function

function check$( i$)
    check$ ="non-recurring"
    length =len( i$) -2     '   allow for the '0.'.
    if length /2 =int( length /2) then if mid$( i$, 3, length /2) =mid$( i$, 3 +length /2, length /2) then check$ ="recurring"
end function


for _,v in ipairs({ 0.9054054, 0.518518, 0.75, math.pi }) do
  local n, d, dmax, eps = 1, 1, 1e7, 1e-15
  while math.abs(n/d-v)>eps and d<dmax do d=d+1 n=math.floor(v*d) end
  print(string.format("%15.13f --> %d / %d", v, n, d))
end


П0	П1	ИП1	{x}	x#0	14	КИП4	ИП1	1	0
*	П1	БП	02	ИП4	10^x	П0	ПA	ИП1	ПB
ИПA	ИПB	/	П9	КИП9	ИПA	ИПB	ПA	ИП9	*
-	ПB	x=0	20	ИПA	ИП0	ИПA	/	П0	ИП1
ИПA	/	П1	ИП0	ИП1	С/П


/*NetRexx program to convert decimal numbers to fractions *************
* 16.08.2012 Walter Pachl derived from Rexx Version 2
**********************************************************************/
options replace format comments java crossref savelog symbols
  Numeric Digits 10               /* use "only" 10 digs of precision */
  ratt('0.9054054054','67/74')
  ratt('0.5185185185','14/27')
  ratt('0.75'        ,'3/4')
  ratt('0.905405400',' 693627417/766095958')
  ratt('0.9054054054','67/74')
  ratt('0.1428571428','1/7')
  ratt('35.000','35')
  ratt('35.001','35001/1000')
  ratt('0.00000000001','?')
  ratt('0.000001000001','1/999999')

ratt(0.9054054054,'1/3')

method ratt(d = Rexx,fs = Rexx) public static
 fract=rat(d)
 Say '  'd '->' fract
 Parse fract no '/' de
 If de='' Then x=no
          Else x=no/de
 If x<>d Then
   Say '> '||x 'is different'

method rat(in, high='') public static
/**********************************************************************
* rat(number<,high) returns a fraction or an integer that is equal to
* or approximately equal to number.
* Nominator and denominator must not have more than high digits
* 16.08.2012 Walter Pachl derived from Rexx Version 2
**********************************************************************/
  if high=='' then
    high=10**(digits - 1)           /* maximum nominator/denominator */
  x=in                                 /* working copy               */
  nom=0                                /* start values nominator     */
  den=1                                /*              denominator   */
  tnom=1                               /*         temp nominator     */
  tden=0                               /*         temp denominator   */
  loop While tnom<=high & tden<=high   /* nominator... not too large */
    n=x.trunc()                        /* take integer part of x     */
    z=tnom;                            /* save temp nominator        */
    tnom=n*tnom+nom;                   /* compute new temp nominator */
    nom=z                              /* assign nominator           */
    z=tden;                            /* save temp denominator      */
    tden=n*tden+den                    /* compute new temp denominato*/
    den=z                              /* assign denominator         */
    if n=x | tnom/tden=in then do
      if tnom>high | tden>high then    /* temp value(s) too large    */
        Leave                          /* don't use them             */
      nom=tnom                         /* otherwise take them as     */
      den=tden                         /* final values               */
      leave                            /* and end the loop           */
      end
    x=1/(x-n)                          /* compute x for next round   */
    end
  If den=1 Then Return nom             /* an integer                 */
           Else Return nom'/'den       /* otherwise a fraction       */


import math
import fenv

type
  Rational = object
    numerator: int
    denominator: int

proc `$`(self: Rational): string =
  if self.denominator == 1:
    $self.numerator
  else:
    $self.numerator & "//" & $self.denominator

func rationalize(x: float, tol: float = epsilon(float)): Rational =
  var xx = x
  let flagNeg = xx < 0.0
  if flagNeg:
    xx = -xx
  if xx < minimumPositiveValue(float):
    return Rational(numerator: 0, denominator: 1)
  if abs(xx - round(xx)) < tol:
    return Rational(numerator: int(round(xx)), denominator: 1)
  var a = 0
  var b = 1
  var c = int(ceil(xx))
  var d = 1
  var aux1 = high(int) div 2
  while c < aux1 and d < aux1:
    var aux2 = (float(a) + float(c)) / (float(b) + float(d))
    if abs(xx - aux2) < tol:
      break
    if xx > aux2:
      inc a, c
      inc b, d
    else:
      inc c, a
      inc d, b
  var gcd = gcd(a + c, b + d)
  if flagNeg:
    Rational(numerator: -(a + c) div gcd, denominator: (b + d) div gcd)
  else:
    Rational(numerator: (a + c) div gcd, denominator: (b + d) div gcd)

echo rationalize(0.9054054054)
echo rationalize(0.9054054054, 0.0001)
echo rationalize(0.5185185185)
echo rationalize(0.5185185185, 0.0001)
echo rationalize(0.75)
echo rationalize(0.1428571428, 0.001)
echo rationalize(35.000)
echo rationalize(35.001)
echo rationalize(0.9)
echo rationalize(0.99)
echo rationalize(0.909)
echo rationalize(0.909, 0.001)


sub gcd {
        my ($m, $n) = @_;
        ($m, $n) = ($n, $m % $n) while $n;
        return $m
}

sub rat_machine {
        my $n = shift;
        my $denom = 1;
        while ($n != int $n) {
                # assuming the machine format is base 2, and multiplying
                # by 2 doesn't change the mantissa
                $n *= 2;

                # multiply denom by 2, ignoring (very) possible overflow
                $denom <<= 1;
        }
        if ($n) {
                my $g = gcd($n, $denom);
                $n /= $g;
                $denom /= $g;
        }
        return $n, $denom;
}

# helper, make continued fraction back into normal fraction
sub get_denom {
        my ($num, $denom) = (1, pop @_);
        for (reverse @_) {
                ($num, $denom) = ($denom, $_ * $denom + $num);
        }
        wantarray ? ($num, $denom) : $denom
}

sub best_approx {
        my ($n, $limit) = @_;
        my ($denom, $neg);
        if ($n < 0) {
                $neg = 1;
                $n = -$n;
        }

        my $int = int($n);
        my ($num, $denom, @coef) = (1, $n - $int);

        # continued fraction, sort of
        while (1) {
                # make sure it terminates
                last if $limit * $denom < 1;
                my $i = int($num / $denom);

                # not the right way to get limit, but it works
                push @coef, $i;

                if (get_denom(@coef) > $limit) {
                        pop @coef;
                        last;
                }

                # we lose precision here, but c'est la vie
                ($num, $denom) = ($denom, $num - $i * $denom);
        }

        ($num, $denom) = get_denom @coef;
        $num += $denom * $int;

        return $neg ? -$num : $num, $denom;
}

sub rat_string {
        my $n = shift;
        my $denom = 1;
        my $neg;

        # trival xyz.0000 ... case
        $n =~ s/\.0+$//;
        return $n, 1 unless $n =~ /\./;

        if ($n =~ /^-/) {
                $neg = 1;
                $n =~ s/^-//;
        }

        # shift decimal point to the right till it's gone
        $denom *= 10    while $n =~ s/\.(\d)/$1\./;
        $n =~ s/\.$//;

        # removing leading zeros lest it looks like octal
        $n =~ s/^0*//;
        if ($n) {
                my $g = gcd($n, $denom);
                $n /= $g;
                $denom /= $g;
        }
        return $neg ? -$n : $n, $denom;
}

my $limit = 1e8;
my $x = 3/8;
print "3/8 = $x:\n";
printf "machine: %d/%d\n", rat_machine $x;
printf "string:  %d/%d\n", rat_string  $x;
printf "approx below $limit:  %d/%d\n", best_approx $x, $limit;

$x = 137/4291;
print "\n137/4291 = $x:\n";
printf "machine: %d/%d\n", rat_machine $x;
printf "string:  %d/%d\n", rat_string  $x;
printf "approx below $limit:  %d/%d\n", best_approx $x, $limit;

$x = sqrt(1/2);
print "\n1/sqrt(2) = $x\n";
printf "machine: %d/%d\n", rat_machine $x;
printf "string:  %d/%d\n", rat_string  $x;
printf "approx below 10:  %d/%d\n", best_approx $x, 10;
printf "approx below 100:  %d/%d\n", best_approx $x, 100;
printf "approx below 1000:  %d/%d\n", best_approx $x, 1000;
printf "approx below 10000:  %d/%d\n", best_approx $x, 10000;
printf "approx below 100000:  %d/%d\n", best_approx $x, 100000;
printf "approx below $limit:  %d/%d\n", best_approx $x, $limit;

$x = -4 * atan2(1,1);
print "\n-Pi = $x\n";
printf "machine: %d/%d\n", rat_machine $x;
printf "string:  %d/%d\n", rat_string  $x;

for (map { 10 ** $_ } 1 .. 10) {
        printf "approx below %g: %d / %d\n", $_, best_approx($x, $_)
}


with javascript_semantics
function decrat(string s)
    integer nom = 0,
            denom = 1
    assert(s[1..2]="0.")
    for i=3 to length(s) do
        integer ch = s[i]
        assert(ch>='0' and ch<='9')
        nom = nom*10 + ch-'0'
        denom *= 10
    end for
    return sq_div({nom,denom},gcd(nom,denom))
end function

?decrat("0.9054054")
?decrat("0.518518")
?decrat("0.75")


(size, fofl):
Convert_Decimal_To_Rational: procedure options (main); /* 14 January 2014, from Ada */

Real_To_Rational: procedure (R, Bound, Numerator, Denominator) recursive
         options (reorder);
   declare R float (18), Bound float,
          (Numerator, Denominator) fixed binary (31);
   declare Error float;
   declare Best fixed binary initial (1);
   declare Best_Error float initial (huge(error));
   declare I fixed binary (31);

   if R = 0 then
      do;
         Numerator   = 0;
         Denominator = 1;
         return;
      end;
   else if R < 0 then
      do;
         call Real_To_Rational(-R, Bound, Numerator, Denominator);
         Numerator = -Numerator;
         return;
      end;
   else
      do I = 1 to Bound;
         Error = abs(I * R - trunc(I * R + sign(R)*0.5));
         if Error < Best_Error then
            do;
               Best = I;
               Best_Error = Error;
            end;
      end;

   Denominator = Best;
   Numerator   = Denominator * R + sign(R) * 0.5;

end Real_To_Rational;

   declare (Num, Denom) fixed binary (31);
   declare R float (18);
   declare I fixed BINARY;

   do R = 0.75, 0.25,   0.3333333,   0.518518000,  0.905405400,
          0.142857143,  3.141592654, 2.718281828, -0.423310825,
          31.415926536, 0;
      put skip edit(R) (f(13,9));
      do I = 0 to 4;
         call Real_to_Rational(R, 10**I, Num, Denom);
         put edit('   ' || trim(Num) || ' / ' || trim(Denom)) (a);
      end;
   end;
end Convert_Decimal_To_Rational;


Procedure.i ggT(a.i, b.i)
  Define t.i : If a < b : Swap a, b : EndIf
  While a%b : t=a : a=b : b=t%a : Wend : ProcedureReturn b
EndProcedure

Procedure.s Dec2Rat(dn.d)
  Define nk$, gt.i, res$
  nk$=Trim(StringField(StrD(dn),2,"."),"0")
  gt=ggT(Val(nk$),Int(Pow(10.0,Len(nk$))))
  res$=Str(Val(nk$)/gt)+"/"+Str(Int(Pow(10.0,Len(nk$)))/gt)
  ProcedureReturn res$
EndProcedure

OpenConsole()
Define d.d
Repeat
  Read.d d : If Not (d>0.0 And d<1.0) : Break : EndIf
  Print(LSet(StrD(d),15," ")+" -> "+#TAB$+Dec2Rat(d)+#CRLF$)
ForEver
Input() : End

DataSection
  Data.d 0.9054054,0.518518,0.75,0.0
EndDataSection


ratio<-function(decimal){
  denominator=1
  while(nchar(decimal*denominator)!=nchar(round(decimal*denominator))){
    denominator=denominator+1
  }
  str=paste(decimal*denominator,"/",sep="")
  str=paste(str,denominator,sep="")
  return(str)
}


[ $ "bigrat.qky" loadfile ] now!

  [ dup echo$
    say " is "
    $->v drop
    dup 100 > if
      [ say "approximately "
        proper 100 round
        improper ]
    vulgar$ echo$
    say "." cr ]     is task ( $ --> )

$ "0.9054054 0.518518 0.75" nest$ witheach task


/*REXX program converts a rational fraction  [n/m]  (or  nnn.ddd)  to it's lowest terms.*/
numeric digits 10                                /*use ten decimal digits of precision. */
parse arg  orig 1 n.1  "/"  n.2;       if n.2=''  then n.2=1         /*get the fraction.*/
if n.1=''  then call er 'no argument specified.'

  do j=1  for 2;     if \datatype(n.j, 'N')  then call er  "argument isn't numeric:"   n.j
  end   /*j*/                                    /* [↑]  validate arguments:  n.1  n.2  */

if n.2=0  then call er "divisor can't be zero."  /*Whoa!   We're dividing by zero !     */
say 'old ='    space(orig)                       /*display the original fraction.       */
say 'new ='    rat(n.1/n.2)                      /*display the result ──► terminal.     */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
er:  say;      say '***error***';     say;    say arg(1);    say;       exit 13
/*──────────────────────────────────────────────────────────────────────────────────────*/
rat: procedure;  parse arg x 1 _x,y;          if y==''  then y = 10**(digits()-1)
     b=0;  g=0;  a=1;  h=1                               /* [↑]    Y   is the tolerance.*/
                            do  while  a<=y & g<=y;   n=trunc(_x)
                            _=a;   a=n*a+b;   b=_
                            _=g;   g=n*g+h;   h=_
                            if n=_x | a/g=x then do;  if a>y | g>y  then iterate
                                                      b=a;     h=g;      leave
                                                 end
                            _x=1/(_x-n)
                            end   /*while*/
     if h==1  then return b                              /*don't return number  ÷  by 1.*/
                   return b'/'h                          /*proper or improper fraction. */


extern crate rand;
extern crate num;

use num::Integer;
use rand::Rng;

fn decimal_to_rational (mut n : f64) -> [isize;2] {
    //Based on Farey sequences
    assert!(n.is_finite());
    let flag_neg  = n < 0.0;
    if flag_neg { n = n*(-1.0) }
    if n < std::f64::MIN_POSITIVE { return [0,1] }
    if (n - n.round()).abs() < std::f64::EPSILON { return [n.round() as isize, 1] }
    let mut a : isize = 0;
    let mut b : isize = 1;
    let mut c : isize = n.ceil() as isize;
    let mut d : isize = 1;
    let aux1 = isize::max_value()/2;
    while c < aux1  && d < aux1 {
        let aux2 : f64 = (a as f64 + c as f64)/(b as f64 + d as f64);
        if (n - aux2).abs() < std::f64::EPSILON { break }
        if n > aux2 {
            a = a + c;
            b = b + d;
        } else {
            c = a + c;
            d = b + d;
        }
    }
    // Make sure that the fraction is irreducible
    let gcd = (a+c).gcd(&(b+d));
    if flag_neg { [-(a + c)/gcd, (b + d)/gcd] } else { [(a + c)/gcd, (b + d)/gcd] }
}

#[test]
fn test1 () {
    // Test the function with 1_000_000 random decimal numbers
    let mut rng = rand::thread_rng();
    for _i in 1..1_000_000 {
        let number = rng.gen::<f64>();
        let result = decimal_to_rational(number);
        assert!((number - (result[0] as f64)/(result[1] as f64)).abs() < std::f64::EPSILON);
        assert!(result[0].gcd(&result[1]) == 1);
    }
}

fn main () {
    let mut rng = rand::thread_rng();
    for _i in 1..10 {
        let number = rng.gen::<f64>();
        let result = decimal_to_rational(number);
        if result[1] == 1 { println!("{} -> {}", number, result[0]) } else { println!("{} ->  {}/{}", number, result[0], result[1]) }
    }
    for i in [-0.9054054, 0.518518, -0.75, 0.5185185185185185, -0.9054054054054054, 0.0, 1.0, 2.0].iter() {
        let result = decimal_to_rational(*i as f64);
        if result[1] == 1 { println!("{} = {}",*i, result[0]) } else { println!("{} =  {}/{}", *i, result[0], result[1]) }
    }
}


$ include "seed7_05.s7i";
  include "bigrat.s7i";

const proc: main is func
  begin
    writeln(bigRational parse "0.9(054)");
    writeln(bigRational parse "0.(518)");
    writeln(bigRational parse "0.75");
    writeln(bigRational parse "3.(142857)");
    writeln(bigRational parse "0.(8867924528301)");
    writeln(bigRational parse "0.(846153)");
    writeln(bigRational parse "0.9054054");
    writeln(bigRational parse "0.518518");
    writeln(bigRational parse "0.14285714285714");
    writeln(bigRational parse "3.14159265358979");
    writeln(bigRational parse "2.718281828");
    writeln(bigRational parse "31.415926536");
    writeln(bigRational parse "0.000000000");
  end func;


#!/usr/bin/env tclsh

 proc dbl2frac {dbl {eps 0.000001}} {
   for {set den 1} {$den<1024} {incr den} {
      set num [expr {round($dbl*$den)}]
      if {abs(double($num)/$den - $dbl) < $eps} break
   }
   list $num $den
 }
#-------------------- That's all... the rest is the test suite
if {[file tail $argv0] eq [file tail [info script]]} {
    foreach {test            -> expected} {
	{dbl2frac 0.518518}  -> {42 81}
	{dbl2frac 0.75}      -> {3 4}
	{dbl2frac 0.9054054} -> {67 74}
    } {
	catch $test res
	if {$res ne $expected} {
	    puts "$test -> $res, expected $expected"
	}
    }
}


Function Real2Rational(r As Double, bound As Long) As String

If r = 0 Then
    Real2Rational = "0/1"
ElseIf r < 0 Then
    Result = Real2Rational(-r, bound)
    Real2Rational = "-" & Result
Else
    best = 1
    bestError = 1E+99
    For i = 1 To bound + 1
        currentError = Abs(i * r - Round(i * r))
        If currentError < bestError Then
            best = i
            bestError = currentError
            If bestError < 1 / bound Then GoTo SkipLoop
        End If
    Next i
SkipLoop:
    Real2Rational = Round(best * r) & "/" & best
End If
End Function

Sub TestReal2Rational()
Debug.Print "0.75" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.75, CLng(Order));
Next i
Debug.Print

Debug.Print "0.518518" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.518518, CLng(Order));
Next i
Debug.Print

Debug.Print "0.9054054" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.9054054, CLng(Order));
Next i
Debug.Print

Debug.Print "0.142857143" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.142857143, CLng(Order));
Next i
Debug.Print

Debug.Print "3.141592654" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(3.141592654, CLng(Order));
Next i
Debug.Print

Debug.Print "2.718281828" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(2.718281828, CLng(Order));
Next i
Debug.Print

Debug.Print "-0.423310825" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(-0.423310825, CLng(Order));
Next i
Debug.Print

Debug.Print "31.415926536" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(31.415926536, CLng(Order));
Next i
End Sub


import "/rat" for Rat
import "/fmt" for Fmt

var tests = [0.9054054, 0.518518, 0.75]
for (test in tests) {
    var r = Rat.fromFloat(test)
    System.print("%(Fmt.s(-9, test)) -> %(r)")
}


fcn real2Rational(r,bound){
   if (r == 0.0) return(0,1);
   if (r < 0.0){
      result := real2Rational(-r, bound);
      return(-result[0],result[1]);
   } else {
      best,bestError := 1,(1.0).MAX;
      foreach i in ([1 .. bound + 1]){
         error := (r*i - (r*i).round()).abs();
	 if (error < bestError) best,bestError = i,error;
      }
      return((r*best).round().toInt(),best);
   }
}


with Ada.Containers.Indefinite_Vectors;

package Nutrition is
   type Food is interface;
   procedure Eat (Object : in out Food) is abstract;

end Nutrition;

with Ada.Containers;
with Nutrition;

generic
   type New_Food is new Nutrition.Food;
package Food_Boxes is

  package Food_Vectors is
      new Ada.Containers.Indefinite_Vectors
          (  Index_Type   => Positive,
             Element_Type => New_Food
          );

   subtype Food_Box is Food_Vectors.Vector;

end Food_Boxes;


template<typename T> //Detection helper struct
struct can_eat       //Detects presence of non-const member function void eat()
{
  private:
    template<typename U, void (U::*)()> struct SFINAE {};
    template<typename U> static char Test(SFINAE<U, &U::eat>*);
    template<typename U> static int Test(...);
  public:
    static constexpr bool value = sizeof(Test<T>(0)) == sizeof(char);
};

struct potato
{ void eat(); };

struct brick
{};

template<typename T>
class FoodBox
{
    //Using static assertion to prohibit non-edible types
    static_assert(can_eat<T>::value, "Only edible items are allowed in foodbox");

    //Rest of class definition
};

int main()
{
    FoodBox<potato> lunch;

    //Following leads to compile-time error
    //FoodBox<brick> practical_joke;
}


(defclass food () ())

(defclass inedible-food (food) ())

(defclass edible-food (food) ())

(defgeneric eat (foodstuff)
  (:documentation "Eat the foodstuff."))

(defmethod eat ((foodstuff edible-food))
  "A specialized method for eating edible-food."
  (format nil "Eating ~w." foodstuff))

(defun eatable-p (thing)
  "Returns true if there are eat methods defined for thing."
  (not (endp (compute-applicable-methods #'eat (list thing)))))

(deftype eatable ()
  "Eatable objects are those satisfying eatable-p."
  '(satisfies eatable-p))

(defun make-food-box (extra-type &rest array-args)
  "Returns an array whose element-type is (and extra-type food).
array-args should be suitable for MAKE-ARRAY, and any provided
element-type keyword argument is ignored."
  (destructuring-bind (dimensions &rest array-args) array-args
    (apply 'make-array dimensions
           :element-type `(and ,extra-type food)
           array-args)))

(defun make-eatable-food-box (&rest array-args)
  "Return an array whose elements are declared to be of type (and
eatable food)."
  (apply 'make-food-box 'eatable array-args))


class Apple
  def eat
  end
end

class Carrot
  def eat
  end
end

class FoodBox(T)
  def initialize(@data : Array(T))
    {% if T.union? %}
    {% raise "All items should be eatable" unless T.union_types.all? &.has_method?(:eat) %}
    {% else %}
    {% raise "Items should be eatable" unless T.has_method?(:eat) %}
    {% end %}
  end
end

FoodBox.new([Apple.new, Apple.new])
FoodBox.new([Apple.new, Carrot.new])
FoodBox.new([Apple.new, Carrot.new, 123])


enum IsEdible(T) = is(typeof(T.eat));

struct FoodBox(T) if (IsEdible!T) {
    T[] food;
    alias food this;
}

struct Carrot {
    void eat() {}
}

static struct Car {}

void main() {
    FoodBox!Carrot carrotsBox; // OK
    carrotsBox ~= Carrot();    // Adds a carrot

    //FoodBox!Car carsBox;     // Not allowed
}


/** Guard accepting only objects with an 'eat' method */
def Eatable {
    to coerce(specimen, ejector) {
        if (Ref.isNear(specimen) && specimen.__respondsTo("eat", 0)) {
            return specimen
        } else {
            throw.eject(ejector, `inedible: $specimen`)
        }
    }
}

def makeFoodBox() {
    return [].diverge(Eatable) # A guard-constrained list
}


deferred class
    EATABLE

feature -- Basic operations

    eat
            -- Eat this eatable substance
        deferred
        end
end


type ^a FoodBox                         // a generic type FoodBox
  when ^a: (member eat: unit -> string) // with an explicit member constraint on ^a,
  (items:^a list) =                     // a one-argument constructor
  member inline x.foodItems = items     // and a public read-only property

// a class type that fullfills the member constraint
type Banana() =
  member x.eat() = "I'm eating a banana."

// an instance of a Banana FoodBox
let someBananas = FoodBox [Banana(); Banana()]


include FMS-SI.f
include FMS-SILib.f
:class Eatable
   :m eat ." successful eat " ;m
;class

\ FoodBox is defined without inspecting for the eat message
:class FoodBox
  object-list eatable-types
  :m init: eatable-types init: ;m
  :m add: ( obj -- )
     dup is-kindOf Eatable
     if   eatable-types add:
     else drop ." not an eatable type "
     then ;m
  :m test
     begin eatable-types each:
     while eat
     repeat ;m
;class

FoodBox aFoodBox
Eatable aEatable
aEatable aFoodBox add:  \ add the e1 object to the object-list
aFoodBox test  \ => successful eat

:class brick
 :m eat cr ." successful eat " ;m
;class

brick abrick  \ create an object that is not eatable
abrick aFoodBox add: \ => not an eatable type

:class apple <super Eatable
;class

apple anapple
anapple aFoodBox add:
aFoodBox test  \ => successful eat successful eat


module cg
    implicit none

    type, abstract :: eatable
    end type eatable

    type, extends(eatable) :: carrot_t
    end type carrot_t

    type :: brick_t; end type brick_t

    type :: foodbox
	class(eatable), allocatable :: food
    contains
        procedure, public :: add_item => add_item_fb
    end type foodbox

contains

    subroutine add_item_fb(this, f)
        class(foodbox), intent(inout) :: this
        class(eatable), intent(in)    :: f
        allocate(this%food, source=f)
    end subroutine add_item_fb
end module cg

program con_gen
    use cg
    implicit none

    type(carrot_t) :: carrot
    type(brick_t)  :: brick
    type(foodbox)  :: fbox

    ! Put a carrot into the foodbox
    call fbox%add_item(carrot)

    ! Try to put a brick in - results in a compiler error
    call fbox%add_item(brick)

end program con_gen


class Eatable a where
  eat :: a -> String


import Utils        # From the UniLib package to get the Class class.

class Eatable:Class()
end

class Fish:Eatable(name)
    method eat(); write("Eating "+name); end
end

class Rock:Class(name)
    method eat(); write("Eating "+name); end
end

class FoodBox(A)
initially
    every item := !A do if "Eatable" == item.Type() then next else bad := "yes"
    return /bad
end

procedure main()
    if FoodBox([Fish("salmon")]) then write("Edible") else write("Inedible")
    if FoodBox([Rock("granite")]) then write("Edible") else write("Inedible")
end


coclass'Connoisseur'
isEdible=:3 :0
  0<nc<'eat__y'
)

coclass'FoodBox'
create=:3 :0
  collection=: 0#y
)
add=:3 :0"0
  'inedible' assert isEdible_Connoisseur_ y
  collection=: collection, y
  EMPTY
)


abstract type Edible end
eat(::Edible) = "Yum!"

mutable struct FoodBox{T<:Edible}
    food::Vector{T}
end

struct Carrot <: Edible
    variety::AbstractString
end

struct Brick
    volume::Float64
end

c = Carrot("Baby")
b = Brick(125.0)
eat(c)
eat(b)


// version 1.0.6

interface Eatable {
    fun eat()
}

class Cheese(val name: String) : Eatable {
    override fun eat() {
       println("Eating $name")
    }

    override fun toString() = name
}

class Meat(val name: String) : Eatable {
    override fun eat() {
       println("Eating $name")
    }

    override fun toString() = name
}

class FoodBox<T: Eatable> {
    private val foodList =  mutableListOf<T>()

    fun add(food: T) {
        foodList.add(food)
    }

    override fun toString() = foodList.toString()
}

fun main(args: Array<String>) {
    val cheddar =  Cheese("cheddar")
    val feta = Cheese("feta")
    val cheeseBox = FoodBox<Cheese>()
    cheeseBox.add(cheddar)
    cheeseBox.add(feta)
    println("CheeseBox contains : $cheeseBox")

    val beef = Meat("beef")
    val ham = Meat("ham")
    val meatBox = FoodBox<Meat>()
    meatBox.add(beef)
    meatBox.add(ham)
    println("MeatBox contains : $meatBox")

    cheddar.eat()
    beef.eat()
    println("Full now!")
}


import morfa.type.traits;

template < T >
alias IsEdible = HasMember< T, "eat" >;

template < T >
if (IsEdible< T >)
struct FoodBox
{
    var food: T[];
}

struct Carrot
{
    func eat(): void {}
}

struct Car {}

func main(): void
{
    var carrotBox: FoodBox< Carrot >;   // OK
    carrotBox.food ~= Carrot();        // Adds a carrot

    // var carBox: FoodBox< Car >;      // Not allowed
    static assert( not trait(compiles, func() { var carBox: FoodBox< Car >; } ));
}


using System.Collections.Generic;

interface IEatable
{
    Eat() : void;
}

class FoodBox[T] : IEnumerable[T]
  where T : IEatable
{
    private _foods : list[T] = [];

    public this() {}

    public this(items : IEnumerable[T])
    {
        this._foods = $[food | food in items];
    }

    public Add(food : T) : FoodBox[T]
    {
        FoodBox(food::_foods);
    }

    public GetEnumerator() : IEnumerator[T]
    {
        _foods.GetEnumerator();
    }
}

class Apple : IEatable
{
    public this() {}

    public Eat() : void
    {
        System.Console.WriteLine("nom..nom..nom");
    }
}

mutable appleBox = FoodBox();
repeat(3) {
    appleBox = appleBox.Add(Apple());
}

foreach (apple in appleBox) apple.Eat();


type
  Eatable = concept e
    eat(e)

  FoodBox[e: Eatable] = seq[e]

  Food = object
    name: string
    count: int

proc eat(x: int) = echo "Eating the int: ", x
proc eat(x: Food) = echo "Eating ", x.count, " ", x.name, "s"

var ints = FoodBox[int](@[1,2,3,4,5])
var fs = FoodBox[Food](@[])

fs.add Food(name: "Hamburger", count: 3)
fs.add Food(name: "Cheeseburger", count: 5)

for f in fs:
  eat(f)


use Collection.Generic;

interface Eatable {
  method : virtual : Eat() ~ Nil;
}

class FoodBox<T : Eatable> {
  food : List<T>;
}

class Plum implements Eatable {
  method : Eat() ~ Nil {
    "Yummy Plum!"->PrintLine();
  }
}

class Genericity {
  function : Main(args : String[]) ~ Nil {
    plums : FoodBox<Plum>;
  }
}


module type Eatable = sig
  type t
  val eat : t -> unit
end


call dinnerTime "yogurt"
call dinnerTime .pizza~new
call dinnerTime .broccoli~new

-- a mixin class that defines the interface for being "food", and
-- thus expected to implement an "eat" method
::class food mixinclass object
::method eat abstract

::class pizza subclass food
::method eat
  Say "mmmmmmmm, pizza".

-- mixin classes can also be used for multiple inheritance
::class broccoli inherit food
::method eat
  Say "ugh, do I have to?".

::routine dinnerTime
  use arg dish
  -- ooRexx arguments are typeless, so tests for constrained
  -- types must be peformed at run time.  The isA method will
  -- check if an object is of the required type
  if \dish~isA(.food) then do
     say "I can't eat that!"
     return
  end
  else dish~eat


macro Gluttony(vartype, capacity, foodlist)
'==========================================

typedef vartype physical

enum food foodlist

type ActualFood
  sys      name
  physical size
  physical quantity
end type

Class foodbox
'============
has ActualFood Item[capacity]
sys max

method put(sys f, physical s,q)
  max++
  Item[max]<=f,s,q
end method

method GetNext(ActualFood *Stuff)
  if max then
    copy @stuff,@Item[max], sizeof Item
    max--
  end if
end method

end class

Class Gourmand
'=============
physical WeightGain, SleepTime

method eats(ActualFood *stuff)
  WeightGain+=stuff.size*stuff.quantity*0.75
  stuff.size=0
  stuff.quantity=0
end method

end class

end macro

'IMPLEMENTATION
'==============

Gluttony (
double,100,{
oyster,trout,bloater,
chocolate,truffles,
cheesecake,cream,pudding,pie
})

% small  1
% medium 2
% large  3
% huge   7

% none    0
% single  1
% few     3
% several 7
% many    12

'INSTANCE
'========

FoodBox  Hamper
Gourmand MrG

'TEST
'====

Hamper.put food.pudding,large,several
Hamper.put food.pie,huge,few
ActualFood Course
Hamper.GetNext Course
MrG.eats Course

print MrG.WeightGain 'result 15.75


include builtins\structs.e as structs

class foodbox
    sequence contents = {}
    procedure add(class food)
        -- (aside: class food is 100% abstract here...
        --     ie: class is *the* root|anything class,
        --         and food is just an arbitrary name)
        integer t = structs:get_field_flags(food,"eat")
        if t!=SF_PROC+SF_PUBLIC then
            throw("not edible") -- no public method eat...
        end if
        -- you might also want something like this:
--      t = structs:fetch_field(food,"eat")
--      if t=NULL then
--          throw("eat not implemented")
--      end if
        this.contents = append(this.contents,food)
    end procedure
    procedure dine()
        integer l = length(this.contents)
        string s = iff(l=1?"":"s")
        printf(1,"foodbox contains %d item%s\n",{l,s})
        for i=1 to l do
            class food = this.contents[i];
            --food.eat();   -- error...
            -- If you don't define an [abstract] eat() method, or use
            --  "class", you end up having to do something like this:
            integer eat = structs:fetch_field(food,"eat")
            eat(food)
        end for
    end procedure
end class
foodbox lunchbox = new()

class fruit
    string name
    procedure eat()
        printf(1,"mmm... %s\n",{this.name})
    end procedure
end class
fruit banana = new({"banana"})

class clay
    string name = "fletton"
end class
clay brick = new()

lunchbox.add(banana)
try
    lunchbox.add(brick) -- throws exception
catch e
    printf(1,"%s line %d error: %s\n",{e[E_FILE],e[E_LINE],e[E_USER]})
end try
lunchbox.dine()


(class +Eatable)

(dm eat> ()
   (prinl "I'm eatable") )

(class +FoodBox)
# obj

(dm set> (Obj)
   (unless (method 'eat> Obj)                # Check if the object is eatable
      (quit "Object is not eatable" Obj) )
   (=: obj Obj) )                            # If so, set the object

(let (Box (new '(+FoodBox))  Eat (new '(+Eatable))  NoEat (new '(+Bla)))
   (set> Box Eat)       # Works
   (set> Box NoEat) )   # Gives an error


#lang racket
(module+ test (require tests/eli-tester))

;; This is all that an object should need to properly implement.
(define edible<%>
  (interface () [eat (->m void?)]))

(define (generic-container<%> containee/c)
  (interface ()
    [contents  (->m (listof containee/c))]
    [insert    (->m containee/c void?)]
    [remove-at (->m exact-nonnegative-integer? containee/c)]
    [count     (->m exact-nonnegative-integer?)]))

(define ((generic-box-mixin containee/c) %)
  (->i ([containee/c contract?])
       (rv (containee/c) (implementation?/c (generic-container<%> containee/c))))
  (class* % ((generic-container<%> containee/c))
    (super-new)
    (define l empty)
    (define/public (contents) l)
    (define/public (insert o) (set! l (cons o l)))
    (define/public (remove-at i)
      (begin0 (list-ref l i)
              (append (take l i) (drop l (add1 i)))))
    (define/public (count) (length l))))

;; As I understand it, a "Food Box" from the task is still a generic... i.e.
;; you will specify it down ;; to an "apple-box%" so: food-box%-generic is still
;; generic. food-box% will take any kind of food.
(define/contract (food-box-mixin T%)
  (-> (or/c (λ (i) (eq? edible<%> i)) (implementation?/c edible<%>))
   (make-mixin-contract))
  (generic-box-mixin (and/c (is-a?/c edible<%>) (is-a?/c T%))))

(module+ test

  (define integer-box% ((generic-box-mixin integer?) object%))
  (define integer-box  (new integer-box%))

  (define apple%
    (class* object% (edible<%>)
      (super-new)
      (define/public (eat)
        (displayln "nom!"))))

  (define banana%
    (class* object% (edible<%>)
      (super-new)
      (define/public (eat)
        (displayln "peel.. peel... nom... nom!"))))

  (define semolina%
    (class* object% () ; <-- empty interfaces clause
      (super-new)
      ;; you can call eat on it... but it's not explicitly (or even vaguely)
      ;; edible<%>
      (define/public (eat) (displayln "blech!"))))

  ;; this will take any object that is edible<%> and edible<%> (therefore all
  ;; edible<%> objects)
  (define any-food-box (new ((food-box-mixin edible<%>) object%)))

  ;; this will take any object that is edible and an apple<%>
  ;; (therefore only apple<%>s)
  (define apple-food-box (new ((food-box-mixin apple%) object%)))

  (test
   ;; Test generic boxes
   (send integer-box insert 22)
   (send integer-box insert "a string") =error> exn:fail:contract?

   ;; Test the food box that takes any edible<%>
   (send any-food-box insert (new apple%))
   (send any-food-box insert (new banana%))
   (send any-food-box insert (new semolina%)) =error> exn:fail:contract?

   ;; Test the food box that takes any apple%
   (send apple-food-box insert (new apple%))
   (send apple-food-box insert (new banana%)) =error> exn:fail:contract?
   (send apple-food-box insert (new semolina%)) =error> exn:fail:contract?
   (send apple-food-box count) => 1

   ;; Show that you cannot make a food-box from the non-edible<%> semolina cannot
   (implementation? semolina% edible<%>) => #f
   (new ((food-box-mixin semolina%) object%)) =error> exn:fail:contract?))


subset Eatable of Any where { .^can('eat') };

class Cake { method eat() {...} }

role FoodBox[Eatable] {
    has %.foodbox;
}

class Yummy does FoodBox[Cake] { }      # composes correctly
# class Yucky does FoodBox[Int] { }     # fails to compose

my Yummy $foodbox .= new;
say $foodbox;


class Foodbox
  def initialize (*food)
    raise ArgumentError, "food must be eadible" unless  food.all?{|f| f.respond_to?(:eat)}
    @box = food
  end
end

class Fruit
  def eat; end
end

class Apple < Fruit; end

p Foodbox.new(Fruit.new, Apple.new)
# => #<Foodbox:0x00000001420c88 @box=[#<Fruit:0x00000001420cd8>, #<Apple:0x00000001420cb0>]>

p Foodbox.new(Apple.new, "string can't eat")
# => test1.rb:3:in `initialize': food must be eadible (ArgumentError)


// This declares the "Eatable" constraint. It could contain no function.
trait Eatable {
    fn eat();
}

// This declares the generic "FoodBox" type,
// whose parameter must satisfy the "Eatable" constraint.
// The objects of this type contain a vector of eatable objects.
struct FoodBox<T: Eatable> {
    _data: Vec<T>,
}

// This implements the functions associated with the "FoodBox" type.
// This statement is not required, but here it is used
// to declare a handy "new" constructor.
impl<T: Eatable> FoodBox<T> {
    fn new() -> FoodBox<T> {
        FoodBox::<T> { _data: Vec::<T>::new() }
    }
}

// This declares a simple type.
struct Banana {}

// This makes the "Banana" type satisfy the "Eatable" constraint.
// For that, every declaration inside the declaration of "Eatable"
// must be implemented here.
impl Eatable for Banana {
    fn eat() {}
}

// This makes also the primitive "char" type satisfy the "Eatable" constraint.
impl Eatable for char {
    fn eat() {}
}

fn main() {
    // This instantiate a "FoodBox" parameterized by the "Banana" type.
    // It is allowed as "Banana" implements "Eatable".
    let _fb1 = FoodBox::<Banana>::new();

    // This instantiate a "FoodBox" parameterized by the "char" type.
    // It is allowed, as "char" implements "Eatable".
    let _fb2 = FoodBox::<char>::new();

    // This instantiate a "FoodBox" parameterized by the "bool" type.
    // It is NOT allowed, as "bool" does not implement "Eatable".
    //let _fb3 = FoodBox::<bool>::new();
}


abstract class $EDIBLE is
  eat;
end;

class FOOD < $EDIBLE is
  readonly attr name:STR;
  eat is
    #OUT + "eating " + self.name + "\n";
  end;
  create(name:STR):SAME is
    res ::= new;
    res.name := name;
    return res;
  end;
end;

class CAR is
  readonly attr name:STR;
  create(name:STR):SAME is
    res ::= new;
    res.name := name;
    return res;
  end;
end;

class FOODBOX{T < $EDIBLE} is
  private attr list:LLIST{T};
  create:SAME is
    res ::= new;
    res.list := #;
    return res;
  end;
  add(c :T) is
    self.list.insert_back(c);
  end;
  elt!:T is loop yield self.list.elt!; end; end;
end;

class MAIN is
  main is
    box  ::= #FOODBOX{FOOD}; -- ok
    box.add(#FOOD("Banana"));
    box.add(#FOOD("Amanita Muscaria"));

    box2 ::= #FOODBOX{CAR};  -- not ok
    box2.add(#CAR("Punto")); -- but compiler let it pass!

    -- eat everything
    loop box.elt!.eat; end;
  end;
end;


type Eatable = { def eat: Unit }

class FoodBox(coll: List[Eatable])

case class Fish(name: String) {
  def eat {
    println("Eating "+name)
  }
}

val foodBox = new FoodBox(List(new Fish("salmon")))


class FoodBox(*food { .all { .respond_to(:eat) } }) { }

class Fruit { method eat { ... } }
class Apple < Fruit {  }

say FoodBox(Fruit(), Apple()).dump  #=> FoodBox(food: [Fruit(), Apple()])
say FoodBox(Apple(), "foo")         #!> ERROR: class `FoodBox` !~ (Apple, String)


// abstract class
class Eatable {
    eat() { /* override in child class */ }
}

class FoodBox {
    construct new(contents) {
        if (contents.any { |e| !(e is Eatable) }) {
            Fiber.abort("All FoodBox elements must be eatable.")
        }
        _contents = contents
    }

    contents { _contents }
}

// Inherits from Eatable and overrides eat() method.
class Pie is Eatable {
    construct new(filling) { _filling = filling }

    eat() { System.print("%(_filling) pie, yum!") }
}

// Not an Eatable.
class Bicycle {
    construct new() {}
}

var items = [Pie.new("Apple"),  Pie.new("Gooseberry")]
var fb = FoodBox.new(items)
fb.contents.each { |item| item.eat() }
System.print()
items.add(Bicycle.new())
fb = FoodBox.new(items) // throws an error because Bicycle not eatable


class Eatable{ var v;
   fcn eat{ println("munching ",self.topdog.name); }
}
class FoodBox{
   fcn init(food1,food2,etc){
      editable,garbage:=vm.arglist.filter22("isChildOf",Eatable);
      var contents=editable;
      if(garbage) println("Rejecting: ",garbage);
   }
}


F primes_upto(limit)
   V is_prime = [0B] * 2 [+] [1B] * (limit - 1)
   L(n) 0 .< Int(limit ^ 0.5 + 1.5)
      I is_prime[n]
         L(i) (n * n .. limit).step(n)
            is_prime[i] = 0B
   R enumerate(is_prime).filter((i, prime) -> prime).map((i, prime) -> i)

V primelist = primes_upto(1'000'000)

V listlen = primelist.len

V pindex = 1
V old_diff = -1
V curr_list = [primelist[0]]
[Int] longest_list

L pindex < listlen

   V diff = primelist[pindex] - primelist[pindex - 1]
   I diff > old_diff
      curr_list.append(primelist[pindex])
      I curr_list.len > longest_list.len
         longest_list = curr_list
   E
      curr_list = [primelist[pindex - 1], primelist[pindex]]

   old_diff = diff
   pindex++

print(longest_list)

pindex = 1
old_diff = -1
curr_list = [primelist[0]]
longest_list.drop()

L pindex < listlen

   V diff = primelist[pindex] - primelist[pindex - 1]
   I diff < old_diff
      curr_list.append(primelist[pindex])
      I curr_list.len > longest_list.len
         longest_list = curr_list
   E
      curr_list = [primelist[pindex - 1], primelist[pindex]]

   old_diff = diff
   pindex++

print(longest_list)


BEGIN # find sequences of primes where the gaps between the elements #
      # are strictly ascending/descending                            #
    # reurns a list of primes up to n #
    PROC prime list = ( INT n )[]INT:
         BEGIN
            # sieve the primes to n #
            INT no = 0, yes = 1;
            [ 1 : n ]INT p;
            p[ 1 ] := no; p[ 2 ] := yes;
            FOR i FROM 3 BY 2 TO n DO p[ i ] := yes OD;
            FOR i FROM 4 BY 2 TO n DO p[ i ] := no  OD;
            FOR i FROM 3 BY 2 TO ENTIER sqrt( n ) DO
                IF p[ i ] = yes THEN FOR s FROM i * i BY i + i TO n DO p[ s ] := no OD FI
            OD;
            # replace the sieve with a list #
            INT p pos := 0;
            FOR i TO n DO IF p[ i ] = yes THEN p[ p pos +:= 1 ] := i FI OD;
            p[ 1 : p pos ]
         END # prime list # ;
    # shos the results of a search #
    PROC show sequence = ( []INT primes, STRING seq name, INT seq start, seq length )VOID:
         BEGIN
            print( ( "    The longest sequence of primes with "
                   , seq name
                   , " differences contains "
                   , whole( seq length, 0 )
                   , " primes"
                   , newline
                   , "        First such sequence (differences in brackets):"
                   , newline
                   , "            "
                   )
                 );
            print( ( whole( primes[ seq start ], 0 ) ) );
            FOR p FROM seq start + 1 TO seq start + ( seq length - 1 ) DO
                print( ( " (", whole( ABS( primes[ p ] - primes[ p - 1 ] ), 0 ), ") ", whole( primes[ p ], 0 ) ) )
            OD;
            print( ( newline ) )
         END # show seuence # ;
    # find the longest sequence of primes where the successive differences are ascending/descending #
    PROC find sequence = ( []INT primes, BOOL ascending, REF INT seq start, seq length )VOID:
         BEGIN
            seq start     := seq length := 0;
            INT start diff = IF ascending THEN 0 ELSE UPB primes + 1 FI;
            FOR p FROM LWB primes TO UPB primes DO
                INT prev diff := start diff;
                INT length    := 1;
                FOR s FROM p + 1 TO UPB primes
                WHILE INT diff = ABS ( primes[ s ] - primes[ s - 1 ] );
                      IF ascending THEN diff > prev diff ELSE diff < prev diff FI
                DO
                    length   +:= 1;
                    prev diff := diff
                OD;
                IF length > seq length THEN
                    # found a longer sequence #
                    seq length := length;
                    seq start  := p
                FI
            OD
         END # find sequence #;
    INT max number   = 1 000 000;
    []INT primes     = prime list( max number );
    INT asc length  := 0;
    INT asc start   := 0;
    INT desc length := 0;
    INT desc start  := 0;
    find sequence( primes, TRUE,   asc start,  asc length );
    find sequence( primes, FALSE, desc start, desc length );
    # show the sequences #
    print( ( "For primes up to ", whole( max number, 0 ), newline ) );
    show sequence( primes, "ascending",   asc start,  asc length );
    show sequence( primes, "descending", desc start, desc length )
END


using System.Linq;
using System.Collections.Generic;
using TG = System.Tuple<int, int>;
using static System.Console;

class Program
{
    static void Main(string[] args)
    {
        const int mil = (int)1e6;
        foreach (var amt in new int[] { 1, 2, 6, 12, 18 })
        {
            int lmt = mil * amt, lg = 0, ng, d, ld = 0;
            var desc = new string[] { "A", "", "De" };
            int[] mx = new int[] { 0, 0, 0 },
                  bi = new int[] { 0, 0, 0 },
                   c = new int[] { 2, 2, 2 };
            WriteLine("For primes up to {0:n0}:", lmt);
            var pr = PG.Primes(lmt).ToArray();
            for (int i = 0; i < pr.Length; i++)
            {
                ng = pr[i].Item2; d = ng.CompareTo(lg) + 1;
                if (ld == d)
                    c[2 - d]++;
                else
                {
                    if (c[d] > mx[d]) { mx[d] = c[d]; bi[d] = i - mx[d] - 1; }
                    c[d] = 2;
                }
                ld = d; lg = ng;
            }
            for (int r = 0; r <= 2; r += 2)
            {
                Write("{0}scending, found run of {1} consecutive primes:\n  {2} ",
                    desc[r], mx[r] + 1, pr[bi[r]++].Item1);
                foreach (var itm in pr.Skip(bi[r]).Take(mx[r]))
                    Write("({0}) {1} ", itm.Item2, itm.Item1); WriteLine(r == 0 ? "" : "\n");
            }
        }
    }
}

class PG
{
    public static IEnumerable<TG> Primes(int lim)
    {
        bool[] flags = new bool[lim + 1];
        int j = 3, lj = 2;
        for (int d = 8, sq = 9; sq <= lim; j += 2, sq += d += 8)
            if (!flags[j])
            {
                yield return new TG(j, j - lj);
                lj = j;
                for (int k = sq, i = j << 1; k <= lim; k += i) flags[k] = true;
            }
        for (; j <= lim; j += 2)
            if (!flags[j])
            {
                yield return new TG(j, j - lj);
                lj = j;
            }
    }
}


#include <cstdint>
#include <iostream>
#include <vector>
#include <primesieve.hpp>

void print_diffs(const std::vector<uint64_t>& vec) {
    for (size_t i = 0, n = vec.size(); i != n; ++i) {
        if (i != 0)
            std::cout << " (" << vec[i] - vec[i - 1] << ") ";
        std::cout << vec[i];
    }
    std::cout << '\n';
}

int main() {
    std::cout.imbue(std::locale(""));
    std::vector<uint64_t> asc, desc;
    std::vector<std::vector<uint64_t>> max_asc, max_desc;
    size_t max_asc_len = 0, max_desc_len = 0;
    uint64_t prime;
    const uint64_t limit = 1000000;
    for (primesieve::iterator pi; (prime = pi.next_prime()) < limit; ) {
        size_t alen = asc.size();
        if (alen > 1 && prime - asc[alen - 1] <= asc[alen - 1] - asc[alen - 2])
            asc.erase(asc.begin(), asc.end() - 1);
        asc.push_back(prime);
        if (asc.size() >= max_asc_len) {
            if (asc.size() > max_asc_len) {
                max_asc_len = asc.size();
                max_asc.clear();
            }
            max_asc.push_back(asc);
        }
        size_t dlen = desc.size();
        if (dlen > 1 && prime - desc[dlen - 1] >= desc[dlen - 1] - desc[dlen - 2])
            desc.erase(desc.begin(), desc.end() - 1);
        desc.push_back(prime);
        if (desc.size() >= max_desc_len) {
            if (desc.size() > max_desc_len) {
                max_desc_len = desc.size();
                max_desc.clear();
            }
            max_desc.push_back(desc);
        }
    }
    std::cout << "Longest run(s) of ascending prime gaps up to " << limit << ":\n";
    for (const auto& v : max_asc)
        print_diffs(v);
    std::cout << "\nLongest run(s) of descending prime gaps up to " << limit << ":\n";
    for (const auto& v : max_desc)
        print_diffs(v);
    return 0;
}


// Longest ascending and decending sequences of difference between consecutive primes: Nigel Galloway. April 5th., 2021
let fN g fW=primes32()|>Seq.takeWhile((>)g)|>Seq.pairwise|>Seq.fold(fun(n,i,g)el->let w=fW el in match w>n with true->(w,el::i,g) |_->(w,[el],if List.length i>List.length g then i else g))(0,[],[])
for i in [1;2;6;12;18;100] do let _,_,g=fN(i*1000000)(fun(n,g)->g-n) in printfn "Longest ascending upto %d000000->%d:" i (g.Length+1); g|>List.rev|>List.iter(fun(n,g)->printf "%d (%d) %d " n (g-n) g); printfn ""
                              let _,_,g=fN(i*1000000)(fun(n,g)->n-g) in printfn "Longest decending upto %d000000->%d:" i (g.Length+1); g|>List.rev|>List.iter(fun(n,g)->printf "%d (%d) %d " n (g-n) g); printfn ""


USING: arrays assocs formatting grouping io kernel literals math
math.primes math.statistics sequences sequences.extras
tools.memory.private ;

<< CONSTANT: limit 1,000,000 >>

CONSTANT: primes $[ limit primes-upto ]

: run ( n quot -- seq quot )
    [ primes ] [ <clumps> ] [ ] tri*
    '[ differences _ monotonic? ] ; inline

: max-run ( quot -- n )
    1 swap '[ 1 + dup _ run find drop ] loop 1 - ; inline

: runs ( quot -- seq )
    [ max-run ] keep run filter ; inline

: .run ( seq -- )
    dup differences [ [ commas ] map ] [email protected]
    [ "(" ")" surround ] map 2array round-robin " " join print ;

: .runs ( quot -- )
    [ runs ] keep [ < ] = "rising" "falling" ? limit commas
    "Largest run(s) of %s gaps between primes less than %s:\n"
    printf [ .run ] each ; inline

[ < ] [ > ] [ .runs nl ] [email protected]


#define UPPER 1000000
#include"isprime.bas"

dim as uinteger champ = 0, record = 0, streak, i, j, n

'first generate all the primes below UPPER
redim as uinteger prime(1 to 2)
prime(1) = 2 : prime(2) = 3
for i = 5 to UPPER step 2
    if isprime(i) then
        redim preserve prime(1 to ubound(prime) + 1)
        prime(ubound(prime)) = i
    end if
next i
n = ubound(prime)

'now look for the longest streak of ascending primes
for i = 2 to n-1
    j = i + 1
    streak = 1
    while j<=n andalso prime(j)-prime(j-1) > prime(j-1)-prime(j-2)
        streak += 1
        j+=1
    wend
    if streak > record then
        champ = i-1
        record = streak
    end if
next i

print "The longest sequence of ascending primes (with their difference from the last one) is:"
for i = champ+1 to champ+record
    print prime(i-1);" (";prime(i)-prime(i-1);") ";
next i
print prime(i-1) : print
'now for the descending ones

record = 0 : champ = 0
for i = 2 to n-1
    j = i + 1
    streak = 1
    while j<=n andalso prime(j)-prime(j-1) < prime(j-1)-prime(j-2)   'identical to above, but for the inequality sign
        streak += 1
        j+=1
    wend
    if streak > record then
        champ = i-1
        record = streak
    end if
next i

print "The longest sequence of descending primes (with their difference from the last one) is:"
for i = champ+1 to champ+record
    print prime(i-1);" (";prime(i)-prime(i-1);") ";
next i
print prime(i-1)


package main

import (
    "fmt"
    "rcu"
)

const LIMIT = 999999

var primes = rcu.Primes(LIMIT)

func longestSeq(dir string) {
    pd := 0
    longSeqs := [][]int{{2}}
    currSeq := []int{2}
    for i := 1; i < len(primes); i++ {
        d := primes[i] - primes[i-1]
        if (dir == "ascending" && d <= pd) || (dir == "descending" && d >= pd) {
            if len(currSeq) > len(longSeqs[0]) {
                longSeqs = [][]int{currSeq}
            } else if len(currSeq) == len(longSeqs[0]) {
                longSeqs = append(longSeqs, currSeq)
            }
            currSeq = []int{primes[i-1], primes[i]}
        } else {
            currSeq = append(currSeq, primes[i])
        }
        pd = d
    }
    if len(currSeq) > len(longSeqs[0]) {
        longSeqs = [][]int{currSeq}
    } else if len(currSeq) == len(longSeqs[0]) {
        longSeqs = append(longSeqs, currSeq)
    }
    fmt.Println("Longest run(s) of primes with", dir, "differences is", len(longSeqs[0]), ":")
    for _, ls := range longSeqs {
        var diffs []int
        for i := 1; i < len(ls); i++ {
            diffs = append(diffs, ls[i]-ls[i-1])
        }
        for i := 0; i < len(ls)-1; i++ {
            fmt.Print(ls[i], " (", diffs[i], ") ")
        }
        fmt.Println(ls[len(ls)-1])
    }
    fmt.Println()
}

func main() {
    fmt.Println("For primes < 1 million:\n")
    for _, dir := range []string{"ascending", "descending"} {
        longestSeq(dir)
    }
}


import Data.Numbers.Primes (primes)

-- generates consecutive subsequences defined by given equivalence relation
consecutives equiv = filter ((> 1) . length) . go []
  where
    go r [] = [r]
    go [] (h : t) = go [h] t
    go (y : ys) (h : t)
      | y `equiv` h = go (h : y : ys) t
      | otherwise = (y : ys) : go [h] t

-- finds maximal values in a list and returns the first one
maximumBy g (h : t) = foldr f h t
  where
    f r x = if g r < g x then x else r

-- the task implementation
task ord n = reverse $ p + s : p : (fst <$> rest)
  where
    (p, s) : rest =
      maximumBy length $
        consecutives (\(_, a) (_, b) -> a `ord` b) $
          differences $
            takeWhile (< n) primes
    differences l = zip l $ zipWith (-) (tail l) l


# For streams of strings or of arrays or of numbers:
def add(s): reduce s as $x (null; .+$x);

# Primes less than . // infinite
def primes:
  (. // infinite) as $n
  | if $n < 3 then empty
    else 2, (range(3; $n) | select(is_prime))
    end;


using Primes

function primediffseqs(maxnum = 1_000_000)
    mprimes = primes(maxnum)
    diffs = map(p -> mprimes[p[1] + 1] - p[2], enumerate(@view mprimes[begin:end-1]))
    incstart, decstart, bestinclength, bestdeclength = 1, 1, 0, 0
    for i in 1:length(diffs)-1
        foundinc, founddec = false, false
        for j in i+1:length(diffs)
            if !foundinc && diffs[j] <= diffs[j - 1]
                if (runlength = j - i) > bestinclength
                    bestinclength, incstart = runlength, i
                end
                foundinc = true
            end
            if !founddec && diffs[j] >= diffs[j - 1]
                if (runlength = j - i) > bestdeclength
                    bestdeclength, decstart = runlength, i
                end
                founddec = true
            end
            foundinc && founddec && break
        end
    end
    println("Ascending: ", mprimes[incstart:incstart+bestinclength], " Diffs: ", diffs[incstart:incstart+bestinclength-1])
    println("Descending: ", mprimes[decstart:decstart+bestdeclength], " Diffs: ", diffs[decstart:decstart+bestdeclength-1])
end

primediffseqs()


function findcps(primelist, fcmp)
  local currlist = {primelist[1]}
  local longlist, prevdiff = currlist, 0
  for i = 2, #primelist do
    local diff = primelist[i] - primelist[i-1]
    if fcmp(diff, prevdiff) then
      currlist[#currlist+1] = primelist[i]
      if #currlist > #longlist then
        longlist = currlist
      end
    else
      currlist = {primelist[i-1], primelist[i]}
    end
    prevdiff = diff
  end
  return longlist
end

primegen:generate(nil, 1000000)
cplist = findcps(primegen.primelist, function(a,b) return a>b end)
print("ASC  ("..#cplist.."):  ["..table.concat(cplist, " ").."]")
cplist = findcps(primegen.primelist, function(a,b) return a<b end)
print("DESC ("..#cplist.."):  ["..table.concat(cplist, " ").."]")


BEGIN # construct continued fraction representations of rational numbers #
      # Translated from the C sample                                     #
      # Uses code from the Arithmetic/Rational task                      #

    # Code from the Arithmetic/Rational task                         #
    # ============================================================== #

    MODE FRAC = STRUCT( INT num #erator#,  den #ominator#);

    PROC gcd = (INT a, b) INT: # greatest common divisor #
       (a = 0 | b |: b = 0 | a |: ABS a > ABS b  | gcd(b, a MOD b) | gcd(a, b MOD a));

    PROC lcm = (INT a, b)INT: # least common multiple #
       a OVER gcd(a, b) * b;

    PRIO // = 9; # higher then the ** operator #
    OP // = (INT num, den)FRAC: ( # initialise and normalise #
       INT common = gcd(num, den);
       IF den < 0 THEN
         ( -num OVER common, -den OVER common)
       ELSE
         ( num OVER common, den OVER common)
       FI
     );

    OP + = (FRAC a, b)FRAC: (
       INT common = lcm(den OF a, den OF b);
       FRAC result := ( common OVER den OF a * num OF a + common OVER den OF b * num OF b, common );
       num OF result//den OF result
    );

    OP - = (FRAC a, b)FRAC: a + -b,
       * = (FRAC a, b)FRAC: (
           INT num = num OF a * num OF b,
           den = den OF a * den OF b;
           INT common = gcd(num, den);
           (num OVER common) // (den OVER common)
         );

    OP - = (FRAC frac)FRAC: (-num OF frac, den OF frac);

    # ============================================================== #
    # end code from the Arithmetic/Rational task                     #

    []FRAC examples = ( 1//2, 3//1, 23//8, 13//11, 22//7, -151//77 );
    []FRAC sqrt2    = ( 14142//10000, 141421//100000, 1414214//1000000, 14142136//10000000 );
    []FRAC pi       = ( 31//10, 314//100, 3142//1000, 31428//10000
                      , 314285//100000, 3142857//1000000, 31428571//10000000, 314285714//100000000
                      );

    # returns the quotient of numerator over denominator and sets #
    #         numerator and denominator to the next values for    #
    #         the continued fraction                              #
    PROC r2cf = ( REF INT numerator, REF INT denominator )INT:
         IF denominator = 0
         THEN 0
         ELSE INT quotient      := numerator OVER denominator;
              INT prev numerator = numerator;
              numerator         := denominator;
              denominator       := prev numerator MOD denominator;
	      quotient
         FI # r2cf # ;
    # shows the continued fractions for the elements of f seq #
    PROC show r2cf = ( STRING legend, []FRAC f seq )VOID:
         BEGIN
            print( ( legend ) );
            FOR i FROM LWB f seq TO UPB f seq DO
                INT num := num OF f seq[ i ];
                INT den := den OF f seq[ i ];
                print( ( newline, "For N = ", whole( num , 0 ), ", D = ", whole( den , 0 ), " :" ) );
                WHILE den /= 0 DO
                    print( ( " ", whole( r2cf( num, den ), 0 ) ) )
                OD
            OD
         END # show r2cf # ;
    BEGIN # task #
        show r2cf( "Running the examples :", examples );
	print( ( newline, newline ) );
        show r2cf( "Running for root2 :", sqrt2 );
	print( ( newline, newline ) );
	show r2cf( "Running for pi :", pi )
    END
END


prime = Prime[Range[PrimePi[10^6]]];
s = Split[Differences[prime], Less];
max = Max[Length /@ s];
diffs = Select[s, Length/*EqualTo[max]];
seqs = SequencePosition[Flatten[s], #, 1][[1]] & /@ diffs;
Take[prime, # + {0, 1}] & /@ seqs

s = Split[Differences[prime], Greater];
max = Max[Length /@ s];
diffs = Select[s, Length/*EqualTo[max]];
seqs = SequencePosition[Flatten[s], #, 1][[1]] & /@ diffs;
Take[prime, # + {0, 1}] & /@ seqs


import math, strformat, sugar

const N = 1_000_000

####################################################################################################
# Erathostenes sieve.

var composite: array[2..N, bool]    # Initialized to false i.e. prime.

for n in 2..int(sqrt(float(N))):
  if not composite[n]:
    for k in countup(n * n, N, n):
      composite[k] = true

let primes = collect(newSeq):
               for n in 2..N:
                 if not composite[n]: n

####################################################################################################
# Longest sequences.

type Order {.pure.} = enum Ascending, Descending

proc longestSeq(order: Order): seq[int] =
  ## Return the longest sequence for the given order.

  let ascending = order == Ascending
  var
    currseq: seq[int]
    prevPrime = 2
    diff = if ascending: 0 else: N

  for prime in primes:
    let nextDiff = prime - prevPrime
    if nextDiff != diff and nextDiff > diff == ascending:
      currseq.add prime
    else:
      if currseq.len > result.len:
        result = move(currseq)
      currseq = @[prevPrime, prime]
    diff = nextDiff
    prevPrime = prime

  if currseq.len > result.len:
    result = move(currseq)

proc `$`(list: seq[int]): string =
  ## Return the representation of a list of primes with interleaved differences.
  var prevPrime: int
  for i, prime in list:
    if i != 0: result.add &" ({prime - prevPrime}) "
    result.addInt prime
    prevPrime = prime

echo "For primes < 1000000.\n"
echo "First longest sequence of consecutive primes with ascending differences:"
echo longestSeq(Ascending)
echo()
echo "First longest sequence of consecutive primes with descending differences:"
echo longestSeq(Descending)


showPrecPrimes(p, n)=
{
  my(v=vector(n));
  v[n]=p;
  forstep(i=n-1,1,-1,
    v[i]=precprime(v[i+1]-1)
  );
  for(i=1,n, print1(v[i]" "));
}
list(lim)=
{
  my(p=3,asc,dec,ar,dr,arAt=3,drAt=3,last=2);
  forprime(q=5,lim,
    my(g=q-p);
    if(g<last,
      asc=0;
      if(desc++>dr,
        dr=desc;
        drAt=q
      )
    ,g>last,
      desc=0;
      if(asc++>ar,
        ar=asc;
        arAt=q
      )
    ,
      asc=desc=0
    );
    p=q;
    last=g
  );
  print("Descending differences:");
  showPrecPrimes(drAt, dr+2);
  print("\nAscending differences:");
  showPrecPrimes(arAt, ar+2);
}
list(10^6)


use strict;
use warnings;
use feature 'say';
use ntheory 'primes';
use List::AllUtils <indexes max>;

my $limit  = 1000000;
my @primes = @{primes( $limit )};

sub runs {
    my($op) = @_;
    my @diff = my $diff = my $run = 1;
    push @diff, map {
        my $next = $primes[$_] - $primes[$_ - 1];
        if ($op eq '>') { if ($next > $diff) { ++$run } else { $run = 1 } }
        else            { if ($next < $diff) { ++$run } else { $run = 1 } }
        $diff = $next;
        $run
    } 1 .. $#primes;

    my @prime_run;
    my $max = max @diff;
    for my $r ( indexes { $_ == $max } @diff ) {
        push @prime_run, join ' ', map { $primes[$r - $_] } reverse 0..$max
    }
    @prime_run
}

say   "Longest run(s) of ascending prime gaps up to $limit:\n"  . join "\n", runs('>');
say "\nLongest run(s) of descending prime gaps up to $limit:\n" . join "\n", runs('<');