fork download
  1. (defun calculate-level-sums (lst)
  2. (calculate-level-sums-helper lst 1 '()))
  3.  
  4. (defun calculate-level-sums-helper (lst level acc)
  5. (cond
  6. ((null lst) acc) ; Базовый случай: пустой список
  7. (t (multiple-value-bind (new-acc remaining-list)
  8. (process-level lst level acc)
  9. (calculate-level-sums-helper remaining-list level new-acc)))))
  10.  
  11. (defun process-level (lst level acc)
  12. (cond
  13. ((null lst) (values acc nil)) ; Базовый случай: пустой список, возвращаем аккумулятор и nil, как признак окончания
  14. ((numberp (car lst))
  15. (let ((new-acc (update-level-sum acc level (car lst))))
  16. (values new-acc (cdr lst)))) ; Обновляем аккумулятор и переходим к следующему элементу
  17. ((listp (car lst))
  18. (multiple-value-bind (inner-acc remaining-inner)
  19. (calculate-level-sums-helper (car lst) (1+ level) acc) ; Рекурсивно обрабатываем подсписок
  20. (values inner-acc (cdr lst)))); Возвращаем аккумулятор от подсписка и остаток исходного
  21. (t (values acc (cdr lst))))) ; Игнорируем не числовые атомы и продолжаем обработку
  22.  
  23. (defun update-level-sum (acc level value)
  24. (let ((existing (assoc level acc)))
  25. (if existing
  26. (let ((new-acc (remove existing acc :test #'equal)))
  27. (cons (list level (+ value (cadr existing))) new-acc))
  28. (cons (list level value) acc))))
  29.  
  30. (defun prepare-result (acc)
  31. (let ((has-level-one (assoc 1 acc)))
  32. (if has-level-one
  33. (sort acc #'< :key #'car)
  34. (sort (cons '(1 0) acc) #'< :key #'car))))
  35.  
  36. (defun calculate-level-sums (lst)
  37. (let ((acc '())) ; Initial accumulator
  38. (let ((result (calculate-level-sums-helper lst 1 acc)))
  39. (prepare-result result))))
  40.  
  41.  
  42. ; Тесты
  43. (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))
  44. (format t "~a~%" (calculate-level-sums '(a b c))) ; ((1 0))
  45. (format t "~a~%" (calculate-level-sums '(1 (2 (3))))) ; ((1 1) (2 2) (3 3))
  46. (format t "~a~%" (calculate-level-sums '(1 2 (3 4 (5 6))))) ; ((1 3) (2 3) (3 10))
Success #stdin #stdout #stderr 0.02s 9560KB
stdin
Standard input is empty
stdout
((1 0) (2 7) (3 9) (4 17) (5 3))
((1 0))
((1 1) (2 2) (3 3))
((1 3) (2 7) (3 11))
stderr
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x15290aa00000 - 0x15290ace4fff
  0x15290ae15000 - 0x15290ae39fff
  0x15290ae3a000 - 0x15290afacfff
  0x15290afad000 - 0x15290aff5fff
  0x15290aff6000 - 0x15290aff8fff
  0x15290aff9000 - 0x15290affbfff
  0x15290affc000 - 0x15290affffff
  0x15290b000000 - 0x15290b002fff
  0x15290b003000 - 0x15290b201fff
  0x15290b202000 - 0x15290b202fff
  0x15290b203000 - 0x15290b203fff
  0x15290b280000 - 0x15290b28ffff
  0x15290b290000 - 0x15290b2c3fff
  0x15290b2c4000 - 0x15290b3fafff
  0x15290b3fb000 - 0x15290b3fbfff
  0x15290b3fc000 - 0x15290b3fefff
  0x15290b3ff000 - 0x15290b3fffff
  0x15290b400000 - 0x15290b403fff
  0x15290b404000 - 0x15290b603fff
  0x15290b604000 - 0x15290b604fff
  0x15290b605000 - 0x15290b605fff
  0x15290b681000 - 0x15290b684fff
  0x15290b685000 - 0x15290b685fff
  0x15290b686000 - 0x15290b687fff
  0x15290b688000 - 0x15290b688fff
  0x15290b689000 - 0x15290b689fff
  0x15290b68a000 - 0x15290b68afff
  0x15290b68b000 - 0x15290b698fff
  0x15290b699000 - 0x15290b6a6fff
  0x15290b6a7000 - 0x15290b6b3fff
  0x15290b6b4000 - 0x15290b6b7fff
  0x15290b6b8000 - 0x15290b6b8fff
  0x15290b6b9000 - 0x15290b6b9fff
  0x15290b6ba000 - 0x15290b6bffff
  0x15290b6c0000 - 0x15290b6c1fff
  0x15290b6c2000 - 0x15290b6c2fff
  0x15290b6c3000 - 0x15290b6c3fff
  0x15290b6c4000 - 0x15290b6c4fff
  0x15290b6c5000 - 0x15290b6f2fff
  0x15290b6f3000 - 0x15290b701fff
  0x15290b702000 - 0x15290b7a7fff
  0x15290b7a8000 - 0x15290b83efff
  0x15290b83f000 - 0x15290b83ffff
  0x15290b840000 - 0x15290b840fff
  0x15290b841000 - 0x15290b854fff
  0x15290b855000 - 0x15290b87cfff
  0x15290b87d000 - 0x15290b886fff
  0x15290b887000 - 0x15290b888fff
  0x15290b889000 - 0x15290b88efff
  0x15290b88f000 - 0x15290b891fff
  0x15290b894000 - 0x15290b894fff
  0x15290b895000 - 0x15290b895fff
  0x15290b896000 - 0x15290b896fff
  0x15290b897000 - 0x15290b897fff
  0x15290b898000 - 0x15290b898fff
  0x15290b899000 - 0x15290b89ffff
  0x15290b8a0000 - 0x15290b8a2fff
  0x15290b8a3000 - 0x15290b8a3fff
  0x15290b8a4000 - 0x15290b8c4fff
  0x15290b8c5000 - 0x15290b8ccfff
  0x15290b8cd000 - 0x15290b8cdfff
  0x15290b8ce000 - 0x15290b8cefff
  0x15290b8cf000 - 0x15290b8cffff
  0x555c5df0f000 - 0x555c5dffffff
  0x555c5e000000 - 0x555c5e109fff
  0x555c5e10a000 - 0x555c5e169fff
  0x555c5e16b000 - 0x555c5e199fff
  0x555c5e19a000 - 0x555c5e1cafff
  0x555c5e1cb000 - 0x555c5e1cefff
  0x555c5fe4c000 - 0x555c5fe6cfff
  0x7ffece2d4000 - 0x7ffece2f4fff
  0x7ffece323000 - 0x7ffece326fff
  0x7ffece327000 - 0x7ffece328fff