Форум программистов, компьютерный форум, киберфорум
Наши страницы
Lisp
Войти
Регистрация
Восстановить пароль
 
serega006
8 / 8 / 3
Регистрация: 16.10.2011
Сообщений: 374
#1

Подсчёт суммы всех числовых элементов на каждом уровне списка - Lisp

29.12.2017, 14:33. Просмотров 202. Ответов 13
Метки нет (Все метки)

Есть код который считает сумму чисел на каждом уровне списка
Lisp
1
2
3
4
5
6
7
8
(defun qq(lst1 &optional (lvl 1)(cntr 0))
    (cond
        ((null lst1) 0 (format t "lvl: ~D summ:~D~%" lvl cntr))
        ((listp (car lst1))
             (qq (car lst1) (+ lvl 1)) (qq (cdr lst1) lvl cntr))
        ((numberp (car lst1))
             (qq (cdr lst1) lvl (+ cntr (car lst1))))
        (t (qq (cdr lst1) lvl cntr))))
Проблема в том, что если в качестве аргумента передать два вложенных списка на одном уровне то результат посчитается для каждого из них отдельно.
Lisp
1
2
3
4
(qq '((12 2) (11 4)))
lvl: 2 summ:14
lvl: 2 summ:15
lvl: 1 summ:0
Как можно доработать программу что бы вывод стал таким?
Lisp
1
2
lvl: 2 summ:29
lvl: 1 summ:0
Думал использовать дополнительный список для хранения суммы на уровнях, но пока не смог реализовать.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
29.12.2017, 14:33
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Подсчёт суммы всех числовых элементов на каждом уровне списка (Lisp):

Описать функцию, которая находила бы сумму всех числовых элементов списка
Здравствуйте, нужна помощь!! Нужно написать функцию которая бы находило бы...

Вычислить произведение элементов списка, находящихся на n-ном уровне списка
Написать функцию произв(x, n), которая вычисляет произведение числовых...

вычисляющую сумму четных элементов-чисел на каждом уровне
Написать функцию, вычисляющую сумму четных элементов-чисел на каждом уровне...

Сумма числовых элементов списка
Вычислить сумму числовых элементов списка, учитывая элементы подсписков. ...

Функция: создать список только из числовых элементов списка-аргумента
Привет , помогите пожалуйста : Описать функцию, которая создавала бы список...

Вычислить сумму числовых элементов списка, учитывая элементы подсписков
Доброго времени суток! Задача состоит в следующем: Вычислить сумму числовых...

13
helter
Эксперт по математике/физике
3741 / 2769 / 297
Регистрация: 12.03.2013
Сообщений: 5,104
29.12.2017, 18:48 #2
Я как-то так написал бы (псевдокод):
Код
current_list = list;
for (level = 1; not(is_empty(current_list)); ++level) {
    sum = 0;
    next_list = empty_list;
    foreach (element: current_list) {
        if (is_number(element)) {
            sum += element;
        } else if (is_list(element)) {
            next_list = append(element, next_list);
        }
    }
    print(level, sum);
    current_list = next_list;
}
3
serega006
8 / 8 / 3
Регистрация: 16.10.2011
Сообщений: 374
29.12.2017, 19:07  [ТС] #3
helter, к сожалению надо обойтись без циклов и переменных, на чистой рекурсии, сложность не в алгоритме, а в написании самого кода на лиспе.
0
Catstail
Модератор
23525 / 11633 / 2034
Регистрация: 12.02.2012
Сообщений: 18,973
29.12.2017, 19:13 #4
serega006, а что должно выдаться для такого вызова:

Lisp
1
(qq '((12 (1 1) 2) (11 4)))
Добавлено через 3 минуты
Постановка непонятна.
1
serega006
8 / 8 / 3
Регистрация: 16.10.2011
Сообщений: 374
29.12.2017, 19:14  [ТС] #5
Catstail,
Сейчас так
Lisp
1
2
3
4
lvl: 3 summ:2
lvl: 2 summ:14
lvl: 2 summ:15
lvl: 1 summ:0
Надо что бы выводило так

Lisp
1
2
3
lvl: 3 summ:2
lvl: 2 summ:29
lvl: 1 summ:0
0
_sg
3702 / 3500 / 236
Регистрация: 12.05.2012
Сообщений: 2,437
29.12.2017, 20:04 #6
как вариант:
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
   (cond ((null w) nil)
         ((= n 0) w)
         ((atom a) (dive-elms n d))
         ((nconc (dive-elms (1- n) a) (dive-elms n d)))))
 
(defun max-depth (w)
  (if (atom w)
      0
      (max (1+ (max-depth (car w)))
           (max-depth (cdr w)))))
 
(defun level-sum (w &aux (n (1- (max-depth w))))
  (loop for a from 0 to n
        collect (list a (loop for a in (dive-elms a w)
                              when (numberp a) sum a))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((0 0) (1 29) (2 2))
2
Catstail
Модератор
23525 / 11633 / 2034
Регистрация: 12.02.2012
Сообщений: 18,973
29.12.2017, 20:07 #7
Лучший ответ Сообщение было отмечено serega006 как решение

Решение

Вот один из путей:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
;; каждое число n превращаем в пару (n l) l - номер уровня
 
(defun mark (lst &optional (lv 0))
  (cond ((null lst) nil)
        ((atom (car lst)) (cons (list (car lst) lv) (mark (cdr lst) lv)))
        (t (cons (mark (car lst) (+ lv 1)) (mark (cdr lst) lv))))) 
 
==> MARK
 
;; Проверим:
 
(mark '(1 2 (12 2) (5 (6 7) 8 9)))
 
==> ((1 0) (2 0) ((12 1) (2 1)) ((5 1) ((6 2) (7 2)) (8 1) (9 1)))
 
;; Проверка, является ли аргумент числовым списком из двух элементов
 
(defun is-pair (lst)
  (and (numberp (car lst)) (numberp (cadr lst)) (null (cddr lst))))
 
;; теперь делаем список пар "плоским"
 
(defun flat (lstp)
  (cond ((null lstp) nil)
        ((is-pair (car lstp)) (cons (car lstp) (flat (cdr lstp))))
        (t (append (flat (car lstp)) (flat (cdr lstp))))))
 
;; Проверим:
 
(flat '((1 0) (2 0) ((12 1) (2 1)) ((5 1) ((6 2) (7 2)) (8 1) (9 1))))
 
==> ((1 0) (2 0) (12 1) (2 1) (5 1) (6 2) (7 2) (8 1) (9 1))
 
;; А теперь - решение задачи:
 
(defun print-list (lstp &optional (lv 0) (sum 0) (acc nil))
  (cond ((null lstp) (prints "lv:") (print lv) (prints " summ:") (print sum) (terpri)
         (cond ((null acc) 'ok)
               (t (print-list acc (+ lv 1) 0 nil))))
        ((= lv (cadar lstp)) (print-list (cdr lstp) lv (+ sum (caar lstp)) acc))
        (t (print-list (cdr lstp) lv sum (cons (car lstp) acc)))))
 
;; Собираем все вместе:
 
(defun task (lst)
  (print-list (flat (mark lst))))
 
==> TASK
 
;; и проверяем:
 
(task '((12 (1 1) 2) (11 4)))
 
lv:0 summ:0
lv:1 summ:29
lv:2 summ:2
 
==> OK
2
_sg
3702 / 3500 / 236
Регистрация: 12.05.2012
Сообщений: 2,437
29.12.2017, 20:09 #8
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
   (cond ((null w) nil)
         ((= n 0) w)
         ((atom a) (dive-elms n d))
         ((nconc (dive-elms (1- n) a) (dive-elms n d)))))
 
(defun max-depth (w)
  (if (atom w)
      0
      (max (1+ (max-depth (car w)))
           (max-depth (cdr w)))))
 
(defun level-sum (w &optional (n (1- (max-depth w))))
  (cond ((zerop n) (list n (loop for a in (dive-elms n w)
                                 when (numberp a) sum a)))
        ((cons (list n (loop for a in (dive-elms n w)
                             when (numberp a) sum a))
               (level-sum w (1- n))))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((2 2) (1 29) 0 0)
2
helter
Эксперт по математике/физике
3741 / 2769 / 297
Регистрация: 12.03.2013
Сообщений: 5,104
29.12.2017, 20:09 #9
Цитата Сообщение от serega006 Посмотреть сообщение
к сожалению надо обойтись без циклов и переменных, на чистой рекурсии
Это бред.

Но почему вы не напишете рекурсивный алгоритм на псевдокоде? Циклы в рекурсию переделываются совершенно стандартно. Напишите, и посмотрим, как это перевести на скобочки.
1
_sg
3702 / 3500 / 236
Регистрация: 12.05.2012
Сообщений: 2,437
29.12.2017, 20:34 #10
Лучший ответ Сообщение было отмечено serega006 как решение

Решение

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
   (cond ((null w) nil)
         ((= n 0) w)
         ((atom a) (dive-elms n d))
         ((nconc (dive-elms (1- n) a) (dive-elms n d)))))
 
(defun max-depth (w)
  (if (atom w)
      0
      (max (1+ (max-depth (car w)))
           (max-depth (cdr w)))))
 
(defun level-sum (w &optional (n (1- (max-depth w))))
  (cond ((zerop n) (list n (sum (dive-elms n w))))
        ((cons (list n (sum (dive-elms n w)))
               (level-sum w (1- n))))))
 
(defun sum (w)
(cond ((null w) 0)
      ((numberp (car w)) (+ (car w) (sum (cdr w))))
      ((sum (cdr w)))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((2 2) (1 29) 0 0)
Добавлено через 3 минуты
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
   (cond ((null w) nil)
         ((= n 0) w)
         ((atom a) (dive-elms n d))
         ((nconc (dive-elms (1- n) a) (dive-elms n d)))))
 
(defun max-depth (w)
  (if (atom w)
      0
      (max (1+ (max-depth (car w)))
           (max-depth (cdr w)))))
 
(defun level-sum (w &optional (n (1- (max-depth w))))
  (cond ((zerop n) (list n (sum (dive-elms n w))))
        ((cons (list n (sum (dive-elms n w)))
               (level-sum w (1- n))))))
 
(defun sum (w)
  (if w (+ (if (numberp (car w)) (car w) 0) (sum (cdr w))) 0))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((2 2) (1 29) 0 0)
Добавлено через 1 минуту
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
   (cond ((null w) nil)
         ((= n 0) w)
         ((atom a) (dive-elms n d))
         ((append (dive-elms (1- n) a) (dive-elms n d)))))
 
(defun max-depth (w)
  (if (atom w) 0
      (max (1+ (max-depth (car w)))
           (max-depth (cdr w)))))
 
(defun level-sum (w &optional (n (1- (max-depth w))))
  (if (zerop n) (list n (sum (dive-elms n w)))
      (cons (list n (sum (dive-elms n w)))
            (level-sum w (1- n)))))
 
(defun sum (w)
  (if w (+ (if (numberp (car w)) (car w) 0) (sum (cdr w))) 0))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((2 2) (1 29) 0 0)
Добавлено через 1 минуту
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
   (cond ((null w) nil)
         ((= n 0) w)
         ((atom a) (dive-elms n d))
         ((append (dive-elms (1- n) a) (dive-elms n d)))))
 
(defun max-depth (w)
  (if (atom w) 0
      (max (1+ (max-depth (car w)))
           (max-depth (cdr w)))))
 
(defun level-sum (w &optional (n (1- (max-depth w))))
  (if (zerop n) (list n (sum (dive-elms n w)))
      (cons (list n (sum (dive-elms n w)))
            (level-sum w (1- n)))))
 
(defun sum (w &aux (a (car w)))
  (if w (+ (if (numberp a) a 0) (sum (cdr w))) 0))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((2 2) (1 29) 0 0)
Добавлено через 4 минуты
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defun level-sum (w &optional (n (1- (max-depth w))))
  (if (zerop n) `(,n ,(sum (dive-elms n w)))
      (cons `(,n ,(sum (dive-elms n w)))
            (level-sum w (1- n)))))
 
(defun max-depth (w)
  (if (atom w) 0 (max (1+ (max-depth (car w)))
                      (max-depth (cdr w)))))
 
(defun sum (w &aux (a (car w)))
  (if w (+ (if (numberp a) a 0) (sum (cdr w))) 0))
 
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
  (when w (cond ((= n 0) w)
                ((atom a) (dive-elms n d))
                ((append (dive-elms (1- n) a)
                         (dive-elms n d))))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((2 2) (1 29) 0 0)
Добавлено через 7 минут
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(defun level-sum (w &optional (n (1- (max-depth w))))
  (cond ((zerop n) (format t "lvl: ~D summ:~D~%" n (sum (dive-elms n w))))
        ((progn (format t "lvl: ~D summ:~D~%" n (sum (dive-elms n w)))
                (level-sum w (1- n))))))
 
(defun max-depth (w)
  (if (atom w) 0 (max (1+ (max-depth (car w)))
                      (max-depth (cdr w)))))
 
(defun sum (w &aux (a (car w)))
  (if w (+ (if (numberp a) a 0) (sum (cdr w))) 0))
 
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
  (when w (cond ((= n 0) w)
                ((atom a) (dive-elms n d))
                ((append (dive-elms (1- n) a)
                         (dive-elms n d))))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
lvl: 2 summ:2
lvl: 1 summ:29
lvl: 0 summ:0
NIL
2
serega006
8 / 8 / 3
Регистрация: 16.10.2011
Сообщений: 374
30.12.2017, 00:20  [ТС] #11
Спасибо большое
0
_sg
3702 / 3500 / 236
Регистрация: 12.05.2012
Сообщений: 2,437
30.12.2017, 10:03 #12
варианты:
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(defun level-sum (w &optional (n (1- (max-depth w))))
  (unless (minusp n)
    (progn (format t "lvl: ~D sum: ~D~%" n (sum (dive-elms n w)))
           (level-sum w (1- n)))))
 
(defun max-depth (w)
  (if (atom w) 0 (max (1+ (max-depth (car w)))
                      (max-depth (cdr w)))))
 
(defun sum (w &aux (a (car w)))
  (if w (+ (if (numberp a) a 0) (sum (cdr w))) 0))
 
(defun dive-elms (n w &aux (a (car w)) (d (cdr w)))
  (when w (cond ((zerop n) w)
                ((atom a) (dive-elms n d))
                ((append (dive-elms (1- n) a)
                         (dive-elms n d))))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
lvl: 2 sum: 2
lvl: 1 sum: 29
lvl: 0 sum: 0
NIL
Добавлено через 32 минуты
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun level-sum (w) (lev-sum (flat-mark w)))
 
(defun lev-sum (w &optional (m (reduce #'max w :key #'car)))
  (loop for a from 0 to m collect
        (list a (loop for e in (remove-if-not
                                #'(lambda (b) (= (car b) a))
                                w)
                      sum (cadr e)))))
 
(defun flat-mark (w &optional (n -1) ac) 
  (cond ((null w) ac)
        ((atom w) (cons (list n w) ac))
        ((flat-mark (car w) (1+ n) (flat-mark (cdr w) n ac)))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((0 0) (1 29) (2 2))
Добавлено через 1 минуту
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
(defun level-sum (w) (lev-sum (flat-mark w)))
 
(defun lev-sum (w &optional (m (reduce #'max w :key #'car)))
  (loop for a from 0 to m collect
        (list a (loop for e in w 
                      when (= (car e) a) sum (cadr e)))))
                     
(defun flat-mark (w &optional (n -1) ac) 
  (cond ((null w) ac)
        ((atom w) (cons (list n w) ac))
        ((flat-mark (car w) (1+ n) (flat-mark (cdr w) n ac)))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
((0 0) (1 29) (2 2))
Добавлено через 5 минут
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(defun level-sum (w) (lev-sum (flat-mark w)))
 
(defun lev-sum (w &optional (m (reduce #'max w :key #'car)))
  (loop for a from 0 to m do
        (format t "lvl: ~D sum: ~D~%"
                a (loop for e in w 
                        when (= (car e) a) sum (cadr e)))))
                     
(defun flat-mark (w &optional (n -1) ac) 
  (cond ((null w) ac)
        ((atom w) (cons (list n w) ac))
        ((flat-mark (car w) (1+ n) (flat-mark (cdr w) n ac)))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
lvl: 0 sum: 0
lvl: 1 sum: 29
lvl: 2 sum: 2
NIL
Добавлено через 19 минут
по условию (без циклов):
Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(defun level-sum (w) (lev-sum (flat-mark w)))
 
(defun lev-sum (w &optional (m (reduce #'max w :key #'car)))
  (unless (minusp m) 
    (progn (format t "lvl: ~D sum: ~D~%"
                m (sum w m))
           (lev-sum w (1- m)))))          
 
(defun sum (w n &aux (a (car w)))
  (cond ((null w) 0)
        ((= (car a) n) (+ (cadr a) (sum (cdr w) n)))
        ((sum (cdr w) n))))
                     
(defun flat-mark (w &optional (n -1) ac) 
  (cond ((null w) ac)
        ((atom w) (cons (list n w) ac))
        ((flat-mark (car w) (1+ n) (flat-mark (cdr w) n ac)))))
 
> (level-sum '((12 (1 1) 2) (11 4)))
lvl: 2 sum: 2
lvl: 1 sum: 29
lvl: 0 sum: 0
NIL
2
Catstail
Модератор
23525 / 11633 / 2034
Регистрация: 12.02.2012
Сообщений: 18,973
30.12.2017, 14:26 #13
С помощью hash-таблиц:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(defun task (lst)
  (let ((h (gensym 'h)) )
    (labels ((scan (lst &optional (lv 0)) 
                (cond ((null lst) nil)
                      ((numberp (car lst)) (if (hashKeyExist h lv) (hashPut h lv (+ (car lst) (car (hashGet h lv))))
                                                                   (hashPut h lv (car lst))) (scan (cdr lst) lv))
                      (t (scan (car lst) (+ lv 1)) (scan (cdr lst) lv))))) 
    (hashCreate h)
    (scan lst)
    (hashMap h (lambda (k v) (printline (list k v))))
    (hashDestroy h))))
 
==> TASK
 
(task '(1 2 (3 4 (5 6))))
(0 3)
(1 7)
(2 11)
2
tmpValue
40 / 72 / 15
Регистрация: 04.10.2017
Сообщений: 274
05.01.2018, 08:12 #14
Цитата Сообщение от serega006 Посмотреть сообщение
Как можно доработать программу что бы вывод стал таким?
Решение вполне очевидно. Постановка задачи вполне идиотична. М.б. суммировать суммы уровней не помешает?
2
05.01.2018, 08:12
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
05.01.2018, 08:12
Привет! Вот еще темы с решениями:

Вернуть подсписки данного списка, сумма числовых элементов которых максимальна
Определить функцию, которая возвращает подсписки данного списка, сумма числовых...

Рекурсивная функция, создающая список только из числовых элементов списка-аргумента
И еще одна просьба: описать функцию, которая создавала бы список тольео из...

Описать функцию, которая создавала бы список только из числовых элементов списка-аргумента
описать функцию, которая создавала бы список только из числовых элементов...

Описать функцию, которая создавала бы список только из числовых элементов списка–аргумента.
Описать функцию, которая создавала бы список только из числовых элементов...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru