Liren Large Software Subsidy 13/13.iso/p/p024/5.img/R11SUPP.EXE/SQR.LSP

Lisp/Scheme | 1990-07-30 | 1.7 KB | 53 lines

;;; --------------------------------------------------------------------------;
;;; SQR.LSP
;;;   Copyright (C) 1990 by Autodesk, Inc.
;;;
;;;   Permission to use, copy, modify, and distribute this software and its
;;;   documentation for any purpose and without fee is hereby granted.
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; --------------------------------------------------------------------------;
;;; DESCRIPTION
;;;
;;;   This is a programming example.
;;;
;;;   This is an implementation of a square root function in
;;;   LISP using the Newton-Raphson method as used in AutoCAD.
;;;   It is intended as a test of floating point arithmetic in
;;;   our LISP, as you can check accuracy with the statement:
;;;      (- (sqr 2) (sqrt 2))
;;;   which will compare the built-in function with this one.
;;;
;;;   John Walker  12/17/84
;;;
;;; --------------------------------------------------------------------------;

(defun sqr (x / y c cl)
  (if (or (= 'REAL(type x)) (= 'INT(type x)))
    (progn
      (cond ((minusp x) 'Negative-argument)
        ((zerop x) 0.0)
        (t (setq y (/ (+ 0.154116 (* x 1.893872)) (+ 1.0 (* x 1.047988))))
           (setq c (/ (- y (/ x y)) 2.0))
           (setq cl 0.0)
           (while (not (equal c cl))
             (setq y (- y c))
             (setq cl c)
             (setq c (/ (- y (/ x y)) 2.0))
           ) y
        )
      )
    )
    (progn
      (princ "Invalid argument.")
      (princ)
    )
  )
)

;;; --------------------------------------------------------------------------;