Perl 6: Функциональный

multi factorial ( Int $n where { $n <= 0 } ){
  return 1;
}
multi factorial ( Int $n ){
   return $n * factorial( $n-1 );
}

Это также будет работать:

multi factorial(0) { 1 }
multi factorial(Int $n) { $n * factorial($n - 1) }

Проверьте журнал Джонатана Уортингтона на use.perl.org, чтобы узнать больше о последнем примере.

Perl 6: Процедурный

sub factorial ( int $n ){

  my $result = 1;

  loop ( ; $n > 0; $n-- ){

    $result *= $n;

  }

  return $result;
}

C:

Обновлено: На самом деле, я думаю, С ++ из-за объявления переменной в цикле for.

 int factorial(int x) {
      int product = 1;

      for (int i = x; i > 0; i--) {
           product *= i;
      }

      return product;
 }

Javascript:

factorial = function( n )
{
   return n > 0 ? n * factorial( n - 1 ) : 1;
}

Я не уверен, что такое Factorial, но он делает то же, что и другие программы, в javascript.

Haskell:

ones = 1 : ones
integers   = head ones     : zipWith (+) integers   (tail ones)
factorials = head integers : zipWith (*) factorials (tail integers)

Схема

Вот простое рекурсивное определение:

(define (factorial x)
  (if (= x 0) 1
      (* x (factorial (- x 1)))))

В Scheme хвостовые рекурсивные функции используют постоянное пространство стека. Вот версия факториала с хвостовой рекурсией:

(define factorial
  (letrec ((fact (lambda (x accum)
                   (if (= x 0) accum
                       (fact (- x 1) (* accum x))))))
    (lambda (x)
      (fact x 1))))

C++

factorial(int n)
{
    for(int i=1, f = 1; i<=n; i++)
        f *= i;
    return f;
}

C / C++: Процедурный

unsigned long factorial(int n)
{
    unsigned long factorial = 1;
    int i;

    for (i = 2; i <= n; i++)
        factorial *= i;

    return factorial;
}

PHP: Процедурный

function factorial($n)
{
    for ($factorial = 1, $i = 2; $i <= $n; $i++)
        $factorial *= $i;

    return $factorial;
}

@Niyaz: вы не указали тип возвращаемого значения для функции

лолкод:

извини я не смог устоять xD

HAI
CAN HAS STDIO?
I HAS A VAR
I HAS A INT
I HAS A CHEEZBURGER
I HAS A FACTORIALNUM
IM IN YR LOOP
    UP VAR!!1
    TIEMZD INT!![CHEEZBURGER]
    UP FACTORIALNUM!!1
    IZ VAR BIGGER THAN FACTORIALNUM? GTFO
IM OUTTA YR LOOP
U SEEZ INT
KTHXBYE    

D шаблоны: функциональные

template factorial(int n : 1)
{
  const factorial = 1;
}

template factorial(int n)
{
  const factorial =
     n * factorial!(n-1);
}

или же

template factorial(int n)
{
  static if (n == 1)
    const factorial = 1;
  else 
    const factorial =
       n * factorial!(n-1);
}

Используется так:

factorial!(5)

Python:

Рекурсивный

def fact(x): 
    return (1 if x==0 else x * fact(x-1))

Использование итератора

import operator

def fact(x):
    return reduce(operator.mul, xrange(1, x+1))

два из многих решений Mathematica (хотя! является встроенным и эффективным):

