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

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

29.12.2017, 14:33. Просмотров 818. Ответов 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
Ответы с готовыми решениями:

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

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

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

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

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

13
helter
Эксперт по математике/физике
3776 / 2800 / 303
Регистрация: 12.03.2013
Сообщений: 5,144
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 / 4
Регистрация: 16.10.2011
Сообщений: 389
29.12.2017, 19:07  [ТС] 3
helter, к сожалению надо обойтись без циклов и переменных, на чистой рекурсии, сложность не в алгоритме, а в написании самого кода на лиспе.
0
Catstail
Модератор
23615 / 11715 / 2047
Регистрация: 12.02.2012
Сообщений: 19,110
29.12.2017, 19:13 4
serega006, а что должно выдаться для такого вызова:

Lisp
1
(qq '((12 (1 1) 2) (11 4)))
Добавлено через 3 минуты
Постановка непонятна.
1
serega006
8 / 8 / 4
Регистрация: 16.10.2011
Сообщений: 389
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
3750 / 3544 / 240
Регистрация: 12.05.2012
Сообщений: 2,470
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
Модератор
23615 / 11715 / 2047
Регистрация: 12.02.2012
Сообщений: 19,110
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
3750 / 3544 / 240
Регистрация: 12.05.2012
Сообщений: 2,470
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
Эксперт по математике/физике
3776 / 2800 / 303
Регистрация: 12.03.2013
Сообщений: 5,144
29.12.2017, 20:09 9
Цитата Сообщение от serega006 Посмотреть сообщение
к сожалению надо обойтись без циклов и переменных, на чистой рекурсии
Это бред.

Но почему вы не напишете рекурсивный алгоритм на псевдокоде? Циклы в рекурсию переделываются совершенно стандартно. Напишите, и посмотрим, как это перевести на скобочки.
1
_sg
3750 / 3544 / 240
Регистрация: 12.05.2012
Сообщений: 2,470
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 / 4
Регистрация: 16.10.2011
Сообщений: 389
30.12.2017, 00:20  [ТС] 11
Спасибо большое
0
_sg
3750 / 3544 / 240
Регистрация: 12.05.2012
Сообщений: 2,470
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
Модератор
23615 / 11715 / 2047
Регистрация: 12.02.2012
Сообщений: 19,110
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
41 / 74 / 15
Регистрация: 04.10.2017
Сообщений: 284
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