[Makswell]

Здравствуйте.
Что-то никак не получается сделать такую вот штуку.

Грубо говоря, допустим есть символы "а" "b" и "c". И задана длина слова (допустим 2 символа). На выходе надо получить:
'("aa" "ab" "ac" "ba" "bb" "bc" "ca" "cb" "cc")

То есть все варианты сочетаний символов.

[Кулик Алексей aka kpblc]

А что будет, если символы повторяются?

[Makswell]

Символы - это просто как буквы алфавита. Они не повторяются.
Применительно к предыдущему примеру можно сказать, что я хочу перебрать все варианты слова, написанного на языке, алфавит которого содержит только буквы "а" "b" и "c".
Но только того слова, которое состоит из 2-х букв.

Кстати из примера наглядно видно, что если
n - количество символов перебора,
k - количество букв в слове,
то количество всех возможных слов будет k^n n^k

В том примере слов получилось 2^3=8 3^2=9.

[CB]

Если по простому, то можно так:

Код:

[Выделить все]

(setq lst '("а" "b" "c"))

(apply
  'append
  (mapcar
    '(lambda (x)
       (mapcar
         '(lambda (y)
            (strcat x y)
          ) ;_ end of lambda
         lst
       ) ;_ end of mapcar
     ) ;_ end of lambda
    lst
  ) ;_ end of mapcar
) ;_ end of apply

[Makswell]

CB, спасибо, для "2-х буквенных слов" работает прекрасно.

Никак не могу переделать логику твоего кода на произвольное число "букв" в слове.

Если брать 1-й пост. Входит так:
("aa" "ab" "ac" "ba" "bb" "bc" "ca" "cb" "cc")

Если изменить условие - длина слова 3 символа, то вроде решение складывается из решения 1 с добавлением к нему каждого из заданных символов.
Добавляем "а"
("aaa" "aab" "aac" "aba" "abb" "abc" "aca" "acb" "acc")
Добавляем "b"
("baa" "bab" "bac" "bba" "bbb" "bbc" "bca" "bcb" "bcc")
Добавляем "с"
("сaa" "сab" "сac" "сba" "сbb" "сbc" "сca" "сcb" "сcc")

Сливаем всё это в один список и получаем ответ.
при n=3 (а" "b" "c) и к=3, список всех вариантов:
("aaa" "aab" "aac" "aba" "abb" "abc" "aca" "acb" "acc" "baa" "bab" "bac" "bba" "bbb" "bbc" "bca" "bcb" "bcc" "сaa" "сab" "сac" "сba" "сbb" "сbc" "сca" "сcb" "сcc")

И по идее вроде бы как логика такая выстраивается.

Т.е. при к=4, берём решение при к=2, добавляем к нему по каждому из символов и получаем предыдуший ответ. Потом к этому ответу добавляем по каждому из символов и всё.

Ну и так далее, при любом k. То есть вроде логика-то одна и та же, а значит она может сложиться в некую функцию.

Интуитивно догадываюсь, что здесь не обойтись без рекурсии.

[Солидворкер]

http://ru.wikipedia.org/wiki/Размещение

[Makswell]

Да, вроде про это. Насколько я понял, я хочу реализовать частный случай - "Размещение с повторениями".
Теорию-то я вроде понял (хотя в комбинаторике понимаю чуть менее, чем ничего))) ), даже формулу вывел для размещения с повторениями - n^k.
Но вот с программной реализацией зашёл в тупик.
О языках, на которых даны примеры в Вики, у меня представления вообще никакого. Как это переделать на лисп, пока не представляю.

Offtop: З.Ы. Хотя вот чего переделывать, если например в Haskell'е, насколько я вижу, есть специально заточенные под это функции.
Вся программа:
import Control.Monad
permutationsWithRepetition xs = iterate (liftM2 (:) xs) [[]]
И пожалуйста, перебирай как хочешь:
Prelude> take 4 (permutationsWithRepetition "ab")
[[""],["a","b"],["aa","ab","ba","bb"],["aaa","aab","aba","abb","baa","bab","bba","bbb"]]
Только подставляй вместо числа 4 и набора "ab" свои данные.

[Vov.Ka]

http://www.theswamp.org/index.php?topic=14831.0

[Do$]

А ну-ка спробуйте:

Код:

[Выделить все]

(defun placement-with-repeat (lst num / rez add-members-for-all-list)
;; Функция получения списка из элементов по методу "размещение с повторениями"
;; Примеры вызова:
;; (placement-with-repeat '(1 2 3 4 5 6) 4)
;; (mapcar '(lambda (sl) (apply 'strcat sl)) (placement-with-repeat '("a" "b" "c" "d" "e") 3))

  (defun add-members-for-all-list (lst memb-lst)
    (if	(not lst)
      (mapcar 'list memb-lst)
      (apply
	'append
	(mapcar
	  '(lambda (m1) (mapcar '(lambda (m2) (cons m2 m1)) memb-lst))
	  lst
	) ;_ end of mapcar
      ) ;_ end of apply
    ) ;_ end of if
  ) ;_ end of defun

  (while (not (zerop num))
    (setq num (1- num))
    (setq rez (add-members-for-all-list rez lst))
  ) ;_ end of while
  rez
) ;_ end of defun