(* returns pure function *)
(FixedPoint[(If[#[[2]]>1,{#[[1]]*#[[2]],#[[2]]-1},#])&,{1,n}][[1]])&

(* not using built-in, returns pure function, don't use: might build 1..n list *)
(Times @@ Range[#])&

Ява: функциональный

int factorial(int x) {
    return x == 0 ? 1 : x * factorial(x-1);
}

Mathematica: использование чисто рекурсивных функций

(If[#>1,# #0[#-1],1])&

Рубин: функционал

def factorial(n)
    return 1 if n == 1
    n * factorial(n -1)
end

Lua

function factorial (n)
  if (n <= 1) then return 1 end
  return n*factorial(n-1)
end

А вот и случайное переполнение стека:

> print (factorial(234132))
stdin:3: stack overflow
stack traceback:
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    ...
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:3: in function 'factorial'
    stdin:1: in main chunk
    [C]: ?

F#: Функциональный

Простой:

let rec fact x = 
    if   x < 0 then failwith "Invalid value."
    elif x = 0 then 1
    else x * fact (x - 1)

Придумываю:

let fact x = [1 .. x] |> List.fold_left ( * ) 1

Haskell: Функциональный

 fact 0 = 1
 fact n = n * fact (n-1)

C++: метапрограммирование шаблонов

Использует классический хак enum.

template<unsigned int n>
struct factorial {
    enum { result = n * factorial<n - 1>::result };
};

template<>
struct factorial<0> {
    enum { result = 1 };
};

Использование.

const unsigned int x = factorial<4>::result;

Факториал полностью рассчитывается во время компиляции на основе параметра шаблона n. Следовательно, factorial :: result является константой после того, как компилятор выполнил свою работу.

Этот не только вычисляет n !, но и O (n!). Однако могут возникнуть проблемы, если вы захотите посчитать что-нибудь «большое».

long f(long n)
{
    long r=1;
    for (long i=1; i<n; i++)
        r=r*i;
    return r;
}

long factorial(long n)
{
    // iterative implementation should be efficient
    long result;
    for (long i=0; i<f(n); i++)
        result=result+1;
    return result;
}

Сборка x86-64: Процедурная

Вы можете вызвать это из C (проверено только с GCC на linux amd64). Сборка была собрана с помощью nasm.

section .text
    global factorial
; factorial in x86-64 - n is passed in via RDI register
; takes a 64-bit unsigned integer
; returns a 64-bit unsigned integer in RAX register
; C declaration in GCC:
;   extern unsigned long long factorial(unsigned long long n);
factorial:
    enter 0,0
    ; n is placed in rdi by caller
    mov rax, 1 ; factorial = 1
    mov rcx, 2 ; i = 2
loopstart:
    cmp rcx, rdi
    ja loopend
    mul rcx ; factorial *= i
    inc rcx
    jmp loopstart
loopend:
    leave
    ret

Visual Basic: Linq

<Extension()> _
Public Function Product(ByVal xs As IEnumerable(Of Integer)) As Integer
    Return xs.Aggregate(1, Function(a, b) a * b)
End Function

Public Function Fact(ByVal n As Integer) As Integer
    Return Aggregate x In Enumerable.Range(1, n) Into Product()
End Function

Это показывает, как использовать ключевое слово Aggregate в VB. C# не может этого сделать (хотя C#, конечно, может вызывать метод расширения напрямую).

PowerShell

function factorial( [int] $n ) 
{ 
    $result = 1; 

    if ( $n -gt 1 ) 
    { 
        $result = $n * ( factorial ( $n - 1 ) ) 
    } 

    $result 
}

Вот однострочник:

$n..1 | % {$result = 1}{$result *= $_}{$result}

Рекурсивный пролог

fac(0,1).
fac(N,X) :- N1 is N -1, fac(N1, T), X is N * T.

Хвостовой рекурсивный пролог

fac(0,N,N).
fac(X,N,T) :- A is N * X, X1 is X - 1, fac(X1,A,T).
fac(N,T) :- fac(N,1,T).

Оболочка Борна: Функциональная

factorial() {
  if [  -eq 0 ]
  then
    echo 1
    return
  fi

  a=`expr  - 1`
  expr  \* `factorial $a`
}

Также работает с Korn Shell и Bourne Again Shell. :-)

Рекурсивный Лисп:

(defun factorial (x) 
   (if (<= x 1) 
       1 
       (* x (factorial (- x 1)))))

JavaScript Использование анонимных функций:

var f = function(n){
  if (n>1){
    return arguments.callee(n-1)*n;
  }
  return 1;
}

Странные примеры? А как насчет использования гамма-функции! Поскольку Gamma n = (n-1)!.

OCaml: Использование гаммы

let rec gamma z =
    let pi = 4.0 *. atan 1.0 in
    if z < 0.5 then
        pi /. ((sin (pi*.z)) *. (gamma (1.0 -. z)))
    else
        let consts = [| 0.99999999999980993; 676.5203681218851; -1259.1392167224028;
                        771.32342877765313; -176.61502916214059; 12.507343278686905;
                 -0.13857109526572012; 9.9843695780195716e-6; 1.5056327351493116e-7;
                     |] 
        in
        let z = z -. 1.0 in
        let results = Array.fold_right 
                          (fun x y -> x +. y)
                          (Array.mapi 
                              (fun i x -> if i = 0 then x else x /. (z+.(float i)))
                              consts
                          )
                          0.0
        in
        let x = z +. (float (Array.length consts)) -. 1.5 in
        let final = (sqrt (2.0*.pi)) *. 
                    (x ** (z+.0.5)) *.
                    (exp (-.x)) *. result
        in
        final

let factorial_gamma n = int_of_float (gamma (float (n+1)))

C: Один лайнер, процедурный

int f(int n) { for (int i = n - 1; i > 0; n *= i, i--); return n ? n : 1; }

Я использовал int для краткости; используйте другие типы для поддержки большего числа.

ОСНОВНОЙ: старая школа

10 HOME
20 INPUT N
30 LET ANS = 1
40 FOR I = 1 TO N
50   ANS = ANS * I
60 NEXT I
70 PRINT ANS

Java 1.6: рекурсивный, мемоизированный (для последующих вызовов)

private static Map<BigInteger, BigInteger> _results = new HashMap()

public static BigInteger factorial(BigInteger n){
    if (0 >= n.compareTo(BigInteger.ONE))
       return BigInteger.ONE.max(n);
    if (_results.containsKey(n))
       return _results.get(n);
    BigInteger result = factorial(n.subtract(BigInteger.ONE)).multiply(n);
    _results.put(n, result);
    return result;
}

Схема: функциональная - хвостовая рекурсивная

(define (factorial n)
  (define (fac-times n acc)
    (if (= n 0)
        acc
        (fac-times (- n 1) (* acc n))))
  (if (< n 0)
      (display "Wrong argument!")
      (fac-times n 1)))

Пакет (NT):

@echo off

set n=%1
set result=1

for /l %%i in (%n%, -1, 1) do (
    set /a result=result * %%i
)

echo %result%

Использование: C:> factorial.bat 15

Haskell: функциональный - хвостовой рекурсивный

factorial n = factorial' n 1

factorial' 0 a = a
factorial' n a = factorial' (n-1) (n*a)

Agda 2: Функциональный, зависимо типизированный.

data Nat = zero | suc (m::Nat)

add (m::Nat) (n::Nat) :: Nat
 = case m of
     (zero ) -> n
     (suc p) -> suc (add p n)

mul (m::Nat) (n::Nat)::Nat
   = case m of
      (zero ) -> zero
      (suc p) -> add n (mul p n)

factorial (n::Nat)::Nat 
 = case n of
    (zero ) -> suc zero
    (suc p) -> mul n (factorial p)

Поиск C#:

На самом деле нечего рассчитывать, просто посмотрите. Чтобы расширить его, добавьте еще 8 чисел в таблицу, и 64-битные целые числа достигли своего предела. Кроме того, требуется класс BigNum.

public static int Factorial(int f)
{ 
    if (f<0 || f>12)
    {
        throw new ArgumentException("Out of range for integer factorial");
    }
    int [] fact = {1,1,2,6,24,120,720,5040,40320,362880,3628800,
                 39916800,479001600};
    return fact[f];
}

Пробел

   	.
 .
 	.
		.
  	.
   	.
			 .
 .
	 	 .
	  .
   	.
 .
  .
 			 .
		  			 .
 .
	.
.
  	 .
 .
.
	.
 	.
.
.
.

Трудно было заставить его показать здесь должным образом, но теперь я попытался скопировать его из превью, и он работает. Вам нужно ввести номер и нажать Enter.

Delphi

facts: array[2..12] of integer;

function TForm1.calculate(f: integer): integer;
begin
    if f = 1 then
      Result := f
    else if f > High(facts) then
      Result := High(Integer)
    else if (facts[f] > 0) then
      Result := facts[f]
    else begin
      facts[f] := f * Calculate(f-1);
      Result := facts[f];
    end;
end;

initialize

  for i := Low(facts) to High(facts) do
    facts[i] := 0;

После первого вычисления факториала, большего или равного желаемому значению, этот алгоритм просто возвращает факториал за постоянное время O (1).

При этом учитывается, что только int32 может содержать до 12!

ЛенивыйK

Ваши кошмары, связанные с чисто функциональным программированием, сбываются!

Единственный Эзотерический полный язык программирования по Тьюрингу, который имеет:

• Чисто функциональная основа, ядро ​​и библиотеки - собственно говоря, вот полный API: S K I
• Нет даже лямбды!
• Нет числа или списков, необходимых или разрешенных
• Нет явной рекурсии, но пока, позволяет рекурсию
• Простой механизм ввода-вывода на основе бесконечный ленивый поток

Вот код Факториала во всей его красе в скобках:

K(SII(S(K(S(S(KS)(S(K(S(KS)))(S(K(S(KK)))(S(K(S(K(S(K(S(K(S(SI(K(S(K(S(S(KS)K)I))
 (S(S(KS)K)(SII(S(S(KS)K)I))))))))K))))))(S(K(S(K(S(SI(K(S(K(S(SI(K(S(K(S(S(KS)K)I))
 (S(S(KS)K)(SII(S(S(KS)K)I))(S(S(KS)K))(S(SII)I(S(S(KS)K)I))))))))K)))))))
 (S(S(KS)K)(K(S(S(KS)K)))))))))(K(S(K(S(S(KS)K)))K))))(SII))II)

Функции:

• Без вычитания или условных выражений
• Печатает все факториалы (если вы подождете достаточно долго)
• Использует второй слой цифр Чёрча для преобразования N-го факториала в N! звездочки, за которыми следует новая строка
• Использует Y комбинатор для рекурсии

Если вам интересно понять это, вот исходный код схемы для запуска через компилятор Lazier:

(lazy-def '(fac input)
   '((Y (lambda (f n a) ((lambda (b) ((cons 10) ((b (cons 42)) (f (1+ n) b))))
       (* a n)))) 1 1))

(для подходящих определений Y, cons, 1, 10, 42, 1+ и *).

Обновлено:

Lazy K Factorial в десятичной системе счисления

(10 КБ тарабарщины а то я бы вставил). Например, в командной строке Unix:

    $ echo "4" | ./lazy facdec.lazy
    24
    $ echo "5" | ./lazy facdec.lazy
    120

Довольно медленно для чисел выше, скажем, 5.

Код немного раздут, потому что мы должны включить код библиотеки для всех наших примитивов (код, написанный на Туманный, интерпретатор лямбда-исчисления и компилятор LC-to-Lazy K, написанный на Haskell).

C#: LINQ

    public static int factorial(int n)
    {
        return (Enumerable.Range(1, n).Aggregate(1, (previous, value) => previous * value));
    }

Проблема с большинством из вышеперечисленных заключается в том, что они не будут иметь точности на отметке 25! (12! С 32-битными целыми числами) или просто переполнение. Вот реализация на C#, которая поможет преодолеть эти ограничения!

class Number
{
  public Number ()
  {
    m_number = "0";
  }

  public Number (string value)
  {
    m_number = value;
  }

  public int this [int column]
  {
    get
    {
      return column < m_number.Length ? m_number [m_number.Length - column - 1] - '0' : 0;
    }
  }

  public static implicit operator Number (string rhs)
  {
    return new Number (rhs);
  }

  public static bool operator == (Number lhs, Number rhs)
  {
    return lhs.m_number == rhs.m_number;
  }

  public static bool operator != (Number lhs, Number rhs)
  {
    return lhs.m_number != rhs.m_number;
  }

  public override bool Equals (object obj)
  {
     return this == (Number) obj;
  }

  public override int GetHashCode ()
  {
    return m_number.GetHashCode ();
  }

  public static Number operator + (Number lhs, Number rhs)
  {
    StringBuilder
      result = new StringBuilder (new string ('0', lhs.m_number.Length + rhs.m_number.Length));

    int
      carry = 0;

    for (int i = 0 ; i < result.Length ; ++i)
    {
      int
        sum = carry + lhs [i] + rhs [i],
        units = sum % 10;

      carry = sum / 10;

      result [result.Length - i - 1] = (char) ('0' + units);
    }

    return TrimLeadingZeros (result);
  }

  public static Number operator * (Number lhs, Number rhs)
  {
    StringBuilder
      result = new StringBuilder (new string ('0', lhs.m_number.Length + rhs.m_number.Length));

    for (int multiplier_index = rhs.m_number.Length - 1 ; multiplier_index >= 0 ; --multiplier_index)
    {
      int
        multiplier = rhs.m_number [multiplier_index] - '0',
        column = result.Length - rhs.m_number.Length + multiplier_index;

      for (int i = lhs.m_number.Length - 1 ; i >= 0 ; --i, --column)
      {
        int
          product = (lhs.m_number [i] - '0') * multiplier,
          units = product % 10,
          tens = product / 10,
          hundreds = 0,
          unit_sum = result [column] - '0' + units;

        if (unit_sum > 9)
        {
          unit_sum -= 10;
          ++tens;
        }

        result [column] = (char) ('0' + unit_sum);

        int
          tens_sum = result [column - 1] - '0' + tens;

        if (tens_sum > 9)
        {
          tens_sum -= 10;
          ++hundreds;
        }

        result [column - 1] = (char) ('0' + tens_sum);

        if (hundreds > 0)
        {
          int
            hundreds_sum = result [column - 2] - '0' + hundreds;

          result [column - 2] = (char) ('0' + hundreds_sum);
        }
      }
    }

    return TrimLeadingZeros (result);
  }

  public override string ToString ()
  {
    return m_number;
  }

  static string TrimLeadingZeros (StringBuilder number)
  {
    while (number [0] == '0' && number.Length > 1)
    {
      number.Remove (0, 1);
    }

    return number.ToString ();
  }

  string
    m_number;
}

static void Main (string [] args)
{
  Number
    a = new Number ("1"),
    b = new Number (args [0]),
    one = new Number ("1");

  for (Number c = new Number ("1") ; c != b ; )
  {
    c = c + one;
    a = a * c;
  }

  Console.WriteLine (string.Format ("{0}! = {1}", new object [] { b, a }));
}

FWIW: 10000! имеет длину более 35500 символов.

Skizz

Python: функциональный, однострочный

factorial = lambda n: reduce(lambda x,y: x*y, range(1, n+1), 1)

ПРИМЕЧАНИЕ:

• Он поддерживает большие целые числа. Пример:

print factorial(100)
93326215443944152681699238856266700490715968264381621468592963895217599993229915\
608941463976156518286253697920827223758251185210916864000000000000000000000000

• Не работает для п.

Это один из самых быстрых алгоритмов, вплоть до 170!. терпит неудачу необъяснимо превышает 170 !, и это относительно медленно для небольших факториалов, но для факториалов между 80 и 170 это невероятно быстро по сравнению со многими алгоритмами.

curl http://www.google.com/search?q=170!

Также есть онлайн-интерфейс попробуйте прямо сейчас!

Дайте мне знать, если вы обнаружите ошибку или более быструю реализацию для больших факториалов.

Обновлено:

Этот алгоритм немного медленнее, но дает результаты больше 170:

curl http://www58.wolframalpha.com/input/?i=171!

Это также упрощает их в различных других представлениях.

Python, C / C++ (переплетение): многоязычный, процедурный

Четыре реализации:

• [ткать]
• [питон]
• [psyco]
• [список]

Код:

#!/usr/bin/env python
""" weave_factorial.py

"""
# [weave] factorial() as extension module in C++
from scipy.weave import ext_tools

def build_factorial_ext():
    func = ext_tools.ext_function(
        'factorial', 
        r"""
        unsigned long long i = 1;
        for ( ; n > 1; --n)
          i *= n;

        PyObject *o = PyLong_FromUnsignedLongLong(i);
        return_val = o;
        Py_XDECREF(o); 
        """,  
        ['n'], 
        {'n': 1}, # effective type declaration
        {})
    mod = ext_tools.ext_module('factorial_ext')
    mod.add_function(func)
    mod.compile()

try: from factorial_ext import factorial as factorial_weave
except ImportError:
    build_factorial_ext()
    from factorial_ext import factorial as factorial_weave


# [python] pure python procedural factorial()
def factorial_python(n):
    i = 1
    while n > 1:
        i *= n
        n -= 1
    return i


# [psyco] factorial() psyco-optimized
try:
    import psyco
    factorial_psyco = psyco.proxy(factorial_python)
except ImportError:
    pass


# [list] list-lookup factorial()
factorials = map(factorial_python, range(21))   
factorial_list = lambda n: factorials[n]

Измерьте относительную производительность:

$ python -mtimeit \
         -s "from weave_factorial import factorial_$label as f" "f($n)"

1. п = 12

   • [weave] 0,70 мкс (2)
   • [python] 3,8 мкс (9)
   • [psyco] 1,2 мкс (3)
   • [список] 0,43 мкс (1)

2. п = 20

   • [weave] 0,85 мкс (2)
   • [python] 9,2 мкс (21 год)
   • [psyco] 4,3 мкс (10)
   • [список] 0,43 мкс (1)

мкс обозначает микросекунды.

Лямбда-исчисление

Входные и выходные данные - это числа Чёрча (т.е. натуральное число k равно \f n. f^k n; поэтому 3 = \f n. f (f (f n)))

(\x. x x) (\y f. f (y y f)) (\y n. n (\x y z. z) (\x y. x) (\f n. f n) (\f. n (y (\f m. n (\g h. h (g f)) (\x. m) (\x. x)) f)))

Рубин: Итеративный

def factorial(n)
  (1 .. n).inject{|a, b| a*b}
end

Рубин: рекурсивный

def factorial(n)
  n == 1 ? 1 : n * factorial(n-1)
end

Nemerle: Функциональный

def fact(n) {
    | 0 => 1
    | x => x * fact(x-1)
}

#Language: T-SQL
#Style: Recursive, divide and conquer

Ради интереса - в T-SQL используется рекурсивный метод «разделяй и властвуй». Да, рекурсивный - в SQL без переполнения стека.

create function factorial(@b int=1, @e int) returns float as begin
  return case when @b>=@e then @e else 
      convert(float,dbo.factorial(@b,convert(int,@b+(@e-@b)/2)))
    * convert(float,dbo.factorial(convert(int,@b+1+(@e-@b)/2),@e)) end
end

назовите это так:

print dbo.factorial(1,170) -- the 1 being the starting number

#Language: T-SQL
#Style: Big Numbers

Вот еще одно решение T-SQL - поддерживает большие числа в стиле Руба Голдберга. Множество наборов операций. Пытался сохранить однозначно SQL. Ужасная производительность (400! Потребовалось 33 секунды на Dell Latitude D830)

create function bigfact(@x varchar(max)) returns varchar(max) as begin
  declare @c int
  declare @n table(n int,e int)
  declare @f table(n int,e int)

  set @c=0
  while @c<len(@x) begin
    set @c=@c+1
    insert @n(n,e) values(convert(int,substring(@x,@c,1)),len(@x)-@c)
  end

  -- our current factorial
  insert @f(n,e) select 1,0

  while 1=1 begin
    declare @p table(n int,e int)
    delete @p
    -- product
    insert @p(n,e) select sum(f.n*n.n), f.e+n.e from @f f cross join @n n group by f.e+n.e

    -- normalize
    while 1=1 begin
      delete @f
      insert @f(n,e) select sum(n),e from (
        select (n % 10) as n,e from @p union all 
        select (n/10) % 10,e+1 from @p union all 
        select (n/100) %10,e+2 from @p union all 
        select (n/1000)%10,e+3 from @p union all 
        select (n/10000) % 10,e+4 from @p union all 
        select (n/100000)% 10,e+5 from @p union all 
        select (n/1000000)%10,e+6 from @p union all 
        select (n/10000000) % 10,e+7 from @p union all 
        select (n/100000000)% 10,e+8 from @p union all 
        select (n/1000000000)%10,e+9 from @p
      ) f group by e having sum(n)>0

      set @c=0
      select @c=count(*) from @f where n>9
      if @c=0 break
      delete @p
      insert @p(n,e) select n,e from @f
    end

    -- decrement
    update @n set n=n-1 where e=0

    -- normalize
    while 1=1 begin
      declare @e table(e int)
      delete @e
      insert @e(e) select e from @n where n<0
      if @@rowcount=0 break

      update @n set n=n+10 where e in (select e from @e)
      update @n set n=n-1 where e in (select e+1 from @e)
    end  

    set @c=0
    select @c=count(*) from @n where n>0
    if @c=0 break
  end

  select @c=max(e) from @f
  set @x=''
  declare @l varchar(max)
  while @c>=0 begin
    set @l='0'
    select @l=convert(varchar(max),n) from @f where e=@c
    set @x=@x+@l
    set @c=@c-1
  end
  return @x
end

Пример:

print dbo.bigfact('69')

возвращает:

171122452428141311372468338881272839092270544893520369393648040923257279754140647424000000000000000

Мне просто смешны следующие реализации:

Эволюция программиста на Haskell

Эволюция программиста на Python

Наслаждаться!

рубиновый рекурсивный

(factorial=Hash.new{|h,k|k*h[k-1]})[1]=1
    

использование:

factorial[5]
 => 120

Название языка: ChucK

Moog moog => dac;
4.0 => moog.gain;

for (0 => int i; i < 8; i++) {
    <<< factorial(i) >>>;
}

fun int factorial(int n) {
    1 => int result;
    if (n != 0) {
        n * factorial(n - 1) => result;
    }

    Std.mtof(result % 128) => moog.freq;
    0.25::second => now;

    return result;
}

И это звучит как это. Не очень интересно, но, эй, это просто факториальная функция!

Brainf * ck

+++++
>+<[[->>>>+<<<<]>>>>[-<<<<+>>+>>]<<<<>[->>+<<]<>>>[-<[->>+<<]>>[-<<+<+>>>]<]<[-]><<<-]

Автор Майкл Райценштейн.

APL (необычный / однострочный):

×/⍳X

1. ⍳X расширяет X в массив целых чисел 1..X
2. × / умножает каждый элемент в массиве

Или со встроенным оператором:

!X

Источник: http://www.webber-labs.com/mpl/lectures/ppt-slides/01.ppt

Bash: рекурсивный

В bash и рекурсивно, но с дополнительным преимуществом, заключающимся в том, что он обрабатывает каждую итерацию в новом процессе. Максимум, который он может вычислить, равен! 20 до переполнения, но вы все равно можете запустить его для больших чисел, если вас не волнует ответ и вы хотите, чтобы ваша система упала;)

#!/bin/bash
echo $(($1 * `( [[ $1 -gt 1 ]] && ./$0 $(($1 - 1)) ) || echo 1`));

Вот интересная версия Ruby. На моем ноуте найду 30000! менее чем за секунду. (Ruby требует больше времени, чтобы отформатировать его для печати, чем вычислить.) Это значительно быстрее, чем наивное решение простого умножения чисел по порядку.

def factorial (n)
  return multiply_range(1, n)
end

def multiply_range(n, m)
  if (m < n)
    return 1
  elsif (n == m)
    return m
  else
    i = (n + m) / 2
    return multiply_range(n, i) * multiply_range(i+1, m)
  end
end

Лучше всего простые решения:

#include <stdexcept>;

long fact(long f)
{
    static long fact [] = { 1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800, 479001600, 1932053504, 1278945280, 2004310016, 2004189184 };
    static long max     = sizeof(fact)/sizeof(long);

    if ((f < 0) || (f >= max))
    {   throw std::range_error("Factorial Range Error");
    }

    return fact[f];
}

Common Lisp: Лисп, как задумал Бог (то есть с LOOP)

(defun fact (n)
  (loop for i from 1 to n
        for acc = 1 then (* acc i)
        finally (return acc)))

Теперь, если кто-то может придумать версию на основе FORMAT ...

Common Lisp: FORMAT (запутанный)

Хорошо, я попробую сам.

(defun format-fact (stream arg colonp atsignp &rest args)
  (destructuring-bind (n acc) arg
    (format stream
            "~[~A~:;~*~/format-fact/~]"
            (1- n)
            acc
            (list (1- n) (* acc n)))))

(defun fact (n)
  (parse-integer (format nil "~/format-fact/" (list n 1))))

Должна быть более приятная, еще более непонятная реализация на основе FORMAT. Это довольно прямолинейно и скучно, просто использовать FORMAT в качестве замены IF. Очевидно, я не эксперт по ФОРМАТУ.

Рекурсивно в Inform 7

(он напоминает вам COBOL, потому что он предназначен для написания текстовых приключений; пропорциональный шрифт преднамерен):

To decide what number is the factorial of (n - a number):
    if n is zero, decide on one;
    otherwise decide on the factorial of (n minus one) times n.

Если вы действительно хотите вызвать эту функцию («фразу») из игры, вам необходимо определить действие и правило грамматики:

"The factorial game" [this must be the first line of the source]

There is a room. [there has to be at least one!]

Factorialing is an action applying to a number.

Understand "factorial [a number]" as factorialing.

Carry out factorialing:
    Let n be the factorial of the number understood;
    Say "It's [n]".

Scala: рекурсивный

• Должен компилироваться до хвостовой рекурсии. Должен!

.

def factorial( value: BigInt ): BigInt = value match {
  case 0 => 1
  case _ => value * factorial( value - 1 )
}

Оккам-пи

PROC subprocess(MOBILE CHAN INT parent.out!,parent.in?)
INT value:
  SEQ
    parent.in ? value
      IF 
        value = 1
          SEQ
            parent.out ! value
        OTHERWISE
          INITIAL MOBILE CHAN INT child.in IS MOBILE CHAN INT:
          INITIAL MOBILE CHAN INT child.out IS MOBILE CHAN INT:
          FORKING
            INT newvalue:
            SEQ
              FORK subprocess(child.in!,child.out?)
              child.out ! (value-1)
              child.in ? newvalue
              parent.out ! (newalue*value)
:

PROC main(CHAN BYTE in?,src!,kyb?)
INITIAL INT value IS 0:
INITIAL MOBILE CHAN INT child.out is MOBILE CHAN INT
INITIAL MOBILE CHAN INT child.in is MOBILE CHAN INT
SEQ 
  WHILE TRUE
    SEQ
      subprocess(child.in!,child.out?)
      child.out ! value
      child.in ? value
      src ! value:
      value := value + 1
:

Значок

Рекурсивная функция

procedure factorial(n)
  return (0<n) * factorial(n-1) | 1
end

Я немного обманул, позволив отрицательным числам возвращать 1. Если вы хотите, чтобы это не удалось, учитывая отрицательный аргумент, это немного менее кратко:

  return (0<n) * factorial(n-1) | (n=0 & 1)

потом

write(factorial(3))
write(factorial(-1))
write(factorial(20))

отпечатки

6
2432902008176640000

Итерационный генератор

procedure factorials()
  local f,n
  f := 1; n := 0
  repeat suspend f *:= (n +:= 1)
end

потом

every write(factorials() \ 5)

отпечатки

1
2
6
24
120

Чтобы понять это: оценка целенаправленна и возвращается в случае неудачи. Не существует логического типа, и бинарные операторы, которые возвращали бы логическое значение в других языках, либо не работают, либо возвращают свой второй аргумент - за исключением |, который в контексте с одним значением возвращает свой первый аргумент, если он завершается успешно, в противном случае пытается его Второй аргумент. (в контексте с несколькими значениями он возвращает свой первый аргумент тогда его второй аргумент)

suspend похож на yield на других языках, за исключением того, что генератор не вызывается явно несколько раз для возврата результатов. Вместо, every запрашивает у своего аргумента все значения, но по умолчанию ничего не возвращает; это полезно с побочными эффектами (в данном случае с вводом-выводом).

\ ограничивает количество значений, возвращаемых генератором, которое в случае factorials будет бесконечным.

FoxPro:

function factorial
    parameters n
return iif ( n>0, n*factorial(n-1), 1)

OCaml

Чтобы никто не поверил, что OCaml и чудак идут рука об руку, я подумал, что предоставлю разумную реализацию факториала.

# let rec factorial n =
    if n=0 then 1 else n * factorial(n - 1);;

Не думаю, что я очень хорошо изложил свою позицию ...

AWK

#!/usr/bin/awk -f
{
    result=1;
    for(i=;i>0;i--){
        result=result*i;
    }
    print result;
}

Подлинно функциональная Java:

public final class Factorial {

  public static void main(String[] args) {
    final int n = Integer.valueOf(args[0]);
    System.out.println("Factorial of " + n + " is " + create(n).apply());
  }

  private static Function create(final int n) {
    return n == 0 ? new ZeroFactorialFunction() : new NFactorialFunction(n);
  }

  interface Function {
    int apply();
  }

  private static class NFactorialFunction implements Function {
    private final int n;
    public NFactorialFunction(final int n) {
      this.n = n;
    }
    @Override
    public int apply() {
      return n * Factorial.create(n - 1).apply();
    }
  }

  private static class ZeroFactorialFunction implements Function {
    @Override
    public int apply() {
      return 1;
    }
  }

}

Erlang: хвостовая рекурсивная

fac(0) -> 1;
fac(N) when N > 0 -> fac(N, 1).

fac(1, R) -> R;
fac(N, R) -> fac(N - 1, R * N).

#Language: T-SQL, C#
#Style: Custom Aggregate

Еще один безумный способ - создать собственный агрегат и применить его к временной таблице целых чисел 1..n.

/* ProductAggregate.cs */
using System;
using System.Data.SqlTypes;
using Microsoft.SqlServer.Server;

[Serializable]
[SqlUserDefinedAggregate(Format.Native)]
public struct product {
  private SqlDouble accum;
  public void Init() { accum = 1; }
  public void Accumulate(SqlDouble value) { accum *= value; }
  public void Merge(product value) { Accumulate(value.Terminate()); }
  public SqlDouble Terminate() { return accum; }
}

добавить это в sql

create assembly ProductAggregate from 'ProductAggregate.dll' with permission_set=safe -- mod path to point to actual dll location on disk.

create aggregate product(@a float) returns float external name ProductAggregate.product

создать таблицу (должен быть встроенный способ сделать это в SQL - хм. a вопрос для SO?)

select 1 as n into #n union select 2 union select 3 union select 4 union select 5

тогда наконец

select dbo.product(n) from #n

Приведенный ниже код является ироничным, однако, если учесть, что возвращаемое значение ограничено n жесткими кодировками 33 значений, это не так уж и плохо :)

public static int Factorial(int n)
{
    switch (n)
    {
        case 1:
            return 1;
        case 2:
            return 2;
        case 3:
            return 6;
        case 4:
            return 24;
        default:
            throw new Exception("Sorry, I can only count to 4");
    }

}

Факториал C# с использованием рекурсии в одной строке

private static int factorial(int n){ if (n == 0)return 1;else return n * factorial(n - 1); }

Perl6

sub factorial ($n) { [*] 1..$n }

Я почти не знаю Perl6. Но я предполагаю, что этот оператор [*] такой же, как product в Haskell.

Этот код работает на Мопсы и, возможно, на Попугай (я не проверял.)

Редактировать

Этот код тоже работает.

sub postfix:<!> ($n) { [*] 1..$n }

# This function(?) call like below ... It looks like mathematical notation.
say 10!;

Haskell:

factorial n = product [1..n]

Эйфелева

class
    APPLICATION
inherit
    ARGUMENTS

create
    make

feature -- Initialization

    make is
            -- Run application.
        local
            l_fact: NATURAL_64
        do
            l_fact := factorial(argument(1).to_natural_64)
            print("Result is: " + l_fact.out)
        end

    factorial(n: NATURAL_64): NATURAL_64 is
            --
        require
            positive_n: n >= 0
        do
            if n = 0 then
                Result := 1
            else
                Result := n * factorial(n-1)
            end
        end

end -- class APPLICATION

PostScript: хвостовой рекурсивный

/fact0 { dup 2 lt { pop } { 2 copy mul 3 1 roll 1 sub exch pop fact0 } ifelse } def
/fact { 1 exch fact0 } def

befunge-93

                                    v
>v"Please enter a number (1-16) : "0<
,:             >$*99g1-:99p#v_.25*,@
^_&:1-99p>:1-:!|10          < 
         ^     <

Эзотерический язык Криса Пресси из Технологии Кошачьего Глаза.

Округ Колумбия

Примечание: уничтожает регистры e и f:

[2++d]se[d1-d_1<fd0>e*]sf

Чтобы использовать, поместите значение, которое вы хотите взять факториалом в верхнюю часть стека, а затем выполните lfx (загрузите регистр f и выполните его), который затем вытолкнет верхнюю часть стека и подтолкнет факториал этого значения.

Объяснение: если вершина стека - x, то первая часть делает вершину стека похожей на (x, x-1). Если новая вершина стека неотрицательна, он вызывает факториал рекурсивно, поэтому теперь стек имеет вид (x, (x-1)!) для x> = 1 или (0, -1) для x = 0. Затем, если новая вершина стека отрицательна, он выполняет 2++d, который заменяет (0, -1) на (1, 1). Наконец, он умножает два верхних значения в стеке.

р - с использованием методов S4 (рекурсивно)

setGeneric( 'fct', function( x ) { standardGeneric( 'fct' ) } )
setMethod( 'fct', 'numeric', function( x ) { 
    lapply( x, function(a) { 
        if ( a == 0 ) 1 else a * fact( a - 1 ) 
    } )
} )

Имеет то преимущество, что вы можете передавать массивы чисел, и он их все обработает ...

например:

> fct( c( 3, 5, 6 ) )
[[1]]
[1] 6

[[2]]
[1] 120

[[3]]
[1] 720

Perl (Y-комбинатор / Функциональный)

print sub {
  my $f = shift;
  sub {
    my $f1 = shift;
    $f->( sub { $f1->( $f1 )->( @_ ) } )
  }->( sub {
    my $f2 = shift;
    $f->( sub { $f2->( $f2 )->( @_ ) } )
  } )
}->( sub {
  my $h = shift;
  sub {
    my $n = shift;
    return 1 if $n <=1;
    return $n * $h->($n-1);
  }
})->(5);

Все после «print» и до «-> (5)» представляет подпрограмму. Факториальная часть находится в последнем "sub {...}". Все остальное - реализовать Y-комбинатор.

Четвертый (рекурсивный):

: factorial ( n -- n )
    dup 1 > if
        dup 1 - recurse *
    else
        drop 1
     then
;

XSLT 1.0

Входной файл factorial.xml:

<?xml version = "1.0"?>
<?xml-stylesheet href = "factorial.xsl" type = "text/xsl" ?>
<n>
  20
</n>

Файл XSLT, factorial.xsl:

<?xml version = "1.0"?>
<xsl:stylesheet version = "1.0"                     
                xmlns:xsl = "http://www.w3.org/1999/XSL/Transform"
                xmlns:msxsl = "urn:schemas-microsoft-com:xslt" >
  <xsl:output method = "text"/>
  <!-- 0! = 1 -->
  <xsl:template match = "text()[. = 0]">
    1
  </xsl:template>
  <!-- n! = (n-1)! * n-->
  <xsl:template match = "text()[. > 0]">
    <xsl:variable name = "x">
      <xsl:apply-templates select = "msxsl:node-set( . - 1 )/text()"/>
    </xsl:variable>
    <xsl:value-of select = "$x * ."/>
  </xsl:template>
  <!-- Calculate n! -->
  <xsl:template match = "/n">
    <xsl:apply-templates select = "text()"/>
  </xsl:template>
</xsl:stylesheet>

Сохраните оба файла в одном каталоге и откройте factorial.xml в IE.

J

   fact=. verb define
*/ >:@i. y
)

Iswim / Lucid:

factorial = 1 fby factorial * (time+1);

Python, один лайнер:

Немного более чистый, чем другой ответ Python. Этот и предыдущий ответ завершатся ошибкой, если ввод меньше 1.

def fact (n): вернуть сокращение (int.мул, xrange (2, n))

Clojure

Хвостовой рекурсивный

(defn fact 
  ([n] (fact n 1))
  ([n acc] (if (= n 0) 
               acc 
               (recur (- n 1) (* acc n)))))

Коротко и просто

 (defn fact [n] (apply * (range 1 (+ n 1))))

Common Lisp

• Назовите это по имени: !
• Рекурсивный хвост
• Common Lisp обрабатывает произвольно большие числа

(defun ! (n)
  "factorial"
  (labels ((fac (n prod)
             (if (zerop n)
                 prod
                 (fac (- n 1) (* prod n)))))
    (fac n 1)))

редактировать: или с аккумулятором в качестве необязательного параметра:

(defun ! (n &optional prod)
  "factorial"
  (if (zerop n)
      prod
      (! (- n 1) (* prod n))))

или как сокращение, за счет большего объема памяти и более затратных:

(defun range (start end &optional acc)
  "range from start inclusive to end exclusive, start = start end)
      (nreverse acc)
      (range (+ start 1) end (cons start acc))))

