Is there any way to make this Haskell program faster? - performance

Mind the following Haskell program:
-- Lambda Calculus ADT
data Term = Fun (Term -> Term) | Num !Double
instance Show Term where
show (Num x) = "(Num "++(if fromIntegral (floor x) == x then show (floor x) else show x)++")"
show (Fun _) = "(<function>)"
-- Lambda Calculus term application
(#) :: Term -> Term -> Term
(Fun f) # x = f x
infixl 0 #
-- We have floats as primitives for performance
float_toChurch :: Term
float_toChurch = Fun (\ (Num n) -> Fun (\f -> Fun (\x ->
if n <= 0
then x
else (f # (float_toChurch # (Num (n - 1)) # f # x)))))
float_add :: Term
float_add = Fun (\ (Num x) -> Fun (\ (Num y) -> Num (x + y)))
-- Function compiled from the Lambda Calculus.
-- It sums all nats from 0 til a number.
sum_til :: Term
sum_til = (Fun(\v0->((((((float_toChurch # v0) # (Fun(\v1->(Fun(\v2->(Fun(\v3->(Fun(\v4->((v3 # v2) # (((v1 # ((float_add # v2) # (Num 1))) # v3) # v4))))))))))) # (Fun(\v1->(Fun(\v2->(Fun(\v3->v3))))))) # (Num 0)) # (Fun(\v1->(Fun(\v2->((float_add # v2) # v1)))))) # (Num 0))))
-- Testing it
main = do
let n = 512*512*8
print $ (sum_til # (Num n))
Since there is no fast lambda calculator around, I'm using the strategy above to compile terms of the Untyped Lambda Calculus to Haskell in order to evaluate them fast. I'm impressed with the performance: that program creates a list of numbers from 0 to 2097152 and sums them all in less than a second on my computer. That is much faster than I expected - only 4 times slower than a Haskell direct equivalent - and sufficient to be useful for my goals. Yet, notice that I had to wrap functions and terms under the Fun/Num constructors in order to satisfy the type system. That boxing is probably not ideal. So, my question is: is it possible to run the same Lambda Calculus program and get the same result even faster? I.e., any way to remove the boxing? (Also, it doesn't need to use Haskell.)


I don't think you can keep Double and avoid wrapping. I think the closest you can get would be just
newtype Term = Term (Term -> Term)
But that's going to make arithmetic massively slower, I would imagine.
The only other thing I can think of is maybe trying to cache previous results to avoid recomputing them (but that could easily be slower, not faster).
I am curious to know what on Earth you've actually "using" this for though. ;-)

Related

Haskell State monad vs state as parameter performance test

I start to learn a State Monad and one idea bother me. Instead of passing accumulator as parameter, we can wrap everything to the state monad.
So I wanted to compare performance between using State monad vs passing it as parameter.
So I created two functions:
sum1 :: Int -> [Int] -> Int
sum1 x [] = x
sum1 x (y:xs) = sum1 (x + y) xs
and
sumState:: [Int] -> Int
sumState xs = execState (traverse f xs) 0
where f n = modify (n+)
I compared them on the input array [1..1000000000].
sumState running time was around 15s
sum1 around 5s
We can see clear winner, but the I realised that sumState can be optimised as:
We can use strict version of modify
We do not need necessary the map list output, so we can use traverse_ instead
So the new optimised state function is:
sumState:: [Int] -> Int
sumState xs = execState (traverse_ f xs) 0
where f n = modify' (n+)
which has running time around 350ms. This is a huge improvement. It was shocking.
Why the modified sumState has better performance then sum1? Can sum1 be optimised to match or even be better then sumState?
I also tried other different implementation of sum as
using built in sum function, which gives me around 240ms ((sum [1..x] ::Int))
using strict foldl', which gives me the same result around 240ms (with implicit [Int] -> Int)
Does it actually mean that it is better to use foldl function or State monad to pass accumulator instead of passing it as argument to the function?
Thank you for help.
EDIT:
Each function was in separate file with own main function and compiled with "-O2" flag.
main = do
x <- (read . head ) <$> getArgs
print $ <particular sum function> [1..x]
Runtime was measured via time command on linux.

To give a bit more explanation as to why traverse is slower: traverse f xs has has type State [()] and that [()] (list of unit tuples) is built up during the summation. This prevents further optimizations and would cause a memory leak if you were not using lazy state.
Update: I think GHC should have been able to notice that that list of unit tuples is never used, so I opened a GHC issue.
In both cases, To get the best performance we want to combine (or fuse) the summation with the enumeration [1..x] into a tight recursive loop which simply increments and adds until it reaches x. The resulting code would look something like this:
sumFromTo :: Int -> Int -> Int -> Int
sumFromTo s x y
| x == y = s + x
| otherwise = sumFromTo (s + x) (x + 1) y
This avoids allocations for the list [1..x].
The base library achieves this optimization using foldr/build fusion, also known as short cut fusion. The sum, foldl' and traverse (for lists) functions are implemented using the foldr function and [1..x] is implemented using the build function. The foldr and build function have special optimization rules so that they can be fused. Your custom sum1 function doesn't use foldr and so it can never be fused with [1..x] in this way.

Ironically, the same problem that plagued your implementation of sumState is also the problem with sum1. You don't have strict accumulation, so you build up thunks like so:
sum 0 [1, 2, 3]
sum (0 + 1) [2, 3]
sum ((0 + 1) + 2) [3]
sum (((0 + 1) + 2) + 3) []
(((0 + 1) + 2) + 3)
((1 + 2) + 3)
(3 + 3)
6
If you add strictness to sum1, you should see a dramatic improvement in efficiency because you eliminate the non-tail-recursive evaluation of the thunk (((0 + 1) + 2) + 3), which is the costly part of sum1. Using strict accumulation makes this much more efficient:
sum1 x [] = []
sum1 x (y : xs) = x `seq` sum1 (x + y) xs
should give you comparable performance to sum (although as noted in another answer, GHC may not be able to use fusion properly to give you the truly magical performance of sum on the list [1..x]).

Why does QuickCheck take a long time when testing a Functor instance with a specific type signature?

I'm working through the wonderful Haskell Book. While solving some exercises I ran QuickCheck test that took a relatively long time to run and I can't figure out why.
The exercise I am solving is in Chapter 16 - I need to write a Functor instance for
data Parappa f g a =
DaWrappa (f a) (g a)
Here is a link to the full code of my solution. The part I think is relevant is this:
functorCompose' :: (Eq (f c), Functor f)
=> Fun a b -> Fun b c -> f a -> Bool
functorCompose' fab gbc x =
(fmap g (fmap f x)) == (fmap (g . f) x)
where f = applyFun fab
g = applyFun gbc
type ParappaComp =
Fun Integer String
-> Fun String [Bool]
-> Parappa [] Maybe Integer
-- -> Parappa (Either Char) Maybe Integer
-> Bool
main :: IO ()
main = do
quickCheck (functorCompose' :: ParappaComp)
When I run this in the REPL it takes ~6 seconds to complete. If I change ParappaComp to use Either Char instead of [] (see comment in code), it finishes instantaneously like I'm used to seeing in all other exercises.
I suspect that maybe QuickCheck is using very long lists causing the test to take a long time, but I am not familiar enough with the environment to debug this or to test this hypothesis.
Why does this take so long?
How should I go about debugging this?

I suspect that maybe QuickCheck is using very long lists causing the test to take a long time, but I am not familiar enough with the environment to debug this or to test this hypothesis.
I'm not sure of the actual cause either, but one way to start debugging this is to use the collect function from QuickCheck to collect statistics about test cases. To start, you can collect the size of the result.
A simple way to obtain a size is by using the length function, requiring the functor f to be Foldable
You will need to implement or derive Foldable for Parappa (add {-# LANGUAGE DeriveFoldable #-} at the top of the file, add deriving Foldable to Parappa)
To use collect, you need to generalize Bool to Property (in the signature of functorCompose' and in the type synonym ParappaComp)
functorCompose' :: (Eq (f c), Functor f, Foldable f)
=> Fun a b -> Fun b c -> f a -> Property
functorCompose' fab gbc x =
collect (length x) $
(fmap g (fmap f x)) == (fmap (g . f) x)
where f = applyFun fab
g = applyFun gbc
With that you can see that the distribution of the lengths of generated lists is clustered around 20, with a long tail up to 100. That alone doesn't seem to explain the slowness, as one would expect that traversing lists of that size should be virtually instantaneous.

Is it possible to infer the normalized source of a pure λ function on Haskell?

Let a pure λ function be a term with nothing but abstractions and applications. On JavaScript, it is possible to infer the source code of a pure function by applying all abstractions to variadic functions that collect their argument list. That is, this is possible:
lambdaSource(function(x){return x(x)}) == "λx.(x x)"
See the code for lambdaSource on this gist. That function became particularly useful for my interests since it allows me to use existing JS engines to normalize untyped lambda calculus expressions much faster than any naive evaluator I could code by myself. Moreover, I know λ-calculus functions can be expressed in Haskell with help of unsafeCoerce:
(let (#) = unsafeCoerce in (\ f x -> (f # (f # (f # x)))))
I do not know how to implement lambdaSource in Haskell because of the lack of variadic functions. Is it possible to infer the normalized source of a pure λ function on Haskell, such that:
lambdaSource (\ f x -> f # (f # (f # x))) == "λ f x . f (f (f x))"
?

Yes, you can, but you need to provide the spine of the type of your function, so it doesn't work for ULC. See also the whole lecture notes.
But as Daniel Wagner says you can just use HOAS.
There is also another opportunity: here is something that looks like HOAS, but is FOAS actually, and all you need is suitable normalization by evaluation (in terms of quote, in terms of reify & reflect). pigworker also wrote a Haskell version of the Jigger, but I can't find it.
We can also do this type-safely in type theory: one way is to use liftable terms (which requires a postulate), or we can reify lambda terms into their PHOAS representation and then convert PHOAS to FOAS (which is very complicated).
EDIT
Here is some HOAS-related code:
{-# LANGUAGE GADTs, FlexibleInstances #-}
infixl 5 #
data Term a = Pure a | Lam (Term a -> Term a) | App (Term a) (Term a)
(#) :: Term a -> Term a -> Term a
Lam f # x = f x
f # x = App f x
instance Show (Term String) where
show = go names where
names = map (:[]) ['a'..'z'] ++ map (++ ['\'']) names
go :: [String] -> Term String -> String
go ns (Pure n) = n
go (n:ns) (Lam f) = concat ["\\", n, " -> ", go ns (f (Pure n))]
go ns (App f x) = concat [go ns f, "(", go ns x, ")"]
k :: Term a
k = Lam $ \x -> Lam $ \y -> x
s :: Term a
s = Lam $ \f -> Lam $ \g -> Lam $ \x -> f # x # (g # x)
omega :: Term a
omega = (Lam $ \f -> f # f) # (Lam $ \f -> f # f)
run t = t :: Term String
main = do
print $ run $ s -- \a -> \b -> \c -> a(c)(b(c))
print $ run $ s # k # k -- \a -> a
-- print $ run $ omega -- bad idea
Also, instead of writing this Lams, #s and stuff, you can parse string representations of lambda terms to HOAS — that's not harder than printing HOAS terms.

Performance comparison of two implementations of a primes filter

I have two programs to find prime numbers (just an exercise, I'm learning Haskell). "primes" is about 10X faster than "primes2", once compiled with ghc (with flag -O). However, in "primes2", I thought it would consider only prime numbers for the divisor test, which should be faster than considering odd numbers in "isPrime", right? What am I missing?
isqrt :: Integral a => a -> a
isqrt = floor . sqrt . fromIntegral
isPrime :: Integral a => a -> Bool
isPrime n = length [i | i <- [1,3..(isqrt n)], mod n i == 0] == 1
primes :: Integral a => a -> [a]
primes n = [2,3,5,7,11,13] ++ (filter (isPrime) [15,17..n])
primes2 :: Integral a => a -> [a]
primes2 n = 2 : [i | i <- [3,5..n], all ((/= 0) . mod i) (primes2 (isqrt i))]

I think what's happening here is that isPrime is a simple loop, whereas primes2 is calling itself recursively — and its recursion pattern looks exponential to me.
Searching through my old source code, I found this code:
primes :: [Integer]
primes = 2 : filter isPrime [3,5..]
isPrime :: Integer -> Bool
isPrime x = all (\n -> x `mod` n /= 0) $
takeWhile (\n -> n * n <= x) primes
This tests each possible prime x only against the primes below sqrt(x), using the already generated list of primes. So it probably doesn't test any given prime more than once.
Memoization in Haskell:
Memoization in Haskell is generally explicit, not implicit. The compiler won't "do the right thing" but it will only do what you tell it to. When you call primes2,
*Main> primes2 5
[2,3,5]
*Main> primes2 10
[2,3,5,7]
Each time you call the function it calculates all of its results all over again. It has to. Why? Because 1) You didn't make it save its results, and 2) the answer is different each time you call it.
In the sample code I gave above, primes is a constant (i.e. it has arity zero) so there's only one copy of it in memory, and its parts only get evaluated once.
If you want memoization, you need to have a value with arity zero somewhere in your code.

I like what Dietrich has done with the memoization, but I think theres a data structure issue here too. Lists are just not the ideal data structure for this. They are, by necessity, lisp style cons cells with no random access. Set seems better suited to me.
import qualified Data.Set as S
sieve :: (Integral a) => a -> S.Set a
sieve top = let l = S.fromList (2:3:([5,11..top]++[7,13..top]))
iter s c
| cur > (div (S.findMax s) 2) = s
| otherwise = iter (s S.\\ (S.fromList [2*cur,3*cur..top])) (S.deleteMin c)
where cur = S.findMin c
in iter l (l S.\\ (S.fromList [2,3]))
I know its kind of ugly, and not too declarative, but it runs rather quickly. Im looking into a way to make this nicer looking using Set.fold and Set.union over the composites. Any other ideas for neatening this up would be appreciated.
PS - see how (2:3:([5,11..top]++[7,13..top])) avoids unnecessary multiples of 3 such as the 15 in your primes. Unfortunately, this ruins your ordering if you work with lists and you sign up for a sorting, but for sets thats not an issue.

Factorial Algorithms in different languages

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
I want to see all the different ways you can come up with, for a factorial subroutine, or program. The hope is that anyone can come here and see if they might want to learn a new language.
Ideas:
Procedural
Functional
Object Oriented
One liners
Obfuscated
Oddball
Bad Code
Polyglot
Basically I want to see an example, of different ways of writing an algorithm, and what they would look like in different languages.
Please limit it to one example per entry.
I will allow you to have more than one example per answer, if you are trying to highlight a specific style, language, or just a well thought out idea that lends itself to being in one post.
The only real requirement is it must find the factorial of a given argument, in all languages represented.
Be Creative!
Recommended Guideline:
# Language Name: Optional Style type
- Optional bullet points
Code Goes Here
Other informational text goes here
I will ocasionally go along and edit any answer that does not have decent formatting.

Polyglot: 5 languages, all using bignums
So, I wrote a polyglot which works in the three languages I often write in, as well as one from my other answer to this question and one I just learned today. It's a standalone program, which reads a single line containing a nonnegative integer and prints a single line containing its factorial. Bignums are used in all languages, so the maximum computable factorial depends only on your computer's resources.
Perl: uses built-in bignum package. Run with perl FILENAME.
Haskell: uses built-in bignums. Run with runhugs FILENAME or your favorite compiler's equivalent.
C++: requires GMP for bignum support. To compile with g++, use g++ -lgmpxx -lgmp -x c++ FILENAME to link against the right libraries. After compiling, run ./a.out. Or use your favorite compiler's equivalent.
brainf*ck: I wrote some bignum support in this post. Using Muller's classic distribution, compile with bf < FILENAME > EXECUTABLE. Make the output executable and run it. Or use your favorite distribution.
Whitespace: uses built-in bignum support. Run with wspace FILENAME.
Edit: added Whitespace as a fifth language. Incidentally, do not wrap the code with <code> tags; it breaks the Whitespace. Also, the code looks much nicer in fixed-width.
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*/;}

lolcode:
sorry I couldn't resist 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

This is one of the faster algorithms, up to 170!. It fails inexplicably beyond 170!, and it's relatively slow for small factorials, but for factorials between 80 and 170 it's blazingly fast compared to many algorithms.
curl http://www.google.com/search?q=170!
There's also an online interface, try it out now!
Let me know if you find a bug, or faster implementation for large factorials.
EDIT:
This algorithm is slightly slower, but gives results beyond 170:
curl http://www58.wolframalpha.com/input/?i=171!
It also simplifies them into various other representations.

C++: Template Metaprogramming
Uses the classic enum hack.
template<unsigned int n>
struct factorial {
enum { result = n * factorial<n - 1>::result };
};
template<>
struct factorial<0> {
enum { result = 1 };
};
Usage.
const unsigned int x = factorial<4>::result;
Factorial is calculated completely at compile time based on the template parameter n. Therefore, factorial<4>::result is a constant once the compiler has done its work.

Whitespace
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
It was hard to get it to show here properly, but now I tried copying it from the preview and it works. You need to input the number and press enter.

I find the following implementations just hilarious:
The Evolution of a Haskell Programmer
Evolution of a Python programmer
Enjoy!

C# Lookup:
Nothing to calculate really, just look it up. To extend it,add another 8 numbers to the table and 64 bit integers are at at their limit. Beyond that, a BigNum class is called for.
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];
}

Lazy K
Your pure functional programming nightmares come true!
The only Esoteric Turing-complete Programming Language that has:
A purely functional foundation, core, and libraries---in fact, here's the complete API: S K I
No lambdas even!
No numbers or lists needed or allowed
No explicit recursion but yet, allows recursion
A simple infinite lazy stream-based I/O mechanism
Here's the Factorial code in all its parenthetical glory:
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)
Features:
No subtraction or conditionals
Prints all factorials (if you wait long enough)
Uses a second layer of Church numerals to convert the Nth factorial to N! asterisks followed by a newline
Uses the Y combinator for recursion
In case you are interested in trying to understand it, here is the Scheme source code to run through the Lazier compiler:
(lazy-def '(fac input)
'((Y (lambda (f n a) ((lambda (b) ((cons 10) ((b (cons 42)) (f (1+ n) b))))
(* a n)))) 1 1))
(for suitable definitions of Y, cons, 1, 10, 42, 1+, and *).
EDIT:
Lazy K Factorial in Decimal
(10KB of gibberish or else I would paste it). For example, at the Unix prompt:
$ echo "4" | ./lazy facdec.lazy
24
$ echo "5" | ./lazy facdec.lazy
120
Rather slow for numbers above, say, 5.
The code is sort of bloated because we have to include library code for all of our own primitives (code written in Hazy, a lambda calculus interpreter and LC-to-Lazy K compiler written in Haskell).

XSLT 1.0
The input file, factorial.xml:
<?xml version="1.0"?>
<?xml-stylesheet href="factorial.xsl" type="text/xsl" ?>
<n>
20
</n>
The XSLT file, 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>
Save both files in the same directory and open factorial.xml in IE.

Python: Functional, One-liner
factorial = lambda n: reduce(lambda x,y: x*y, range(1, n+1), 1)
NOTE:
It supports big integers. Example:
print factorial(100)
93326215443944152681699238856266700490715968264381621468592963895217599993229915\
608941463976156518286253697920827223758251185210916864000000000000000000000000
It does not work for n < 0.

APL (oddball/one-liner):
×/⍳X
⍳X expands X into an array of the integers 1..X
×/ multiplies every element in the array
Or with the built-in operator:
!X
Source: http://www.webber-labs.com/mpl/lectures/ppt-slides/01.ppt

Perl6
sub factorial ($n) { [*] 1..$n }
I hardly know about Perl6. But I guess this [*] operator is same as Haskell's product.
This code runs on Pugs, and maybe Parrot (I didn't check it.)
Edit
This code also works.
sub postfix:<!> ($n) { [*] 1..$n }
# This function(?) call like below ... It looks like mathematical notation.
say 10!;

x86-64 Assembly: Procedural
You can call this from C (only tested with GCC on linux amd64).
Assembly was assembled with 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

Recursively in Inform 7
(it reminds you of COBOL because it's for writing text adventures; proportional font is deliberate):
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.
If you want to actually call this function ("phrase") from a game you need to define an action and grammar rule:
"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]".

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

Erlang: tail recursive
fac(0) -> 1;
fac(N) when N > 0 -> fac(N, 1).
fac(1, R) -> R;
fac(N, R) -> fac(N - 1, R * N).

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

Brainf*ck
+++++
>+<[[->>>>+<<<<]>>>>[-<<<<+>>+>>]<<<<>[->>+<<]<>>>[-<[->>+<<]>>[-<<+<+>>>]<]<[-]><<<-]
Written by Michael Reitzenstein.

BASIC: old school
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

Batch (NT):
#echo off
set n=%1
set result=1
for /l %%i in (%n%, -1, 1) do (
set /a result=result * %%i
)
echo %result%
Usage:
C:>factorial.bat 15

F#: Functional
Straight forward:
let rec fact x =
if x < 0 then failwith "Invalid value."
elif x = 0 then 1
else x * fact (x - 1)
Getting fancy:
let fact x = [1 .. x] |> List.fold_left ( * ) 1

Recursive Prolog
fac(0,1).
fac(N,X) :- N1 is N -1, fac(N1, T), X is N * T.
Tail Recursive Prolog
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).

ruby recursive
(factorial=Hash.new{|h,k|k*h[k-1]})[1]=1
usage:
factorial[5]
=> 120

Scheme
Here is a simple recursive definition:
(define (factorial x)
(if (= x 0) 1
(* x (factorial (- x 1)))))
In Scheme tail-recursive functions use constant stack space. Here is a version of factorial that is tail-recursive:
(define factorial
(letrec ((fact (lambda (x accum)
(if (= x 0) accum
(fact (- x 1) (* accum x))))))
(lambda (x)
(fact x 1))))

Oddball examples? What about using the gamma function! Since, Gamma n = (n-1)!.
OCaml: Using Gamma
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)))

Freshman Haskell programmer
fac n = if n == 0
then 1
else n * fac (n-1)
Sophomore Haskell programmer, at MIT
(studied Scheme as a freshman)
fac = (\(n) ->
(if ((==) n 0)
then 1
else ((*) n (fac ((-) n 1)))))
Junior Haskell programmer
(beginning Peano player)
fac 0 = 1
fac (n+1) = (n+1) * fac n
Another junior Haskell programmer
(read that n+k patterns are “a disgusting part of Haskell” [1]
and joined the “Ban n+k patterns”-movement [2])
fac 0 = 1
fac n = n * fac (n-1)
Senior Haskell programmer
(voted for Nixon Buchanan Bush — “leans right”)
fac n = foldr (*) 1 [1..n]
Another senior Haskell programmer
(voted for McGovern Biafra Nader — “leans left”)
fac n = foldl (*) 1 [1..n]
Yet another senior Haskell programmer
(leaned so far right he came back left again!)
-- using foldr to simulate foldl
fac n = foldr (\x g n -> g (x*n)) id [1..n] 1
Memoizing Haskell programmer
(takes Ginkgo Biloba daily)
facs = scanl (*) 1 [1..]
fac n = facs !! n
Pointless (ahem) “Points-free” Haskell programmer
(studied at Oxford)
fac = foldr (*) 1 . enumFromTo 1
Iterative Haskell programmer
(former Pascal programmer)
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
Iterative one-liner Haskell programmer
(former APL and C programmer)
fac n = snd (until ((>n) . fst) (\(i,m) -> (i+1, i*m)) (1,1))
Accumulating Haskell programmer
(building up to a quick climax)
facAcc a 0 = a
facAcc a n = facAcc (n*a) (n-1)
fac = facAcc 1
Continuation-passing Haskell programmer
(raised RABBITS in early years, then moved to New Jersey)
facCps k 0 = k 1
facCps k n = facCps (k . (n *)) (n-1)
fac = facCps id
Boy Scout Haskell programmer
(likes tying knots; always “reverent,” he
belongs to the Church of the Least Fixed-Point [8])
y f = f (y f)
fac = y (\f n -> if (n==0) then 1 else n * f (n-1))
Combinatory Haskell programmer
(eschews variables, if not obfuscation;
all this currying’s just a phase, though it seldom hinders)
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)))
List-encoding Haskell programmer
(prefers to count in unary)
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
Interpretive Haskell programmer
(never “met a language” he didn't like)
-- 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)))
Static Haskell programmer
(he does it with class, he’s got that fundep Jones!
After Thomas Hallgren’s “Fun with Functional Dependencies” [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
Beginning graduate Haskell programmer
(graduate education tends to liberate one from petty concerns
about, e.g., the efficiency of hardware-based integers)
-- 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 programmer
(always starts out with the “basic Bird fold”)
-- (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
Cartesianally-inclined Haskell programmer
(prefers Greek food, avoids the spicy Indian stuff;
inspired by Lex Augusteijn’s “Sorting Morphisms” [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)
Ph.D. Haskell programmer
(ate so many bananas that his eyes bugged out, now he needs new lenses!)
-- 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
Post-doc Haskell programmer
(from Uustalu, Vene and Pardo’s “Recursion Schemes from Comonads” [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
Tenured professor
(teaching Haskell to freshmen)
fac n = product [1..n]

D Templates: Functional
template factorial(int n : 1)
{
const factorial = 1;
}
template factorial(int n)
{
const factorial =
n * factorial!(n-1);
}
or
template factorial(int n)
{
static if(n == 1)
const factorial = 1;
else
const factorial =
n * factorial!(n-1);
}
Used like this:
factorial!(5)

Java 1.6: recursive, memoized (for subsequent calls)
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;
}

PowerShell
function factorial( [int] $n )
{
$result = 1;
if ( $n -gt 1 )
{
$result = $n * ( factorial ( $n - 1 ) )
}
$result
}
Here's a one-liner:
$n..1 | % {$result = 1}{$result *= $_}{$result}

Bash: Recursive
In bash and recursive, but with the added advantage that it deals with each iteration in a new process. The max it can calculate is !20 before overflowing, but you can still run it for big numbers if you don't care about the answer and want your system to fall over ;)
#!/bin/bash
echo $(($1 * `( [[ $1 -gt 1 ]] && ./$0 $(($1 - 1)) ) || echo 1`));

Resources