Author Topic: Round UP and to NEAREST  (Read 5488 times)

0 Members and 1 Guest are viewing this topic.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Round UP and to NEAREST
« on: September 13, 2007, 08:28:43 PM »
Anyone have any improvement on these.
As noted, they are intended for Positive value Numbers.
Code: [Select]
;;;---------------------------------------------------------------------------
;;* 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
    )
)
;;;---------------------------------------------------------------------------
Code: [Select]
;;;---------------------------------------------------------------------------
;;* 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
    )
)
;;;---------------------------------------------------------------------------
Quote
(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
« Last Edit: September 13, 2007, 08:30:42 PM by Kerry Brown »
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Joe Burke

  • Guest
Re: Round UP and to NEAREST
« Reply #1 on: September 14, 2007, 10:33:18 AM »
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

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9717
Re: Round UP and to NEAREST
« Reply #2 on: September 14, 2007, 11:23:28 AM »
About rounding...
Evgeniy and i had almost this very same discussion; here are some results you may like.
Code: [Select]
(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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

SomeCallMeDave

  • Guest
Re: Round UP and to NEAREST
« Reply #3 on: September 14, 2007, 06:04:08 PM »
FWIW, mine is very much like Kerry's

Code: [Select]


(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
Code: [Select]
(defun dkb_RoundDown(pNum pRoundTo)
  (- pNum (rem pNum pRoundTo))
);defun css_RoundDown


LE

  • Guest
Re: Round UP and to NEAREST
« Reply #4 on: September 14, 2007, 06:29:54 PM »
this code/tests is dated 2-19-2003 - including the functions by Joe and Doug....

Code: [Select]
(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)

gile

  • Water Moccasin
  • Posts: 2283
  • Marseille, France
Re: Round UP and to NEAREST
« Reply #5 on: September 14, 2007, 06:33:29 PM »
Hi,

my way looks like Doug's one

Code: [Select]
;;; (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))
     )
  )
)
Speaking English as a French Frog

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Round UP and to NEAREST
« Reply #6 on: September 14, 2007, 07:13:44 PM »
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 ..
 
Code: [Select]
(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)
            )
)

Quote
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
« Last Edit: September 14, 2007, 07:36:27 PM by Kerry Brown »
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

Joe Burke

  • Guest
Re: Round UP and to NEAREST
« Reply #7 on: September 18, 2007, 11:04:46 AM »
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