TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Kerry on September 13, 2007, 08:28:43 PM
-
Anyone have any improvement on these.
As noted, they are intended for Positive value Numbers.
;;;---------------------------------------------------------------------------
;;* kdub:roundUp (numVal roundTo displayPrecision)
;; Raise a numeric positive number UP to the next 'rounded' number
;; and format to n digits
;; kwb@theSwamp 20070814
(DEFUN kdub:roundUp (numVal roundTo displayPrecision / remNum)
(RTOS (FLOAT (IF (= 0 (SETQ remNum (REM numval roundTo)))
numVal
(+ numVal (- roundTo remNum))
)
)
2
displayPrecision
)
)
;;;---------------------------------------------------------------------------
;;;---------------------------------------------------------------------------
;;* kdub:roundNearest (numVal roundTo displayPrecision)
;; Round a numeric positive number to the NEAREST 'rounded' number
;; and format to n digits
;; kwb@theSwamp 20070814
(DEFUN kdub:roundNearest (numVal roundTo displayPrecision / remNum)
(SETQ remNum (REM numVal roundTo))
(RTOS (IF (>= (* 2 remNum) roundTo)
(+ numVal (- roundTo remNum))
(- numVal remNum)
)
2
displayPrecision
)
)
;;;---------------------------------------------------------------------------
(kdub:roundUp 740 25 0) ;=> "750"
(kdub:roundUp 34 10 3) ;=> "40.000"
(kdub:roundUp 77 5 1) ;=> "80"
(kdub:roundUp 3.0034 0.2 2) ;=> "3.20"
(kdub:roundUp 3.0034 0.01 4) ;=> "3.0100"
(kdub:roundUp 3.0034 0.001 4) ;=> "3.0040"
(kdub:roundUp 3.0034 0.0001 4) ;=> "3.0034"
(kdub:roundUp 3.0034 0.0001 3) ;=> "3.003"
(kdub:roundUp 3.0184 0.1 2) ;=> "3.10"
(kdub:roundUp 3.0184 0.01 2) ;=> "3.02"
(kdub:roundUp 3.0184 0.001 2) ;=> "3.02"
(kdub:roundUp 3.0184 1 2) ;=> "4.00"
(kdub:roundUp 3.0184 2 2) ;=> "4.00"
(kdub:roundUp 3.0184 3 2) ;=> "6.00"
(kdub:roundUp 3.0184 5 2) ;=> "5.00"
;;--------------------------------------------------------------------
(kdub:roundNearest 44 5 2) ; "45.00"
(kdub:roundNearest 46 5 2) ; "45.00"
(kdub:roundNearest 42.49 5 2) ; "40.00"
(kdub:roundNearest 42.51 5 2) ; "45.00"
(kdub:roundNearest 42.51 1 2) ; "43.00"
(kdub:roundNearest 42.48 1 2) ; "42.00"
(kdub:roundNearest 42.48 50 2) ; "50.00"
(kdub:roundNearest 24 50 2) ; "0.00"
(kdub:roundNearest 3.1234567 0.001 5) ; "3.12300"
(kdub:roundNearest 3.9876543 0.001 5) ; "3.98800"
(kdub:roundNearest 3.1234567 0.005 5) ; "3.12500"
(kdub:roundNearest 3.9876543 0.005 5) ; "3.99000"
;;--------------------------------------------------------------------
;; ... and
(DISTOF (kdub:roundNearest 3.1234567 0.001 5)) ; 3.123
;; ... etc
-
Kerry,
Two functions by Doug Broad and myself which deal with rounding numbers. They may provide some insight.
;; Joe Burke
(defun round (value to)
(if (zerop to) value
(* (atoi (rtos (/ (float value) to) 2 0)) to)))
;; Doug's version
(defun round (value to)
(setq to (abs to))
(* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to)))
)
Notice both do not use use the rem function in terms of your RoundNearest function.
Rounding up is a different question as I see it.
Regards
-
About rounding...
Evgeniy and i had almost this very same discussion; here are some results you may like.
(BenchMark '((distof (rtos 1.006 2 2) 2)
(/ (fix (+ 0.5 (* 100 1.006))) 100.)
(atof (rtos 1.006 2 2))
(read (rtos 1.006 2 2))
)
)
> kdub:roundNearest
I'll think about this one, you've got a fairly good application there already but i want to see if i cant think up another version.
-
FWIW, mine is very much like Kerry's
(defun dkb_Round(pNum pRoundTo / REM1 RETVAL)
(setq Rem1 (rem pNum pRoundTo))
(if (< Rem1 (/ pRoundTo 2.0))
(setq RetVal (- pNum Rem1))
(setq RetVal (+ pNum (- pRoundTo Rem1)))
);if
RetVal
)
I didn't have a RoundUp, but did have a simple RoundDown
(defun dkb_RoundDown(pNum pRoundTo)
(- pNum (rem pNum pRoundTo))
);defun css_RoundDown
-
this code/tests is dated 2-19-2003 - including the functions by Joe and Doug....
(defun roundNum (num /)
(if (>= (abs (- num (fix num))) 0.5)
(if (minusp num)
(1- (fix num))
(1+ (fix num)))
(fix num)))
(defun roundTo (num to /)
(if (>= (abs (- num (fix num))) to)
(if (minusp num)
(* (/ (fix num) to) to)
(1+ (fix num))
)
(fix num)))
(roundTo -283.1 10)
(setq num 1.4 to 0.4)
(setq num -1.4 to 0.4)
(setq num -283.1 to 10)
(setq num -283.1 to -10)
(setq num -280.6 to -10)
(setq num -1.4 to 0.5)
(setq num -1.4 to -0.8)
(setq num -1.7 to -0.2)
(- 1.4 (rem 1.4 0.5))
(setq num 23321344.677812 to 18)
;; untested
;; (round2 -283.1 10) -> -280
;; (round2 -283.1 -10) -> -280
;; (round2 -283.1 40)
(defun round2 (num to /) (* (/ (fix num) to) to))
(defun round2 (num to /) (- (/ (fix num) to) to))
(rem 3 3.1)
(- 283 (rem 283 10))
(if (< (setq n (- 1.4 (rem 1.4 0.5))) 1.4) (+ n 0.5))
(if (< (setq n (- 283 (rem 283 10))) 283) (+ n 10))
(- 283 (rem 283 50))
(- 1.2 (rem 1.2 0.5))
(- 1.4 (rem 1.4 0.5))
(defun rx (num to) (+ (fix num) (rem to num)))
(setq num 1.4 to 0.5)
(round -283.1 30) -> 270
(round2 -283.1 30) -> -270
(round -283.1 40) -> 280
(round2 -283.1 40) -> -280
(round 1.4 0.5) -> 1.5
(round2 1.4 0.5)
;;DCB - modified due to catch by Joe Burke
(defun round (n to)
(* to
(fix
(/
((if (minusp n) - +)
(/ to 2.0) n) to))))
Command: (round -283.1 10)
-270
(setq n -1.4 to 0.5)
(round -1.4 0.5)
(roundNum -1.4 0.5)
(setq num -1.4 to 0.5)
(setq num -280.6 to -10)
(defun roundNum (num to /)
(if (>= (abs (- num (fix num))) to)
(if (minusp num)
(+ (1- (fix num)) to)
(- (1+ (fix num)) to))
(fix num)))
(+ (+ (abs (fix num)) to) to)
;Thanks Doug Broad and Joe Burke
(defun round (n to)
(setq to (abs to))
((if (minusp n) - +)
(* to (fix (/ (+ (/ to 2.0) (abs n)) to)))
)
)
(setq num -283.1 to 10)
(+ (fix (- num to)) (/ to 2.0))
Command: (round -283.1 10)
280
Command: (round -283.1 -10)
270
Should return -280 in both cases?
; *** num ***
(defun sq (x) (* x x))
(defun mag (x y z)
(sqrt (+ (sq x) (sq y) (sq z))))
(defun mag (x y z)
(- (sq x) (sq y) (sq z)))
(defun dist (p1 p2)
(mag (- (car p1) (car p2))
(- (cadr p1) (cadr p2))
(- (caddr p1) (caddr p2))))
(setq lst (list a b c d))
(setq px (mapcar '(lambda (pt) (mag (car pt) (cadr pt) (caddr pt))) lst))
(defun round (val unit)
(* unit (fix (/ ((if (minusp val) - +) val (* unit 0.5)) unit)))
)
(acet-calc-round -283.1 -10)
(setq num 283.1)
(setq n 10)
(if (< (setq n (- 1.4 (rem 1.4 0.5))) 1.4) (+ n 0.5))
(if (< (setq n (- num (rem num n))) num) (+ n 10))
(setq num 1.2)
(setq n 0.5)
(setq num 283.1)
(setq n 10)
(setq num 285)
(setq n 5)
(setq num 0.9)
(setq n 1)
(setq num -283.1)
(setq n -10)
(cond
((and (<= n 0.5) (< (setq n (- num (rem num n))) num))
(+ n 0.5))
((and (not (minusp num)) (zerop (- num (rem num n))))
(1+ (fix num)))
((and (minusp num) (not (zerop (- num (rem num n)))))
(1- (fix num)))
(t (- num (rem num n))))
(round-to-fraction -283.1 -10)
(round-to-fraction 283.1 10)
(round-to-fraction 1.4 0.5)
(round-to-fraction 285 5)
(defun round-to-fraction (num n /)
(abs
(cond
((and (<= n 0.5) (< (setq n (- num (rem num n))) num))
(+ n 0.5))
((and (not (minusp num)) (zerop (- num (rem num n))))
(1+ (fix num)))
((and (minusp num) (not (zerop (- num (rem num n)))))
(- num (rem num n)))
(t (- num (rem num n))))))
;; ultima correccion de Doug.. sirve
(defun round (value to)
(setq to (abs to))
(* to
(fix (/ ((if (minusp value)
-
+)
value
(* to 0.5))
to))))
Sample data:
(round 283 10)
280
(round -283 10)
-280
(round -283 -10)
-280
(round 283 10.0)
280.0
(round 1.4 0.5)
(round 283.1 10)
;;;------------------------------------------------------------------------------
;;;;;;(setq num -283)
;;;;;;
;;;;;;object.AddDimRotated (XLine1Point, XLine2Point, DimLineLocation, RotationAngle)
;;;;;;
;;;;;;(entget ent)
;;;;;;
;;;;;;(setq obj (vlax-ename->vla-object ent))
;;;;;;
;;;;;;(vla-put-roundDistance obj 10)
;;;;;;(vla-get-measurement obj)
;;;;;;(vla-update obj)
(* (fix (/ 283.0 10)) 10)
(if (<= 0.5 0.5)
(- (fix (/ 1.4 0.5)) 0.5)
(* (fix (/ 283.0 10)) 10))
(setq num 1.4 n 0.5)
(setq num 283 n 10.0)
(not (zerop (- num (fix num))))
(defun round (num n)
(if (<= (rem num n) n)
(- (fix (/ num n)) n)
(* (fix (/ num n)) n)))
(setq num 283.1 n 10)
(setq num -283.1 n 30)
(setq num -283.1 n 40)
(acet-calc-round -283.1 40)
(round -283.1 0.0) ;revisar no division por cero
;;;(defun round (num n / x)
;;; ;; is a fraction?
;;; (if (and (not (zerop (setq x (- num (fix num)))))
;;; (not (equal x 0.1 0.0001)))
;;; (- (fix (/ num n)) n)
;;; (* (fix (/ num n)) n)))
(defun round (value to)
(setq to (abs to))
(* to
(fix (/ ((if (minusp value)
-
+)
value
(* to 0.5))
to))))
;; LE mi funcion de redondeo...
(defun round (num n / x)
(cond
((and (not (zerop (setq x (- num (fix num)))))
(not (equal x 0.1 0.0001))
(not (minusp x)))
(- (fix (/ num n)) n))
(t (* (fix (/ num n)) n))))
Command: (round -283.283283 0.001)
-283.283
Command: (round -283.283283 0.002)
-283.284
(acet-calc-round -283.283283 0.002)
(setq num -283.283283 n 0.002)
-
Hi,
my way looks like Doug's one
;;; (round pi 0.01) -> 3.14
;;; (round pi 1e-5) -> 3.14159
;;; (round 5456.50 1) -> 5457
;;; (round 5456.50 100) -> 5500
(defun round (num prec)
(* prec
(if (minusp num)
(fix (- (/ num prec) 0.5))
(fix (+ (/ num prec) 0.5))
)
)
)
-
Thanks guys
Initially I didn't need functionality for negative numbers, but I think I'll change it just for completeness.
I removed my display option for testing ..
(SETQ numVal 2.987654
roundTo 0.005
)
(BenchMark '(
(db:round numVal roundTo)
(jb:round numVal roundTo)
(gile:round numVal roundTo)
(kdub:roundNearest numVal roundTo)
(le:roundTo numVal roundTo)
)
)
Benchmarking [M.P. @ the Swamp 2005] ..................
Elapsed milliseconds for 32768 iteration(s)/ relative Timing :
(JB:ROUND NUMVAL ROUNDTO) ..............2000 / 1.1331 <slowest>
(DB:ROUND NUMVAL ROUNDTO) ..............1797 / 1.0181
(KDUB:ROUNDNEAREST NUMVAL ROUNDTO).....1797 / 1.0181
(LE:ROUNDTO NUMVAL ROUNDTO). ...........1797 / 1.0181
(GILE:ROUND NUMVAL ROUNDTO) ............1765 / 1.0000 <fastest>
ADDED: included Luis's routine
ADDED-2: When you really look at these numbers, the difference in process speed is pretty small :-)
.. a quarter of a second for 32000 process cycles
-
Thanks guys
Initially I didn't need functionality for negative numbers, but I think I'll change it just for completeness.
I removed my display option for testing ..
Kerry,
A bit of history behind the discussion Luis mentioned. Doug had posted a rounding function sometime before. I found it did not work with negative numbers. That kicked off a rather lengthy thread to solve that issue in an efficient manner.
The result was two versions, one by Doug and one by me, which I think everyone agreed worked equally as well.
Regards