(defun calculate-level-sums (lst)
  "Вычисляет суммы чисел на каждом уровне вложенности списка lst.
   Возвращает список пар (уровень сумма), отсортированный по уровню."
  (prepare-result (calculate-level-sums-helper lst 1 '())))

(defun calculate-level-sums-helper (lst level acc)
  "Рекурсивная функция, которая проходит по списку lst на заданном уровне level,
   накапливая суммы чисел в аккумуляторе acc. Аккумулятор acc - это список пар (уровень сумма)."
  (cond
    ((null lst) acc) ; Базовый случай: если список пуст, возвращаем аккумулятор
    (t (let ((head (car lst))  ; Берем первый элемент списка
             (tail (cdr lst))) ; Берем остаток списка
         (multiple-value-bind (new-acc remaining-tail)  ; Обрабатываем текущий элемент
           (process-item head level acc) ; Функция process-item определяет, что делать с элементом
           (calculate-level-sums-helper tail level new-acc)))))) ; Рекурсивно вызываем себя для остатка списка

(defun process-item (item level acc)
  "Обрабатывает один элемент item на заданном уровне level.
   Если элемент - число, обновляет аккумулятор.
   Если элемент - список, рекурсивно вызывает calculate-level-sums-helper для этого списка."
  (cond
    ((numberp item) ; Если элемент - число
     (values (update-level-sum acc level item) nil)) ; Обновляем сумму для уровня и возвращаем новый аккумулятор
    ((listp item) ; Если элемент - список
     (values (calculate-level-sums-helper item (1+ level) acc) nil)) ; Рекурсивно вызываем себя для списка, увеличив уровень
    (t (values acc nil)))) ; Если элемент - не число и не список (например, символ), просто игнорируем его

(defun update-level-sum (acc level value)
  "Обновляет аккумулятор acc суммой для заданного уровня level, добавляя value.
   Если уровень уже есть в аккумуляторе, добавляет value к существующей сумме.
   Иначе, добавляет новую пару (уровень value) в аккумулятор."
  (let ((existing (assoc level acc))) ; Ищем существующую запись для уровня
    (if existing ; Если уровень уже есть в аккумуляторе
        (let ((new-acc (remove existing acc :test #'equal))) ; Удаляем старую запись
          (cons (list level (+ value (cadr existing))) new-acc)) ; Добавляем обновленную запись с новой суммой
        (cons (list level value) acc)))) ; Иначе, добавляем новую пару (уровень value) в аккумулятор

(defun prepare-result (acc)
  "Подготавливает результат, сортируя аккумулятор по уровню и добавляя уровень 1 с суммой 0, если его нет."
  (if (assoc 1 acc) ; Проверяем, есть ли уровень 1 в аккумуляторе
      (sort acc #'< :key #'car) ; Если есть, сортируем аккумулятор по уровню
      (sort (cons '(1 0) acc) #'< :key #'car))) ; Иначе, добавляем (1 0) и сортируем

;; Тесты
(format t "~a~%" (calculate-level-sums '(a (b (4 (2 e (3) k 15) e 5) 7)))) ; ((1 0) (2 7) (3 9) (4 17) (5 3))
(format t "~a~%" (calculate-level-sums '(a b c))) ; ((1 0))
(format t "~a~%" (calculate-level-sums '(1 (2 (3))))) ; ((1 1) (2 2) (3 3))
(format t "~a~%" (calculate-level-sums'(1 (2 3 (4 (5 6)))))) ; ((1 1) (2 5) (3 4) (4 11))