(defun ! (n)
  "factorial"
  (reduce #'* (range 1 (+ n 1))))

Фактор

ИСПОЛЬЗОВАНИЕ: math.ranges

: факториал (n - n!) 1 [a, b] произведение;

Scala

Факториал можно определить функционально как:

def fact(n: Int): BigInt = 1 to n reduceLeft(_*_)

или более традиционно как

def fact(n: Int): BigInt = if (n == 0) 1 else fact(n-1) * n

и мы можем сделать! допустимый метод для Ints:

object extendBuiltins extends Application {

  class Factorizer(n: Int) {
    def ! = 1 to n reduceLeft(_*_)
  }

  implicit def int2fact(n: Int) = new Factorizer(n)

  println("10! = " + (10!))
}

Время компиляции в C++

template<unsigned i>
struct factorial
{ static const unsigned value = i * factorial<i-1>::value; };

template<>
struct factorial<0>
{ static const unsigned value = 1; };

Используйте в коде как:

Factorial<5>::value

Haskell

factorial n = product [1..n]

Программист-первокурсник на Haskell

fac n = if n == 0 
           then 1
           else n * fac (n-1)

Программист-второкурсник на Haskell, Массачусетский технологический институт (изучал Схему на первом курсе)

fac = (\(n) ->
        (if ((==) n 0)
            then 1
            else ((*) n (fac ((-) n 1)))))

Младший программист Haskell (начинающий игрок на пеано)

fac  0    =  1
fac (n+1) = (n+1) * fac n

Еще один молодой программист на Haskell (читаем, что n + k шаблонов - «отвратительная часть Haskell» [1] и присоединился к движению «Ban n + k patterns» [2])

fac 0 = 1
fac n = n * fac (n-1)

Старший программист Haskell (проголосовал за Никсона Бьюкенена Буша - «наклоняется вправо»)

fac n = foldr (*) 1 [1..n]

Другой старший программист Haskell (проголосовали за Макговерн Биафра Надер - «наклоняется влево»)

fac n = foldl (*) 1 [1..n]

Еще один старший программист Haskell (наклонился так далеко вправо, что снова вернулся влево!)

-- using foldr to simulate foldl

fac n = foldr (\x g n -> g (x*n)) id [1..n] 1

Программист Memoizing Haskell (принимает гинкго билоба ежедневно)

facs = scanl (*) 1 [1..]

fac n = facs !! n

Бессмысленный (кхм) программист на Haskell без точек (учился в Оксфорде)

fac = foldr (*) 1 . enumFromTo 1

Итеративный программист на Haskell (бывший программист Pascal)

fac n = result (for init next done)
        where init = (0,1)
              next   (i,m) = (i+1, m * (i+1))
              done   (i,_) = i==n
              result (_,m) = m

for i n d = until d n i

Итеративный однострочный программист на Haskell (бывший программист APL и C)

fac n = snd (until ((>n) . fst) (\(i,m) -> (i+1, i*m)) (1,1))

Накапливающий программист Haskell (готовясь к быстрой кульминации)

facAcc a 0 = a
facAcc a n = facAcc (n*a) (n-1)

fac = facAcc 1

Программист с продолжением обучения на Haskell (в ранние годы выращивал КРОЛИКОВ, затем переехал в Нью-Джерси)

facCps k 0 = k 1
facCps k n = facCps (k . (n *)) (n-1)

fac = facCps id

Программист Boy Scout Haskell (любит завязывать узлы; всегда «благоговейный», он принадлежит Церкви наименьшей неподвижной точки [8])

y f = f (y f)

fac = y (\f n -> if (n==0) then 1 else n * f (n-1))

Комбинаторный программист на Haskell (избегает переменных, если не обфускации; все это каррирование - всего лишь фаза, хотя и редко мешает)

s f g x = f x (g x)

k x y   = x

b f g x = f (g x)

c f g x = f x g

y f     = f (y f)

cond p f g x = if p x then f x else g x

fac  = y (b (cond ((==) 0) (k 1)) (b (s (*)) (c b pred)))

Программист Haskell, кодирующий списки (предпочитает считать одинарным)

arb = ()    -- "undefined" is also a good RHS, as is "arb" :)

listenc n = replicate n arb
listprj f = length . f . listenc

listprod xs ys = [ i (x,y) | x<-xs, y<-ys ]
                 where i _ = arb

facl []         = listenc  1
facl n@(_:pred) = listprod n (facl pred)

fac = listprj facl

Программист-интерпретатор Haskell (никогда не «встречал язык», который ему не нравился)

-- a dynamically-typed term language

data Term = Occ Var
          | Use Prim
          | Lit Integer
          | App Term Term
          | Abs Var  Term
          | Rec Var  Term

type Var  = String
type Prim = String


-- a domain of values, including functions

data Value = Num  Integer
           | Bool Bool
           | Fun (Value -> Value)

instance Show Value where
  show (Num  n) = show n
  show (Bool b) = show b
  show (Fun  _) = ""

prjFun (Fun f) = f
prjFun  _      = error "bad function value"

prjNum (Num n) = n
prjNum  _      = error "bad numeric value"

prjBool (Bool b) = b
prjBool  _       = error "bad boolean value"

binOp inj f = Fun (\i -> (Fun (\j -> inj (f (prjNum i) (prjNum j)))))


-- environments mapping variables to values

type Env = [(Var, Value)]

getval x env =  case lookup x env of
                  Just v  -> v
                  Nothing -> error ("no value for " ++ x)


-- an environment-based evaluation function

eval env (Occ x) = getval x env
eval env (Use c) = getval c prims
eval env (Lit k) = Num k
eval env (App m n) = prjFun (eval env m) (eval env n)
eval env (Abs x m) = Fun  (\v -> eval ((x,v) : env) m)
eval env (Rec x m) = f where f = eval ((x,f) : env) m


-- a (fixed) "environment" of language primitives

times = binOp Num  (*)

minus = binOp Num  (-)
equal = binOp Bool (==)
cond  = Fun (\b -> Fun (\x -> Fun (\y -> if (prjBool b) then x else y)))

prims = [ ("*", times), ("-", minus), ("= = ", equal), ("if", cond) ]


-- a term representing factorial and a "wrapper" for evaluation

facTerm = Rec "f" (Abs "n" 
              (App (App (App (Use "if")
                   (App (App (Use "= = ") (Occ "n")) (Lit 0))) (Lit 1))
                   (App (App (Use "*")  (Occ "n"))
                        (App (Occ "f")  
                             (App (App (Use "-") (Occ "n")) (Lit 1))))))

fac n = prjNum (eval [] (App facTerm (Lit n)))

Статический программист Haskell (он делает это с классом, у него есть тот фандеп, Джонс! По мотивам книги Томаса Халлгрена «Развлечение с функциональными зависимостями» [7])

-- static Peano constructors and numerals

data Zero
data Succ n

type One   = Succ Zero
type Two   = Succ One
type Three = Succ Two
type Four  = Succ Three


-- dynamic representatives for static Peanos

zero  = undefined :: Zero
one   = undefined :: One
two   = undefined :: Two
three = undefined :: Three
four  = undefined :: Four


-- addition, a la Prolog

class Add a b c | a b -> c where
  add :: a -> b -> c

instance              Add  Zero    b  b
instance Add a b c => Add (Succ a) b (Succ c)


-- multiplication, a la Prolog

class Mul a b c | a b -> c where
  mul :: a -> b -> c

instance                           Mul  Zero    b Zero
instance (Mul a b c, Add b c d) => Mul (Succ a) b d


-- factorial, a la Prolog

class Fac a b | a -> b where
  fac :: a -> b

instance                                Fac  Zero    One
instance (Fac n k, Mul (Succ n) k m) => Fac (Succ n) m

-- try, for "instance" (sorry):
-- 
--     :t fac four

Начинающий программист на Haskell (высшее образование обычно освобождает от мелких забот о, например, эффективности аппаратных целых чисел)

-- the natural numbers, a la Peano

data Nat = Zero | Succ Nat


-- iteration and some applications

iter z s  Zero    = z
iter z s (Succ n) = s (iter z s n)

plus n = iter n     Succ
mult n = iter Zero (plus n)


-- primitive recursion

primrec z s  Zero    = z
primrec z s (Succ n) = s n (primrec z s n)


-- two versions of factorial

fac  = snd . iter (one, one) (\(a,b) -> (Succ a, mult a b))
fac' = primrec one (mult . Succ)


-- for convenience and testing (try e.g. "fac five")

int = iter 0 (1+)

instance Show Nat where
  show = show . int

(zero : one : two : three : four : five : _) = iterate Succ Zero

Программист Origamist Haskell (всегда начинается с «базовой птичьей фолда»)

-- (curried, list) fold and an application

fold c n []     = n
fold c n (x:xs) = c x (fold c n xs)

prod = fold (*) 1


-- (curried, boolean-based, list) unfold and an application

unfold p f g x = 
  if p x 
     then [] 
     else f x : unfold p f g (g x)

downfrom = unfold (==0) id pred


-- hylomorphisms, as-is or "unfolded" (ouch! sorry ...)

refold  c n p f g   = fold c n . unfold p f g

refold' c n p f g x = 
  if p x 
     then n 
     else c (f x) (refold' c n p f g (g x))


-- several versions of factorial, all (extensionally) equivalent

fac   = prod . downfrom
fac'  = refold  (*) 1 (==0) id pred
fac'' = refold' (*) 1 (==0) id pred

Программист на языке Haskell с картезианским уклоном (предпочитает греческую еду, избегает острых индийских блюд; вдохновленный работой Лекса Огюстейна «Сортировка морфизмов» [3])

-- (product-based, list) catamorphisms and an application

cata (n,c) []     = n
cata (n,c) (x:xs) = c (x, cata (n,c) xs)

mult = uncurry (*)
prod = cata (1, mult)


-- (co-product-based, list) anamorphisms and an application

ana f = either (const []) (cons . pair (id, ana f)) . f

cons = uncurry (:)

downfrom = ana uncount

uncount 0 = Left  ()
uncount n = Right (n, n-1)


-- two variations on list hylomorphisms

hylo  f  g    = cata g . ana f

hylo' f (n,c) = either (const n) (c . pair (id, hylo' f (c,n))) . f

