home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 10.img / BONUS3.LIB / SQR.LSP < prev    next >
Encoding:
Text File  |  1993-01-23  |  2.0 KB  |  61 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;; SQR.LSP
  3. ;;;   (C) ¬⌐┼v 1988-1992  Autodesk ñ╜Ñq
  4. ;;;
  5. ;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
  6. ;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
  7. ;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
  8. ;;;
  9. ;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
  10. ;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
  11. ;;;
  12. ;;;
  13. ;;;
  14. ;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
  15. ;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
  16. ;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
  17. ;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
  18. ;;;
  19. ;;;
  20. ;;; --------------------------------------------------------------------------;
  21. ;;; DESCRIPTION
  22. ;;;
  23. ;;;   This is a programming example.
  24. ;;;
  25. ;;;   This is an implementation of a square root function in
  26. ;;;   LISP using the Newton-Raphson method as used in AutoCAD.
  27. ;;;   It is intended as a test of floating point arithmetic in
  28. ;;;   our LISP, as you can check accuracy with the statement:
  29. ;;;      (- (sqr 2) (sqrt 2))
  30. ;;;   which will compare the built-in function with this one.
  31. ;;;
  32. ;;;   John Walker  12/17/84
  33. ;;;
  34. ;;; --------------------------------------------------------------------------;
  35.  
  36. (defun sqr (x / y c cl)
  37.   (if (or (= 'REAL(type x)) (= 'INT(type x)))
  38.     (progn
  39.       (cond ((minusp x) 'Negative-argument)
  40.         ((zerop x) 0.0)
  41.         (t (setq y (/ (+ 0.154116 (* x 1.893872)) (+ 1.0 (* x 1.047988))))
  42.            (setq c (/ (- y (/ x y)) 2.0))
  43.            (setq cl 0.0)
  44.            (while (not (equal c cl))
  45.              (setq y (- y c))
  46.              (setq cl c)
  47.              (setq c (/ (- y (/ x y)) 2.0))
  48.            ) y
  49.         )
  50.       )
  51.     )
  52.     (progn
  53.       (princ "ñ▐╝╞╡L«─íC")
  54.       (princ)
  55.     )
  56.   )
  57. )
  58.  
  59. ;;; --------------------------------------------------------------------------;
  60.  
  61.