#include <iostream>

class factorion_t {
public:
    factorion_t() {
        f[0] = 1u;
        for (uint n = 1u; n < 12u; n++)
            f[n] = f[n - 1] * n;
    }

    bool operator()(uint i, uint b) const {
        uint sum = 0;
        for (uint j = i; j > 0u; j /= b)
            sum += f[j % b];
        return sum == i;
    }

private:
    ulong f[12];  //< cache factorials from 0 to 11
};

int main() {
    factorion_t factorion;
    for (uint b = 9u; b <= 12u; ++b) {
        std::cout << "factorions for base " << b << ':';
        for (uint i = 1u; i < 1500000u; ++i)
            if (factorion(i, b))
                std::cout << ' ' << i;
        std::cout << std::endl;
    }
    return 0;
}


(defparameter *bases* '(9 10 11 12))
(defparameter *limit* 1500000)

(defun ! (n) (apply #'* (loop for i from 2 to n collect i)))

(defparameter *digit-factorials* (mapcar #'! (loop for i from 0 to (1- (apply #'max *bases*)) collect i)))

(defun fact (n) (nth n *digit-factorials*))

(defun digit-value (digit)
  (let ((decimal (digit-char-p digit)))
    (cond ((not (null decimal)) decimal)
          ((char>= #\Z digit #\A) (+ (char-code digit) (- (char-code #\A)) 10))
          ((char>= #\z digit #\a) (+ (char-code digit) (- (char-code #\a)) 10))
          (t nil))))

(defun factorionp (n &optional (base 10))
  (= n (apply #'+
            (mapcar #'fact
                    (map 'list #'digit-value
                         (write-to-string n :base base))))))

(loop for base in *bases* do
  (let ((factorions
        (loop for i from 1 while (< i *limit*) if (factorionp i base) collect i)))
    (format t "In base ~a there are ~a factorions:~%" base (list-length factorions))
    (loop for n in factorions do
      (format t "~c~a" #\Tab (write-to-string n :base base))
      (if (/= base 10) (format t " (decimal ~a)" n))
      (format t "~%"))
    (format t "~%")))


program Factorions;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

begin
  var fact: TArray<UInt64>;
  SetLength(fact, 12);

  fact[0] := 0;
  for var n := 1 to 11 do
    fact[n] := fact[n - 1] * n;

  for var b := 9 to 12 do
  begin
    writeln('The factorions for base ', b, ' are:');
    for var i := 1 to 1499999 do
    begin
      var sum := 0;
      var j := i;
      while j > 0 do
      begin
        var d := j mod b;
        sum := sum + fact[d];
        j := j div b;
      end;
      if sum = i then
        writeln(i, ' ');
    end;
    writeln(#10);
  end;
  readln;
end.


//  Factorians. Nigel Galloway: October 22nd., 2021
let N=[|let mutable n=1 in yield n; for g in 1..11 do n<-n*g; yield n|]
let fG n g=let rec fN g=function i when i<n->g+N.[i] |i->fN(g+N.[i%n])(i/n) in fN 0 g
{9..12}|>Seq.iter(fun n->printf $"In base %d{n} Factorians are:"; {1..1500000}|>Seq.iter(fun g->if g=fG n g then printf $" %d{g}"); printfn "")


USING: formatting io kernel math math.parser math.ranges memoize
prettyprint sequences ;
IN: rosetta-code.factorions

! Memoize factorial function
MEMO: factorial ( n -- n! ) [ 1 ] [ [1,b] product ] if-zero ;

: factorion? ( n base -- ? )
    dupd >base string>digits [ factorial ] map-sum = ;

: show-factorions ( limit base -- )
    dup "The factorions for base %d are:\n" printf
    [ [1,b) ] dip [ dupd factorion? [ pprint bl ] [ drop ] if ]
    curry each nl ;

1,500,000 9 12 [a,b] [ show-factorions nl ] with each


Dim As Integer fact(12), suma, d, j
fact(0) = 1
For n As Integer = 1 To 11
    fact(n) = fact(n-1) * n
Next n
For b As Integer = 9 To 12
    Print "Los factoriones para base " & b & " son: "
    For i As Integer = 1 To 1499999
        suma = 0
        j = i
        While j > 0
            d = j Mod b
            suma += fact(d)
            j \= b
        Wend
        If suma = i Then Print i & " ";
    Next i
    Print : Print
Next b
Sleep


factorion[n, base] := sum[map["factorial", integerDigits[n, base]]]

for base = 9 to 12
{
   for n = 1 to 1_499_999
      if n == factorion[n, base]
         println["$base\t$n"]
}


package main

import (
    "fmt"
    "strconv"
)

func main() {
    // cache factorials from 0 to 11
    var fact [12]uint64
    fact[0] = 1
    for n := uint64(1); n < 12; n++ {
        fact[n] = fact[n-1] * n
    }

    for b := 9; b <= 12; b++ {
        fmt.Printf("The factorions for base %d are:\n", b)
        for i := uint64(1); i < 1500000; i++ {
            digits := strconv.FormatUint(i, b)
            sum := uint64(0)
            for _, digit := range digits {
                if digit < 'a' {
                    sum += fact[digit-'0']
                } else {
                    sum += fact[digit+10-'a']
                }
            }
            if sum == i {
                fmt.Printf("%d ", i)
            }
        }
        fmt.Println("\n")
    }
}


import Text.Printf (printf)
import Data.List (unfoldr)
import Control.Monad (guard)

factorion :: Int -> Int -> Bool
factorion b n = f b n == n
 where
  f b = sum . map (product . enumFromTo 1) . unfoldr (\x -> guard (x > 0) >> pure (x `mod` b, x `div` b))

main :: IO ()
main = mapM_ (uncurry (printf "Factorions for base %2d: %s\n") . (\(a, b) -> (b, result a b)))
  [(3,9), (4,10), (5,11), (2,12)]
 where
  factorions b = filter (factorion b) [1..]
  result n = show . take n . factorions


public class Factorion {
    public static void main(String [] args){
        System.out.println("Base 9:");
        for(int i = 1; i <= 1499999; i++){
            String iStri = String.valueOf(i);
            int multiplied = operate(iStri,9);
            if(multiplied == i){
                System.out.print(i + "\t");
            }
        }
        System.out.println("\nBase 10:");
        for(int i = 1; i <= 1499999; i++){
            String iStri = String.valueOf(i);
            int multiplied = operate(iStri,10);
            if(multiplied == i){
                System.out.print(i + "\t");
            }
        }
        System.out.println("\nBase 11:");
        for(int i = 1; i <= 1499999; i++){
            String iStri = String.valueOf(i);
            int multiplied = operate(iStri,11);
            if(multiplied == i){
                System.out.print(i + "\t");
            }
        }
        System.out.println("\nBase 12:");
        for(int i = 1; i <= 1499999; i++){
            String iStri = String.valueOf(i);
            int multiplied = operate(iStri,12);
            if(multiplied == i){
                System.out.print(i + "\t");
            }
        }
    }
    public static int factorialRec(int n){
        int result = 1;
        return n == 0 ? result : result * n * factorialRec(n-1);
    }

    public static int operate(String s, int base){
        int sum = 0;
        String strx = fromDeci(base, Integer.parseInt(s));
        for(int i = 0; i < strx.length(); i++){
            if(strx.charAt(i) == 'A'){
                sum += factorialRec(10);
            }else if(strx.charAt(i) == 'B') {
                sum += factorialRec(11);
            }else if(strx.charAt(i) == 'C') {
                sum += factorialRec(12);
            }else {
                sum += factorialRec(Integer.parseInt(String.valueOf(strx.charAt(i)), base));
            }
        }
        return sum;
    }
    // Ln 57-71 from Geeks for Geeks @ https://www.geeksforgeeks.org/convert-base-decimal-vice-versa/
    static char reVal(int num) {
        if (num >= 0 && num <= 9)
            return (char)(num + 48);
        else
            return (char)(num - 10 + 65);
    }
    static String fromDeci(int base, int num){
        StringBuilder s = new StringBuilder();
        while (num > 0) {
            s.append(reVal(num % base));
            num /= base;
        }
        return new String(new StringBuilder(s).reverse());
    }
}


isfactorian(n, base) = mapreduce(factorial, +, map(c -> parse(Int, c, base=16), split(string(n, base=base), ""))) == n

printallfactorian(base) = println("Factorians for base $base: ", [n for n in 1:100000 if isfactorian(n, base)])

foreach(printallfactorian, 9:12)


from math import fac
from strutils import join

iterator digits(n, base: Natural): Natural =
  ## Yield the digits of "n" in base "base".
  var n = n
  while true:
    yield n mod base
    n = n div base
    if n == 0: break

func isFactorion(n, base: Natural): bool =
  ## Return true if "n" is a factorion for base "base".
  var s = 0
  for d in n.digits(base):
    inc s, fac(d)
  result = s == n

func factorions(base, limit: Natural): seq[Natural] =
  ## Return the list of factorions for base "base" up to "limit".
  for n in 1..limit:
    if n.isFactorion(base):
      result.add(n)

for base in 9..12:
  echo "Factorions for base ", base, ':'
  echo factorions(base, 1_500_000 - 1).join(" ")


let () =
  (* cache factorials from 0 to 11 *)
  let fact = Array.make 12 0 in
  fact.(0) <- 1;
  for n = 1 to pred 12 do
    fact.(n) <- fact.(n-1) * n;
  done;

  for b = 9 to 12 do
    Printf.printf "The factorions for base %d are:\n" b;
    for i = 1 to pred 1_500_000 do
      let sum = ref 0 in
      let j = ref i in
      while !j > 0 do
        let d = !j mod b in
        sum := !sum + fact.(d);
        j := !j / b;
      done;
      if !sum = i then (print_int i; print_string " ")
    done;
    print_string "\n\n";
  done


program munchhausennumber;
{$IFDEF FPC}{$MODE objFPC}{$Optimization,On,all}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
uses
  sysutils;
type
  tdigit  = byte;
const
  MAXBASE = 17;

var
  DgtPotDgt : array[0..MAXBASE-1] of NativeUint;
  dgtCnt : array[0..MAXBASE-1] of NativeInt;
  cnt: NativeUint;

function convertToString(n:NativeUint;base:byte):AnsiString;
const
  cBASEDIGITS = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvxyz';
var
  r,dgt: NativeUint;
begin
  IF base > length(cBASEDIGITS) then
    EXIT('Base to big');
  result := '';
  repeat
    r := n div base;
    dgt := n-r*base;
    result := cBASEDIGITS[dgt+1]+result;
    n := r;
  until n =0;
end;

function CheckSameDigits(n1,n2,base:NativeUInt):boolean;
var

  i : NativeUInt;
Begin
  fillchar(dgtCnt,SizeOf(dgtCnt),#0);
  repeat
    //increment digit of n1
    i := n1;n1 := n1 div base;i := i-n1*base;inc(dgtCnt[i]);
    //decrement digit of n2
    i := n2;n2 := n2 div base;i := i-n2*base;dec(dgtCnt[i]);
  until (n1=0) AND (n2= 0);
  result := true;
  For i := 2 to Base-1 do
    result := result AND (dgtCnt[i]=0);
  result := result AND (dgtCnt[0]+dgtCnt[1]=0);

end;

procedure Munch(number,DgtPowSum,minDigit:NativeUInt;digits,base:NativeInt);
var
  i: NativeUint;
  s1,s2: AnsiString;
begin
  inc(cnt);
  number := number*base;
  IF digits > 1 then
  Begin
    For i := minDigit to base-1 do
      Munch(number+i,DgtPowSum+DgtPotDgt[i],i,digits-1,base);
  end
  else
    For i := minDigit to base-1 do
      //number is always the arrangement of the digits leading to smallest number
      IF (number+i)<= (DgtPowSum+DgtPotDgt[i]) then
        IF CheckSameDigits(number+i,DgtPowSum+DgtPotDgt[i],base) then
          iF number+i>0 then
          begin
            s1 := convertToString(DgtPowSum+DgtPotDgt[i],base);
            s2 := convertToString(number+i,base);
            If length(s1)= length(s2) then
              writeln(Format('%*d %*s  %*s',[Base-1,DgtPowSum+DgtPotDgt[i],Base-1,s1,Base-1,s2]));
          end;
end;

//factorions
procedure InitDgtPotDgt(base:byte);
var
  i: NativeUint;
Begin
  DgtPotDgt[0]:= 1;
  For i := 1 to Base-1 do
    DgtPotDgt[i] := DgtPotDgt[i-1]*i;
  DgtPotDgt[0]:= 0;
end;
{
//Munchhausen numbers
procedure InitDgtPotDgt;
var
  i,k,dgtpow: NativeUint;
Begin
  // digit ^ digit ,special case 0^0 here 0
  DgtPotDgt[0]:= 0;
  For i := 1 to Base-1 do
  Begin
    dgtpow := i;
    For k := 2 to i do
      dgtpow := dgtpow*i;
    DgtPotDgt[i] := dgtpow;
  end;
end;
}
var
  base : byte;
begin
  cnt := 0;
  For base := 2 to MAXBASE do
  begin
    writeln('Base = ',base);
    InitDgtPotDgt(base);
    Munch(0,0,0,base,base);
  end;
  writeln('Check Count ',cnt);
end.


use strict;
use warnings;
use ntheory qw/factorial todigits/;

my $limit = 1500000;

for my $b (9 .. 12) {
    print "Factorions in base $b:\n";
    $_ == factorial($_) and print "$_ " for 0..$b-1;

    for my $i (1 .. int $limit/$b) {
        my $sum;
        my $prod = $i * $b;

        for (reverse todigits($i, $b)) {
            $sum += factorial($_);
            $sum = 0 && last if $sum > $prod;
        }

        next if $sum == 0;
        ($sum + factorial($_) == $prod + $_) and print $prod+$_ . ' ' for 0..$b-1;
    }
    print "\n\n";
}


with javascript_semantics
for base=9 to 12 do
    printf(1,"The factorions for base %d are: ", base)
    for i=1 to 1499999 do
        atom total = 0, j = i, d
        while j>0 and total<=i do
            d = remainder(j,base)
            total += factorial(d)
            j = floor(j/base)
        end while
        if total==i then printf(1,"%d ", i) end if
    end for
    printf(1,"\n")
end for


Declare main()

If OpenConsole() : main() : Else : End 1 : EndIf
Input() : End

Procedure main()
  Define.i n,b,d,i,j,sum
  Dim fact.i(12)

  fact(0)=1
  For n=1 To 11 : fact(n)=fact(n-1)*n : Next

  For b=9 To 12
    PrintN("The factorions for base "+Str(b)+" are: ")
    For i=1 To 1500000-1
      sum=0 : j=i
      While j>0
        d=j%b : sum+fact(d) : j/b
      Wend
      If sum=i : Print(Str(i)+" ") : EndIf
    Next
    Print(~"\n\n")
  Next
EndProcedure


fact = [1] # cache factorials from 0 to 11
for n in range(1, 12):
    fact.append(fact[n-1] * n)

for b in range(9, 12+1):
    print(f"The factorions for base {b} are:")
    for i in range(1, 1500000):
        fact_sum = 0
        j = i
        while j > 0:
            d = j % b
            fact_sum += fact[d]
            j = j//b
        if fact_sum == i:
            print(i, end=" ")
    print("\n")


  [ table ]              is results   (   n --> s )
  4 times
    [ ' [ stack [ ] ]
      copy
      ' results put ]

  [ results dup take
    rot join swap put ]  is addresult ( n n -->   )

  [ table 9 10 11 12 ]   is radix     (   n --> n )

  [ table 1 ]            is !         (   n --> n )
  1 11 times
    [ i^ 1+ * dup
      ' ! put ]
  drop

  [ dip dup
    0 temp put
    [ tuck /mod !
      temp tally
      swap over 0 =
      until ]
    2drop
    temp take = ]       is factorion ( n n --> b )

  1500000 times
    [ i^ 4 times
      [ dup
        i^ radix
        factorion if
          [ dup i^
            addresult ] ]
      drop ]
  4 times
    [ say "Factorions for base "
     i^ radix echo say ": "
     i^ results take echo cr ]


#lang racket

(define fact
  (curry list-ref (for/fold ([result (list 1)] #:result (reverse result))
                            ([x (in-range 1 20)])
                    (cons (* x (first result)) result))))

(for ([b (in-range 9 13)])
  (printf "The factorions for base ~a are:\n" b)
  (for ([i (in-range 1 1500000)])
    (let loop ([sum 0] [n i])
      (cond
        [(positive? n) (loop (+ sum (fact (modulo n b))) (quotient n b))]
        [(= sum i) (printf "~a " i)])))
  (newline))


constant @factorial = 1, |[\*] 1..*;

constant $limit = 1500000;

constant $bases = 9 .. 12;

my @result;

$bases.map: -> $base {

    @result[$base] = "\nFactorions in base $base:\n1 2";

    sink (1 .. $limit div $base).map: -> $i {
        my $product = $i * $base;
        my $partial;

        for $i.polymod($base xx *) {
            $partial += @factorial[$_];
            last if $partial > $product
        }

        next if $partial > $product;

        my $sum;

        for ^$base {
            last if ($sum = $partial + @factorial[$_]) > $product + $_;
            @result[$base] ~= " $sum" and last if $sum == $product + $_
        }
    }
}

.say for @result[$bases];


/*REXX program calculates and displays   factorions   in  bases  nine ───► twelve.      */
parse arg LOb HIb lim .                          /*obtain optional arguments from the CL*/
if LOb=='' | LOb==","  then LOb=       9         /*Not specified?  Then use the default.*/
if HIb=='' | HIb==","  then HIb=      12         /* "      "         "   "   "      "   */
if lim=='' | lim==","  then lim= 1500000  -  1   /* "      "         "   "   "      "   */

  do fact=0  to HIb;   !.fact= !(fact)           /*use memoization for factorials.      */
  end   /*fact*/

  do base=LOb  to  HIb                           /*process all the required bases.      */
  @= 1 2                                         /*initialize the list  (@)  to  1 & 2. */
          do j=3  for lim-2;  $= 0               /*initialize the sum   ($)  to  zero.  */
                                          t= j   /*define the target  (for the sum !'s).*/
                                 do until t==0;    d= t // base      /*obtain a "digit".*/
                                                   $= $ + !.d        /*add  !(d) to sum.*/
                                                   t= t % base       /*get a new target.*/
                                 end   /*until*/
          if $==j  then @= @ j                   /*Good factorial sum? Then add to list.*/
          end   /*i*/
  say
  say 'The factorions for base '      right( base, length(HIb) )        " are: "         @
  end   /*base*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!: procedure; parse arg x;  !=1;    do j=2  to x;  !=!*j;  end;   return !  /*factorials*/


def factorion?(n, base)
  n.digits(base).sum{|digit| (1..digit).inject(1, :*)} == n
end

(9..12).each do |base|
  puts "Base #{base} factorions: #{(1..1_500_000).select{|n| factorion?(n, base)}.join(" ")} "
end


object Factorion extends App {
    private def is_factorion(i: Int, b: Int): Boolean = {
        var sum = 0L
        var j = i
        while (j > 0) {
            sum +=  f(j % b)
            j /= b
        }
        sum == i
    }

    private val f = Array.ofDim[Long](12)
    f(0) = 1L
    (1 until 12).foreach(n => f(n) = f(n - 1) * n)
    (9 to 12).foreach(b => {
        print(s"factorions for base $b:")
        (1 to 1500000).filter(is_factorion(_, b)).foreach(i => print(s" $i"))
        println
    })
}


func max_power(b = 10) {
    var m = 1
    var f = (b-1)!
    while (m*f >= b**(m-1)) {
        m += 1
    }
    return m-1
}

func factorions(b = 10) {

    var result = []
    var digits = @^b
    var fact = digits.map { _! }

    for k in (1 .. max_power(b)) {
        digits.combinations_with_repetition(k, {|*comb|
            var n = comb.sum_by { fact[_] }
            if (n.digits(b).sort == comb) {
                result << n
            }
        })
    }

    return result
}

for b in (2..12) {
    var r = factorions(b)
    say "Base #{'%2d' % b} factorions: #{r}"
}


var fact = Array(repeating: 0, count: 12)

fact[0] = 1

for n in 1..<12 {
  fact[n] = fact[n - 1] * n
}

for b in 9...12 {
  print("The factorions for base \(b) are:")

  for i in 1..<1500000 {
    var sum = 0
    var j = i

    while j > 0 {
      sum += fact[j % b]
      j /= b
    }

    if sum == i {
      print("\(i)", terminator: " ")
      fflush(stdout)
    }
  }

  print("\n")
}


import strconv

fn main() {
    // cache factorials from 0 to 11
    mut fact := [12]u64{}
    fact[0] = 1
    for n := u64(1); n < 12; n++ {
        fact[n] = fact[n-1] * n
    }

    for b := 9; b <= 12; b++ {
        println("The factorions for base $b are:")
        for i := u64(1); i < 1500000; i++ {
            digits := strconv.format_uint(i, b)
            mut sum := u64(0)
            for digit in digits {
                if digit < `a` {
                    sum += fact[digit-`0`]
                } else {
                    sum += fact[digit+10-`a`]
                }
            }
            if sum == i {
                print("$i ")
            }
        }
        println("\n")
    }
}


// cache factorials from 0 to 11
var fact = List.filled(12, 0)
fact[0] = 1
for (n in 1..11) fact[n] = fact[n-1] * n

for (b in 9..12) {
    System.print("The factorions for base %(b) are:")
    for (i in 1...1500000) {
        var sum = 0
        var j = i
        while (j > 0) {
            var d = j % b
            sum = sum + fact[d]
            j = (j/b).floor
        }
        if (sum == i) System.write("%(i) ")
    }
    System.print("\n")
}


' Factorions - VBScript - PG - 26/04/2020
    Dim fact()
	nn1=9 : nn2=12
	lim=1499999
    ReDim fact(nn2)
	fact(0)=1
	For i=1 To nn2
		fact(i)=fact(i-1)*i
	Next
	For base=nn1 To nn2
		list=""
		For i=1 To lim
			s=0
			t=i
			Do While t<>0
				d=t Mod base
				s=s+fact(d)
				t=t\base
			Loop
			If s=i Then list=list &" "& i
		Next
		Wscript.Echo "the factorions for base "& right(" "& base,2) &" are: "& list
	Next


var facts=[0..12].pump(List,fcn(n){ (1).reduce(n,fcn(N,n){ N*n },1) }); #(1,1,2,6....)
fcn factorions(base){
   fs:=List();
   foreach n in ([1..1_499_999]){
      sum,j := 0,n;
      while(j){
	 sum+=facts[j%base];
	 j/=base;
      }
      if(sum==n) fs.append(n);
   }
   fs
}


F farey(n)
   V a = 0
   V b = 1
   V c = 1
   V d = n
   V far = ‘0/1 ’
   V farn = 1
   L c <= n
      V k = (n + b) I/ d
      (a, b, c, d) = (c, d, k * c - a, k * d - b)
      far ‘’= a‘/’b‘ ’
      farn++
   R (far, farn)

L(i) 1..11
   print(i‘: ’farey(i)[0])

L(i) (100..1000).step(100)
   print(i‘: ’farey(i)[1]‘ items’)


BEGIN # construct some Farey Sequences and calculate their lengths       #
    # prints an element of a Farey Sequence                              #
    PROC print element = ( INT a, b )VOID:
         print( ( " ", whole( a, 0 ), "/", whole( b, 0 ) ) );
    # returns the length of the Farey Sequence of order n, optionally    #
    #         printing it                                                #
    PROC farey sequence length = ( INT n, BOOL print sequence )INT:
         IF n < 1 THEN 0
         ELSE
            INT a := 0, b := 1, c := 1, d := n;
            IF print sequence THEN
                print( ( whole( n, -2 ), ":" ) );
                print element( a, b )
            FI;
            INT length := 1;
            WHILE c <= n DO
                INT k     = ( n + b ) OVER d;
                INT old a = a, old b = b;
                a := c;
                b := d;
                c := ( k * c ) - old a;
                d := ( k * d ) - old b;
                IF print sequence THEN print element( a, b ) FI;
                length +:= 1
            OD;
            IF print sequence THEN print( ( newline ) ) FI;
            length
         FI # farey sequence length # ;
    # task #
    FOR i TO 11 DO farey sequence length( i, TRUE ) OD;
    FOR n FROM 100 BY 100 TO 1 000 DO
        print( ( "Farey Sequence of order ", whole( n, -4 )
               , " has length: ", whole( farey sequence length( n, FALSE ), -6 )
               , newline
               )
             )
    OD
END


farey←{{⍵[⍋⍵]}∪∊{(0,⍳⍵)÷⍵}¨⍳⍵}
fract←{1∧(0(⍵=0)+⊂⍵)*1 ¯1}
print←{{(⍕⍺),'/',(⍕⍵),' '}⌿↑fract farey ⍵}


# syntax: GAWK -f FAREY_SEQUENCE.AWK
BEGIN {
    for (i=1; i<=11; i++) {
      farey(i); printf("\n")
    }
    for (i=100; i<=1000; i+=100) {
      printf(" %d items\n",farey(i))
    }
    exit(0)
}
function farey(n,  a,aa,b,bb,c,cc,d,dd,items,k) {
    a = 0; b = 1; c = 1; d = n
    printf("%d:",n)
    if (n <= 11) {
      printf(" %d/%d",a,b)
    }
    while (c <= n) {
      k = int((n+b)/d)
      aa = c; bb = d; cc = k*c-a; dd = k*d-b
      a = aa; b = bb; c = cc; d = dd
      items++
      if (n <= 11) {
        printf(" %d/%d",a,b)
      }
    }
    return(1+items)
}


for i = 1 to 11
    print "F"; i; " = ";
    call farey(i, FALSE)
next i
print
for i = 100 to 1000 step 100
    print "F"; i;
    if i <> 1000 then print " "; else print "";
    print " = ";
    call farey(i, FALSE)
next i
end

subroutine farey(n, descending)
    a = 0 : b = 1 : c = 1 : d = n : k = 0
    cont = 0

    if descending = TRUE then
        a = 1 : c = n -1
    end if

    cont += 1
    if n < 12 then print a; "/"; b; " ";

    while ((c <= n) and not descending) or ((a > 0) and descending)
        aa = a : bb = b : cc = c : dd = d
        k = (n + b) \ d
        a = cc : b = dd : c = k * cc - aa : d = k * dd - bb
        cont += 1
        if n < 12 then print a; "/"; b; " ";
    end while

    if n < 12 then print else print rjust(cont,7)
end subroutine


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

void farey(int n)
{
	typedef struct { int d, n; } frac;
	frac f1 = {0, 1}, f2 = {1, n}, t;
	int k;

	printf("%d/%d %d/%d", 0, 1, 1, n);
	while (f2.n > 1) {
		k = (n + f1.n) / f2.n;
		t = f1, f1 = f2, f2 = (frac) { f2.d * k - t.d, f2.n * k - t.n };
		printf(" %d/%d", f2.d, f2.n);
	}

	putchar('\n');
}

typedef unsigned long long ull;
ull *cache;
size_t ccap;

ull farey_len(int n)
{
	if (n >= ccap) {
		size_t old = ccap;
		if (!ccap) ccap = 16;
		while (ccap <= n) ccap *= 2;
		cache = realloc(cache, sizeof(ull) * ccap);
		memset(cache + old, 0, sizeof(ull) * (ccap - old));
	} else if (cache[n])
		return cache[n];

	ull len = (ull)n*(n + 3) / 2;
	int p, q = 0;
	for (p = 2; p <= n; p = q) {
		q = n/(n/p) + 1;
		len -= farey_len(n/p) * (q - p);
	}

	cache[n] = len;
	return len;
}

int main(void)
{
	int n;
	for (n = 1; n <= 11; n++) {
		printf("%d: ", n);
		farey(n);
	}

	for (n = 100; n <= 1000; n += 100)
		printf("%d: %llu items\n", n, farey_len(n));

	n = 10000000;
	printf("\n%d: %llu items\n", n, farey_len(n));
	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

public static class FareySequence
{
    public static void Main() {
        for (int i = 1; i <= 11; i++) {
            Console.WriteLine($"F{i}: " + string.Join(", ", Generate(i).Select(f => $"{f.num}/{f.den}")));
        }
        for (int i = 100; i <= 1000; i+=100) {
            Console.WriteLine($"F{i} has {Generate(i).Count()} terms.");
        }
    }

    public static IEnumerable<(int num, int den)> Generate(int i) {
        var comparer = Comparer<(int n, int d)>.Create((a, b) => (a.n * b.d).CompareTo(a.d * b.n));
        var seq = new SortedSet<(int n, int d)>(comparer);
        for (int d = 1; d <= i; d++) {
            for (int n = 0; n <= d; n++) {
                seq.Add((n, d));
            }
        }
        return seq;
    }
}


#include <iostream>

struct fraction {
    fraction(int n, int d) : numerator(n), denominator(d) {}
    int numerator;
    int denominator;
};

std::ostream& operator<<(std::ostream& out, const fraction& f) {
    out << f.numerator << '/' << f.denominator;
    return out;
}

class farey_sequence {
public:
    explicit farey_sequence(int n) : n_(n), a_(0), b_(1), c_(1), d_(n) {}
    fraction next() {
        // See https://en.wikipedia.org/wiki/Farey_sequence#Next_term
        fraction result(a_, b_);
        int k = (n_ + b_)/d_;
        int next_c = k * c_ - a_;
        int next_d = k * d_ - b_;
        a_ = c_;
        b_ = d_;
        c_ = next_c;
        d_ = next_d;
        return result;
    }
    bool has_next() const { return a_ <= n_; }
private:
    int n_, a_, b_, c_, d_;
};

int main() {
    for (int n = 1; n <= 11; ++n) {
        farey_sequence seq(n);
        std::cout << n << ": " << seq.next();
        while (seq.has_next())
            std::cout << ' ' << seq.next();
        std::cout << '\n';
    }
    for (int n = 100; n <= 1000; n += 100) {
        int count = 0;
        for (farey_sequence seq(n); seq.has_next(); seq.next())
            ++count;
        std::cout << n << ": " << count << '\n';
    }
    return 0;
}


(defun farey (n)
  (labels ((helper (begin end)
	     (let ((med (/ (+ (numerator begin) (numerator end))
			   (+ (denominator begin) (denominator end)))))
	       (if (<= (denominator med) n)
		   (append (helper begin med)
			   (list med)
			   (helper med end))))))
      (append (list 0) (helper 0 1) (list 1))))

;; Force printing of integers in X/1 format
(defun print-ratio (stream object &optional colonp at-sign-p)
  (format stream "~d/~d" (numerator object) (denominator object)))

(loop for i from 1 to 11 do
     (format t "~a: ~{~/print-ratio/ ~}~%" i (farey i)))

(loop for i from 100 to 1001 by 100 do
     (format t "Farey sequence of order ~a has ~a terms.~%" i (length (farey i))))


require "big"

def farey(n)
    a, b, c, d = 0, 1, 1, n
    fracs = [] of BigRational
    fracs << BigRational.new(0,1)
    while c <= n
        k = (n + b) // d
        a, b, c, d = c, d, k * c - a, k * d - b
        fracs << BigRational.new(a,b)
    end
    fracs.uniq.sort
end

puts "Farey sequence for order 1 through 11 (inclusive):"
(1..11).each do |n|
  puts "F(#{n}): 0/1 #{farey(n)[1..-2].join(" ")} 1/1"
end

puts "Number of fractions in the Farey sequence:"
(100..1000).step(100) do |i|
  puts "F(%4d) =%7d" % [i, farey(i).size]
end


import std.stdio, std.algorithm, std.range, arithmetic_rational;

auto farey(in int n) pure nothrow @safe {
    return rational(0, 1).only.chain(
            iota(1, n + 1)
            .map!(k => iota(1, k + 1).map!(m => rational(m, k)))
            .join.sort().uniq);
}

void main() @safe {
    writefln("Farey sequence for order 1 through 11:\n%(%s\n%)",
             iota(1, 12).map!farey);
    writeln("\nFarey sequence fractions, 100 to 1000 by hundreds:\n",
            iota(100, 1_001, 100).map!(i => i.farey.walkLength));
}


(define distinct-divisors
	(compose make-set prime-factors))

;; euler totient :  Φ :  n / product(p_i) * product (p_i - 1)
;; # of divisors <= n

(define (Φ n)
	(let ((pdiv (distinct-divisors n)))
	(/ (* n  (for/product ((p pdiv)) (1- p))) (for/product ((p pdiv)) p))))

;; farey-sequence length |Fn|  = 1 + sigma (m=1..) Φ(m)

(define ( F-length n) (1+ (for/sum ((m (1+ n))) (Φ m))))

;; farey sequence
;; apply the definition :  O(n^2)
(define (Farey N)
	(set! N (1+ N))
	(make-set (for*/list ((n N) (d (in-range n N))) (rational n d))))


 [Farey sequence for Rosetta Code website.
  EDSAC program, Initial Orders 2.
  Prints Farey sequences up to order 11
  (or other limit determined by a simple edit).]

 [Modification of library subroutine P6.
  Prints number (absolute value <= 65535)
  passed in 0F, without leading spaces.
  41 locations.]
          T 56 K
  [email protected]@[email protected]@[email protected]@[email protected]
  [email protected]@[email protected]@[email protected]
  [email protected]@[email protected]

          T 100 K
          G     K
  [Maximum order to be printed. For convenience, entered as
  an address, not an integer, e.g. 'P 11 F' not 'P 5 D'.]
    [0]   P  11 F [<--- edit here]
  [Other constants]
    [1]   P     D [1]
    [2]   #     F [figure shift]
    [3]   X     F [slash]
    [4]   !     F [space]
    [5]   @     F [carriage return]
    [6]   &     F [line feed]
    [7]   K4096 F [teleprinter null]
  [Variables]
    [8]   P     F [n, order of current Farey sequence]
    [9]   P     F [maximum n + 1, as integer]
          [a/b and c/d are consecutive terms of the Farey sequence]
   [10]   P     F [a]
   [11]   P     F [b]
   [12]   P     F [c]
   [13]   P     F [d]
   [14]   P     F [t, temporary store]

          [Subroutine to print c/d]
   [15]   A   3 F [plant link for return]
          T  26 @
          A  12 @ [load c]
          T     F [to 0F for printing]
   [19]   A  19 @ [for subroutine return]
          G  56 F [print c]
          O   3 @ [print '/']
          A  13 @ [load d]
          T     F [to 0F for printing]
   [24]   A  24 @ [for subroutine return]
          G  56 F [print d]
   [26]   E     F [return]

           [Main routine.
           Enter with accumulator = 0.]
   [27]   O   2 @ [set teleprinter to figures]
          A     @ [max order as address]
          R     D [shift 1 right to make integer]
          A   1 @ [add 1]
          T   9 @ [save for comparison]
          A   1 @ [start with order 1]
          [Here with next order (n) in the accumulator]
   [33]   S   9 @ [subtract (max order) + 1]
          E  84 @ [exit if over maximum]
          A   9 @ [restore after test]
          T   8 @ [store]
          [Prefix the Farey sequence with a formal term -1/0.
           The second term is calculated from this and the first term.]
          S   1 @ [acc := -1]
          T  10 @ [a := -1]
          T  11 @ [b := 0]
          T  12 @ [c := 0]
          A   1 @ [d := 1]
          T  13 @
          A  43 @ [for subroutine return]
          G  15 @ [call subroutine to print c/d]

          [Calculate next term; basically same as Wikipedia method]
   [45]   T     F [clear acc]
          A  10 @ [t := a]
          T  14 @
          A  12 @ [a := c;]
          T  10 @
          S  14 @ [c := -t]
          T  12 @
          A  11 @ [t := b]
          T  14 @
          A  13 @ [b := d]
          T  11 @
          S  14 @ [d := -t]
          T  13 @
          A   8 @ [t := n + t]
          A  14 @
          T  14 @
          [Inner loop, get t div b by repeated subtraction]
   [61]   A  14 @ [t := t - b]
          S  11 @
          G  72 @ [jump out when t < 0]
          T  14 @
          A  12 @ [c := c + a]
          A  10 @
          T  12 @
          A  13 @ [d := d + b]
          A  11 @
          T  13 @
          E  61 @ [loop back (always, since acc = 0)]
          [End of inner loop, print c/d preceded by space]
   [72]   O   4 @
          T     F
   [74]   A  74 @ [for subroutine return]
          G  15 @ [call subroutine to print c/d]
          A   1 @ [form 1 - d, to test for d = 1]
          S  13 @
          G  45 @ [if d > 1, loop for next term]
          O   5 @ [else print end of line (CR LF)]
          O   6 @

          [Next Farey series.]
          A   8 @ [load order]
          A   1 @ [add 1]
          E  33 @ [loop back]

          [Here when finished]
   [84]   O   7 @ [output null to flush teleprinter buffer]
          Z     F [stop]
          E  27 Z [define start of execution]
          P     F [start with accumulator = 0]


USING: formatting io kernel math math.primes.factors math.ranges
locals prettyprint sequences sequences.extras sets tools.time ;
IN: rosetta-code.farey-sequence

! Given the order n and a farey pair, calculate the next member
! of the sequence.
:: p/q ( n a/b c/d -- p/q )
    a/b c/d [ >fraction ] [email protected] :> ( a b c d )
    n b + d / >integer [ c * a - ] [ d * b - ] bi / ;

: print-farey ( order -- )
    [ "F(%-2d): " printf ] [ 0 1 pick / ] bi "0/1 " write
    [ dup 1 = ] [ dup pprint bl 3dup p/q [ nip ] dip ] until
    3drop "1/1" print ;

: φ ( n -- m ) ! Euler's totient function
    [ factors members [ 1 swap recip - ] map-product ] [ * ] bi ;

: farey-length ( order -- length )
   dup 1 = [ drop 2 ]
   [ [ 1 - farey-length ] [ φ ] bi + ] if ;

: part1 ( -- ) 11 [1,b] [ print-farey ] each nl ;

: part2 ( -- )
    100 1,000 100 <range>
    [ dup farey-length "F(%-4d): %-6d members.\n" printf ] each ;

: main ( -- ) [ part1 part2 nl ] time ;

MAIN: main


' version 05-04-2017
' compile with: fbc -s console

' TRUE/FALSE are built-in constants since FreeBASIC 1.04
' But we have to define them for older versions.
#Ifndef TRUE
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

Function farey(n As ULong, descending As Long) As ULong

    Dim As Long a, b = 1, c = 1, d = n, k
    Dim As Long aa, bb, cc, dd, count

    If descending = TRUE Then
        a = 1 : c = n -1
    End If

    count += 1
    If n < 12 Then Print Str(a); "/"; Str(b); " ";

    While ((c <= n) And Not descending) Or ((a > 0) And descending)
        aa = a : bb = b : cc = c : dd = d
        k = (n + b) \ d
        a = cc : b = dd : c = k * cc - aa : d = k * dd - bb
        count += 1
        If n < 12 Then Print Str(a); "/"; Str(b); " ";
    Wend

    If n < 12 Then Print

    Return count

End Function

' ------=< MAIN >=------

For i As Long = 1 To 11
    Print "F"; Str(i); " = ";
    farey(i, FALSE)
Next
Print
For i As Long= 100 To 1000 Step 100
    Print "F";Str(i);
    Print iif(i <> 1000, " ", ""); " = ";
    Print Using "######"; farey(i, FALSE)
Next

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


def farey( n ) =
  res = seq()
  a, b, c, d = 0, 1, 1, n
  res += "$a/$b"

  while c <= n
    k = (n + b)\d
    a, b, c, d = c, d, k*c - a, k*d - b
    res += "$a/$b"

for i <- 1..11
  println( "$i: ${farey(i).mkString(', ')}" )

for i <- 100..1000 by 100
  println( "$i: ${farey(i).length()}" )


package main

import "fmt"

type frac struct{ num, den int }

func (f frac) String() string {
    return fmt.Sprintf("%d/%d", f.num, f.den)
}

func f(l, r frac, n int) {
    m := frac{l.num + r.num, l.den + r.den}
    if m.den <= n {
        f(l, m, n)
        fmt.Print(m, " ")
        f(m, r, n)
    }
}

func main() {
    // task 1.  solution by recursive generation of mediants
    for n := 1; n <= 11; n++ {
        l := frac{0, 1}
        r := frac{1, 1}
        fmt.Printf("F(%d): %s ", n, l)
        f(l, r, n)
        fmt.Println(r)
    }
    // task 2.  direct solution by summing totient function
    // 2.1 generate primes to 1000
    var composite [1001]bool
    for _, p := range []int{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31} {
        for n := p * 2; n <= 1000; n += p {
            composite[n] = true
        }
    }
    // 2.2 generate totients to 1000
    var tot [1001]int
    for i := range tot {
        tot[i] = 1
    }
    for n := 2; n <= 1000; n++ {
        if !composite[n] {
            tot[n] = n - 1
            for a := n * 2; a <= 1000; a += n {
                f := n - 1
                for r := a / n; r%n == 0; r /= n {
                    f *= n
                }
                tot[a] *= f
            }
        }
    }
    // 2.3 sum totients
    for n, sum := 1, 1; n <= 1000; n++ {
        sum += tot[n]
        if n%100 == 0 {
            fmt.Printf("|F(%d)|: %d\n", n, sum)
        }
    }
}


import Data.List (unfoldr, mapAccumR)
import Data.Ratio ((%), denominator, numerator)
import Text.Printf (PrintfArg, printf)

-- The n'th order Farey sequence.
farey :: Integer -> [Rational]
farey n = 0 : unfoldr step (0, 1, 1, n)
  where
    step (a, b, c, d)
      | c > n = Nothing
      | otherwise =
        let k = (n + b) `quot` d
        in Just (c %d, (c, d, k * c - a, k * d - b))

-- A list of pairs, (n, fn n), where fn is a function applied to the n'th order
-- Farey sequence.  We assume the list of orders is increasing.  Only the
-- highest order Farey sequence is evaluated; the remainder are generated by
-- successively pruning this sequence.
fareys :: ([Rational] -> a) -> [Integer] -> [(Integer, a)]
fareys fn ns = snd $ mapAccumR prune (farey $ last ns) ns
  where
    prune rs n =
      let rs'' = filter ((<= n) . denominator) rs
      in (rs'', (n, fn rs''))

fprint
  :: (PrintfArg b)
  => String -> [(Integer, b)] -> IO ()
fprint fmt = mapM_ (uncurry $ printf fmt)

showFracs :: [Rational] -> String
showFracs =
  unwords .
  map (concat . (<*>) [show . numerator, const "/", show . denominator] . pure)

main :: IO ()
main = do
  putStrLn "Farey Sequences\n"
  fprint "%2d %s\n" $ fareys showFracs [1 .. 11]
  putStrLn "\nSequence Lengths\n"
  fprint "%4d %d\n" $ fareys length [100,200 .. 1000]


Farey=: x:@/:[email protected](0 , ~.)@(#~ <:&1)@:,@(%/[email protected](1 + i.))      NB. calculates Farey sequence
displayFarey=: ('r/' charsub '0r' , ,&'r1')@":           NB. format character representation of Farey sequence according to task requirements
order=: ': ' ,~ ":                                       NB. decorate order of Farey sequence


import java.util.TreeSet;

public class Farey{
	private static class Frac implements Comparable<Frac>{
		int num;
		int den;

		public Frac(int num, int den){
			this.num = num;
			this.den = den;
		}

		@Override
		public String toString(){
			return num + "/" + den;
		}

		@Override
		public int compareTo(Frac o){
			return Double.compare((double)num / den, (double)o.num / o.den);
		}
	}

	public static TreeSet<Frac> genFarey(int i){
		TreeSet<Frac> farey = new TreeSet<Frac>();
		for(int den = 1; den <= i; den++){
			for(int num = 0; num <= den; num++){
				farey.add(new Frac(num, den));
			}
		}
		return farey;
	}

	public static void main(String[] args){
		for(int i = 1; i <= 11; i++){
			System.out.println("F" + i + ": " + genFarey(i));
		}

		for(int i = 100; i <= 1000; i += 100){
			System.out.println("F" + i + ": " + genFarey(i).size() + " members");
		}
	}
}


using DataStructures

function farey(n::Int)
    rst = SortedSet{Rational}(Rational[0, 1])
    for den in 1:n, num in 1:den-1
        push!(rst, Rational(num, den))
    end
    return rst
end

for n in 1:11
    print("F_$n: ")
    for frac in farey(n)
        print(numerator(frac), "/", denominator(frac), " ")
    end
    println()
end

for n in 100:100:1000
    println("F_$n has ", length(farey(n)), " fractions")
end


// version 1.1

fun farey(n: Int): List<String> {
    var a = 0
    var b = 1
    var c = 1
    var d = n
    val f = mutableListOf("$a/$b")
    while (c <= n) {
        val k = (n + b) / d
        val aa = a
        val bb = b
        a = c
        b = d
        c = k * c - aa
        d = k * d - bb
        f.add("$a/$b")
    }
    return f.toList()
}

fun main(args: Array<String>) {
    for (i in 1..11)
        println("${"%2d".format(i)}: ${farey(i).joinToString(" ")}")
    println()
    for (i in 100..1000 step 100)
        println("${"%4d".format(i)}: ${"%6d".format(farey(i).size)} fractions")
}


-- Return farey sequence of order n
function farey (n)
    local a, b, c, d, k = 0, 1, 1, n
    local farTab = {{a, b}}
    while c <= n do
        k = math.floor((n + b) / d)
        a, b, c, d = c, d, k * c - a, k * d - b
        table.insert(farTab, {a, b})
    end
    return farTab
end

-- Main procedure
for i = 1, 11 do
    io.write(i .. ": ")
    for _, frac in pairs(farey(i)) do io.write(frac[1] .. "/" .. frac[2] .. " ") end
    print()
end
for i = 100, 1000, 100 do print(i .. ": " .. #farey(i) .. " items") end


#Displays terms in Farey_sequence of order n
farey_sequence := proc(n)
  local a,b,c,d,k;
  a,b,c,d := 0,1,1,n;
  printf("%d/%d", a,b);
  while c <= n do
    k := iquo(n+b,d);
    a,b,c,d := c,d,c*k-a,d*k-b;
    printf(", %d/%d", a,b)
  end do;
  printf("\n");
end proc:

#Returns the length of a Farey sequence
farey_len := proc(n)
  return 1 + add(NumberTheory:-Totient(k), k=1..n);
end proc;

for i to 11 do
  farey_sequence(i);
end do;
printf("\n");
for j from 100 to 1000 by 100 do
  printf("%d\n", farey_len(j));
end do;


with Ada.Numerics.Generic_Complex_Arrays;

generic
   with package Complex_Arrays is
      new Ada.Numerics.Generic_Complex_Arrays (<>);
   use Complex_Arrays;
function Generic_FFT (X : Complex_Vector) return Complex_Vector;


farey[n_]:[email protected]@Riffle[[email protected][#]<>"/"<>[email protected][#]&/@FareySequence[n],", "]
TableForm[farey/@Range[11]]
Table[Length[FareySequence[n]], {n, 100, 1000, 100}]


import strformat

proc farey(n: int) =
  var f1 = (d: 0, n: 1)
  var f2 = (d: 1, n: n)
  write(stdout, fmt"0/1 1/{n}")
  while f2.n > 1:
    let k = (n + f1.n) div f2.n
    let aux = f1
    f1 = f2
    f2 = (f2.d * k - aux.d, f2.n * k - aux.n)
    write(stdout, fmt" {f2.d}/{f2.n}")
  write(stdout, "\n")

proc fareyLength(n: int, cache: var seq[int]): int =
  if n >= cache.len:
    var newLen = cache.len
    if newLen == 0:
      newLen = 16
    while newLen <= n:
      newLen *= 2
    cache.setLen(newLen)
  elif cache[n] != 0:
    return cache[n]

  var length = n * (n + 3) div 2
  var p = 2
  var q = 0
  while p <= n:
    q = n div (n div p) + 1
    dec length, fareyLength(n div p, cache) * (q - p)
    p = q
  cache[n] = length
  return length

for n in 1..11:
  write(stdout, fmt"{n:>8}: ")
  farey(n)

var cache: seq[int] = @[]
for n in countup(100, 1000, step=100):
  echo fmt"{n:>8}: {fareyLength(n, cache):14} items"

let n = 10_000_000
echo fmt"{n}: {fareyLength(n, cache):14} items"


Farey(n)=my(v=List()); for(k=1,n,for(i=0,k,listput(v,i/k))); vecsort(Set(v));
countFarey(n)=1+sum(k=1, n, eulerphi(k));
fmt(n)=if(denominator(n)>1,n,Str(n,"/1"));
for(n=1,11,print(apply(fmt, Farey(n))))
apply(countFarey, 100*[1..10])


PRIO DICE = 9; # ideally = 11 #

OP DICE = ([]SCALAR in, INT step)[]SCALAR: (
    ### Dice the array, extract array values a "step" apart ###
    IF step = 1 THEN
        in
    ELSE
        INT upb out := 0;
        [(UPB in-LWB in)%step+1]SCALAR out;
        FOR index FROM LWB in BY step TO UPB in DO
            out[upb out+:=1] := in[index] OD;
        out[@LWB in]
    FI
);

PROC fft = ([]SCALAR in t)[]SCALAR: (
    ### The Cooley-Tukey FFT algorithm ###
    IF LWB in t >= UPB in t THEN
      in t[@0]
    ELSE
        []SCALAR t = in t[@0];
        INT n = UPB t + 1, half n = n % 2;
        [LWB t:UPB t]SCALAR coef;

        []SCALAR even = fft(t    DICE 2),
                  odd = fft(t[1:]DICE 2);

        COMPL i = 0 I 1;

        REAL w =  2*pi / n;
        FOR k FROM LWB t TO half n-1 DO
            COMPL cis t = scalar exp(0 I (-w * k))*odd[k];
            coef[k]          := even[k] + cis t;
            coef[k + half n] := even[k] - cis t
        OD;
        coef
    FI
);


program Farey;
 {$IFDEF FPC }{$MODE DELPHI}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
uses
   sysutils;
type
   tNextFarey= record
                 nom,dom,n,c,d: longInt;
               end;

function  InitFarey(maxdom:longINt):tNextFarey;
Begin
  with result do
  Begin
    nom := 0; dom := 1; n   := maxdom;
    c   := 1; d   := maxdom;
  end;
end;

function NextFarey(var fn:tNextFarey):boolean;
var
  k,tmp: longInt;
Begin
  with fn do
  Begin
    k := trunc((n + dom)/d);
    tmp := c;c:= k*c-nom;nom:= tmp;
    tmp := d;d:= k*d-dom;dom:= tmp;
    result := nom <> dom;
  end;
end;

procedure CheckFareyCount( num: NativeUint);
var
  TestF : tNextFarey;
  cnt : NativeUint;
Begin
  TestF:= InitFarey(num);
  cnt := 1;
  repeat
    inc(cnt);
  until NOT(NextFarey(TestF));

  writeln('F(',TestF.n:4,')  = ',cnt:7);
end;

var
  TestF : tNextFarey;
  cnt: NativeInt;
Begin

  Writeln('Farey sequence for order 1 through 11 (inclusive): ');

  For cnt := 1 to 11 do
  Begin
      TestF:= InitFarey(cnt);
      write('F(',cnt:2,') =  ');
      repeat
         write(TestF.nom,'/',TestF.dom,',');
     until NOT(NextFarey(TestF));
     writeln(TestF.nom,'/',TestF.dom);
   end;
  writeln;
  writeln('Number of fractions in the Farey sequence:');
  cnt := 100;
  repeat
    CheckFareyCount(cnt);
    inc(cnt,100);
  until cnt > 1000;
end.


fft←{
    1>k←2÷⍨N←⍴⍵:⍵
    0≠1|2⍟N:'Argument must be a power of 2 in length'
    even←∇(N⍴0 1)/⍵
    odd←∇(N⍴1 0)/⍵
    T←even×*(0J¯2×(○1)×(¯1+⍳k)÷N)
    (odd+T),odd-T
}


use warnings;
use strict;
use Math::BigRat;
use ntheory qw/euler_phi vecsum/;

sub farey {
  my $N = shift;
  my @f;
  my($m0,$n0, $m1,$n1) = (0, 1, 1, $N);
  push @f, Math::BigRat->new("$m0/$n0");
  push @f, Math::BigRat->new("$m1/$n1");
  while ($f[-1] < 1) {
    my $m = int( ($n0 + $N) / $n1) * $m1 - $m0;
    my $n = int( ($n0 + $N) / $n1) * $n1 - $n0;
    ($m0,$n0, $m1,$n1) = ($m1,$n1, $m,$n);
    push @f, Math::BigRat->new("$m/$n");
  }
  @f;
}
sub farey_count { 1 + vecsum(euler_phi(1, shift)); }

for (1 .. 11) {
  my @f = map { join "/", $_->parts }   # Force 0/1 and 1/1
          farey($_);
  print "F$_: [@f]\n";
}
for (1 .. 10, 100000) {
  print "F${_}00: ", farey_count(100*$_), " members\n";
}


#include <stdio.h>
#include <math.h>
#include <complex.h>

double PI;
typedef double complex cplx;

void _fft(cplx buf[], cplx out[], int n, int step)
{
	if (step < n) {
		_fft(out, buf, n, step * 2);
		_fft(out + step, buf + step, n, step * 2);

		for (int i = 0; i < n; i += 2 * step) {
			cplx t = cexp(-I * PI * i / n) * out[i + step];
			buf[i / 2]     = out[i] + t;
			buf[(i + n)/2] = out[i] - t;
		}
	}
}

void fft(cplx buf[], int n)
{
	cplx out[n];
	for (int i = 0; i < n; i++) out[i] = buf[i];

	_fft(buf, out, n, 1);
}

void show(const char * s, cplx buf[]) {
	printf("%s", s);
	for (int i = 0; i < 8; i++)
		if (!cimag(buf[i]))
			printf("%g ", creal(buf[i]));
		else
			printf("(%g, %g) ", creal(buf[i]), cimag(buf[i]));
}

int main()
{
	PI = atan2(1, 1) * 4;
	cplx buf[] = {1, 1, 1, 1, 0, 0, 0, 0};

	show("Data: ", buf);
	fft(buf, 8);
	show("\nFFT : ", buf);

	return 0;
}


with javascript_semantics
function farey(integer n)
    integer a=0, b=1, c=1, d=n, items=1
    if n<=11 then
        printf(1,"%d: %d/%d",{n,a,b})
    end if
    while c<=n do
        integer k = floor((n+b)/d)
        {a,b,c,d} = {c,d,k*c-a,k*d-b}
        items += 1
        if n<=11 then
            printf(1," %d/%d",{a,b})
        end if
    end while
    return items
end function

printf(1,"Farey sequence for order 1 through 11:\n")
for i=1 to 11 do
    {} = farey(i)
    printf(1,"\n")
end for
sequence nf = apply(tagset(1000,100,100),farey)
printf(1,"Farey sequence fractions, 100 to 1000 by hundreds:\n%v\n",{nf})


go ?=>
  member(N,1..11),
  Farey = farey(N),
  println(N=Farey),
  fail,
  nl.
go => true.

farey(N) = M =>
  M1 = [0=$(0/1)] ++
       [I2/J2=$(I2/J2) : I in 1..N, J in I..N,
        GCD=gcd(I,J),I2 =I//GCD,J2=J//GCD].sort_remove_dups(),
  M = [ E: _=E in M1]. % extract the rational representation


using System;
using System.Numerics;
using System.Linq;
using System.Diagnostics;

// Fast Fourier Transform in C#
public class Program {

    /* Performs a Bit Reversal Algorithm on a postive integer
     * for given number of bits
     * e.g. 011 with 3 bits is reversed to 110 */
    public static int BitReverse(int n, int bits) {
       int reversedN = n;
       int count = bits - 1;

       n >>= 1;
       while (n > 0) {
            reversedN = (reversedN << 1) | (n & 1);
            count--;
            n >>= 1;
        }

        return ((reversedN << count) & ((1 << bits) - 1));
    }

    /* Uses Cooley-Tukey iterative in-place algorithm with radix-2 DIT case
     * assumes no of points provided are a power of 2 */
    public static void FFT(Complex[] buffer) {
#if false
        int bits = (int)Math.Log(buffer.Length, 2);
        for (int j = 1; j < buffer.Length / 2; j++) {

            int swapPos = BitReverse(j, bits);
            var temp = buffer[j];
            buffer[j] = buffer[swapPos];
            buffer[swapPos] = temp;
        }
// Said Zandian
// The above section of the code is incorrect and does not work correctly and has two bugs.
// BUG 1
// The bug is that when you reach and index that was swapped previously it does swap it again
// Ex. binary value n = 0010 and Bits = 4 as input to BitReverse routine and  returns 4. The code section above //     swaps it. Cells 2 and 4 are swapped. just fine.
//     now binary value n = 0010 and Bits = 4 as input to BitReverse routine and returns 2. The code Section
//     swap it. Cells 4 and 2 are swapped.     WROOOOONG
//
// Bug 2
// The code works on the half section of the cells. In the case of Bits = 4 it means that we are having 16 cells
// The code works on half the cells        for (int j = 1; j < buffer.Length / 2; j++) buffer.Length returns 16
// and divide by 2 makes 8, so j goes from 1 to 7. This covers almost everything but what happened to 1011 value
// which must be swap with 1101. and this is the second bug.
//
// use the following corrected section of the code. I have seen this bug in other languages that uses bit
// reversal routine.

#else
            for (int j = 1; j < buffer.Length; j++)
            {
                int swapPos = BitReverse(j, bits);
                if (swapPos <= j)
                {
                    continue;
                }
                var temp = buffer[j];
                buffer[j] = buffer[swapPos];
                buffer[swapPos] = temp;
            }

// First the full length is used and 1011 value is swapped with 1101. Second if new swapPos is less than j
// then it means that swap was happen when j was the swapPos.

#endif

        for (int N = 2; N <= buffer.Length; N <<= 1) {
            for (int i = 0; i < buffer.Length; i += N) {
                for (int k = 0; k < N / 2; k++) {

                    int evenIndex = i + k;
                    int oddIndex = i + k + (N / 2);
                    var even = buffer[evenIndex];
                    var odd = buffer[oddIndex];

                    double term = -2 * Math.PI * k / (double)N;
                    Complex exp = new Complex(Math.Cos(term), Math.Sin(term)) * odd;

                    buffer[evenIndex] = even + exp;
                    buffer[oddIndex] = even - exp;

                }
            }
        }
    }

    public static void Main(string[] args) {
        Complex[] input = {1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0};

        FFT(input);

        Console.WriteLine("Results:");
        foreach (Complex c in input) {
            Console.WriteLine(c);
        }
    }
}


task(1) :-
	between(1, 11, I),
	farey(I, F),
	write(I), write(': '),
	rwrite(F), nl, fail; true.

task(2) :- between(1, 10, I),
	I100 is I*100,
	farey( I100, F),
	length(F,N),
	write('|F('), write(I100), write(')| = '), writeln(N), fail; true.

% farey(+Order, Sequence)
farey(Order, Sequence) :-
  bagof( R,
	 I^J^(between(1, Order, J), between(0, J, I), R is I rdiv J),
	 S),
  predsort( rcompare, S, Sequence ).

rprint( rdiv(A,B) ) :- write(A), write(/), write(B), !.
rprint( I ) :- integer(I), write(I), write(/), write(1), !.

rwrite([]).
rwrite([R]) :- rprint(R).
rwrite([R, T|Rs]) :- rprint(R), write(', '), rwrite([T|Rs]).

rcompare(<, A, B) :- A < B, !.
rcompare(>, A, B) :- A > B, !.
rcompare(=, A, B) :- A =< B.


#include <complex>
#include <iostream>
#include <valarray>

const double PI = 3.141592653589793238460;

typedef std::complex<double> Complex;
typedef std::valarray<Complex> CArray;

// Cooley–Tukey FFT (in-place, divide-and-conquer)
// Higher memory requirements and redundancy although more intuitive
void fft(CArray& x)
{
    const size_t N = x.size();
    if (N <= 1) return;

    // divide
    CArray even = x[std::slice(0, N/2, 2)];
    CArray  odd = x[std::slice(1, N/2, 2)];

    // conquer
    fft(even);
    fft(odd);

    // combine
    for (size_t k = 0; k < N/2; ++k)
    {
        Complex t = std::polar(1.0, -2 * PI * k / N) * odd[k];
        x[k    ] = even[k] + t;
        x[k+N/2] = even[k] - t;
    }
}

// Cooley-Tukey FFT (in-place, breadth-first, decimation-in-frequency)
// Better optimized but less intuitive
// !!! Warning : in some cases this code make result different from not optimased version above (need to fix bug)
// The bug is now fixed @2017/05/30
void fft(CArray &x)
{
	// DFT
	unsigned int N = x.size(), k = N, n;
	double thetaT = 3.14159265358979323846264338328L / N;
	Complex phiT = Complex(cos(thetaT), -sin(thetaT)), T;
	while (k > 1)
	{
		n = k;
		k >>= 1;
		phiT = phiT * phiT;
		T = 1.0L;
		for (unsigned int l = 0; l < k; l++)
		{
			for (unsigned int a = l; a < N; a += n)
			{
				unsigned int b = a + k;
				Complex t = x[a] - x[b];
				x[a] += x[b];
				x[b] = t * T;
			}
			T *= phiT;
		}
	}
	// Decimate
	unsigned int m = (unsigned int)log2(N);
	for (unsigned int a = 0; a < N; a++)
	{
		unsigned int b = a;
		// Reverse bits
		b = (((b & 0xaaaaaaaa) >> 1) | ((b & 0x55555555) << 1));
		b = (((b & 0xcccccccc) >> 2) | ((b & 0x33333333) << 2));
		b = (((b & 0xf0f0f0f0) >> 4) | ((b & 0x0f0f0f0f) << 4));
		b = (((b & 0xff00ff00) >> 8) | ((b & 0x00ff00ff) << 8));
		b = ((b >> 16) | (b << 16)) >> (32 - m);
		if (b > a)
		{
			Complex t = x[a];
			x[a] = x[b];
			x[b] = t;
		}
	}
	//// Normalize (This section make it not working correctly)
	//Complex f = 1.0 / sqrt(N);
	//for (unsigned int i = 0; i < N; i++)
	//	x[i] *= f;
}

// inverse fft (in-place)
void ifft(CArray& x)
{
    // conjugate the complex numbers
    x = x.apply(std::conj);

    // forward fft
    fft( x );

    // conjugate the complex numbers again
    x = x.apply(std::conj);

    // scale the numbers
    x /= x.size();
}

int main()
{
    const Complex test[] = { 1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0 };
    CArray data(test, 8);

    // forward fft
    fft(data);

    std::cout << "fft" << std::endl;
    for (int i = 0; i < 8; ++i)
    {
        std::cout << data[i] << std::endl;
    }

    // inverse fft
    ifft(data);

    std::cout << std::endl << "ifft" << std::endl;
    for (int i = 0; i < 8; ++i)
    {
        std::cout << data[i] << std::endl;
    }
    return 0;
}


EnableExplicit

Structure farey_struc
  complex.POINT
  quotient.d
EndStructure

#MAXORDER=1000
Global NewList fareylist.farey_struc()

Define v_start.i,
       v_end.i,
       v_step.i,
       order.i,
       fractions.i,
       check.b,
       t$

Procedure farey(order)
  NewList sequence.farey_struc()
  Define quotient.d,
         divisor.i,
         dividend.i

  For divisor=1 To order
    For dividend=0 To divisor
      quotient.d=dividend/divisor
      AddElement(sequence())
      sequence()\complex\x=dividend
      sequence()\complex\y=divisor
      sequence()\quotient=quotient
    Next
  Next

  SortStructuredList(sequence(),#PB_Sort_Ascending,
                     OffsetOf(farey_struc\quotient),
                     TypeOf(farey_struc\quotient))

  FirstElement(sequence())
  quotient=sequence()\quotient
  AddElement(fareylist())
  fareylist()\complex\x=sequence()\complex\x
  fareylist()\complex\y=sequence()\complex\y
  fareylist()\quotient=sequence()\quotient

  ForEach sequence()
    If quotient=sequence()\quotient : Continue : EndIf
    quotient=sequence()\quotient
    AddElement(fareylist())
    fareylist()\complex\x=sequence()\complex\x
    fareylist()\complex\y=sequence()\complex\y
    fareylist()\quotient=sequence()\quotient
  Next
  FreeList(sequence())
EndProcedure

OpenConsole("Farey sequence [Input exit = program end]")
Repeat
  Print("Input-> start end step [start>=1; end<=1000; step>=1; (start<end)] : ")
  t$=Input() : If Trim(LCase(t$))="exit" : End : EndIf
  v_start=Val(StringField(t$,1," "))
  v_end=Val(StringField(t$,2," "))
  v_step=Val(StringField(t$,3," "))
  check=Bool(v_start>=1 And v_end<=#MAXORDER And v_step>=1 And v_start<v_end)
Until check=#True
PrintN(~"\n"+LSet("-",80,"-"))

order=v_start
While order<=v_end
  FreeList(fareylist()) : NewList fareylist()
  farey(order)
  fractions=ListSize(fareylist())
  PrintN("Farey sequence for order "+Str(order)+" has "+Str(fractions)+" fractions.")
  If fractions<100
    ForEach fareylist()
      If ListIndex(fareylist()) % 7 = 0 : PrintN("") : EndIf
      Print(~"\t"+
             RSet(Str(fareylist()\complex\x),2," ")+"/"+
             RSet(Str(fareylist()\complex\y),2," "))
    Next
  EndIf
  PrintN(~"\n"+LSet("=",80,"="))
  order+v_step
Wend
Input()


(defun fft (a &key (inverse nil) &aux (n (length a)))
  "Perform the FFT recursively on input vector A.
   Vector A must have length N of power of 2."
  (declare (type boolean inverse)
           (type (integer 1) n))
  (if (= n 1)
      a
      (let* ((n/2 (/ n 2))
             (2iπ/n (complex 0 (/ (* 2 pi) n (if inverse -1 1))))
             (⍵_n (exp 2iπ/n))
             (⍵ #c(1.0d0 0.0d0))
             (a0 (make-array n/2))
             (a1 (make-array n/2)))
        (declare (type (integer 1) n/2)
                 (type (complex double-float) ⍵ ⍵_n))
        (symbol-macrolet ((a0[j]  (svref a0 j))
                          (a1[j]  (svref a1 j))
                          (a[i]   (svref a i))
                          (a[i+1] (svref a (1+ i))))
          (loop :for i :below (1- n) :by 2
                :for j :from 0
                :do (setf a0[j] a[i]
                          a1[j] a[i+1])))
        (let ((â0 (fft a0 :inverse inverse))
              (â1 (fft a1 :inverse inverse))
              (â (make-array n)))
          (symbol-macrolet ((â[k]     (svref â k))
                            (â[k+n/2] (svref â (+ k n/2)))
                            (â0[k]    (svref â0 k))
                            (â1[k]    (svref â1 k)))
            (loop :for k :below n/2
                  :do (setf â[k]     (+ â0[k] (* ⍵ â1[k]))
                            â[k+n/2] (- â0[k] (* ⍵ â1[k])))
                  :when inverse
                    :do (setf â[k]     (/ â[k] 2)
                              â[k+n/2] (/ â[k+n/2] 2))
                  :do (setq ⍵ (* ⍵ ⍵_n))
                  :finally (return â)))))))


from fractions import Fraction

class Fr(Fraction):
    def __repr__(self):
        return '(%s/%s)' % (self.numerator, self.denominator)

def farey(n, length=False):
    if not length:
        return [Fr(0, 1)] + sorted({Fr(m, k) for k in range(1, n+1) for m in range(1, k+1)})
    else:
        #return 1         +    len({Fr(m, k) for k in range(1, n+1) for m in range(1, k+1)})
        return  (n*(n+3))//2 - sum(farey(n//k, True) for k in range(2, n+1))

if __name__ == '__main__':
    print('Farey sequence for order 1 through 11 (inclusive):')
    for n in range(1, 12):
        print(farey(n))
    print('Number of fractions in the Farey sequence for order 100 through 1,000 (inclusive) by hundreds:')
    print([farey(i, length=True) for i in range(100, 1001, 100)])


  [ $ "bigrat.qky" loadfile ] now!

  [  rot + dip + reduce ] is mediant ( n/d n/d --> n/d )

  [ 1+ temp put [] swap
    dup size 1 - times
    [ dup i^ peek
      rot over nested join
      unrot over i^ 1+ peek
      join do mediant
      dup temp share < iff
      [ join nested
        rot swap join
        swap ]
      else 2drop ]
    drop
    ' [ [ 1 1 ] ] join
    temp release ]          is nextfarey ( fy n --> fy )

  [ witheach
      [ unpack vulgar$
        echo$ sp ] ]        is echofarey ( fy --> )

  [ 0 swap dup times
      [ i over gcd
        1 = rot + swap ]
      drop ]                is totient ( n --> n )

  [ 0 swap times
      [ i 1+ totient + ] ]  is totientsum ( n --> n )

  [ totientsum 1+ ]         is fareylength ( n --> n )

  say "First eleven Farey series:" cr
  ' [ [ 0 1 ] [ 1 1 ] ]
  10 times
    [ dup echofarey cr
      i^ 2 + nextfarey ]
    echofarey cr
  cr
  say "Length of Farey series 100, 200 ... 1000: "
  [] 10 times
     [ i^ 1+ 100 *
       fareylength join ]
  echo


require "complex"

def fft(x : Array(Int32 | Float64)) #: Array(Complex)
  return [x[0].to_c] if x.size <= 1
  even = fft(Array.new(x.size // 2) { |k| x[2 * k] })
  odd  = fft(Array.new(x.size // 2) { |k| x[2 * k + 1] })
  c = Array.new(x.size // 2) { |k| Math.exp((-2 * Math::PI * k / x.size).i) }
  codd = Array.new(x.size // 2) { |k| c[k] * odd[k] }
  return Array.new(x.size // 2) { |k| even[k] + codd[k] } + Array.new(x.size // 2) { |k| even[k] - codd[k] }
end

fft([1,1,1,1,0,0,0,0]).each{ |c| puts c }


farey <- function(n, length_only = FALSE) {
  a <- 0
  b <- 1
  c <- 1
  d <- n
  if (!length_only)
    cat(a, "/", b, sep = "")
  count <- 1
  while (c <= n) {
    count <- count + 1
    k <- ((n + b) %/% d)
    next_c <- k * c - a
    next_d <- k * d - b
    a <- c
    b <- d
    c <- next_c
    d <- next_d
    if (!length_only)
      cat(" ", a, "/", b, sep = "")
  }
  if (length_only)
    cat(count, "items")
  cat("\n")
}

for (i in 1:11) {
  cat(i, ": ", sep = "")
  farey(i)
}

for (i in 100 * 1:10) {
  cat(i, ": ", sep = "")
  farey(i, length_only = TRUE)
}


#lang racket
(require math/number-theory)
(define (display-farey-sequence order show-fractions?)
  (define f-s (farey-sequence order))
  (printf "-- Farey Sequence for order ~a has ~a fractions~%" order (length f-s))
  ;; racket will simplify 0/1 and 1/1 to 0 and 1 respectively, so deconstruct into numerator and
  ;; denomimator (and take the opportunity to insert commas
  (when show-fractions?
    (displayln
     (string-join
      (for/list ((f f-s))
        (format "~a/~a" (numerator f) (denominator f)))
      ", "))))

; compute and show the Farey sequence for order:
;  1   through   11   (inclusive).
(for ((order (in-range 1 (add1 11)))) (display-farey-sequence order #t))
; compute and display the number of fractions in the Farey sequence for order:
;  100   through   1,000   (inclusive)   by hundreds.
(for ((order (in-range 100 (add1 1000) 100))) (display-farey-sequence order #f))


void main() {
    import std.stdio, std.numeric;

    [1.0, 1, 1, 1, 0, 0, 0, 0].fft.writeln;
}


program Fast_Fourier_transform;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.VarCmplx,
  System.Math;

function BitReverse(n: UInt64; bits: Integer): UInt64;
var
  count, reversedN: UInt64;
begin
  reversedN := n;
  count := bits - 1;

  n := n shr 1;

  while n > 0 do
  begin
    reversedN := (reversedN shl 1) or (n and 1);
    dec(count);
    n := n shr 1;
  end;

  Result := ((reversedN shl count) and ((1 shl bits) - 1));
end;

procedure FFT(var buffer: TArray<Variant>);
var
  j, bits: Integer;
  tmp: Variant;
begin
  bits := Trunc(Log2(length(buffer)));

  for j := 1 to High(buffer) do
  begin
    var swapPos := BitReverse(j, bits);
    if swapPos <= j then
      Continue;

    tmp := buffer[j];
    buffer[j] := buffer[swapPos];
    buffer[swapPos] := tmp;
  end;

  var N := 2;
  while N <= Length(buffer) do
  begin
    var i := 0;
    while i < Length(buffer) do
    begin
      for var k := 0 to N div 2 - 1 do
      begin
        var evenIndex := i + k;
        var oddIndex := i + k + (N div 2);
        var _even := buffer[evenIndex];
        var _odd := buffer[oddIndex];
        var term := -2 * PI * k / N;
        var _exp := VarComplexCreate(Cos(term), Sin(term)) * _odd;

        buffer[evenIndex] := _even + _exp;
        buffer[oddIndex] := _even - _exp;
      end;
      i := i + N;
    end;
    N := N shl 1;
  end;

end;

const
  input: array of Double = [1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0];

var
  inputc: TArray<Variant>;

begin
  SetLength(inputc, length(input));
  for var i := 0 to High(input) do
    inputc[i] := VarComplexCreate(input[i]);

  FFT(inputc);

  for var c in inputc do
    writeln(c);
  readln;
end.


sub farey ($order) {
    my @l = 0/1, 1/1;
    (2..$order).map: { push @l, |(1..$^d).map: { $_/$d } }
    unique @l
}

say "Farey sequence order ";
.say for (1..11).hyper(:1batch).map: { "$_: ", .&farey.sort.map: *.nude.join('/') };
.say for (100, 200 ... 1000).race(:1batch).map: { "Farey sequence order $_ has " ~ [.&farey].elems ~ ' elements.' }


/*REXX program  computes and displays  a  Farey sequence  (or the number of fractions). */
parse arg LO HI INC .                            /*obtain optional arguments from the CL*/
if  LO=='' |  LO==","  then  LO=  1              /*Not specified?  Then use the default.*/
if  HI=='' |  HI==","  then  HI= LO              /* "      "         "   "   "     "    */
if INC=='' | INC==","  then INC=  1              /* "      "         "   "   "     "    */
sw= linesize() - 1                               /*obtain the linesize of the terminal. */
oLO= LO                                          /*save original value of the the orders*/
       do j=abs(LO)  to abs(HI)  by INC          /*process each of the specified numbers*/
       #= fareyF(j)                              /*go ye forth & compute Farey sequence.*/
       say center('Farey sequence for order '   j   " has "   #   ' fractions.', sw, "═")
       if oLO>=0  then call show                 /*display the Farey fractions.         */
       end   /*j*/
exit #                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fareyF: procedure expose n. d.;  parse arg x
        n.1= 0;   d.1= 1;   n.2= 1;   d.2= x     /*some kit parts for the fraction list.*/
                    do k=1  until n.z>x          /*construct from thirds  and  on  "up".*/
                    y= k+1;       z= k+2         /*calculate the next K and the next Z. */
                         _= d.k + x              /*calculation used as a shortcut.      */
                    n.z= _ % d.y*n.y   -   n.k   /*    "     the fraction   numerator.  */
                    d.z= _ % d.y*d.y   -   d.k   /*    "      "     "     denominator.  */
                    if n.z>x  then leave         /*Should the construction be stopped ? */
                    end   /*k*/
        return z - 1                             /*return the count of Farey fractions. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:   $= '0/1'                                 /*construct the start of the Farey seq.*/
          do k=2  for #-1;   _= n.k'/'d.k        /*build a fraction:   numer. / denom.  */
          if length($ _)>sw  then do; say $; $= _; end   /*Is new line too wide? Show it*/
                             else $= $ _                 /*No?  Keep it & keep building.*/
          end   /*k*/
      if $\==''  then say $;      return         /*display any residual fractions.      */


# Project : Farey sequence

for i = 1 to 11
     count = 0
     see "F" + string(i) + " = "
     farey(i, false)
next
see nl
for x = 100 to 1000 step 100
      count = 0
      see "F" + string(x) + " = "
      see farey(x, false)
      see nl
next

func farey(n, descending)
        a = 0
        b = 1
        c = 1
        d = n
        if descending = true
           a = 1
           c = n -1
        ok
        count = count + 1
        if n < 12
           see string(a) + "/" + string(b) + " "
        ok
        while ((c <= n) and not descending) or ((a > 0) and descending)
                  aa = a
                  bb = b
                  cc = c
                  dd = d
                  k = floor((n + b) / d)
                  a = cc
                  b = dd
                  c = k * cc - aa
                  d = k * dd - bb
                  count = count + 1
                  if n < 12
                     see string(a) + "/" + string(b) + " "
                  ok
        end
        if n < 12
           see nl
        ok
        return count


def farey(n, length=false)
  if length
    (n*(n+3))/2 - (2..n).sum{|k| farey(n/k, true)}
  else
    (1..n).each_with_object([]){|k,a|(0..k).each{|m|a << Rational(m,k)}}.uniq.sort
  end
end

puts 'Farey sequence for order 1 through 11 (inclusive):'
for n in 1..11
  puts "F(#{n}): " + farey(n).join(", ")
end
puts 'Number of fractions in the Farey sequence:'
for i in (100..1000).step(100)
  puts "F(%4d) =%7d" % [i, farey(i, true)]
end


PROGRAM FFT

CONST CNT=8

!$DYNAMIC
DIM REL[0],IMG[0],CMP[0],V[0]

BEGIN
   SIG=INT(LOG(CNT)/LOG(2)+0.9999)
   REAL1=2^SIG

   REAL=REAL1-1
   REAL2=INT(REAL1/2)
   REAL4=INT(REAL1/4)
   REAL3=REAL4+REAL2

!$DIM REL[REAL1],IMG[REAL1],CMP[REAL3]

FOR I=0 TO CNT-1 DO
   READ(REL[I],IMG[I])
END FOR

DATA(1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0)

SIG2=INT(SIG/2)
SIG1=SIG-SIG2
CNT1=2^SIG1
CNT2=2^SIG2

!$DIM V[CNT1-1]
V[0]=0
DV=1
PTR=CNT1

FOR J=1 TO SIG1 DO
  HLFPTR=INT(PTR/2)
  PT=CNT1-HLFPTR
  FOR I=HLFPTR TO PT STEP PTR DO
    V[I]=V[I-HLFPTR]+DV
  END FOR
  DV=2*DV
  PTR=HLFPTR
END FOR

K=2*π/REAL1

FOR X=0 TO REAL4 DO
   CMP[X]=COS(K*X)
   CMP[REAL2-X]=-CMP[X]
   CMP[REAL2+X]=-CMP[X]
END FOR

PRINT("FFT: BIT REVERSAL")

FOR I=0 TO CNT1-1 DO
  IP=I*CNT2
  FOR J=0 TO CNT2-1 DO
    H=IP+J
    G=V[J]*CNT2+V[I]
    IF G>H THEN
       SWAP(REL[G],REL[H])
       SWAP(IMG[G],IMG[H])
    END IF
  END FOR
END FOR

T=1
FOR STAGE=1 TO SIG DO
  PRINT("STAGE:";STAGE)
  D=INT(REAL2/T)
  FOR II=0 TO T-1 DO
     L=D*II
     LS=L+REAL4
     FOR I=0 TO D-1 DO
       A=2*I*T+II
       B=A+T
       F1=REL[A]
       F2=IMG[A]
       CNT1=CMP[L]*REL[B]
       CNT2=CMP[LS]*IMG[B]
       CNT3=CMP[LS]*REL[B]
       CNT4=CMP[L]*IMG[B]
       REL[A]=F1+CNT1-CNT2
       IMG[A]=F2+CNT3+CNT4
       REL[B]=F1-CNT1+CNT2
       IMG[B]=F2-CNT3-CNT4
     END FOR
  END FOR
  T=2*T
END FOR

PRINT("NUM REAL     IMAG")
FOR I=0 TO REAL DO
    IF ABS(REL[I])<1E-5 THEN REL[I]=0 END IF
    IF ABS(IMG[I])<1E-5 THEN IMG[I]=0 END IF
    PRINT(I;"";)
    WRITE("##.###### ##.######";REL[I];IMG[I])
END FOR
END PROGRAM


#[derive(Copy, Clone)]
struct Fraction {
    numerator: u32,
    denominator: u32,
}

use std::fmt;

impl fmt::Display for Fraction {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        write!(f, "{}/{}", self.numerator, self.denominator)
    }
}

impl Fraction {
    fn new(n: u32, d: u32) -> Fraction {
        Fraction {
            numerator: n,
            denominator: d,
        }
    }
}

fn farey_sequence(n: u32) -> impl std::iter::Iterator<Item = Fraction> {
    let mut a = 0;
    let mut b = 1;
    let mut c = 1;
    let mut d = n;
    std::iter::from_fn(move || {
        if a > n {
            return None;
        }
        let result = Fraction::new(a, b);
        let k = (n + b) / d;
        let next_c = k * c - a;
        let next_d = k * d - b;
        a = c;
        b = d;
        c = next_c;
        d = next_d;
        Some(result)
    })
}

fn main() {
    for n in 1..=11 {
        print!("{}:", n);
        for f in farey_sequence(n) {
            print!(" {}", f);
        }
        println!();
    }
    for n in (100..=1000).step_by(100) {
        println!("{}: {}", n, farey_sequence(n).count());
    }
}


object FareySequence {

  def fareySequence(n: Int, start: (Int, Int), stop: (Int, Int)): LazyList[(Int, Int)] = {
    val (nominator_l, denominator_l) = start
    val (nominator_r, denominator_r) = stop

    val mediant = ((nominator_l + nominator_r), (denominator_l + denominator_r))

    if (mediant._2 <= n) fareySequence(n, start, mediant) ++ mediant #:: fareySequence(n, mediant, stop)
    else LazyList.empty
  }

  def farey(n: Int, start: (Int, Int) = (0, 1), stop: (Int, Int) = (1, 1)): LazyList[(Int, Int)] = {
    start #:: fareySequence(n, start, stop) ++ stop #:: LazyList.empty[(Int, Int)]
  }

  def main(args: Array[String]): Unit = {
    for (i <- 1 to 11) {
      println(s"$i: " + farey(i).map(e => s"${e._1}/${e._2}").mkString(", "))
    }
    println
    for (i <- 100 to 1000 by 100) {
      println(s"$i: " + farey(i).length + " elements")
    }
  }

}


module fft_mod
  implicit none
  integer,       parameter :: dp=selected_real_kind(15,300)
  real(kind=dp), parameter :: pi=3.141592653589793238460_dp
contains

  ! In place Cooley-Tukey FFT
  recursive subroutine fft(x)
    complex(kind=dp), dimension(:), intent(inout)  :: x
    complex(kind=dp)                               :: t
    integer                                        :: N
    integer                                        :: i
    complex(kind=dp), dimension(:), allocatable    :: even, odd

    N=size(x)

    if(N .le. 1) return

    allocate(odd((N+1)/2))
    allocate(even(N/2))

    ! divide
    odd =x(1:N:2)
    even=x(2:N:2)

    ! conquer
    call fft(odd)
    call fft(even)

    ! combine
    do i=1,N/2
       t=exp(cmplx(0.0_dp,-2.0_dp*pi*real(i-1,dp)/real(N,dp),kind=dp))*even(i)
       x(i)     = odd(i) + t
       x(i+N/2) = odd(i) - t
    end do

    deallocate(odd)
    deallocate(even)

  end subroutine fft

end module fft_mod

program test
  use fft_mod
  implicit none
  complex(kind=dp), dimension(8) :: data = (/1.0, 1.0, 1.0, 1.0, 0.0,

0.0, 0.0, 0.0/)
  integer :: i

  call fft(data)

  do i=1,8
     write(*,'("(", F20.15, ",", F20.15, "i )")') data(i)
  end do

end program test


(import (scheme base)
        (scheme write))

;; create a generator for Farey sequence n
;; using next term formula from https://en.wikipedia.org/wiki/Farey_sequence
(define (farey-generator n)
  (let ((a #f) (b 1) (c #f) (d n))
    (lambda ()
      (cond ((not a)    ; first item in sequence
             (set! a 0)
             (/ a b))
            ((not c)    ; second item in sequence
             (set! c 1)
             (/ c d))
            ((= c d)    ; return #f when finished sequence
             #f)
            (else       ; compute next term
              (let* ((f (floor (/ (+ n b) d)))
                     (p (- (* f c) a))
                     (q (- (* f d) b)))
                (set! a c)
                (set! b d)
                (set! c p)
                (set! d q)
                (/ p q)))))))

(define (farey-sequence n display?)
  (define (display-rat n) ; ensure 0,1 show /1
    (display n)
    (when (= 1 (denominator n))
      (display "/1"))
    (display " "))
  ;
  (let ((gen (farey-generator n)))
    (do ((res (gen) (gen))
         (count 0 (+ 1 count)))
      ((not res) (when display? (newline))
                 count)
      (when display? (display-rat res)))))

;;

(display "Farey sequence for order 1 through 11 (inclusive):\n")
(do ((i 1 (+ i 1)))
  ((> i 11) )
  (display (string-append "F(" (number->string i) "): "))
  (farey-sequence i #t))

(display "\nNumber of fractions in the Farey sequence:\n")
(do ((i 100 (+ i 100)))
  ((> i 1000) )
  (display
    (string-append "F(" (number->string i) ") = "
                   (number->string (farey-sequence i #f))))
  (newline))


'Graphic fast Fourier transform demo,
'press any key for the next image.
'131072 samples: the FFT is fast indeed.

'screen resolution
const dW = 800, dH = 600
'--------------------------------------
type samples
declare constructor (byval p as integer)

   'sw = 0 forward transform
   'sw = 1 reverse transform
   declare sub FFT (byval sw as integer)

   'draw mythical birds
   declare sub oiseau ()

   'plot frequency and amplitude
   declare sub famp ()

   'plot transformed samples
   declare sub bird ()

as double x(any), y(any)
as integer fl, m, n, n2
end type

constructor samples (byval p as integer)
   m = p
  'number of points
   n = 1 shl p
   n2 = n shr 1
  'real and complex values
redim x(n - 1), y(n - 1)
end constructor

'--------------------------------------
'in-place complex-to-complex FFT adapted from
'[ http://paulbourke.net/miscellaneous/dft/ ]

sub samples.FFT (byval sw as integer)
dim as double c1, c2, t1, t2, u1, u2, v
dim as integer i, j = 0, k, L, l1, l2

   'bit reversal sorting
   for i = 0 to n - 2
      if i < j then
         swap x(i), x(j)
         swap y(i), y(j)
      end if

      k = n2
      while k <= j
         j -= k: k shr= 1
      wend
      j += k
   next i

   'initial cosine & sine
   c1 = -1.0
   c2 = 0.0
   'loop for each stage
   l2 = 1
   for L = 1 to m
      l1 = l2: l2 shl= 1

      'initial vertex
      u1 = 1.0
      u2 = 0.0
      'loop for each sub DFT
      for k = 1 to l1
         'butterfly dance
         for i = k - 1 to n - 1 step l2
            j = i + l1
            t1 = u1 * x(j) - u2 * y(j)
            t2 = u1 * y(j) + u2 * x(j)
            x(j) = x(i) - t1
            y(j) = y(i) - t2
            x(i) += t1
            y(i) += t2
         next i

         'next polygon vertex
         v =  u1 * c1 - u2 * c2
         u2 = u1 * c2 + u2 * c1
         u1 = v
      next k

      'half-angle sine
      c2 = sqr((1.0 - c1) * .5)
      if sw = 0 then c2 = -c2
      'half-angle cosine
      c1 = sqr((1.0 + c1) * .5)
   next L

   'scaling for reverse transform
   if sw then
      for i = 0 to n - 1
         x(i) /= n
         y(i) /= n
      next i
   end if
end sub

'--------------------------------------
'Gumowski-Mira attractors "Oiseaux mythiques"
'[ http://www.atomosyd.net/spip.php?article98 ]

sub samples.oiseau
dim as double a, b, c, t, u, v, w
dim as integer dx, y0, dy, i, k

'bounded non-linearity
if fl then
   a = -0.801
   dx = 20: y0 =-1: dy = 12
else
   a = -0.492
   dx = 17: y0 =-3: dy = 14
end if
   window (-dx, y0-dy)-(dx, y0+dy)

   'dissipative coefficient
   b = 0.967
   c = 2 - 2 * a

   u = 1: v = 0.517: w = 1

   for i = 0 to n - 1
      t = u
      u = b * v + w
      w = a * u + c * u * u / (1 + u * u)
      v = w - t

      'remove bias
      t = u - 1.830
      x(i) = t
      y(i) = v
      k = 5 + point(t, v)
      pset (t, v), 1 + k mod 14
   next i
   sleep
end sub

'--------------------------------------
sub samples.famp
dim as double a, s, f = n / dW
dim as integer i, k
   window

   k = iif(fl, dW / 5, dW / 3)
   for i = k to dW step k
      line (i, 0)-(i, dH), 1
   next i

   a = 0
   k = 0: s = f - 1
   for i = 0 to n - 1
      a += x(i) * x(i) + y(i) * y(i)

      if i > s then
         a = log(1 + a / f) * 0.045
         if k then
            line -(k, (1 - a) * dH), 15
         else
            pset(0, (1 - a) * dH), 15
         end if

         a = 0
         k += 1: s += f
      end if
   next i
   sleep
end sub

sub samples.bird
dim as integer dx, y0, dy, i, k

if fl then
   dx = 20: y0 =-1: dy = 12
else
   dx = 17: y0 =-3: dy = 14
end if
   window (-dx, y0-dy)-(dx, y0+dy)

   for i = 0 to n - 1
      k = 2 + point(x(i), y(i))
      pset (x(i), y(i)), 1 + k mod 14
   next i
   sleep
end sub

'main
'--------------------------------------
dim as integer i, p = 17
'n = 2 ^ p
dim as samples z = p

screenres dW, dH, 4, 1

for i = 0 to 1
   z.fl = i
   z.oiseau

   'forward
   z.FFT(0)

   'amplitude plot with peaks at the
   '± winding numbers of the orbits.
   z.famp

   'reverse
   z.FFT(1)

   z.bird
   cls
next i
end


func farey_count(n) {   # A005728
    1 + sum(1..n, {|k| euler_phi(k) })
}

func farey(n) {

    var seq = [0]
    var (a,b,c,d) = (0,1,1,n)

    while (c <= n) {
        var k = (n+b)//d
        (a,b,c,d) = (c, d, k*c - a, k*d - b)
        seq << a/b
    }

    return seq
}

say "Farey sequence for order 1 through 11 (inclusive):"
for n in (1..11) {
    say("F(%2d): %s" % (n, farey(n).map{.as_frac}.join(" ")))
}

say "\nNumber of fractions in the Farey sequence:"
for n in (100..1000 -> by(100)) {
    say ("F(%4d) =%7d" % (n, farey_count(n)))
}


mata
function totient(n_) {
	n = n_
	if (n<4) {
		if (n<1) return(.)
		else if (n>1) return(n-1)
		else return(1)
	}
	else {
		r = 1
		if (mod(n,2)==0) {
			n = floor(n/2)
			while (mod(n,2)==0) {
				n = floor(n/2)
				r = r*2
			}
		}
		for (k=3; k*k<=n; k=k+2) {
			if (mod(n,k)==0) {
				r = r*(k-1)
				n = floor(n/k)
				while (mod(n,k)==0) {
					n = floor(n/k)
					r = r*k
				}
			}
		}
		if (n>1) r = r*(n-1)
		return(r)
	}
}

function map(f,a) {
	n = rows(a)
	p = cols(a)
	b = J(n,p,.)
	for (i=1; i<=n; i++) {
		for (j=1; j<=p; j++) {
			b[i,j] = (*f)(a[i,j])
		}
	}
	return(b)
}

function farey_length(n) {
	return(1+sum(map(&totient(),1::n)))
}

function farey(n) {
	m = 1+sum(map(&totient(),1::n))
	r = J(m,2,.)
	r[1,.] = 0,1
	a = 0
	b = 1
	c = 1
	d = n
	i = 1
	while (c<=n) {
		k = floor((n+b)/d)
		a = k*c-a
		b = k*d-b
		swap(a,c)
		swap(b,d)
		r[++i,.] = a,b
	}
	return(r)
}

for (n=1; n<=11; n++) {
	a = farey(n)
	m = rows(a)
	for (i=1; i<=m; i++) printf("%f/%f ",a[i,1],a[i,2])
	printf("\n")
}

map(&farey_length(),100*(1..10))
end


package main

import (
    "fmt"
    "math"
    "math/cmplx"
)

func ditfft2(x []float64, y []complex128, n, s int) {
    if n == 1 {
        y[0] = complex(x[0], 0)
        return
    }
    ditfft2(x, y, n/2, 2*s)
    ditfft2(x[s:], y[n/2:], n/2, 2*s)
    for k := 0; k < n/2; k++ {
        tf := cmplx.Rect(1, -2*math.Pi*float64(k)/float64(n)) * y[k+n/2]
        y[k], y[k+n/2] = y[k]+tf, y[k]-tf
    }
}

func main() {
    x := []float64{1, 1, 1, 1, 0, 0, 0, 0}
    y := make([]complex128, len(x))
    ditfft2(x, y, len(x), 1)
    for _, c := range y {
        fmt.Printf("%8.4f\n", c)
    }
}


class Farey {
    let n: Int

    init(_ x: Int) {
        n = x
    }

    //using algorithm from wikipedia
    var sequence: [(Int,Int)] {
        var a = 0
        var b = 1
        var c = 1
        var d = n
        var results = [(a, b)]
        while c <= n {
            let k = (n + b) / d
            let oldA = a
            let oldB = b
            a = c
            b = d
            c = k * c - oldA
            d = k * d - oldB
            results += [(a, b)]
        }
        return results
    }

    var formattedSequence: String {
        var s = "\(n):"
        for pair in sequence {
            s += " \(pair.0)/\(pair.1)"
        }
        return s
    }

}

print("Sequences\n")

for n in 1...11 {
    print(Farey(n).formattedSequence)
}

print("\nSequence Lengths\n")

for n in 1...10 {
    let m = n * 100
    print("\(m): \(Farey(m).sequence.count)")
}


package require Tcl 8.6

proc farey {n} {
    set nums [lrepeat [expr {$n+1}] 1]
    set result {{0 1}}
    for {set found 1} {$found} {} {
	set nj [lindex $nums [set j 1]]
	for {set found 0;set i 1} {$i <= $n} {incr i} {
	    if {[lindex $nums $i]*$j < $nj*$i} {
		set nj [lindex $nums [set j $i]]
		set found 1
	    }
	}
	lappend result [list $nj $j]
	for {set i $j} {$i <= $n} {incr i $j} {
	    lset nums $i [expr {[lindex $nums $i] + 1}]
	}
    }
    return $result
}

for {set i 1} {$i <= 11} {incr i} {
    puts F($i):\x20[lmap n [farey $i] {join $n /}]
}
for {set i 100} {$i <= 1000} {incr i 100} {
    puts |F($i)|\x20=\x20[llength [farey $i]]
}


import Data.Complex

-- Cooley-Tukey
fft [] = []
fft [x] = [x]
fft xs = zipWith (+) ys ts ++ zipWith (-) ys ts
    where n = length xs
          ys = fft evens
          zs = fft odds
          (evens, odds) = split xs
          split [] = ([], [])
          split [x] = ([x], [])
          split (x:y:xs) = (x:xt, y:yt) where (xt, yt) = split xs
          ts = zipWith (\z k -> exp' k n * z) zs [0..]
          exp' k n = cis $ -2 * pi * (fromIntegral k) / (fromIntegral n)

main = mapM_ print $ fft [1,1,1,1,0,0,0,0]


struct Fraction {
  public uint d;
  public uint n;
}

void farey(uint n) {
  Fraction f1 = {0, 1};
  Fraction f2 = {1, n};
  print("0/1 1/%u ", n);
  while (f2.n > 1) {
    var k = (n + f1.n) / f2.n;
    var aux = f1;
    f1 = f2;
    f2 = {f2.d * k - aux.d, f2.n * k - aux.n};
    print("%u/%u ", f2.d, f2.n);
  }
  print("\n");
}

uint fareyLength(uint n, uint[] cache) {
  if (n >= cache.length) {
    uint newLen = cache.length;
    if (newLen == 0)
      newLen = 16;
    while (newLen <= n)
      newLen *= 2;
    cache.resize((int)newLen);
  }
  else if (cache[n] != 0)
    return cache[n];

  uint length = n * (n + 3) / 2;
  for (uint p = 2, q = 2; p <= n; p = q) {
    q = n / (n / p) + 1;
    length -= fareyLength(n / p, cache) * (q - p);
  }

  cache[n] = length;
  return length;
}

void main() {
  for (uint n = 1; n < 12; n++)
  {
    print("%8u: ", n);
    farey(n);
  }

  uint[] cache = new uint[0];
  for (uint n = 100; n <= 1000; n += 100)
    print("%8u: %14u items\n", n, fareyLength(n, cache));
}


module Main

import Data.Complex

concatPair : List (a, a) -> List (a)
concatPair xs with (unzip xs)
  | (xs1, xs2) = xs1 ++ xs2

fft' : List (Complex Double) -> Nat -> Nat -> List (Complex Double)
fft' (x::xs) (S Z) _ = [x]
fft' xs n s = concatPair $ map (\(x1,x2,k) =>
                let eTerm = ((cis (-2 * pi * ((cast k) - 1) / (cast n))) * x2) in
                  (x1 + eTerm, x1 - eTerm)) $ zip3 left right [1..n `div` 2]

             where
                  left : List (Complex Double)
                  right : List (Complex Double)
                  left  = fft' (xs) (n `div` 2) (2 * s)
                  right = fft' (drop s xs) (n `div` 2) (2 * s)

-- Recursive Cooley-Tukey with radix-2 DIT case
-- assumes no of points provided are a power of 2
fft : List (Complex Double) -> List (Complex Double)
fft [] = []
fft xs = fft' xs (length xs) 1

main : IO()
main = traverse_ printLn $ fft [1,1,1,1,0,0,0,0]


cube  =: ($~ q:@#) :. ,
rou   =: ^@[email protected]@(% #)@[email protected]:  NB. roots of unity
floop =: 4 : 'for_r. i.#$x do. (y=.{."1 y) ] x=.(+/x) ,&,:"r (-/x)*y end.'
fft   =: ] floop&.cube [email protected]#


import static java.lang.Math.*;

public class FastFourierTransform {

    public static int bitReverse(int n, int bits) {
        int reversedN = n;
        int count = bits - 1;

        n >>= 1;
        while (n > 0) {
            reversedN = (reversedN << 1) | (n & 1);
            count--;
            n >>= 1;
        }

        return ((reversedN << count) & ((1 << bits) - 1));
    }

    static void fft(Complex[] buffer) {

        int bits = (int) (log(buffer.length) / log(2));
        for (int j = 1; j < buffer.length / 2; j++) {

            int swapPos = bitReverse(j, bits);
            Complex temp = buffer[j];
            buffer[j] = buffer[swapPos];
            buffer[swapPos] = temp;
        }

        for (int N = 2; N <= buffer.length; N <<= 1) {
            for (int i = 0; i < buffer.length; i += N) {
                for (int k = 0; k < N / 2; k++) {

                    int evenIndex = i + k;
                    int oddIndex = i + k + (N / 2);
                    Complex even = buffer[evenIndex];
                    Complex odd = buffer[oddIndex];

                    double term = (-2 * PI * k) / (double) N;
                    Complex exp = (new Complex(cos(term), sin(term)).mult(odd));

                    buffer[evenIndex] = even.add(exp);
                    buffer[oddIndex] = even.sub(exp);
                }
            }
        }
    }

    public static void main(String[] args) {
        double[] input = {1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0};

        Complex[] cinput = new Complex[input.length];
        for (int i = 0; i < input.length; i++)
            cinput[i] = new Complex(input[i], 0.0);

        fft(cinput);

        System.out.println("Results:");
        for (Complex c : cinput) {
            System.out.println(c);
        }
    }
}

class Complex {
    public final double re;
    public final double im;

    public Complex() {
        this(0, 0);
    }

    public Complex(double r, double i) {
        re = r;
        im = i;
    }

    public Complex add(Complex b) {
        return new Complex(this.re + b.re, this.im + b.im);
    }

    public Complex sub(Complex b) {
        return new Complex(this.re - b.re, this.im - b.im);
    }

    public Complex mult(Complex b) {
        return new Complex(this.re * b.re - this.im * b.im,
                this.re * b.im + this.im * b.re);
    }

    @Override
    public String toString() {
        return String.format("(%f,%f)", re, im);
    }
}


struct Frac {
    num int
    den int
}

fn (f Frac) str() string {
    return "$f.num/$f.den"
}

fn f(l Frac, r Frac, n int) {
    m := Frac{l.num + r.num, l.den + r.den}
    if m.den <= n {
        f(l, m, n)
        print("$m ")
        f(m, r, n)
    }
}

fn main() {
    // task 1.  solution by recursive generation of mediants
    for n := 1; n <= 11; n++ {
        l := Frac{0, 1}
        r := Frac{1, 1}
        print("F($n): $l ")
        f(l, r, n)
        println(r)
    }
    // task 2.  direct solution by summing totient fntion
    // 2.1 generate primes to 1000
    mut composite := [1001]bool{}
    for p in [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31] {
        for n := p * 2; n <= 1000; n += p {
            composite[n] = true
        }
    }
    // 2.2 generate totients to 1000
    mut tot := [1001]int{init: 1}
    for n := 2; n <= 1000; n++ {
        if !composite[n] {
            tot[n] = n - 1
            for a := n * 2; a <= 1000; a += n {
                mut f := n - 1
                for r := a / n; r%n == 0; r /= n {
                    f *= n
                }
                tot[a] *= f
            }
        }
    }
    // 2.3 sum totients
    for n, sum := 1, 1; n <= 1000; n++ {
        sum += tot[n]
        if n%100 == 0 {
            println("|F($n)|: $sum")
        }
    }
}


/*
complex fast fourier transform and inverse from
http://rosettacode.org/wiki/Fast_Fourier_transform#C.2B.2B
*/
function icfft(amplitudes)
{
	var N = amplitudes.length;
	var iN = 1 / N;

	//conjugate if imaginary part is not 0
	for(var i = 0 ; i < N; ++i)
		if(amplitudes[i] instanceof Complex)
			amplitudes[i].im = -amplitudes[i].im;

	//apply fourier transform
	amplitudes = cfft(amplitudes)

	for(var i = 0 ; i < N; ++i)
	{
		//conjugate again
		amplitudes[i].im = -amplitudes[i].im;
		//scale
		amplitudes[i].re *= iN;
		amplitudes[i].im *= iN;
	}
	return amplitudes;
}

function cfft(amplitudes)
{
	var N = amplitudes.length;
	if( N <= 1 )
		return amplitudes;

	var hN = N / 2;
	var even = [];
	var odd = [];
	even.length = hN;
	odd.length = hN;
	for(var i = 0; i < hN; ++i)
	{
		even[i] = amplitudes[i*2];
		odd[i] = amplitudes[i*2+1];
	}
	even = cfft(even);
	odd = cfft(odd);

	var a = -2*Math.PI;
	for(var k = 0; k < hN; ++k)
	{
		if(!(even[k] instanceof Complex))
			even[k] = new Complex(even[k], 0);
		if(!(odd[k] instanceof Complex))
			odd[k] = new Complex(odd[k], 0);
		var p = k/N;
		var t = new Complex(0, a * p);
		t.cexp(t).mul(odd[k], t);
		amplitudes[k] = even[k].add(t, odd[k]);
		amplitudes[k + hN] = even[k].sub(t, even[k]);
	}
	return amplitudes;
}

//test code
//console.log( cfft([1,1,1,1,0,0,0,0]) );
//console.log( icfft(cfft([1,1,1,1,0,0,0,0])) );


import "/math" for Int
import "/trait" for Stepped
import "/fmt" for Fmt
import "/rat" for Rat

var f //recursive
f = Fn.new { |l, r, n|
    var m = Rat.new(l.num + r.num, l.den + r.den)
    if (m.den <= n) {
        f.call(l, m, n)
        System.write("%(m) ")
        f.call(m, r, n)
    }
}

/* Task 1: solution by recursive generation of mediants. */
for (n in 1..11) {
    var l = Rat.zero
    var r = Rat.one
    System.write("F(%(n)): %(l) ")
    f.call(l, r, n)
    System.print(r)
}
System.print()

/* Task 2: direct solution by summing totient function. */

// generate primes to 1000
var comp = Int.primeSieve(1001, false)

// generate totients to 1000
var tot = List.filled(1001, 1)
for (n in 2..1000) {
    if (!comp[n]) {
        tot[n] = n - 1
        for (a in Stepped.ascend(n*2..1000, n)) {
            var f = n - 1
            var r = (a/n).floor
            while (r%n == 0) {
                f = f * n
                r = (r/n).floor
            }
            tot[a] = tot[a] * f
        }
    }
}

// sum totients
var sum = 1
for (n in 1..1000) {
    sum = sum + tot[n]
    if (n%100 == 0) System.print("F(%(Fmt.d(4, n))): %(Fmt.dc(7, sum))")
}


# multiplication of real or complex numbers
def cmult(x; y):
    if (x|type) == "number" then
       if  (y|type) == "number" then [ x*y, 0 ]
       else [x * y[0], x * y[1]]
       end
    elif (y|type) == "number" then cmult(y;x)
    else [ x[0] * y[0] - x[1] * y[1],  x[0] * y[1] + x[1] * y[0]]
    end;

def cplus(x; y):
    if (x|type) == "number" then
       if  (y|type) == "number" then [ x+y, 0 ]
       else [ x + y[0], y[1]]
       end
    elif (y|type) == "number" then cplus(y;x)
    else [ x[0] + y[0], x[1] + y[1] ]
    end;

def cminus(x; y): cplus(x; cmult(-1; y));

# e(ix) = cos(x) + i sin(x)
def expi(x): [ (x|cos), (x|sin) ];


using FFTW # or using DSP

fft([1,1,1,1,0,0,0,0])


proc Farey(N);          \Show Farey sequence for N
\Translation of Python program on Wikipedia:
int  N, A, B, C, D, K, T;
[A:= 0;  B:= 1;  C:= 1;  D:= N;
Text(0, "0/1");
while C <= N do
    [K:= (N+B)/D;
    T:= C;
    C:= K*C - A;
    A:= T;
    T:= D;
    D:= K*D - B;
    B:= T;
    ChOut(0, ^ );  IntOut(0, A);
    ChOut(0, ^/);  IntOut(0, B);
    ];
];

func GCD(N, D);         \Return the greatest common divisor of N and D
int  N, D;              \numerator and denominator
int  R;
[if D > N then
    [R:= D;  D:= N;  N:= R];    \swap D and N
while D > 0 do
    [R:= rem(N/D);
    N:= D;
    D:= R;
    ];
return N;
];      \GCD

func Totient(N);        \Return the totient of N
int  N, Phi, M;
[Phi:= 0;
for M:= 1 to N do
    if GCD(M, N) = 1 then Phi:= Phi+1;
return Phi;
];

func FareyLen(N);       \Return length of Farey sequence for N
int  N, Sum, M;
[Sum:= 1;
for M:= 1 to N do
    Sum:= Sum + Totient(M);
return Sum;
];

int N;
[for N:= 1 to 11 do
    [IntOut(0, N);  Text(0, ": ");
    Farey(N);
    CrLf(0);
    ];
for N:= 1 to 10 do
    [IntOut(0, N);  Text(0, "00: ");
    IntOut(0, FareyLen(N*100));
    CrLf(0);
    ];
RlOut(0, 3.0 * sq(1000.0) / sq(3.141592654));  CrLf(0);
]


// Rosetta Code problem: https://rosettacode.org/wiki/Farey_sequence
// by Jjuanhdez, 06/2022

for i = 1 to 11
    print "F", i, " = ";
    farey(i, FALSE)
next i
print
for i = 100 to 1000 step 100
    print "F", i;
    if i <> 1000 then print " "; else print ""; : fi
    print " = ";
    farey(i, FALSE)
next i
end

sub farey(n, descending)
    a = 0 : b = 1 : c = 1 : d = n : k = 0
    cont = 0

    if descending = TRUE then
        a = 1 : c = n -1
    end if

    cont = cont + 1
    if n < 12 then print a, "/", b, " "; : fi

    while ((c <= n) and not descending) or ((a > 0) and descending)
        aa = a : bb = b : cc = c : dd = d
        k = int((n + b) / d)
        a = cc : b = dd : c = k * cc - aa : d = k * dd - bb
        cont = cont + 1
        if n < 12 then print a, "/", b, " "; : fi
    end while

    if n < 12 then print else print cont using("######") : fi
end sub


import java.lang.Math.*

class Complex(val re: Double, val im: Double) {
    operator infix fun plus(x: Complex) = Complex(re + x.re, im + x.im)
    operator infix fun minus(x: Complex) = Complex(re - x.re, im - x.im)
    operator infix fun times(x: Double) = Complex(re * x, im * x)
    operator infix fun times(x: Complex) = Complex(re * x.re - im * x.im, re * x.im + im * x.re)
    operator infix fun div(x: Double) = Complex(re / x, im / x)
    val exp: Complex by lazy { Complex(cos(im), sin(im)) * (cosh(re) + sinh(re)) }

    override fun toString() = when {
        b == "0.000" -> a
        a == "0.000" -> b + 'i'
        im > 0 -> a + " + " + b + 'i'
        else -> a + " - " + b + 'i'
    }

    private val a = "%1.3f".format(re)
    private val b = "%1.3f".format(abs(im))
}


1) the function fft

{def fft
 {lambda {:s :x}
  {if {= {list.length :x} 1}
   then :x
   else {let { {:s :s}
               {:ev {fft :s {evens :x}} }
               {:od {fft :s {odds  :x}} } }
        {let { {:ev :ev} {:t {rotate :s :od 0 {list.length :od}}} }
        {list.append {list.map Cadd :ev :t}
                     {list.map Csub :ev :t}} }}}}}

{def rotate
 {lambda {:s :f :k :N}
  {if {list.null? :f}
   then nil
   else {cons {Cmul {car :f} {Cexp {Cnew 0 {/ {* :s {PI} :k} :N}}}}
              {rotate :s {cdr :f} {+ :k 1} :N}}}}}

2) functions for lists

We add to the existing {lambda talk}'s list primitives a small set of functions required by the function fft.

{def evens
 {lambda {:l}
  {if {list.null? :l}
   then nil
   else {cons {car :l} {evens {cdr {cdr :l}}}}}}}

{def odds
 {lambda {:l}
  {if {list.null? {cdr :l}}
   then nil
   else {cons {car {cdr :l}} {odds {cdr {cdr :l}}}}}}}

{def list.map
 {def list.map.r
  {lambda {:f :a :b :c}
   {if {list.null? :a}
    then :c
    else {list.map.r :f {cdr :a} {cdr :b}
                        {cons {:f {car :a} {car :b}} :c}} }}}
 {lambda {:f :a :b}
  {list.map.r :f {list.reverse :a} {list.reverse :b} nil}}}

{def list.append
 {def list.append.r
  {lambda {:a :b}
   {if {list.null? :b}
    then :a
    else {list.append.r {cons {car :b} :a} {cdr :b}}}}}
 {lambda {:a :b}
  {list.append.r :b {list.reverse :a}} }}

3) functions for Cnumbers

{lambda talk} has no primitive functions working on complex numbers. We add the minimal set required by the function fft.

{def Cnew
 {lambda {:x :y}
  {cons :x :y} }}

{def Cnorm
 {lambda {:c}
  {sqrt {+ {* {car :c} {car :c}}
           {* {cdr :c} {cdr :c}}}} }}

{def Cadd
 {lambda {:x :y}
  {cons {+ {car :x} {car :y}}
        {+ {cdr :x} {cdr :y}}} }}

{def Csub
 {lambda {:x :y}
  {cons {- {car :x} {car :y}}
        {- {cdr :x} {cdr :y}}} }}

{def Cmul
 {lambda {:x :y}
  {cons {- {* {car :x} {car :y}} {* {cdr :x} {cdr :y}}}
        {+ {* {car :x} {cdr :y}} {* {cdr :x} {car :y}}}} }}

{def Cexp
  {lambda {:x}
   {cons {* {exp {car :x}} {cos {cdr :x}}}
         {* {exp {car :x}} {sin {cdr :x}}}} }}

{def Clist
 {lambda {:s}
  {list.new {map {lambda {:i} {cons :i 0}} :s}}}}

4) testing

Applying the fft function on such a sample (1 1 1 1 0 0 0 0) where numbers have been promoted as complex

{list.disp {fft -1 {Clist 1 1 1 1 0 0 0 0}}} ->

(4 0)
(1 -2.414213562373095)
(0 0)
(1 -0.4142135623730949)
(0 0)
(0.9999999999999999 0.4142135623730949)
(0 0)
(0.9999999999999997 2.414213562373095)

A more usefull example can be seen in http://lambdaway.free.fr/lambdaspeech/?view=zorg


F fib_iter(n)
   I n < 2
      R n
   V fib_prev = 1
   V fib = 1
   L 2 .< n
      (fib_prev, fib) = (fib, fib + fib_prev)
   R fib

L(i) 1..20
   print(fib_iter(i), end' ‘ ’)
print()