pair (f,g) (x,y) = (f x, g y)


-- several versions of factorial, all (extensionally) equivalent

fac   = prod . downfrom
fac'  = hylo  uncount (1, mult)
fac'' = hylo' uncount (1, mult)

Кандидат наук. Программист Haskell (съел столько бананов, что глаза вылезли, теперь ему нужны новые линзы!)

-- explicit type recursion based on functors

newtype Mu f = Mu (f (Mu f))  deriving Show

in      x  = Mu x
out (Mu x) = x


-- cata- and ana-morphisms, now for *arbitrary* (regular) base functors

cata phi = phi . fmap (cata phi) . out
ana  psi = in  . fmap (ana  psi) . psi


-- base functor and data type for natural numbers,
-- using a curried elimination operator

data N b = Zero | Succ b  deriving Show

instance Functor N where
  fmap f = nelim Zero (Succ . f)

nelim z s  Zero    = z
nelim z s (Succ n) = s n

type Nat = Mu N


-- conversion to internal numbers, conveniences and applications

int = cata (nelim 0 (1+))

instance Show Nat where
  show = show . int

zero = in   Zero
suck = in . Succ       -- pardon my "French" (Prelude conflict)

plus n = cata (nelim n     suck   )
mult n = cata (nelim zero (plus n))


