home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / examples / stirling.lsp < prev   
Encoding:
Lisp/Scheme  |  1993-10-23  |  1.3 KB  |  54 lines
  1. ;; Ausrechnen der Doppelfolge der Stirling-Zahlen
  2. ;; Bruno Haible 28.1.1990
  3.  
  4. (provide 'stirling)
  5. (require 'intmisc) ; Macro defun-N0
  6.  
  7.  
  8. ;; Stirling-Zahlen 2. Art S(n,k)
  9.  
  10. ; liefert zu n>=0 einen Array #(stirling2(n,0) ... stirling2(n,n))
  11. (defun-N0 stirling2-table (n)
  12.   (if (= n 0)
  13.     (vector '1)
  14.     (let ((A_n-1 (stirling2-table (1- n)))
  15.           (A_n (make-array (1+ n))))
  16.       (do ((i 0 (1+ i)))
  17.           ((> i n))
  18.         (setf (aref A_n i)
  19.           (+ (if (> i 0) (aref A_n-1 (1- i)) 0)
  20.              (* i (if (< i n) (aref A_n-1 i) 0))
  21.       ) ) )
  22.       A_n
  23. ) ) )
  24.  
  25. ; S(n,k) für ganze Zahlen n, k
  26. (defun stirling2 (n k)
  27.   (if (<= 0 k n) (aref (stirling2-table n) k) 0)
  28. )
  29.  
  30.  
  31. ;; Stirling-Zahlen 1. Art s(n,k)
  32.  
  33. ; liefert zu n>=0 einen Array #(stirling1(n,0) ... stirling1(n,n))
  34. (defun-N0 stirling1-table (n)
  35.   (if (= n 0)
  36.     (vector '1)
  37.     (let* ((n-1 (1- n))
  38.            (A_n-1 (stirling1-table n-1))
  39.            (A_n (make-array (1+ n))))
  40.       (do ((i 0 (1+ i)))
  41.           ((> i n))
  42.         (setf (aref A_n i)
  43.           (- (if (> i 0) (aref A_n-1 (1- i)) 0)
  44.              (* n-1 (if (< i n) (aref A_n-1 i) 0))
  45.       ) ) )
  46.       A_n
  47. ) ) )
  48.  
  49. ; s(n,k) für ganze Zahlen n, k
  50. (defun stirling1 (n k)
  51.   (if (<= 0 k n) (aref (stirling1-table n) k) 0)
  52. )
  53.  
  54.