можно и рекурсией, но цикл надежнее.

[Makswell]

Do$, ты Мегамозг! Так и эдак попробовал, вроде то, что надо. Спасибо!!

Сейчас ухожу медитировать над твоим кодом, ибо пока, с наскоку, разобраться в его работе сложно. Но понять хочется.

а на кой зачем такое надо?

[Do$]

Ну и славненько! На здоровье
Даже лучше вот так (порядок элементов на выходе соответствует входному списку):

Код:

[Выделить все]

(defun placement-with-repeat (lst num / rez add-members-for-all-list)
  ;; Функция получения списка из элементов по методу "размещение с повторениями"
  ;; Примеры вызова:
  ;; (placement-with-repeat '(1 2 3 4 5 6) 4)
  ;; (mapcar '(lambda (sl) (apply 'strcat sl)) (placement-with-repeat '("a" "b" "c" "d" "e") 3))

  (defun add-members-for-all-list (lst memb-lst)
    (if	(not lst)
      (mapcar 'list memb-lst)
      (apply
	'append
	(mapcar
	  '(lambda (m1) (mapcar '(lambda (m2) (cons m2 m1)) memb-lst))
	  lst
	) ;_ end of mapcar
      ) ;_ end of apply
    ) ;_ end of if
  ) ;_ end of defun

  (while (not (zerop num))
    (setq num (1- num))
    (setq rez (add-members-for-all-list rez lst))
  ) ;_ end of while
  (mapcar 'reverse rez) ;_ изменение тут
) ;_ end of defun

[CB]

Можно и так:

Код:

[Выделить все]

(defun test (lst n / l)
;;;(setq lst '("а" "b" "c"))
;;;(test lst 3)
  (setq l lst)
  (if (<= n 1)
    lst
    (repeat (1- n)
      (setq l
             (apply
               'append
               (mapcar
                 '(lambda (x)
                    (mapcar
                      '(lambda (y)
                         (strcat x y)
                       ) ;_ end of lambda
                      l
                    ) ;_ end of mapcar
                  ) ;_ end of lambda
                 lst
               ) ;_ end of mapcar
             ) ;_ end of apply
      ) ;_ end of setq
    ) ;_ end of repeat
  ) ;_ end of if
) ;_ end of defun

[Makswell]

Сообщение от CB Можно и так:

Немного модифицировал твой код:

Код:

[Выделить все]

(defun test_CB (lst n / l)
;;;модифицированный код из поста http://forum.dwg.ru/showpost.php?p=592037&postcount=13
;;;(test_CB '("а" "b" "c") 3)
  (setq l (mapcar 'list lst))
  (if (<= n 1)
    lst
    (repeat (1- n)
      (setq l
	     (apply
	       'append
	       (mapcar
		 '(lambda (x)
		    (mapcar
		      '(lambda (y)
			 (cons x y)
		       )
		      l
		    )
		  )
		 lst
	       )
	     )
      )
    )
  )
)

Теперь он возвращает точно такой же результат, как и код от Do$ из поста №12.
(На самом деле в такой форме (в виде списка из списков символов) для меня как раз удобней, чем в виде списка из строк.)

Так вот, я протестировал эти 2 кода всем известной программой BenchMark.

Результаты.

_$ (BenchMark '((placement-with-repeat '("à" "b" "c") 3) (test_CB '("à" "b" "c") 3)) ) Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s): (TEST_CB (QUOTE ("à" "b" "c")) 3)............1703 / 1.41 <fastest> (PLACEMENT-WITH-REPEAT (QUOTE ("à" "...).....2406 / 1.00 <slowest>

Код от CB получился заметно быстрей. Так что я возьму на вооружение его, потому что в таком деле, как брутфорс, скорость выполнения - это самый критичный параметр ибо количество итераций - n^k, т.е. увеличивается очень быстро, даже при небольшом увеличении как количества символов, так и "букв в слове".

[hwd]

Вынужден всех огорчить - на .Net код пишется в одну строку:

[Sad Dog]

Огорчить не удалось. Пост №14 - это тоже в одну строку (точнее, в один тоненький столбик, для удобства восприятия).

[hwd]

Сообщение от Sad Dog Огорчить не удалось. Пост №14 - это тоже в одну строку (точнее, в один тоненький столбик, для удобства восприятия).

мой вариант выглядит не так страшно