home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / LISP / PDLISP.ZIP / EXAMPLES.L < prev    next >
Encoding:
Text File  |  1986-02-13  |  2.2 KB  |  95 lines
  1. ; examples.l - miscellaneous examples
  2. ;
  3. ;
  4. ; rfib - recursive fibonacci function.
  5. ; 
  6. (def rfib (lambda (n)
  7.      (cond ((< n 2) 1)
  8.            (t (+ (rfib (- n 1)) (rfib (- n 2)))))))
  9.  
  10. ; tfib - one implementation of fibonacci function.
  11. ; don't use EQ here, or the computation will never terminate.
  12. ;
  13. (defun tfib (x)
  14.     (cond ( (eql x 1) 1)
  15.         ((eql x 2) 1)
  16.         (t (+ (tfib (- x 1))
  17.               (tfib (- x 2))))))
  18. ;
  19. ; ifib - iterative fibonacci function.
  20. ;
  21. ; not done yet - would anybody like to contribute one ?
  22.  
  23. ;
  24. ; ipower - iteratively coded n ^ mth power routine
  25. ; m and m must both be integers.
  26. (def ipower (lambda (m n)
  27.     (prog ((result 1) (exponent n))
  28. ;
  29. ; first, some checking of the parameters:
  30. ;
  31.     (cond
  32.         ((not (integerp m))
  33.         (return (err "***> IPOWER: 1st arg must be an integer")))
  34.         ((not (integerp n))
  35.         (return (err "***> IPOWER: 2nd arg must be an integer"))))
  36. ;
  37. ; main loop:
  38. ;
  39. ploop    (cond ((zerop exponent) (return result)))    ;test
  40.         (setq result (* m result))            ;reset
  41.         (setq exponent (- exponent 1))            ;reset
  42.         (go ploop))))                                ;repeat
  43. ;
  44. ;
  45. ; do_ipower - same as ipower, above,
  46. ; except coded with a DO instead of a PROG.
  47. ; 
  48. (def do_ipower (lambda (m n)
  49.     (do
  50.     ((result 1) (exponent n))    ;INIT part of DO
  51.     ((zerop exponent) result)    ;TEST part of DO
  52. ;
  53. ; rest of the function is the BODY of the DO:
  54. ;
  55.     (setq result (* m result))
  56.     (setq exponent (- exponent 1)))))
  57. ;        
  58. ;
  59. ; ifact - iteratively coded factorial
  60. ;
  61. (def ifact (lambda (e)
  62.     (prog (result count)
  63.         (setq result 1)            ;initialize result
  64.         (setq count e)            ;initialize e
  65.  
  66.     ploop
  67.         (cond
  68.         ((<= count 0) (return result)))        ;exit test
  69.         (setq result (* result count))        ;accumulate result
  70.         (setq count (- count 1))        ;reset
  71.         (go ploop))))                ;repeat
  72.  
  73. ;
  74. ; rfact - recursively coded factorial function
  75. ;
  76. (def rfact (lambda (x)
  77.     (cond
  78.     ((zerop x) 1)
  79.     (t (* x (rfact (- x 1)))))))
  80. ;
  81. ; rev & app - slow versions of reverse and append which appeared
  82. ; in BYTE, july 1984, p 288.
  83. ;
  84. (def rev (lambda (x)
  85.     (cond
  86.     ((null x) nil)
  87.     (t (app (rev (cdr x)) (list (car x)))) ) ))
  88. ;
  89. (def app (lambda (x y)
  90.     (cond
  91.     ((null x) y)
  92.     (t (app (rev (cdr (rev x))) (cons (car (rev x)) y))))))
  93. ;
  94. ;
  95. ; end of file