-- base functor and data type for lists

data L a b = Nil | Cons a b  deriving Show

instance Functor (L a) where
  fmap f = lelim Nil (\a b -> Cons a (f b))

lelim n c  Nil       = n
lelim n c (Cons a b) = c a b

type List a = Mu (L a)


-- conversion to internal lists, conveniences and applications

list = cata (lelim [] (:))

instance Show a => Show (List a) where
  show = show . list

prod = cata (lelim (suck zero) mult)

upto = ana (nelim Nil (diag (Cons . suck)) . out)

diag f x = f x x

fac = prod . upto

Пост-документ, программист на Haskell (из «Схемы рекурсии из комонад» Уусталу, Вене и Пардо [4])

-- explicit type recursion with functors and catamorphisms

newtype Mu f = In (f (Mu f))

unIn (In x) = x

cata phi = phi . fmap (cata phi) . unIn


-- base functor and data type for natural numbers,
-- using locally-defined "eliminators"

data N c = Z | S c

instance Functor N where
  fmap g  Z    = Z
  fmap g (S x) = S (g x)

type Nat = Mu N

zero   = In  Z
suck n = In (S n)

add m = cata phi where
  phi  Z    = m
  phi (S f) = suck f

mult m = cata phi where
  phi  Z    = zero
  phi (S f) = add m f


