fork(1) download
copy 
  1.  
  2. (defun arithmetic-geometric-mean (a b)
  3.   (values (/ (+ a b) 2)
  4.           (sqrt (* a b))))
  5.  
  6. (defun converge (epsilon fun a b)
  7.   (loop
  8.     :while (< epsilon (abs (- a b)))
  9.     :do (multiple-value-setq (a b) (funcall fun a b))
  10.     :finally (return (values a b))))
  11.  
  12. (format t ";; --> ~{~S~^~%;;     ~}~%" (multiple-value-list
  13. (converge 1d-15
  14.           (lambda (a b)
  15.             (format t ";; ~24,21F ~24,21F~%" a b)
  16.             (arithmetic-geometric-mean a b))
  17.           24d0 6d0)
  18. ))
  19.  
  20.  
  21. (defun geothmetic-meandian (set)
  22.   (sort (vector (/ (reduce (function +) set :initial-value 0.0d0)
  23.                    (length set))
  24.                 (expt (reduce (function *) set  :initial-value 1.0d0)
  25.                       (/ (length set)))
  26.                 (aref set (truncate (length set) 2)))
  27.         (function <)))
  28.  
  29. (defun converge-set (epsilon fun set)
  30.   ;; set is sorted.
  31.   (loop
  32.     :while (< epsilon (abs (- (aref set 0) (aref set (1- (length set))))))
  33.     :do (setf set (funcall fun set))
  34.     :finally (return set)))
  35.  
  36. (format t ";; --> ~{~S~^~%;;     ~}~%" (multiple-value-list
  37. (converge-set
  38.   1d-3
  39.   (lambda (set)
  40.     (format t ";;~{ ~24,21F~}~%" (coerce set 'list))
  41.     (geothmetic-meandian set))
  42.   #(1 1 2 3 5))
  43. ))
Success #stdin #stdout 0.01s 25760KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
;; 24.000000000000000000000  6.000000000000000000000
;; 15.000000000000000000000 12.000000000000000000000
;; 13.500000000000000000000 13.416407864998739000000
;; 13.458203932499370000000 13.458139030990985000000
;; 13.458171481745177000000 13.458171481706055000000
;; --> 13.458171481725616d0
;;     13.458171481725616d0
;;  1.000000000000000000000  1.000000000000000000000  2.000000000000000000000  3.000000000000000000000  5.000000000000000000000
;;  1.974350485834820000000  2.000000000000000000000  2.400000000000000000000
;;  2.000000000000000000000  2.116192460544808400000  2.124783495278273000000
;;  2.079536819479580200000  2.080325318607693800000  2.116192460544808400000
;;  2.080325318607693800000  2.091948604915222300000  2.092018199544027500000
;;  2.088090133120960000000  2.088097374355647700000  2.091948604915222300000
;;  2.088097374355647700000  2.089377914218486500000  2.089378704130609800000
;; --> #(2.088951243615992d0 2.0889513309015815d0 2.0893779142184865d0)
https://ideone.com/8s3uh4
language:
Common Lisp (sbcl 1.4.16)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!