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))))
  40.  
  41.  
Success #stdin #stdout #stderr 0.02s 9468KB
comments (?)
stdin
copy 
(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))
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
  0x155298200000 - 0x1552984e4fff
  0x155298615000 - 0x155298639fff
  0x15529863a000 - 0x1552987acfff
  0x1552987ad000 - 0x1552987f5fff
  0x1552987f6000 - 0x1552987f8fff
  0x1552987f9000 - 0x1552987fbfff
  0x1552987fc000 - 0x1552987fffff
  0x155298800000 - 0x155298802fff
  0x155298803000 - 0x155298a01fff
  0x155298a02000 - 0x155298a02fff
  0x155298a03000 - 0x155298a03fff
  0x155298a80000 - 0x155298a8ffff
  0x155298a90000 - 0x155298ac3fff
  0x155298ac4000 - 0x155298bfafff
  0x155298bfb000 - 0x155298bfbfff
  0x155298bfc000 - 0x155298bfefff
  0x155298bff000 - 0x155298bfffff
  0x155298c00000 - 0x155298c03fff
  0x155298c04000 - 0x155298e03fff
  0x155298e04000 - 0x155298e04fff
  0x155298e05000 - 0x155298e05fff
  0x155298f83000 - 0x155298f86fff
  0x155298f87000 - 0x155298f87fff
  0x155298f88000 - 0x155298f89fff
  0x155298f8a000 - 0x155298f8afff
  0x155298f8b000 - 0x155298f8bfff
  0x155298f8c000 - 0x155298f8cfff
  0x155298f8d000 - 0x155298f9afff
  0x155298f9b000 - 0x155298fa8fff
  0x155298fa9000 - 0x155298fb5fff
  0x155298fb6000 - 0x155298fb9fff
  0x155298fba000 - 0x155298fbafff
  0x155298fbb000 - 0x155298fbbfff
  0x155298fbc000 - 0x155298fc1fff
  0x155298fc2000 - 0x155298fc3fff
  0x155298fc4000 - 0x155298fc4fff
  0x155298fc5000 - 0x155298fc5fff
  0x155298fc6000 - 0x155298fc6fff
  0x155298fc7000 - 0x155298ff4fff
  0x155298ff5000 - 0x155299003fff
  0x155299004000 - 0x1552990a9fff
  0x1552990aa000 - 0x155299140fff
  0x155299141000 - 0x155299141fff
  0x155299142000 - 0x155299142fff
  0x155299143000 - 0x155299156fff
  0x155299157000 - 0x15529917efff
  0x15529917f000 - 0x155299188fff
  0x155299189000 - 0x15529918afff
  0x15529918b000 - 0x155299190fff
  0x155299191000 - 0x155299193fff
  0x155299196000 - 0x155299196fff
  0x155299197000 - 0x155299197fff
  0x155299198000 - 0x155299198fff
  0x155299199000 - 0x155299199fff
  0x15529919a000 - 0x15529919afff
  0x15529919b000 - 0x1552991a1fff
  0x1552991a2000 - 0x1552991a4fff
  0x1552991a5000 - 0x1552991a5fff
  0x1552991a6000 - 0x1552991c6fff
  0x1552991c7000 - 0x1552991cefff
  0x1552991cf000 - 0x1552991cffff
  0x1552991d0000 - 0x1552991d0fff
  0x1552991d1000 - 0x1552991d1fff
  0x5651c4142000 - 0x5651c4232fff
  0x5651c4233000 - 0x5651c433cfff
  0x5651c433d000 - 0x5651c439cfff
  0x5651c439e000 - 0x5651c43ccfff
  0x5651c43cd000 - 0x5651c43fdfff
  0x5651c43fe000 - 0x5651c4401fff
  0x5651c52dd000 - 0x5651c52fdfff
  0x7ffd2907f000 - 0x7ffd2909ffff
  0x7ffd290c5000 - 0x7ffd290c8fff
  0x7ffd290c9000 - 0x7ffd290cafff
https://ideone.com/BlXYL0
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!