-- explicit products and their functorial action

data Prod e c = Pair c e

outl (Pair x y) = x
outr (Pair x y) = y

fork f g x = Pair (f x) (g x)

instance Functor (Prod e) where
  fmap g = fork (g . outl) outr


-- comonads, the categorical "opposite" of monads

class Functor n => Comonad n where
  extr :: n a -> a
  dupl :: n a -> n (n a)

instance Comonad (Prod e) where
  extr = outl
  dupl = fork id outr


-- generalized catamorphisms, zygomorphisms and paramorphisms

gcata :: (Functor f, Comonad n) =>
           (forall a. f (n a) -> n (f a))
             -> (f (n c) -> c) -> Mu f -> c

gcata dist phi = extr . cata (fmap phi . dist . fmap dupl)

zygo chi = gcata (fork (fmap outl) (chi . fmap outr))

para :: Functor f => (f (Prod (Mu f) c) -> c) -> Mu f -> c
para = zygo In


-- factorial, the *hard* way!

fac = para phi where
  phi  Z             = suck zero
  phi (S (Pair f n)) = mult f (suck n)


-- for convenience and testing

int = cata phi where
  phi  Z    = 0
  phi (S f) = 1 + f

instance Show (Mu N) where
  show = show . int

Штатный профессор (обучение Haskell первокурсникам)

fac n = product [1..n]

Smalltalk, используя закрытие

    fac := [ :x | x = 0 ifTrue: [ 1 ] ifFalse: [ x * (fac value: x -1) ]].

    Transcript show: (fac value: 24) "-> 620448401733239439360000"

NB не работает в Squeak, требует полного закрытия.

Smalltalk, мемоизированный

Определите метод в словаре

Dictionary >> fac: x
    ^self at: x ifAbsentPut: [ x * (self fac: x - 1) ]

использование

 d := Dictionary new.
 d at: 0 put: 1.
 d fac: 24 

Smalltalk, 1-строчный

(1 to: 24) inject: 1 into: [ :a :b | a * b ] 

Java Script: творческий метод, использующий «вопрос для собеседования», считающий биты fnc.

function nu(x)
{
  var r=0
  while( x ) {
    x &= x-1
    r++
  }
  return r
}

function fac(n)
{
  var r= Math.pow(2,n-nu(n))

  for ( var i=3 ; i <= n ; i+= 2 )
    r *= Math.pow(i,Math.floor(Math.log(n/i)/Math.LN2)+1)
  return r
}

Работает до 21 года! затем Chrome переходит на научную нотацию. Вдохновение благодаря недостатку сна и «конкретной математике» Кнута и других.

Нет ничего быстрее, чем трепать & до н.э:

function fac { seq  | paste -sd* | bc; }  
$ fac 42
1405006117752879898543142606244511569936384000000000
$

В MUMPS:

fact(N)
  N F,I S F=1 F  I=2:1:N S F=F*I
  QUIT F

Или, если вы поклонник косвенного обращения:

fact(N)
  N F,I S F=1 F I=2:1:N S F=F_"*"_I
  QUIT @F

Mathematica: нерекурсивный

fact[n_] := Times @@ Range[n]

Это синтаксический сахар для Apply[Times, Range[n]]. Я считаю, что это лучший способ, не считая, конечно, встроенного n!. Обратите внимание, что это автоматически использует bignums.

Версия Common Lisp:

(defun ! (n) (reduce #'* (loop for i from 2 below (+ n 1) collect i)))

Вроде бы довольно быстро.

* (! 42)

1405006117752879898543142606244511569936384000000000

Common Lisp, поскольку этого еще никто не делал:

(defun factorial (n)
  (if (<= n 1)
      1 
      (* n (factorial (1- n)))))

Brainfuck: с большой поддержкой!

Принимает в качестве входных данных неотрицательное целое число, за которым следует новая строка, и выводит соответствующий факториал, за которым следует новая строка.

>>>>,----------[>>>>,----------]>>>>++<<<<<<<<[>++++++[<----
-->-]<-<<<<]>>>>[[>>+<<-]>>[<<+>+>-]<->+<[>>>>+<<<-<[-]]>[-]
>>]>[-<<<<<[<<<<]>>>>[[>>+<<-]>>[<<+>+>-]>>]>>>>[-[>+<-]+>>>
>]<<<<[<<<<]<<<<[<<<<]>>>>>[>>>[>>>>]>>>>[>>>>]<<<<[[>>>>+<<
<<-]<<<<]>>>>+<<<<<<<[<<<<]>>>>-[>>>[>>>>]>>>>[>>>>]<<<<[>>>
+<<<-]>>>[<<<+>>+>-]<-[>>+<<[-]]<<[<<<<]>>>>[>[>+<-]>[<<+>+>
-]<<[>>>+<<<-]>>>[<<<+>>+>-]<->+++++++++[-<[-[>>>>+<<<<-]]>>
>>[<<<<+>>>>-]<<<]<[>>+<<<<[-]>>[<<+>>-]]>>]<<<<[<<<<]<<<[<<
<<]>>>>-]>>>>]>>>[>[-]>>>]<<<<[>>+<<-]>>[<<+>+>-]<->+<[>-<[-
]]>[-<<-<<<<[>>+<<-]>>[<<+>+>-]<->+<[>-<[-]]>]<<[<<<<]<<<<-[
>>+<<-]>>[<<+>+>-]+<[>-<[-]]>[-<<++++++++++<<<<-[>>+<<-]>>[<
<+>+>-]+<[>-<[-]]>]<<[<<<<]>>>>[[>>+<<-]>>[<<+>+>-]<->+<[>>>
>+<<<-<[-]]>[-]>>]>]>>>[>>>>]<<<<[>+++++++[<+++++++>-]<--.<<
<<]++++++++++.

В отличие от мозгового ответа, опубликованного ранее, этот не переполняет любые ячейки памяти. (Эта реализация помещает n! В одну ячейку памяти, эффективно ограничивая его значением n меньше 6 в соответствии со стандартными правилами bf.) Эта программа выведет n! для любого значения n, ограниченного только временем и памятью (или реализацией bf). Например, при использовании компилятора Urban Muller на моей машине вычисление 1000 занимает 12 секунд! Я думаю, что это неплохо, учитывая, что программа может двигаться только влево / вправо и увеличивать / уменьшать на единицу.

Вы не поверите, но это первая программа для bf, которую я написал; это заняло около 10 часов, которые в основном были потрачены на отладку. К сожалению, позже я узнал, что Дэниел Б. Кристофани написал факторный генератор, который просто выводит все более крупные факториалы, никогда не заканчиваясь:

>++++++++++>>>+>+[>>>+[-[<<<<<[+<<<<<]>>[[-]>[<<+>+>-]<[>+<-
]<[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>[-]>>>>+>+<
<<<<<-[>+<-]]]]]]]]]]]>[<+>-]+>>>>>]<<<<<[<<<<<]>>>>>>>[>>>>
>]++[-<<<<<]>>>>>>-]+>>>>>]<[>++<-]<<<<[<[>+<-]<<<<]>>[->[-]
++++++[<++++++++>-]>>>>]<<<<<[<[>+>+<<-]>.<<<<<]>.>>>>]

