Задача о рюкзаке

@trailK · Регистрация: 16.05.2013

Студворк — интернет-сервис помощи студентам

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

@helter · 16.05.2013, 22:07

А алгоритм-то расскажете? К Лиспу он не относится, гуглить лень, изобретать велосипед тоже лень.

@_sg · 17.05.2013, 14:49

Lisp
1
2
3
4
5
6
7
8
9
10
(defun knapsack (w n)
  (mapcar #'reverse (remove-duplicates (knap w n) :test #'equal)))
 
(defun knap (w n &optional acc ac &aux (a (car w)) (d (cdr w)) (z (apply #'+ ac)))
  (cond ((null w) acc)
        ((= (+ a z) n) (cons (cons a ac) acc))
        ((knap d n (knap d n acc) (if (< (+ a z) n) (cons a ac) ac)))))
 
> (knapsack '(9 8 7 6 5 4 3 2 1) 13)
((9 4) (8 5) (7 6) (6 5 2) (5 4 3 1))

knap возвращает повторяющиеся списки:

Lisp
1
2
3
> (knap '(9 8 7 6 5 4 3 2 1) 13)
((4 9) (1 3 4 5) (2 5 6) (1 3 4 5) (6 7) (2 5 6) (1 3 4 5) (5 8) (1 3 4 5)
 (2 5 6) (1 3 4 5) (6 7) (2 5 6) (1 3 4 5))

Lisp
1
не находит: (9 3 1) (7 5 1)

@Catstail · 17.05.2013, 15:12

Вот "тупой" перебор. Для небольших размерностей - приемлемое решение:

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
;; Генерация множества всех подмножеств
(defun set-of-subsets (lst)
  (cond ((= (length lst) 1) (list nil (list (car lst))))
        (t (let ((tmp (set-of-subsets (cdr lst)))) 
                (append tmp (mapcar #'(lambda (x) (cons (car lst) x)) tmp))))))
;; Решение задачи
(defun task (lst sum)
  (let ((res nil))
   (iter (for l in (set-of-subsets lst)) (when (= (apply '+ l) sum) (collecting l into res)))
   res))
;; Проверка:
(task '(9 8 7 6 5 4 3 2 1) 13)
 
==> ((5 4 3 1) (6 4 2 1) (6 4 3) (6 5 2) (7 3 2 1) (7 4 2) (7 5 1) (7 6) (8 3 2) (8 4 1) (8 5) (9 3 1) (9 4))

@_sg · 17.05.2013, 17:51

Lisp
1
2
3
4
5
6
7
8
9
10
(defun knapsack (w n)
  (mapcar #'reverse (remove-duplicates (knap w n) :test #'equal)))
 
(defun knap (w n &optional acc ac &aux (a (car w)) (d (cdr w)) (z (apply #'+ ac)))
  (cond ((null w) acc)
        ((= (+ a z) n)(knap d n (cons (cons a ac) acc) ac))
        ((knap d n (knap d n acc) (if (< (+ a z) n) (cons a ac) ac)))))
 
> (knapsack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 5) (7 5 1) (7 6) (6 5 2) (5 4 3 1))

Добавлено через 3 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun knapsack (w n)
  (mapcar #'reverse (remove-duplicates (knap w n) :test #'equal)))
 
(defun knap (w n &optional acc ac &aux (a (car w)) (d (cdr w)) (z (apply #'+ ac)))
  (cond ((null w) acc)
        ((= (+ a z) n)(knap d n (cons (cons a ac) acc) ac))
        ((knap d n (knap d n acc ac) (if (< (+ a z) n) (cons a ac) ac)))))
 
> (knapsack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

Добавлено через 2 часа 24 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac))
                  (z (apply #'+ ac)))
  (cond ((null w) acc)
        ((= (+ a z) n)
         (knapstack d n (if (member (reverse b) acc
                                    :test #'equal)
                            acc
                            (cons (reverse b) acc))
                    ac))
        ((knapstack d n (knapstack d n acc ac)
                    (if (< (+ a z) n) b ac)))))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

Добавлено через 9 минут

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac))
                  (z (apply #'+ ac)))
  (cond ((null w) acc)
        ((= (+ a z) n)
         (knapstack d n (let ((c (reverse b)))
                          (if (member c acc :test #'equal)
                              acc
                              (cons c acc)))
                          ac))
         ((knapstack d n (knapstack d n acc ac)
                     (if (< (+ a z) n) b ac)))))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

@_sg · 22.05.2013, 11:00

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac))
                  (z (apply #'+ ac)))
  (if w
      (if (= (+ a z) n)
          (knapstack d n (let ((c (reverse b)))
                           (if (member c acc :test #'equal)
                              acc
                              (cons c acc)))
                     ac)
          (knapstack d n (knapstack d n acc ac)
                     (if (< (+ a z) n) b ac)))
      acc))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

Добавлено через 4 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac))
                  (z (apply #'+ ac)))
  (if w (knapstack d n (if (= (+ a z) n)
                           (let ((c (reverse b)))
                             (if (member c acc :test #'equal)
                                 acc
                                 (cons c acc)))
                           (knapstack d n acc ac))
                   (if (< (+ a z) n) b ac))
      acc))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

@_sg · 14.05.2015, 09:57

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac))
                  (z (apply #'+ ac)))
  (cond ((null w) acc)
        ((= (+ a z) n)
         (knapstack d n (adjoin (reverse b) acc :test #'equal) ac))
        ((knapstack d n (knapstack d n acc ac)
                    (if (< (+ a z) n) b ac)))))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

Добавлено через 3 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
11
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac)))
  (cond ((null w) acc)
        ((= (apply #'+ b) n)
         (knapstack d n (adjoin (reverse b) acc :test #'equal) ac))
        ((knapstack d n (knapstack d n acc ac)
                    (if (< (apply #'+ b) n) b ac)))))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

Добавлено через 8 минут

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac)))
  (if w 
      (knapstack d
                 n
                 (if (= (apply #'+ b) n)
                     (adjoin (reverse b) acc :test #'equal)
                     (knapstack d n acc ac))
                 (if (< (apply #'+ b) n) b ac))
      acc))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2)
 (6 4 2 1) (6 4 3) (5 4 3 1))

Добавлено через 4 минуты

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(defun knapstack (w n &optional acc ac
                  &aux (a (car w)) (d (cdr w)) (b (cons a ac)))
  (if w 
      (let ((z (apply #'+ b)))
        (knapstack d
                   n
                   (if (= z n)
                       (adjoin (reverse b) acc :test #'equal)
                       (knapstack d n acc ac))
                   (if (< z n) b ac)))
      acc))
 
> (knapstack '(9 8 7 6 5 4 3 2 1) 13)
((9 3 1) (9 4) (8 4 1) (8 3 2) (8 5) (7 5 1) (7 4 2) (7 3 2 1) (7 6) (6 5 2) 
 (6 4 2 1) (6 4 3) (5 4 3 1))

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

@trailK 1 / 1 / 0 Регистрация: 16.05.2013 Сообщений: 15

	Задача о рюкзаке 16.05.2013, 21:18. Показов 1875. Ответов 6 Метки нет (Все метки) Алгоритм решает задачу о рюкзаке, которая формулируется так: дан, упорядоченный по убыванию, массив A целых положительных чисел и некоторые Sum, необходимо найти подпоследовательности массива A, сумма элементов которых равна в точности Sum. 0

@helter 4528 / 3522 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	16.05.2013, 22:07
	А алгоритм-то расскажете? К Лиспу он не относится, гуглить лень, изобретать велосипед тоже лень. 0