;-----------------------------------------------------------------------------------
; Функция округления числа по правилам статистики (Правило четной цифры).
; (C)KAI, 2006 г. (413-2) 65-05-10 Магадан. http://geol-dh.ru/ (http://geol-dh.narod.ru/)
;-----------------------------------------------------------------------------------
(defun RTOS_ROUND_STAT (numb prec / )
; Параметры: 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
(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 ***
|
|