Его программа намного короче, но он практически профессиональный игрок в гольф.

Полиглот: 5 языков, на всех используются большие буквы.

Итак, я написал полиглот, который работает на трех языках, на которых я часто пишу, а также на одном из моих ответов на этот вопрос и на одном, который я только что выучил сегодня. Это автономная программа, которая считывает одну строку, содержащую неотрицательное целое число, и печатает одну строку, содержащую его факториал. Бигнумы используются на всех языках, поэтому максимальный вычислимый факториал зависит только от ресурсов вашего компьютера.

• Perl: использует встроенный пакет bignum. Запустите perl FILENAME.
• Haskell: использует встроенные бигнумы. Запустите runhugs FILENAME или эквивалент вашего любимого компилятора.
• C++: требуется GMP для поддержки bignum. Для компиляции с g ++ используйте g++ -lgmpxx -lgmp -x c++ FILENAME для компоновки с нужными библиотеками. После компиляции запустите ./a.out. Или используйте эквивалент вашего любимого компилятора.
• мозгф * ск: Я написал некоторую поддержку bignum в эта почта. Используя Классическая раздача Мюллера, скомпилируйте с bf < FILENAME > EXECUTABLE. Сделайте выходной исполняемый файл и запустите его. Или используйте свой любимый дистрибутив.
• Пробел: использует встроенную поддержку bignum. Запустите wspace FILENAME.

Редактировать: добавил Whitespace в качестве пятого языка. Между прочим, нет оборачивает код тегами <code>; он разбивает пробел. Кроме того, код с фиксированной шириной выглядит намного лучше.

char //# b=0+0{- |0*/; #>>>>,----------[>>>>,--------
#define	a/*#--]>>>>++<<<<<<<<[>++++++[<------>-]<-<<<
#Perl	><><><>	 <> <> <<]>>>>[[>>+<<-]>>[<<+>+>-]<->
#C++	--><><>	<><><><	> < > <	+<[>>>>+<<<-<[-]]>[-]
#Haskell >>]>[-<<<<<[<<<<]>>>>[[>>+<<-]>>[<<+>+>-]>>]
#Whitespace	>>>>[-[>+<-]+>>>>]<<<<[<<<<]<<<<[<<<<
#brainf*ck > < ]>>>>>[>>>[>>>>]>>>>[>>>>]<<<<[[>>>>*/
exp; ;//;#+<<<<-]<<<<]>>>>+<<<<<<<[<<<<][.POLYGLOT^5.
#include <gmpxx.h>//]>>>>-[>>>[>>>>]>>>>[>>>>]<<<<[>>
#define	eval int	main()//>+<<<-]>>>[<<<+>>+>->
#include <iostream>//<]<-[>>+<<[-]]<<[<<<<]>>>>[>[>>>
#define	print std::cout	<< // >	<+<-]>[<<+>+>-]<<[>>>
#define	z std::cin>>//<< +<<<-]>>>[<<<+>>+>-]<->+++++
#define c/*++++[-<[-[>>>>+<<<<-]]>>>>[<<<<+>>>>-]<<*/
#define	abs int $n //><	<]<[>>+<<<<[-]>>[<<+>>-]]>>]<
#define	uc mpz_class fact(int	$n){/*<<<[<<<<]<<<[<<
use bignum;sub#<<]>>>>-]>>>>]>>>[>[-]>>>]<<<<[>>+<<-]
z{$_[0+0]=readline(*STDIN);}sub fact{my($n)=shift;#>>
#[<<+>+>-]<->+<[>-<[-]]>[-<<-<<<<[>>+<<-]>>[<<+>+>+*/
uc;if ($n==0){return 1;}return $n*fact($n-1);	}//;#
eval{abs;z($n);print fact($n);print("\n")/*2;};#-]<->
'+<[>-<[-]]>]<<[<<<<]<<<<-[>>+<<-]>>[<<+>+>-]+<[>-+++
-}--	<[-]]>[-<<++++++++++<<<<-[>>+<<-]>>[<<+>+>-++
fact 0	= 1 -- ><><><><	> <><><	]+<[>-<[-]]>]<<[<<+ +
fact	n=n*fact(n-1){-<<]>>>>[[>>+<<-]>>[<<+>+++>+-}
main=do{n<-readLn;print(fact n)}-- +>-]<->+<[>>>>+<<+
{-x<-<[-]]>[-]>>]>]>>>[>>>>]<<<<[>+++++++[<+++++++>-]
<--.<<<<]+written+by+++A+Rex+++2009+.';#+++x-}--x*/;}

ActionScript: процедурный / ООП

function f(n) {
    var result = n>1 ? arguments.callee(n-1)*n : 1;
    return result;
}
// function call
f(3);

Common Lisp

Я почти уверен, что это могло бы быть более эффективным. Это моя первая функция lisp, кроме "hello, world" и ввода кода примера из третьей главы. Практический Common Lisp - отличный текст. Эта функция действительно хорошо обрабатывает большие факториалы.

(defun factorial (x)
  (if (< x 2) (return-from factorial (print 1)))
  (let ((tempx 1) (ans 1))
  (loop until (equalp x tempx) do
       (incf tempx)
       (setf ans (* tempx ans)))
  (list ans)))

Delphi итеративная

Хотя рекурсия может быть единственным достойным решением проблемы, для факториалов это не так. Чтобы описать это, да. Чтобы его запрограммировать, нет. Итерация самая дешевая.

Эта функция вычисляет факториалы для более крупных аргументов.

function Factorial(aNumber: Int64): String;
var
  F: Double;
begin
  F := 0;
  while aNumber > 1 do begin
    F := F + log10(aNumber);
    dec(aNumber);
  end;
  Result := FloatToStr(Power(10, Frac(F))) + ' * 10^' + IntToStr(Trunc(F));
end;

1000000! = 8,2639327850046 * 10 ^ 5565708

Хм ... нет TCL

proc factorial {n} {
  if { $n == 0 } { return 1 }
  return [expr {$n*[factorial [expr {$n-1}]]}]
}
puts [factorial 6]

Но, конечно, это ни черта не работает для больших значений n .... мы можем добиться большего с помощью tcllib!

package require math::bignum
proc factorial {n} {
  if { $n == 0 } { return 1 }
  return [ ::math::bignum::tostr [ ::math::bignum::mul [
    ::math::bignum::fromstr $n] [ ::math::bignum::fromstr [
      factorial [expr {$n-1} ]
    ]]]]
}
puts [factorial 60]

Посмотрите на все эти] в конце. Это практически LISP!

Я оставлю версию для значений n> 2 ^ 32 в качестве упражнения для читателя.

Логотип

? to factorial :n
> ifelse :n = 0 [output 1] [output :n * factorial :n - 1]
> end

И вызвать:

? print factorial 5
120

Здесь используется диалект логотипа UCBLogo.

Mathematica, Memoized

f[n_ /; n < 2] := 1
f[n_] := (f[n] = n*f[n - 1])

Mathematica поддерживает! изначально, но это показывает, как делать определения на лету. Когда вы выполняете f [2], этот код создает определение f [2] = 2, которое впоследствии будет выполняться не иначе, чем если бы вы его жестко запрограммировали; нет необходимости во внутренней структуре данных; вы просто используете собственный механизм определения функций языка.

Лисп: хвостовая рекурсивная

(defun factorial(x)
  (labels((f (x acc)
             (if (> x 1)
                 (f (1- x)(* x acc))
                 acc)))
         (f x 1)))

Agda2

Это Agda2 с очень красивым синтаксисом Agda2.

module fac where

