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