home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Examples.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  2.6 KB  |  86 lines
  1. -- Some examples of functional programming for Hugs
  2. module Examples where
  3.  
  4. import Gofer
  5.  
  6. -- Factorials:
  7.  
  8. fact n = product [1..n]                     -- a simple definition
  9.  
  10. fac n  = if n==0 then 1 else n * fac (n-1)  -- a recursive definition
  11.  
  12. fac' 0 = 1                                  -- using two equations
  13. fac' n = n * fac (n-1)
  14.  
  15. facts, facts' :: (Enum a, Num a) => [a]
  16. facts          = scanl (*) 1 [1..]            -- infinite list of factorials
  17. facts'         = 1 : zipWith (*) facts' [1..] -- another way of doing it
  18.  
  19. facFix :: Num a => a -> a
  20. facFix = fixedPt f                          -- using a fixed point combinator
  21.          where  f g 0       = 1             -- overlapping patterns
  22.                 f g n       = n * g (n-1)
  23.                 fixedPt f = g where g = f g -- fixed point combinator
  24.  
  25. facCase :: Integral a => a -> a
  26. facCase  = \n -> case n of
  27.                    0     ->  1
  28.                    (m+1) -> (m+1) * facCase m
  29.  
  30. -- Fibonacci numbers:
  31.  
  32. fib 0     = 0                               -- using pattern matching:
  33. fib 1     = 1                               -- base cases...
  34. fib (n+2) = fib n + fib (n+1)               -- recursive case
  35.  
  36. fastFib n = fibs !! n                       -- using an infinite stream
  37.             where fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
  38.  
  39. -- Perfect numbers:
  40.  
  41. factors n    = [ i | i<-[1..n-1], n `mod` i == 0 ]
  42. perfect n    = sum (factors n) == n
  43. firstperfect = head perfects
  44. perfects     = filter perfect [(1::Int)..]
  45.  
  46. -- Prime numbers:
  47.  
  48. primes      :: Integral a => [a]
  49. primes       = map head (iterate sieve [2..])
  50. sieve (p:xs) = [ x | x<-xs, x `rem` p /= 0 ]
  51.  
  52. -- Pythagorean triads:
  53.  
  54. triads n     = [ (x,y,z) | let ns=[1..n], x<-ns, y<-ns, z<-ns, x*x+y*y==z*z ]
  55.  
  56. -- The Hamming problem:
  57.  
  58. hamming     :: [Integer]
  59. hamming      = 1 : (map (2*) hamming || map (3*) hamming || map (5*) hamming)
  60.                where (x:xs) || (y:ys)  | x==y  =  x : (xs || ys)
  61.                                        | x<y   =  x : (xs || (y:ys))
  62.                                        | y<x   =  y : (ys || (x:xs))
  63.  
  64. -- Digits of e:
  65.  
  66. eFactBase ::  [Int]
  67. eFactBase  =  map head (iterate scale (2:repeat 1))
  68.  
  69. scale     ::  Integral a => [a] -> [a]
  70. scale      =  renorm . map (10*) . tail
  71. renorm ds  =  foldr step [0] (zip ds [2..])
  72.  
  73. step (d,n) bs | (d `mod` n + 9) < n  = (d `div` n) : b : tail bs
  74.               | otherwise            = c           : b : tail bs
  75.               where b' = head bs
  76.                     b  = (d+b') `mod` n
  77.                     c  = (d+b') `div` n
  78.  
  79. -- Pascal's triangle
  80.  
  81. pascal :: [[Int]]
  82. pascal  = iterate (\row -> zipWith (+) ([0]++row) (row++[0])) [1]
  83.  
  84. showPascal = putStr ((layn . map show . take 14) pascal)
  85.  
  86.