fork download
copy 
  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))))
Success #stdin #stdout #stderr 0.02s 9504KB
comments (?)
stdin
copy 
(format t "~a~%" (calculate-level-sums '(a (b (4 (2 e (3) k 15) e 5) 7))))
(format t "~a~%" (calculate-level-sums '(1 (2 (3)))))
(format t "~a~%" (calculate-level-sums '(1 2 (3 4 (5 6)))))
stdout
copy 
Standard output is empty
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x1485b4e00000 - 0x1485b50e4fff
  0x1485b5215000 - 0x1485b5239fff
  0x1485b523a000 - 0x1485b53acfff
  0x1485b53ad000 - 0x1485b53f5fff
  0x1485b53f6000 - 0x1485b53f8fff
  0x1485b53f9000 - 0x1485b53fbfff
  0x1485b53fc000 - 0x1485b53fffff
  0x1485b5400000 - 0x1485b5402fff
  0x1485b5403000 - 0x1485b5601fff
  0x1485b5602000 - 0x1485b5602fff
  0x1485b5603000 - 0x1485b5603fff
  0x1485b5680000 - 0x1485b568ffff
  0x1485b5690000 - 0x1485b56c3fff
  0x1485b56c4000 - 0x1485b57fafff
  0x1485b57fb000 - 0x1485b57fbfff
  0x1485b57fc000 - 0x1485b57fefff
  0x1485b57ff000 - 0x1485b57fffff
  0x1485b5800000 - 0x1485b5803fff
  0x1485b5804000 - 0x1485b5a03fff
  0x1485b5a04000 - 0x1485b5a04fff
  0x1485b5a05000 - 0x1485b5a05fff
  0x1485b5a64000 - 0x1485b5a67fff
  0x1485b5a68000 - 0x1485b5a68fff
  0x1485b5a69000 - 0x1485b5a6afff
  0x1485b5a6b000 - 0x1485b5a6bfff
  0x1485b5a6c000 - 0x1485b5a6cfff
  0x1485b5a6d000 - 0x1485b5a6dfff
  0x1485b5a6e000 - 0x1485b5a7bfff
  0x1485b5a7c000 - 0x1485b5a89fff
  0x1485b5a8a000 - 0x1485b5a96fff
  0x1485b5a97000 - 0x1485b5a9afff
  0x1485b5a9b000 - 0x1485b5a9bfff
  0x1485b5a9c000 - 0x1485b5a9cfff
  0x1485b5a9d000 - 0x1485b5aa2fff
  0x1485b5aa3000 - 0x1485b5aa4fff
  0x1485b5aa5000 - 0x1485b5aa5fff
  0x1485b5aa6000 - 0x1485b5aa6fff
  0x1485b5aa7000 - 0x1485b5aa7fff
  0x1485b5aa8000 - 0x1485b5ad5fff
  0x1485b5ad6000 - 0x1485b5ae4fff
  0x1485b5ae5000 - 0x1485b5b8afff
  0x1485b5b8b000 - 0x1485b5c21fff
  0x1485b5c22000 - 0x1485b5c22fff
  0x1485b5c23000 - 0x1485b5c23fff
  0x1485b5c24000 - 0x1485b5c37fff
  0x1485b5c38000 - 0x1485b5c5ffff
  0x1485b5c60000 - 0x1485b5c69fff
  0x1485b5c6a000 - 0x1485b5c6bfff
  0x1485b5c6c000 - 0x1485b5c71fff
  0x1485b5c72000 - 0x1485b5c74fff
  0x1485b5c77000 - 0x1485b5c77fff
  0x1485b5c78000 - 0x1485b5c78fff
  0x1485b5c79000 - 0x1485b5c79fff
  0x1485b5c7a000 - 0x1485b5c7afff
  0x1485b5c7b000 - 0x1485b5c7bfff
  0x1485b5c7c000 - 0x1485b5c82fff
  0x1485b5c83000 - 0x1485b5c85fff
  0x1485b5c86000 - 0x1485b5c86fff
  0x1485b5c87000 - 0x1485b5ca7fff
  0x1485b5ca8000 - 0x1485b5caffff
  0x1485b5cb0000 - 0x1485b5cb0fff
  0x1485b5cb1000 - 0x1485b5cb1fff
  0x1485b5cb2000 - 0x1485b5cb2fff
  0x55e340f61000 - 0x55e341051fff
  0x55e341052000 - 0x55e34115bfff
  0x55e34115c000 - 0x55e3411bbfff
  0x55e3411bd000 - 0x55e3411ebfff
  0x55e3411ec000 - 0x55e34121cfff
  0x55e34121d000 - 0x55e341220fff
  0x55e3417c0000 - 0x55e3417e0fff
  0x7fffe903c000 - 0x7fffe905cfff
  0x7fffe91ac000 - 0x7fffe91affff
  0x7fffe91b0000 - 0x7fffe91b1fff
https://ideone.com/04yLps
language:
Common Lisp (clisp 2.49.92)
created:
1 day ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!