[CB]

Надеюсь будет полезна небольшая функция для округления чисел.
Может использоваться, например для корректировки длин линий, величины размера и т.д.

Код:

[Выделить все]

;|Функция (round число <точность округления>)
Аргумент ЧИСЛО округляется в зависимости от значения аргумента <точность округления>
Примеры вызова:
(round 126.643 0.1) 126.6 
(round 126.663 0.1) 126.7
(round 126.243 0.5) 126.0
(round 126.643 0.5) 126.5
(round 126.843 0.5) 127.0
(round 126.443 1) 126
(round 126.543 1) 127
(round 122.343 5) 120
(round 122.843 5) 125
(round 126.843 5) 125
(round 127.843 5) 130
Ну и т.д.
|;
(defun round (value precision)
  ((lambda (x)
     (if (apply '<= (list (rem x 1.) 0.5))
       (* (fix x) precision)
       (+ (* (fix x) precision) precision)
     ) ;_ end of if
   ) ;_ end of lambda
    (apply '/ (mapcar 'float (list value precision)))
  )
) ;_ end of defun

[zenon]

Не понял, а каких чисел? чисел чего?

[Кулик Алексей aka kpblc]

Тогда уж _dwgru-value-round или как-то так надо называть...

[Alaspher]

Сдаётся мне, что результат будет одинаков:

Код:

[Выделить все]

(defun round (val prec)
 (* (fix (+ (/ val (float prec)) 0.5)) prec)
)

[CB]

Кулик Алексей aka kpblc
Здесь раздел только для функций библиотеки _dwgru или можно выкладывать функции не претендующие для нее? Я выложил просто так...
Alaspher
Сдается мне, что тоже... Как всегда красиво!

[Кулик Алексей aka kpblc]

CB, ну как бы тут функции, которые планируется включать в DwgRuLispLib Ну и именование соответствующее

[Mazai]

Выкладываю немного доработанную функцию, позволяющую округлять ещё и список чисел. У меня это было вызвано необходимостью округлять значения координат до определённой точности.

Код:

[Выделить все]

;|===========================================================
*	Функция округления чисел задаваемой точностью
*	Параметры вызова:
*		value 		- число или список чисел
*		precision 	- точность округления
*
*	Пример вызова:
*		(_dwgru-value-round (list 123.122 234.32) 0.01)
*					-> (123.12 234.32)
*		(_dwgru-value-round 123.122 0.01)
*					-> 123.12
=============================================================|;

