home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / CONTRIB / LISP / FACT.L < prev    next >
Lisp/Scheme  |  1994-10-25  |  922b  |  68 lines
  1. { Factorial using Peano Axioms - gri 12 Aug 1994 }
  2.  
  3. (setq s
  4.    (lambda (x)
  5.       (cons 's (cons x nil))))
  6.       
  7. (setq p
  8.    (lambda (x)
  9.       (car (cdr x))))
  10.       
  11. (setq myAdd
  12.    (lambda (x y)
  13.       (cond
  14.          ((atom x) y)
  15.          (t (s (myAdd (p x) y))))))
  16.          
  17. (setq myMul
  18.    (lambda (x y)
  19.       (cond
  20.          ((atom x) 0)
  21.          (t (myAdd (myMul (p x) y) y)))))
  22.          
  23. (setq gen
  24.    (lambda (n)
  25.       (cond
  26.          ((<= n 0) 0)
  27.          (t (s (gen (- n 1)))))))
  28.          
  29. (setq fact
  30.    (lambda (x)
  31.       (cond
  32.          ((atom x) (s 0))
  33.          (t (myMul x (fact (p x)))))))
  34.  
  35.  
  36. { Examples:
  37.   gen is used to create Peano Integers:
  38.  
  39. (gen 0)
  40. (gen 2)
  41. (gen 10)
  42. (gen 100)
  43.  
  44. (p (gen 3))
  45. }
  46.  
  47.  
  48. { Peano addition:
  49.  
  50. (myAdd (gen 3) (gen 4))
  51. (myAdd (gen 0) (gen 2))
  52. }
  53.  
  54.  
  55. { Peano multiplication:
  56.  
  57. (myMul (gen 2) (gen 3))
  58. }
  59.  
  60.  
  61. { Peano factorial:
  62.  
  63. (fact (gen 0))
  64. (fact (gen 2))
  65. (fact (gen 4))
  66. (fact (gen 5))
  67. (fact (gen 6))
  68. }