I've written a simple implementation of Conway's Game of Life using the Store comonad (see code below). My problem is that the grid generation is getting visibly slower from the fifth iteration onwards. Is my issue related to the fact that I'm using the Store comonad? Or am I making a glaring mistake? As far as I could tell, other implementations, which are based on the Zipper comonad, are efficient.
import Control.Comonad
data Store s a = Store (s -> a) s
instance Functor (Store s) where
fmap f (Store g s) = Store (f . g) s
instance Comonad (Store s) where
extract (Store f a) = f a
duplicate (Store f s) = Store (Store f) s
type Pos = (Int, Int)
seed :: Store Pos Bool
seed = Store g (0, 0)
where
g ( 0, 1) = True
g ( 1, 0) = True
g (-1, -1) = True
g (-1, 0) = True
g (-1, 1) = True
g _ = False
neighbours8 :: [Pos]
neighbours8 = [(x, y) | x <- [-1..1], y <- [-1..1], (x, y) /= (0, 0)]
move :: Store Pos a -> Pos -> Store Pos a
move (Store f (x, y)) (dx, dy) = Store f (x + dx, y + dy)
count :: [Bool] -> Int
count = length . filter id
getNrAliveNeighs :: Store Pos Bool -> Int
getNrAliveNeighs s = count $ fmap (extract . move s) neighbours8
rule :: Store Pos Bool -> Bool
rule s = let n = getNrAliveNeighs s
in case (extract s) of
True -> 2 <= n && n <= 3
False -> n == 3
blockToStr :: [[Bool]] -> String
blockToStr = unlines . fmap (fmap f)
where
f True = '*'
f False = '.'
getBlock :: Int -> Store Pos a -> [[a]]
getBlock n store#(Store _ (x, y)) =
[[extract (move store (dx, dy)) | dy <- yrange] | dx <- xrange]
where
yrange = [(x - n)..(y + n)]
xrange = reverse yrange
example :: IO ()
example = putStrLn
$ unlines
$ take 7
$ fmap (blockToStr . getBlock 5)
$ iterate (extend rule) seed
The store comonad per se doesn't really store anything (except in an abstract sense that a function is a “container”), but has to compute it from scratch. That clearly gets very inefficient over a couple of iterations.
You can alleviate this with no change to your code though, if you just back up the s -> a function with some memoisation:
import Data.MemoTrie
instance HasTrie s => Functor (Store s) where
fmap f (Store g s) = Store (memo $ f . g) s
instance HasTrie s => Comonad (Store s) where
extract (Store f a) = f a
duplicate (Store f s) = Store (Store f) s
Haven't tested whether this really gives acceptable performance.
Incidentally, Edward Kmett had an explicitly-memoised version in an old version of the comonad-extras package, but it's gone now. I've recently looked if that still works (seems like it does, after adjusting dependencies).
Let's says I have a string of a length N that contains only 0 or 1. I want to split that string in multiples strings and each string should contains only one digit.
Example:
00011010111
Should be split into:
000
11
0
1
0
111
The only solution I can think of if using a for loop with a string builder (Written in pseudo code below, more c# like sorry):
result = new list<string>
tmpChar = ""
tmpString = ""
for each character c in MyString
if tmpchar != c
if tmpsString != ""
result.add tmpString
tmpString = ""
endIf
tmpchar = c
endIf
tmpString += tmpChar
endFor
Do you have any other solution and maybe a clever solution that use a more functional approach?
I think Seq.scan would be a good fit for this, this is a very procedural problem in nature, preserving the order like that. But here is code that I believe does what you are asking.
"00011010111"
|> Seq.scan (fun (s, i) x ->
match s with
| Some p when p = x -> Some x, i
| _ -> Some x, i + 1 ) (None, 0)
|> Seq.countBy id
|> Seq.choose (function
| (Some t, _), n -> Some(t, n)
| _ -> None )
|> Seq.toList
Perhaps something along the lines of:
let result =
let rec groupWhileSame xs result =
match xs with
| a when a |> Seq.isEmpty -> result
| _ ->
let head = xs |> Seq.head
let str = xs |> Seq.takeWhile ((=) head)
let rest = xs |> Seq.skipWhile ((=) head)
groupWhileSame rest (Seq.append result [str])
groupWhileSame (myStr) []
Seq.fold (fun (acc:(string list)) x ->
match acc with
| y::rst when y.StartsWith(string x) -> (string x) + y::rst
| _ -> (string x)::acc)
[]
"00011010111"
Consider this function (which is generic):
let chunk s =
if Seq.isEmpty s then []
else
let rec chunk items chunks =
if Seq.isEmpty items then chunks
else
let chunks' =
match chunks with
| [] -> [(Seq.head items, 1)]
| x::xs ->
let c,n = x in let c' = Seq.head items in
if c = c' then (c, n + 1) :: xs else (c', 1) :: x :: xs
chunk (Seq.tail items) chunks'
chunk s [] |> List.rev
It returns a list of tuples, where each tuple represents an item and its repetitions.
So
"00011010111" |> Seq.toList |> chunk
actually returns
[('0', 3); ('1', 2); ('0', 1); ('1', 1); ('0', 1); ('1', 3)]
Basically, we're doing run length encoding (which is admittedly a bit wasteful in the case of your example string).
To get the list of strings that you want, we use code like following:
"00011010111"
|> Seq.toList
|> chunk
|> List.map (fun x -> let c,n = x in new string(c, n))
Here's a working version of OP's proposal with light syntax:
let chunk (s: string) =
let result = System.Collections.Generic.List<string>()
let mutable tmpChar = ""
let mutable tmpString = ""
for c in s do
if tmpChar <> string c then
if tmpString <> "" then
result.Add tmpString
tmpString <- ""
tmpChar <- string c
tmpString <- tmpString + tmpChar
result.Add tmpString
result
No attempt was made to follow a functional style.
I was playing around with Project Euler #34, and I wrote these functions:
import Data.Time.Clock.POSIX
import Data.Char
digits :: (Integral a) => a -> [Int]
digits x
| x < 10 = [fromIntegral x]
| otherwise = let (q, r) = x `quotRem` 10 in (fromIntegral r) : (digits q)
digitsByShow :: (Integral a, Show a) => a -> [Int]
digitsByShow = map (\x -> ord x - ord '0') . show
I thought that for sure digits has to be the faster one, as we don't convert to a String. I could not have been more wrong. I ran the two versions via pe034:
pe034 digitFunc = sum $ filter sumFactDigit [3..2540160]
where
sumFactDigit :: Int -> Bool
sumFactDigit n = n == (sum $ map sFact $ digitFunc n)
sFact :: Int -> Int
sFact n
| n == 0 = 1
| n == 1 = 1
| n == 2 = 2
| n == 3 = 6
| n == 4 = 24
| n == 5 = 120
| n == 6 = 720
| n == 7 = 5040
| n == 8 = 40320
| n == 9 = 362880
main = do
begin <- getPOSIXTime
print $ pe034 digitsByShow -- or digits
end <- getPOSIXTime
print $ end - begin
After compiling with ghc -O, digits consistently takes .5 seconds, while digitsByShow consistently takes .3 seconds. Why is this so? Why is the function which stays within Integer arithmetic slower, whereas the function which goes into string comparison is faster?
I ask this because I come from programming in Java and similar languages, where the % 10 trick of generating digits is way faster than the "convert to String" method. I haven't been able to wrap my head around the fact that converting to a string could be faster.
This is the best I can come up with.
digitsV2 :: (Integral a) => a -> [Int]
digitsV2 n = go n []
where
go x xs
| x < 10 = fromIntegral x : xs
| otherwise = case quotRem x 10 of
(q,r) -> go q (fromIntegral r : xs)
when compiled with -O2 and tested with Criterion
digits runs in 470.4 ms
digitsByShow runs in 421.8 ms
digitsV2 runs in 258.0 ms
results may vary
edit:
I am not sure why building the list like this helps so much.
But you can improve your codes speed by strictly evaluating quotRem x 10
You can do this with BangPatterns
| otherwise = let !(q, r) = x `quotRem` 10 in (fromIntegral r) : (digits q)
or with case
| otherwise = case quotRem x 10 of
(q,r) -> fromIntegral r : digits q
Doing this drops digits down to 323.5 ms
edit: time without using Criterion
digits = 464.3 ms
digitsStrict = 328.2 ms
digitsByShow = 259.2 ms
digitV2 = 252.5 ms
note: The criterion package measures software performance.
Let's investigate why #No_signal's solution is faster.
I made three runs of ghc:
ghc -O2 -ddump-simpl digits.hs >digits.txt
ghc -O2 -ddump-simpl digitsV2.hs >digitsV2.txt
ghc -O2 -ddump-simpl show.hs >show.txt
digits.hs
digits :: (Integral a) => a -> [Int]
digits x
| x < 10 = [fromIntegral x]
| otherwise = let (q, r) = x `quotRem` 10 in (fromIntegral r) : (digits q)
main = return $ digits 1
digitsV2.hs
digitsV2 :: (Integral a) => a -> [Int]
digitsV2 n = go n []
where
go x xs
| x < 10 = fromIntegral x : xs
| otherwise = let (q, r) = x `quotRem` 10 in go q (fromIntegral r : xs)
main = return $ digits 1
show.hs
import Data.Char
digitsByShow :: (Integral a, Show a) => a -> [Int]
digitsByShow = map (\x -> ord x - ord '0') . show
main = return $ digitsByShow 1
If you'd like to view the complete txt files, I placed them on ideone (rather than paste a 10000 char dump here):
digits.txt
digitsV2.txt
show.txt
If we carefully look through digits.txt, it appears that this is the relevant section:
lvl_r1qU = __integer 10
Rec {
Main.$w$sdigits [InlPrag=[0], Occ=LoopBreaker]
:: Integer -> (# Int, [Int] #)
[GblId, Arity=1, Str=DmdType <S,U>]
Main.$w$sdigits =
\ (w_s1pI :: Integer) ->
case integer-gmp-1.0.0.0:GHC.Integer.Type.ltInteger#
w_s1pI lvl_r1qU
of wild_a17q { __DEFAULT ->
case GHC.Prim.tagToEnum# # Bool wild_a17q of _ [Occ=Dead] {
False ->
let {
ds_s16Q [Dmd=<L,U(U,U)>] :: (Integer, Integer)
[LclId, Str=DmdType]
ds_s16Q =
case integer-gmp-1.0.0.0:GHC.Integer.Type.quotRemInteger
w_s1pI lvl_r1qU
of _ [Occ=Dead] { (# ipv_a17D, ipv1_a17E #) ->
(ipv_a17D, ipv1_a17E)
} } in
(# case ds_s16Q of _ [Occ=Dead] { (q_a11V, r_X12h) ->
case integer-gmp-1.0.0.0:GHC.Integer.Type.integerToInt r_X12h
of wild3_a17c { __DEFAULT ->
GHC.Types.I# wild3_a17c
}
},
case ds_s16Q of _ [Occ=Dead] { (q_X12h, r_X129) ->
case Main.$w$sdigits q_X12h
of _ [Occ=Dead] { (# ww1_s1pO, ww2_s1pP #) ->
GHC.Types.: # Int ww1_s1pO ww2_s1pP
}
} #);
True ->
(# GHC.Num.$fNumInt_$cfromInteger w_s1pI, GHC.Types.[] # Int #)
}
}
end Rec }
digitsV2.txt:
lvl_r1xl = __integer 10
Rec {
Main.$wgo [InlPrag=[0], Occ=LoopBreaker]
:: Integer -> [Int] -> (# Int, [Int] #)
[GblId, Arity=2, Str=DmdType <S,U><L,U>]
Main.$wgo =
\ (w_s1wh :: Integer) (w1_s1wi :: [Int]) ->
case integer-gmp-1.0.0.0:GHC.Integer.Type.ltInteger#
w_s1wh lvl_r1xl
of wild_a1dp { __DEFAULT ->
case GHC.Prim.tagToEnum# # Bool wild_a1dp of _ [Occ=Dead] {
False ->
case integer-gmp-1.0.0.0:GHC.Integer.Type.quotRemInteger
w_s1wh lvl_r1xl
of _ [Occ=Dead] { (# ipv_a1dB, ipv1_a1dC #) ->
Main.$wgo
ipv_a1dB
(GHC.Types.:
# Int
(case integer-gmp-1.0.0.0:GHC.Integer.Type.integerToInt ipv1_a1dC
of wild2_a1ea { __DEFAULT ->
GHC.Types.I# wild2_a1ea
})
w1_s1wi)
};
True -> (# GHC.Num.$fNumInt_$cfromInteger w_s1wh, w1_s1wi #)
}
}
end Rec }
I actually couldn't find the relevant section for show.txt. I'll work on that later.
Right off the bat, digitsV2.hs produces shorter code. That's probably a good sign for it.
digits.hs seems to be following this psuedocode:
def digits(w_s1pI):
if w_s1pI < 10: return [fromInteger(w_s1pI)]
else:
ds_s16Q = quotRem(w_s1pI, 10)
q_X12h = ds_s16Q[0]
r_X12h = ds_s16Q[1]
wild3_a17c = integerToInt(r_X12h)
ww1_s1pO = r_X12h
ww2_s1pP = digits(q_X12h)
ww2_s1pP.pushFront(ww1_s1pO)
return ww2_s1pP
digitsV2.hs seems to be following this psuedocode:
def digitsV2(w_s1wh, w1_s1wi=[]): # actually disguised as go(), as #No_signal wrote
if w_s1wh < 10:
w1_s1wi.pushFront(fromInteger(w_s1wh))
return w1_s1wi
else:
ipv_a1dB, ipv1_a1dC = quotRem(w_s1wh, 10)
w1_s1wi.pushFront(integerToIn(ipv1a1dC))
return digitsV2(ipv1_a1dC, w1_s1wi)
It might not be that these functions mutate lists like my psuedocode suggests, but this immediately suggests something: it looks as if digitsV2 is fully tail-recursive, whereas digits is actually not (may have to use some Haskell trampoline or something). It appears as if Haskell needs to store all the remainders in digits before pushing them all to the front of the list, whereas it can just push them and forget about them in digitsV2. This is purely speculation, but it is well-founded speculation.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
How can I write a program to find the factorial of any natural number?
This will work for the factorial (although a very small subset) of positive integers:
unsigned long factorial(unsigned long f)
{
if ( f == 0 )
return 1;
return(f * factorial(f - 1));
}
printf("%i", factorial(5));
Due to the nature of your problem (and level that you have admitted), this solution is based more in the concept of solving this rather than a function that will be used in the next "Permutation Engine".
This calculates factorials of non-negative integers[*] up to ULONG_MAX, which will have so many digits that it's unlikely your machine can store a whole lot more, even if it has time to calculate them. Uses the GNU multiple precision library, which you need to link against.
#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>
void factorial(mpz_t result, unsigned long input) {
mpz_set_ui(result, 1);
while (input > 1) {
mpz_mul_ui(result, result, input--);
}
}
int main() {
mpz_t fact;
unsigned long input = 0;
char *buf;
mpz_init(fact);
scanf("%lu", &input);
factorial(fact, input);
buf = malloc(mpz_sizeinbase(fact, 10) + 1);
assert(buf);
mpz_get_str(buf, 10, fact);
printf("%s\n", buf);
free(buf);
mpz_clear(fact);
}
Example output:
$ make factorial CFLAGS="-L/bin/ -lcyggmp-3 -pedantic" -B && ./factorial
cc -L/bin/ -lcyggmp-3 -pedantic factorial.c -o factorial
100
93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
[*] If you mean something else by "number" then you'll have to be more specific. I'm not aware of any other numbers for which the factorial is defined, despite valiant efforts by Pascal to extend the domain by use of the Gamma function.
Why do it in C when you can do it in Haskell:
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]
Content from The Evolution of a Haskell Programmer by Fritz Ruehr, Willamette University - 11 July 01
Thanks to Christoph, a C99 solution that works for quite a few "numbers":
#include <math.h>
#include <stdio.h>
double fact(double x)
{
return tgamma(x+1.);
}
int main()
{
printf("%f %f\n", fact(3.0), fact(5.0));
return 0;
}
produces 6.000000 120.000000
For large n you may run into some issues and you may want to use Stirling's approximation:
Which is:
If your main objective is an interesting looking function:
int facorial(int a) {
int b = 1, c, d, e;
a--;
for (c = a; c > 0; c--)
for (d = b; d > 0; d--)
for (e = c; e > 0; e--)
b++;
return b;
}
(Not recommended as an algorithm for real use.)
a tail-recursive version:
long factorial(long n)
{
return tr_fact(n, 1);
}
static long tr_fact(long n, long result)
{
if(n==1)
return result;
else
return tr_fact(n-1, n*result);
}
In C99 (or Java) I would write the factorial function iteratively like this:
int factorial(int n)
{
int result = 1;
for (int i = 2; i <= n; i++)
{
result *= i;
}
return result;
}
C is not a functional language and you can't rely on tail-call optimization. So don't use recursion in C (or Java) unless you need to.
Just because factorial is often used as the first example for recursion it doesn't mean you need recursion to compute it.
This will overflow silently if n is too big, as is the custom in C (and Java).
If the numbers int can represent are too small for the factorials you want to compute then choose another number type. long long if it needs be just a little bit bigger, float or double if n isn't too big and you don't mind some imprecision, or big integers if you want the exact values of really big factorials.
Here's a C program that uses OPENSSL's BIGNUM implementation, and therefore is not particularly useful for students. (Of course accepting a BIGNUM as the input parameter is crazy, but helpful for demonstrating interaction between BIGNUMs).
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#include <openssl/crypto.h>
#include <openssl/bn.h>
BIGNUM *factorial(const BIGNUM *num)
{
BIGNUM *count = BN_new();
BIGNUM *fact = NULL;
BN_CTX *ctx = NULL;
BN_one(count);
if( BN_cmp(num, BN_value_one()) <= 0 )
{
return count;
}
ctx = BN_CTX_new();
fact = BN_dup(num);
BN_sub(count, fact, BN_value_one());
while( BN_cmp(count, BN_value_one()) > 0 )
{
BN_mul(fact, count, fact, ctx);
BN_sub(count, count, BN_value_one());
}
BN_CTX_free(ctx);
BN_free(count);
return fact;
}
This test program shows how to create a number for input and what to do with the return value:
int main(int argc, char *argv[])
{
const char *test_cases[] =
{
"0", "1",
"1", "1",
"4", "24",
"15", "1307674368000",
"30", "265252859812191058636308480000000",
"56", "710998587804863451854045647463724949736497978881168458687447040000000000000",
NULL, NULL
};
int index = 0;
BIGNUM *bn = NULL;
BIGNUM *fact = NULL;
char *result_str = NULL;
for( index = 0; test_cases[index] != NULL; index += 2 )
{
BN_dec2bn(&bn, test_cases[index]);
fact = factorial(bn);
result_str = BN_bn2dec(fact);
printf("%3s: %s\n", test_cases[index], result_str);
assert(strcmp(result_str, test_cases[index + 1]) == 0);
OPENSSL_free(result_str);
BN_free(fact);
BN_free(bn);
bn = NULL;
}
return 0;
}
Compiled with gcc:
gcc factorial.c -o factorial -g -lcrypto
int factorial(int n){
return n <= 1 ? 1 : n * factorial(n-1);
}
You use the following code to do it.
#include <stdio.h>
#include <stdlib.h>
int main()
{
int x, number, fac;
fac = 1;
printf("Enter a number:\n");
scanf("%d",&number);
if(number<0)
{
printf("Factorial not defined for negative numbers.\n");
exit(0);
}
for(x = 1; x <= number; x++)
{
if (number >= 0)
fac = fac * x;
else
fac=1;
}
printf("%d! = %d\n", number, fac);
}
For large numbers you probably can get away with an approximate solution, which tgamma gives you (n! = Gamma(n+1)) from math.h. If you want even larger numbers, they won't fit in a double, so you should use lgamma (natural log of the gamma function) instead.
If you're working somewhere without a full C99 math.h, you can easily do this type of thing yourself:
double logfactorial(int n) {
double fac = 0.0;
for ( ; n>1 ; n--) fac += log(fac);
return fac;
}
I don't think I'd use this in most cases, but one well-known practice which is becoming less widely used is to have a look-up table. If we're only working with built-in types, the memory hit is tiny.
Just another approach, to make the poster aware of a different technique. Many recursive solutions also can be memoized whereby a lookup table is filled in when the algorithm runs, drastically reducing the cost on future calls (kind of like the principle behind .NET JIT compilation I guess).
We have to start from 1 to the limit specfied say n.Start from 1*2*3...*n.
In c, i am writing it as a function.
main()
{
int n;
scanf("%d",&n);
printf("%ld",fact(n));
}
long int fact(int n)
{
long int facto=1;
int i;
for(i=1;i<=n;i++)
{
facto=facto*i;
}
return facto;
}
Simple solution:
unsigned int factorial(unsigned int n)
{
return (n == 1 || n == 0) ? 1 : factorial(n - 1) * n;
}
Simplest and most efficient is to sum up logarithms. If you use Log10 you get power and exponent.
Pseudocode
r=0
for i from 1 to n
r= r + log(i)/log(10)
print "result is:", 10^(r-floor(r)) ,"*10^" , floor(r)
You might need to add the code so the integer part does not increase too much and thus decrease accuracy, but result should be ok for even very large factorials.
Example in C using recursion
unsigned long factorial(unsigned long f)
{
if (f) return(f * factorial(f - 1));
return 1;
}
printf("%lu", factorial(5));
I used this code for Factorial:
#include<stdio.h>
int main(){
int i=1,f=1,n;
printf("\n\nEnter a number: ");
scanf("%d",&n);
while(i<=n){
f=f*i;
i++;
}
printf("Factorial of is: %d",f);
getch();
}
I would do this with a pre-calculated lookup table as suggested by Mr. Boy. This would be faster to calculate than an iterative or recursive solution. It relies on how fast n! grows, because the largest n! you can calculate without overflowing an unsigned long long (max value of 18,446,744,073,709,551,615) is only 20!, so you only need an array with 21 elements. Here's how it would look in c:
long long factorial (int n) {
long long f[22] = {1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800, 479001600, 6227020800, 87178291200, 1307674368000, 20922789888000, 355687428096000, 6402373705728000, 121645100408832000, 2432902008176640000, 51090942171709440000};
return f[n];
}
See for yourself!