Главная СПДС СПДС. Функция RTOS_ROUND_STAT

;-----------------------------------------------------------------------------------
; Функция округления числа по правилам статистики (Правило четной цифры).
; (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 ***

  при полном или частичном использовании материалов сайта ссылка на источник обязательна ©2002-2012