data Nat : Set where        -- Peano numbers
  zero : Nat
  suc : Nat -> Nat
{-# BUILTIN NATURAL Nat #-}
{-# BUILTIN SUC suC#-}
{-# BUILTIN ZERO zero #-}

infixl 10 _+_               -- Addition over Peano numbers
_+_ : Nat -> Nat -> Nat
zero + n    = n
(suc n) + m = suc (n + m)

infixl 20 _*_               -- Multiplication over Peano numbers
_*_ : Nat -> Nat -> Nat
zero * n = zero
n * zero = zero
(suc n) * (suc m) = suc n + (suc n * m)

_! : Nat -> Nat             -- Factorial function, syntax: "x !"
zero ! = suc zero
(suc n) ! = (suc n) * (n !)

Еще один рубиновый.

class Integer
  def fact
    return 1 if self.zero?
    (1..self).to_a.inject(:*)
  end
end

Это работает, если to_proc поддерживается символами.

Perl, пессимальный:

# Because there are just so many other ways to get programs wrong...
use strict;
use warnings;

sub factorial {
    my ($x)=@_;

    for(my $f=1;;$f++) {
        my $tmp=$f;
        foreach my $g (1..$x) {
           $tmp/=$g;
        }
        return $f if $tmp == 1;
    }
}

Надеюсь, я получаю дополнительные баллы за то, что не использую оператор '*' ...

REBOL

Математика - это определенно, а не одна из сильных сторон REBOL, поскольку в ней отсутствуют целые числа произвольной точности. Для полноты картины подумал, что все равно добавлю.

Вот стандартная наивная рекурсивная реализация:

fac: func [ [catch] n [integer!] ] [
    if n < 0 [ throw make error! "Hey dummy, your argument was less than 0!" ]
    either n = 0 [ 1 ] [
        n * fac (n - 1)
    ]
]

Вот и все. Идите, ребята, здесь нечего смотреть ... :)

Вот мое предложение. Работает в Mathematica, отлично работает:

gen[f_, n_] := Module[{id = -1, val = Table[Null, {n}], visit},
  visit[k_] := Module[{t},
    id++; If[k != 0, val[[k]] = id];
    If[id == n, f[val]];
    Do[If[val[[t]] == Null, visit[t]], {t, 1, n}];
    id--; val[[k]] = Null;];
  visit[0];
  ]

Factorial[n_] := Module[{res=0}, gen[res++&, n]; res]

Обновлять Хорошо, вот как это работает: функция посещения взята из книги алгоритмов Седжвика, она "посещает" все перестановки длины n. Во время посещения он вызывает функцию f с перестановкой в ​​качестве аргумента.

Итак, Factorial перечисляет все перестановки длины n, и для каждой перестановки счетчик res увеличивается, таким образом вычисляя n! за O (n + 1)! время.

Python:

def factorial(n):
    return reduce(lambda x, y: x * y,range(1, n + 1))

PHP - 59 символов

function f($n){return array_reduce(range(1,$n),'bcmul',1);}

Улучшенная версия - 27 символов

array_product(range(1,$n));

* Оболочка NIX

Версия для Linux:

seq -s'*' 42 | bc

Версия BSD:

jot -s'*' 42 | bc

SETL

... откуда Haskell и Python позаимствовали свои представления о списках.

proc factorial(n);
    return 1 */ {1..n};
end factorial;

А встроенный тип INTEGER имеет произвольную точность, поэтому он будет работать для любого положительного n.

Befunge:

0&>:1-:v v *_$.@ 
  ^    _$>\:^

ЗАКРЫТЬ

Я вижу, как решения Common Lisp злоупотребляют рекурсией, LOOP и даже FORMAT. Думаю, пора кому-нибудь написать решение, злоупотребляющее CLOS!

(defgeneric factorial (n))
(defmethod factorial ((n (eql 0))) 1)
(defmethod factorial ((n integer)) (* n (factorial (1- n))))

(Может ли диспетчер объектной системы вашего любимого языка сделать это?)

Golfscript: конечно, предназначен для игры в гольф

~),1>{*}*

• ~ оценивает входную строку (до целого числа)
• ) увеличивает число
• , - это диапазон (4, становится [0 1 2 3])
• 1> выбирает значения с индексом 1 или больше
• {*}* складывает умножение по списку
• Содержимое стека печатается при завершении программы.

Бежать:

echo 5 | ruby gs.rb fact.gs

FORTH, итеративный 1 лайнер

: FACT 1 SWAP 1 + 1 DO I * LOOP ;

О, fork () это еще один пример на Perl

Это будет использовать ваши многоядерные процессоры ... хотя, возможно, не самым эффективным образом. Оператор открыто клонирует процесс с помощью fork и открывает канал от дочернего процесса к родительскому. Работа по умножению чисел 2 за один раз делится между деревом очень короткоживущих процессов. Конечно, этот пример немного глупый. Дело в том, что если вам действительно нужно было выполнить более сложные вычисления, то этот пример иллюстрирует один из способов разделить работу параллельно.

#!/usr/bin/perl -w

use strict;
use bigint;

print STDOUT &main::rangeProduct(1,$ARGV[0])."\n";

sub main::rangeProduct {
    my($l, $h) = @_;
    return $l    if ($l==$h);
    return $l*$h if ($l==($h-1));
    # arghhh - multiplying more than 2 numbers at a time is too much work
    # find the midpoint and split the work up :-)
    my $m = int(($h+$l)/2);
    my $pid = open(my $KID, "-|");
      if ($pid){ # parent
        my $X = &main::rangeProduct($l,$m);
        my $Y = <$KID>;
        chomp($Y);
        close($KID);
        die "kid failed" unless defined $Y;
        return $X*$Y;
      } else {
        # kid
        print STDOUT &main::rangeProduct($m+1,$h)."\n";
        exit(0);
    }
}

В Ио:

factorial := method(n,
    if (list(0, 1) contains(n),
       1,
       n * factorial(n - 1)
    )
)

Схема эволюции

Программа регулярной схемы:

(define factorial
   (lambda (n)
     (if (= n 0)
         1
         (* n (factorial (- n 1))))))

Должно работать, но обратите внимание, что вызов этой функции для больших чисел будет расширять стек при каждой рекурсии, что плохо для таких языков, как C и Java.

Продолжение прохождения стиля

(define factorial
  (lambda (n)
    (factorial_cps n (lambda (k) k))))

(define factorial_cps
  (lambda (n k)
    (if (zero? n)
        (k 1)
        (factorial (- n 1) (lambda (v)
                             (k (* n v)))))))

Ах, таким образом мы не увеличиваем наш стек при каждой рекурсии, потому что вместо этого мы можем расширить продолжение. Однако в C нет продолжений.

Независимый от представления CPS

(define factorial
  (lambda (n)
    (factorial_cps n (k_))))

(define factorial_cps
  (lambda (n k)
    (if (zero? n)
        (apply_k 1)
        (factorial (- n 1) (k_extend n k))))

(define apply_k
  (lambda (ko v)
    (ko v)))
(define kt_empty
  (lambda ()
    (lambda (v) v)))
(define kt_extend 
  (lambda ()
    (lambda (v)
      (apply_k k (* n v)))))

Обратите внимание, что ответственность за представление продолжений, используемых в исходной программе CPS, была передана вспомогательным процедурам kt_.

Независимый от представления CPS с использованием союзов ParentheC

Поскольку представление продолжений находится во вспомогательных процедурах, мы можем переключиться на использование ParentheC вместо этого, при этом kt_ будет обозначением типа.

(define factorial
  (lambda (n)
    (factorial_cps n (kt_empty))))

(define factorial_cps
  (lambda (n k)
    (if (zero? n)
        (apply_k 1)
        (factorial (- n 1) (kt_extend n k))))

(define-union kt
  (empty)
  (extend n k))
(define apply_k
  (lambda ()
    (union-case kh kt
      [(empty) v]
      [(extend n k) (begin
                      (set! kh k)
                      (set! v (* n v))
                      (apply_k))])))

Батут, зарегистрированная программа ParentheC

Этого не достаточно. Теперь мы заменяем все вызовы функций, вместо этого устанавливая глобальные переменные и счетчик программы. Процедуры теперь являются метками, подходящими для операторов GOTO.

(define-registers n k kh v)
(define-program-counter pc)

(define-label main
  (begin
    (set! n 5) ; what is the factorial of 5??
    (set! pc factorial_cps)
    (mount-trampoline kt_empty k pc)
    (printf "Factorial of 5: ~d\n" v)))

(define-label factorial_cps
  (if (zero? n)
      (begin
        (set! kh k)
        (set! v 1)
        (set! pc apply_k))
      (begin
        (set! k (kt_extend n k))
        (set! n (- n 1))
        (set! pc factorial_cps))))

(define-union kt
  (empty dismount) ; get off the trampoline!
  (extend n k))

(define-label apply_k
  (union-case kh kt
    [(empty dismount) (dismount-trampoline dismount)]
    [(extend n k) (begin
                    (set! kh k)
                    (set! v (* n v))
                    (set! pc apply_k))]))

О, смотрите, у нас теперь тоже есть процедура main. Теперь все, что осталось сделать, это сохранить этот файл как fact5.pc и запустить его через pc2c ParentheC:

> (load "pc2c.ss")
> (pc2c "fact5.pc" "fact5.c" "fact5.h")

Может быть? У нас есть fact5.c и fact5.h. Давайте посмотрим...

$ gcc fact5.c -o fact5
$ ./fact5
Factorial of 5: 120

Успех! Мы преобразовали рекурсивную программу Scheme в нерекурсивную программу C! И для этого потребовалось всего несколько часов и множество отпечатков в форме лба на стене! Для удобства fact5.c и и fact5.h.

Python: функциональный, рекурсивный однострочник с использованием логической оценки короткого замыкания.

    factorial = lambda n: ((n <= 1) and 1) or factorial(n-1) * n

T-SQL: рекурсивный CTE

Встроенная табличная функция, использующая рекурсивное общее табличное выражение. SQL Server 2005 и выше.

CREATE FUNCTION dbo.Factorial(@n int) RETURNS TABLE
AS
RETURN
    WITH RecursiveCTE (N, Value) AS
    (
        SELECT 1, CAST(1 AS decimal(38,0))
        UNION ALL
        SELECT N+1, CAST(Value*(N+1) AS decimal(38,0))
        FROM RecursiveCTE
    )
    SELECT TOP 1 Value
    FROM RecursiveCTE
    WHERE N = @n

C++ constexpr

constexpr uint64_t fact(uint32_t n)
{
    return  (n==0) ? 1:n*fact(n-1);
}

Vb6:

Private Function factCalculation(ByVal Number%)
  Dim intNum%
  intNum = 1
  For i = 2 To Number
     intNum = intNum * Number
  Next i
  return intNum
End Function

Private Sub Form_Load()
 Dim FactResult% : FactResult = factCalculation(3) 'e.g
 Print FactResult
End Sub