(defun calculate-level-sums (lst)
  (calculate-level-sums-helper lst 1 '()))

(defun calculate-level-sums-helper (lst level acc)
  (cond
    ((null lst) acc) ; Базовый случай: пустой список
    (t (multiple-value-bind (new-acc remaining-list)
           (process-level lst level acc)
         (calculate-level-sums-helper remaining-list level new-acc)))))

(defun process-level (lst level acc)
  (cond
    ((null lst) (values acc nil)) ; Базовый случай: пустой список, возвращаем аккумулятор и nil, как признак окончания
    ((numberp (car lst))
     (let ((new-acc (update-level-sum acc level (car lst))))
       (values new-acc (cdr lst)))) ; Обновляем аккумулятор и переходим к следующему элементу
    ((listp (car lst))
     (multiple-value-bind (inner-acc remaining-inner)
        (calculate-level-sums-helper (car lst) (1+ level) acc) ; Рекурсивно обрабатываем подсписок
      (values inner-acc (cdr lst)))); Возвращаем аккумулятор от подсписка и остаток исходного
    (t (values acc (cdr lst))))) ; Игнорируем не числовые атомы и продолжаем обработку

(defun update-level-sum (acc level 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))))

(defun prepare-result (acc)
    (let ((has-level-one (assoc 1 acc)))
        (if has-level-one
          (sort acc #'< :key #'car)
          (sort (cons '(1 0) acc) #'< :key #'car))))

(defun calculate-level-sums (lst)
  (let ((acc '())) ; Initial accumulator
    (let ((result (calculate-level-sums-helper lst 1 acc)))
      (prepare-result result))))


; Тесты
(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 3) (2 3) (3 10))