(defun _dwgru-value-round (value precision)
   (if (= (type value) 'LIST)
     (mapcar '(lambda (El) (* (fix (+ (/ El (float precision)) 0.5)) precision)) value)
     (* (fix (+ (/ value (float precision)) 0.5)) precision)
   ) ;_ end if
)

[Елпанов Евгений]

Странные у вас округления...
Для сравнения, я взял все представленные здесь программы и стандартную rtos.
Чтоб небыло разночтений, сначала выкладываю все коды программ:

Код:

[Выделить все]

(defun round (value precision)
  ((lambda (x)
     (if (apply '<= (list (rem x 1.) 0.5))
       (* (fix x) precision)
       (+ (* (fix x) precision) precision)
     ) ;_ end of if
   ) ;_ end of lambda
    (apply '/ (mapcar 'float (list value precision)))
  )
)
(defun round1 (val prec)
 (* (fix (+ (/ val (float prec)) 0.5)) prec)
)
(defun _dwgru-value-round (value precision)
   (if (= (type value) 'LIST)
     (mapcar '(lambda (El) (* (fix (+ (/ El (float precision)) 0.5)) precision)) value)
     (* (fix (+ (/ value (float precision)) 0.5)) precision)
   ) ;_ end if
)

А теперь сравнительный анализ отрицательных чисел:

Код:

[Выделить все]

(atof (rtos -1.04 2 1)) ; -1.0
(round -1.04 0.1) ; -0.9
(round1 -1.04 0.1) ; -1.0
(_dwgru-value-round -1.04 0.1) ; -0.9

(atof (rtos -1.06 2 1)) ; -1.1
(round -1.06 0.1) ; -1.0
(round1 -1.06 0.1) ; -1.0
(_dwgru-value-round -1.06 0.1) ; -1.0

[KAI]

>EE
Прикольно! Наступаем на те же грабли, только отрицательные.

[CB]

>Елпанов Евгений
Согласен... Наверно так будет корректнее:

Код:

[Выделить все]

(defun round (val prec)
  ((lambda (a)
     (* (fix ((eval a) (/ val (float prec)) 0.5)) prec)
   ) ;_ end of lambda
    (if (minusp val) - +)
  )
) ;_ end of defun

[Елпанов Евгений]

Сообщение от CB >Елпанов Евгений Согласен... Наверно так будет корректнее:

тогда уж так:

Код:

[Выделить все]

(defun round(val prec)
 (*(fix((if(minusp val)- +)(/ val(float prec))0.5))prec)
)

Хотя, я предпочитаю

Код:

[Выделить все]

(atof (rtos -1.06 2 1))

В конечном итоге, так быстрее...

[KAI]

Может моя функция подойдет?

Код:

[Выделить все]

;-----------------------------------------------------------------------------------
; Функция округления числа по правилам статистики (Правило четной цифры).
; (C)KAI, 2006 г. (413-2) 65-05-10 Магадан. http://geol-dh.ru/ (http://geol-dh.narod.ru/)
;-----------------------------------------------------------------------------------
(defun RTOS_ROUND_STAT (numb prec / numb_str numb_prec numb_int numb_temp)
  ; Параметры: numb - число для округления (вещественное или целое)
  ;            prec - точность округления (число чисел после десятичной точки)

  ; Возвращает: numb_str - строку с заданной точностью
  
  ;   Текущее значение системной переменной DIMZIN влияет вид возвращаемой строки:
  ;   DIMZIN = 0 - незначащие нули в строке выводятся,
  ;   DIMZIN = 8 - незначащие нули в строке отсекаются
  
  ; Как известно, AutoCAD при цифре 5 всегда выполняет округление предыдущей цифры в большую сторону.
  ; Что для некоторых случаев не всегда корректно (например, при подсчете запасов золота),
  ; так как в общем случае сумма таких округленных значений будет завышена.
  
  ; Округление в функции работает по "Правилу четной цифры".
  ;  Округление производится постепенно, справа налево:
  ;   1. когда последняя значащая цифра меньше 4, она просто отбрасывается;
  ;   2. в том случае, если она больше 6, ближайшая слева от нее цифра увеличивается на единицу;
  ;   3. когда она равна 5, ближайшая слева от нее цифра увеличивается на единицу, если она нечетная,
  ;   или не изменяется, если она четная
  ;
  ; Ограничения: Округление выполняется только по 3-м цифрам после заданной точности,
  ;               за пределами - округление идет по правилам Acad
  ;              Функция работает до значений numb_prec < 99'999'999'999'999,
  ;              то есть практически до 99 миллиардов при точности в 3 знака
  ;              при превышении данного значения - строка возвращается встроенной функцией RTOS
  ;
  (setq numb_str (rtos numb 2 prec)); значение по умолчанию, округление по правилам Acad
  (if (= geo_com_rstat- 1); эта переменная отвечает за округление по правилам статистики!
    (progn
      (setq numb_prec (* numb (expt 10 prec))); увеличиваем число на 10 в степени prec
      ; Проверка: цифры за пределами заданной точности лежат в указанных пределах?
      ; Пределы задаются такие, чтобы округление до десятых давало всегда цифру 5
      (if (and (< numb_prec 99999999999999)
               (> (setq numb_temp (atof (rtos (abs (- numb_prec (setq numb_int (fix numb_prec)))) 2 3))) 0.454)
               (< numb_temp 0.546)
               );and
        (if (/= (rem numb_int 2) 0);если число перед цифрой 5 - нечетное
          ;да: увеличиваем число на единицу и приводим к прежнему порядку
          (if (minusp numb_int); что для отрицательных чисел равносильно уменьшению на единицу!
            (setq numb_str (rtos (/ (1- numb_int) (expt 10.0 prec)) 2 prec))
            (setq numb_str (rtos (/ (1+ numb_int) (expt 10.0 prec)) 2 prec))
          )
          ;нет: только приводим к прежнему порядку
          (setq numb_str (rtos (/ numb_int (expt 10.0 prec)) 2 prec))
        )
      )
    )
  )
  numb_str ; строка с заданной точностью
);end of *** RTOS_ROUND_STAT ***
;

[CB]

Собственно эта ф-ция не в противовес стандартной rtos, а просто для расширения возможностей при округлении чисел... Например можно ли с помощью rtos округлить так?

Код:

[Выделить все]

 
(round 126.243 0.5) 126.0
(round 126.643 0.5) 126.5
(round 126.843 0.5) 127.0
(round 122.343 5) 120
(round 122.843 5) 125
(round 126.843 5) 125
(round 127.843 5) 130

[Елпанов Евгений]

Сообщение от CB Собственно эта ф-ция не в противовес стандартной rtos, а просто для расширения возможностей при округлении чисел... Например можно ли с помощью rtos округлить так? Код: [Выделить все] (round 126.243 0.5) 126.0 (round 126.643 0.5) 126.5 (round 126.843 0.5) 127.0 (round 122.343 5) 120 (round 122.843 5) 125 (round 126.843 5) 125 (round 127.843 5) 130

для таких случаев, я тоже умножаю и делю на некоторое число, но для округлений использую rtos. Попробуй сравнить скорость этих программ и поймешь, что встроенная функция быстрее...

[VVA]

Еще тема про функции округления
http://www.theswamp.org/index.php?topic=18695.0

[Елпанов Евгений]

Сообщение от VVA Еще тема про функции округления http://www.theswamp.org/index.php?topic=18695.0

ага, самой быстрой из всех, оказалась функция:

Код:

[Выделить все]

;; Joe Burke
(defun round (value to)
  (if (zerop to) value
    (* (atoi (rtos (/ (float value) to) 2 0)) to)))

т.е. использование fix - только видимость ускорения...

[Vov.Ka]

если дело в скорости, то...

Код:

[Выделить все]

(defun vk_RoundReal (InReal Precision)
  (/ (fix (- (* InReal (setq Precision (expt 10. Precision)))
	     (/ (abs InReal) InReal -2.)
	  )
     )
     Precision
  )
)

хотя сам я использую (atof (rtos -1.06 2 1)), для надежности что ли

[Krieger]

Сообщение от CB Собственно эта ф-ция не в противовес стандартной rtos, а просто для расширения возможностей при округлении чисел... Например можно ли с помощью rtos округлить так? Код: [Выделить все] (round 126.243 0.5) 126.0 (round 126.643 0.5) 126.5 (round 126.843 0.5) 127.0 (round 122.343 5) 120 (round 122.843 5) 125 (round 126.843 5) 125 (round 127.843 5) 130

Можно.

Код:

[Выделить все]

(defun Kr_roundof (num presc / )
(* (atof (rtos (/ num presc) 2 0)) presc)
  )

[superkot007]

Сообщение от Alaspher Сдаётся мне, что результат будет одинаков: Код: [Выделить все] (defun round (val prec) (* (fix (+ (/ val (float prec)) 0.5)) prec) )

Не всегда.
Округление "до сотых" функцией из шапки сбоИт - 134.465 с точностью 0.01 округляется до 134.46.
Возможно, не принципиально, но все-таки...
Если поменять местами строки

Код:

[Выделить все]

 
       (+ (* (fix x) precision) precision)
       (* (fix x) precision)

то 134.465 округляется правильно, до 134.47.