Напишите функцию format+ - Lisp

Узнай цену своей работы

Формулировка задачи:

Напишите функцию format+, которая поддерживает все возможности функции format, но вдобавок позволяет обрабатывать форматную директиву ~z, предназначенную для форматирования страхового номера индивидуального лицевого счета (СНИЛС) гражданина РФ. СНИЛС должен форматироваться следующим образом: ABC-DEF-GHI-CC, где ABC, DEF и GHI – группы из трех цифр, а CC (контрольная сумма) – группа из двух цифр. Контрольная сумма рассчитывается следующим образом: 1. Находится сумма произведений цифр номера на номер их позиции, то есть A*9+B*8+C*7+D*6+E*5+F*4+G*3+H*2+I. 2. Находится остаток от деления суммы на 101 и из него берутся две младших цифры, они и являются контрольной суммой. Аргументом директивы ~z может являться либо целое положительное число, либо строка. Если в числе не хватает значащих цифр, то слева оно дополняется нулями до 11 разрядов. Строка может содержать не более 11 десятичных цифр. В случае недопустимых аргументов и других ошибок считать СНИЛС неправильно сформированным и отображать как [bad SNILS]. Примеры форматирования с помощью директивы ~z: (format+ t "Vasya's ~a = ~z" "SNILS" "00202203341") ==> Vasya's SNILS = 002-022-033-41 (format+ nil "~d: ~z, ~d: ~z" 1 120344511 2 "111abc22233344") ==> "1: [bad SNILS], 2: [bad SNILS]" Замечание: Для упрощения задания можно считать, что директива ~z не поддерживается внутри условной директивы ~[, внутри циклов ~{ и в сочетании с директивами выбора аргументов типа ~:* Подсказка: Разумеется, реализовывать самостоятельно все директивы функции format не нужно. Нужно обработать директиву ~z и затем передать новую форматную строку и измененный список аргументов в функцию format.

Решение задачи: «Напишите функцию format+»

textual
Листинг программы
  1. (defun check-dig (s)
  2.   (dotimes (i (length s) t)
  3.      (when (null (search (subseq s i (+ i 1)) "0123456789")) (return nil))))
  4.  
  5. (defun check-sum (n)
  6.   (let ((c 1)
  7.         (s 0))
  8.     (dotimes (i 9 (mod (mod s 101) 100))
  9.        (setf s (+ s (* c (mod n 10))))
  10.        (setf n (truncate (/ n 10)))
  11.        (setf c (+ c 1)))))
  12.  
  13. (defun fsnils (snils)
  14.   (let ((sn 0)
  15.         (ds "")
  16.         (cs 0))
  17.     (cond ((not (or (integerp snils) (stringp snils))) "[bad SNILS]")
  18.           ((and (integerp snils) (> snils 99999999999)) "[bad SNILS]")
  19.           ((and (stringp snils) (not (check-dig snils))) "[bad SNILS]")          
  20.           (t (when (stringp snils) (setf sn (parse-integer snils))
  21.                                    (setf ds (format nil "~11,'0d" sn)))
  22.              (when (integerp snils)(setf ds (format nil "~11,'0d" snils)))                      
  23.              (setf cs (check-sum (truncate (/ (parse-integer ds) 100))))
  24.              (if (/= cs  (mod (parse-integer ds) 100)) "[bad SNILS]"
  25.                  (concatenate 'string (subseq ds 0 3) "-"
  26.                                       (subseq ds 3 6) "-"
  27.                                       (subseq ds 6 9) "-"
  28.                                       (format nil "~2d" cs)))))))
  29.  
  30. (defun prepro (fstr arglist)
  31.   (let ((fstro "")
  32.         (argo nil)
  33.         (pz 0))        
  34.     (loop
  35.           (setf pz (search "~z" fstr))
  36.           (when (null pz) (return (list (concatenate 'string fstro fstr) (append argo arglist))))
  37.           (setf pz (search "~" fstr))
  38.           (when (null pz) (return (list (concatenate 'string fstro fstr) (append argo arglist))))
  39.           (when (plusp pz) (setf fstro (concatenate 'string fstro (subseq fstr 0 pz)))
  40.                            (setf fstr (subseq fstr pz)))
  41.           (cond ((string= "z" (subseq fstr 1 2))
  42.                  (setf fstro (concatenate 'string fstro (fsnils (car arglist))))
  43.                  (setf fstr (subseq fstr 2))
  44.                  (setf arglist (cdr arglist)))
  45.                 (t (setf fstro (concatenate 'string fstro (subseq fstr 0 2)))
  46.                    (setf fstr (subseq fstr 2))
  47.                    (setf argo (append argo (list (car arglist))))
  48.                    (setf arglist (cdr arglist)))))))
  49.                    
  50. (defun format+ (to fstr &rest arglist)
  51.   (let ((p (prepro fstr arglist)))
  52.     (apply #'format (append  (list to (car p)) (cadr p)))))

Объяснение кода листинга программы

  1. Функция check-dig принимает строку s и возвращает nil, если строка не является допустимым контрольным числом, иначе возвращает t.
  2. Функция check-sum принимает число n и возвращает контрольную сумму в виде строки.
  3. Функция fsnils принимает строку snils и возвращает строку с проверенным и отформатированным контрольным числом.
  4. Функция prepro принимает строку fstr и список аргументов arglist и возвращает список, где первый элемент - отформатированная строка без значений, второй элемент - список аргументов без значений.
  5. Функция format+ принимает символ to, строку fstr и список аргументов arglist и возвращает отформатированную строку.

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

7   голосов , оценка 4.571 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы