home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / examples / pfzbsp.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1993-10-23  |  2.2 KB  |  67 lines
  1. ; Beispiele für die Primfaktorzerlegungsroutinen
  2.  
  3. (require 'primzahl)
  4.  
  5. ; (primwurz x p) stellt fest, ob x eine Primitivwurzel mod p ist, p Primzahl.
  6. (defun primwurz (x p)
  7.   (and (not (zerop (mod x p)))
  8.        (dolist (j (primteiler (1- p)) t)
  9.          (unless (/= 1 (exptmod x (/ (1- p) j) p))) (return nil))
  10. ) )    )
  11.  
  12. ; (invphi m) bestimmt für m>0 eine Liste aller n>0 mit phi(n)=m.
  13. (defun invphi (m &optional (s 1))
  14.   ; bestimmt nur die n, bei denen alle Primfaktoren > s sind.
  15.   (append
  16.     (if (= m 1) '(1)) ; n=1 liefert m=1
  17.     (mapcan ; n>1 hat einen kleinsten Primfaktor p
  18.       #'(lambda (d &aux (p (1+ d)))
  19.           (if (and (> p s) (isprime p))
  20.             (do ((pj p (* pj p)) ; pj=p^j, j=1,2,...
  21.                  (m1 (/ m d) (/ m1 p)) ; m1=m/(p-1)p^(j-1)
  22.                  (accu nil (append
  23.                              (mapcar #'(lambda (n1) (* n1 pj))
  24.                                      (invphi m1 p)
  25.                              )
  26.                              accu
  27.                 ))         )
  28.                 ((not (integerp m1)) accu)
  29.         ) ) )
  30.       (pdivisors m)
  31. ) ) )
  32.  
  33. (defun test (S)
  34.  (with-open-file (f "invphi.dat" :direction :output :if-exists :new-version)
  35.   (let ((stream (make-broadcast-stream *standard-output* f)))
  36.     (do ((i 1 (1+ i)))
  37.         ((> i S))
  38.       (format stream "~%phi^-1(~D) = ~S" i (sort (invphi i) #'<))
  39. ))) )
  40.  
  41. ; (tau n) ergibt die Anzahl aller positiven Teiler von n>0.
  42. ; (defun tau (n) (length (pdivisors n)))
  43. (defun tau (n)
  44.   (reduce #'* (mapcar #'(lambda (pe) (1+ (cdr pe))) (pfzv n)) )
  45. )
  46.  
  47. ; (sigma n) ergibt die Summe aller positiven Teiler von n>0.
  48. ; (defun sigma (n) (reduce #'+ (pdivisors n)))
  49. (defun sigma (n)
  50.   (reduce #'* (mapcar #'(lambda (pe &aux (p (car pe)) (e (cdr pe)))
  51.                           (do* ((i 0 (1+ i))
  52.                                 (q 1 (* q p))
  53.                                 (s 1 (+ s q)))
  54.                                ((= i e) s)
  55.                         ) )
  56.                       (pfzv n)
  57. ) )           )
  58.  
  59. #-CLISP (require 'fak)
  60. #+CLISP (defun fak (n) (! n))
  61.  
  62. (defun f (i) ; zerlegt i!-1 in Primfaktoren
  63.   (if (>= i 2)
  64.     (time (format t "~%~D!-1 = ~S" i (pfz (1- (fak i)))))
  65. ) )
  66.  
  67.