Toutes les possibilités....

[Bred]

Salut,

Je reste planté sur un truc qui me semblait évident.... comme toujours....

certainement avez vous ce genre de choses dans vos sacs....

 

Je cherche à créer une liste contenant toutes les combinaisons possibles de rangement d'une liste.

 

Ex :

(setq l '(A B C D))

 

(Toutecombinaison l)

=> '((A) (B) © (D) (A B) (A C) (A D) (B C) (B D) (C D) (A B C) (A C D) (B C D) ... etc ....

 

... ceci afin de tester ensuite toutes les listes afin d'analyse les possibilités (bien sûr, les entités 'A, 'B, etc... sont en fait des listes d'info ....)

 

merci pour tout.

[(gile)]

Salut,

 

Regarde la routine combi dans ce challenge

[(gile)]

Re,

 

le challenge demandait de trier les combinaisons possibles de listes de lettres, si on veut quelque chose de plus général et sans tri :

 

;; REMOVE_IND
;; Retourne la liste privée de l'élément à l'indice spécifié
;; (premier élément = 0)

(defun remove_ind (lst ind / tmp)
 (if (or (zerop ind) (null lst))
   (cdr lst)
   (cons (car lst) (remove_ind (cdr lst) (1- ind)))
 )
)

;; COMBI-1
;; Retourne toutes les combinaisons possibles avec 1 élément en moins
;; (combi-1 '("a" "b" "c")) -> (("a" "b") ("a" "c") ("b" "c"))

(defun combi-1 (lst / n ret)
 (setq n -1)
 (repeat (length lst)
   (setq ret (cons (remove_ind lst (setq n (1+ n))) ret))
 )
)


;; COMBINAISONS
;; retourne la liste de toutes les combinaisons possibles

(defun combinaisons (lst / first ret)
 (setq lst (list lst))
 (while (    (if	(member first ret)
     (setq lst (cdr lst))
     (if (= 1 (length first))
(setq ret (cons first ret)
      lst (cdr lst)
)
(setq ret (cons first ret)
      lst (append (cdr lst) (combi-1 first))
)
     )
   )
 )
 ret
) 

 

[Edité le 29/10/2007 par (gile)]

[Bred]

Merci encore, (gile) !

(je n'avais plus fait attention au challenge que tu cites, désolé)

[Bred]

Re,

Ben ça va trés loin !...

Comme je dois tester beacoup de données, ma liste est souvent longue, et je me retrouve à attendre.... attendre.... que toutes les combinaisons soient finis....

 

ex :

(defun c:ttt ()
(combinaisons '(a b c d e f g h i j k l m n))
 )

 

Donc je voudrais interrompre le calcul à chaque combinaison trouvé, et le reprendre si besoin après avoir posé une question (et fait un test que la combinaison précedement calculé)... mais je ne sais pas comment faire...

 

merci....

[(gile)]

Salut,

 

Eh oui c'est long...

 

Le nombre de combinaisons retournées pour une liste de n éléments est égal à (2^n) - 1

soit 7 pour 3 éléments, 15 pour 4, 16383 pour 14.

 

Mais ce résultat ne compte pas les doublons qui sont quand même évalués.

 

Pour une liste de 3 éléments on a, doublons compris, 1 + 3 + (3 * 2) = 10 possibilités.

Pour 4 éléments : 1 + 4 + (4 * 3) + (4 * 3 * 2) = 41 possibilités.

Pour 5 éléments : 1 + 5 + (5 * 4) + (5 * 4 * 3) + (5 * 4 *3 * 2) = 206 possibilités.

Pour 14 éléments : 3767985541 possibilités.

 

Si tu veux faire une évaluation sur chaque combinaison, il faut l'inclure dans "combinaisons" après chacun des deux (setq ret (cons first ret) ...) où "first" est la première combinaison de la liste.

[(gile)]

Re,

 

Depuis le début du challenge 13 j'avais le sentiment qu'on pouvait trouver un algorythme plus efficace que celui duquel je n'arrivais pas à me sortir.

 

Je pense avoir trouver quelque chose de beaucoup mieux : la liste des combinaisons est constituée directement en évitant les doublons.

Ça prend environ 5 secondes pour (combinaisons '(a b c d e f g h i j k l m n)) sur mon poste (16383 éléments).

 

(defun combinaisons (lst / subr first tmp1 tmp2 tmp3 ret)

 (defun subr (l1 l2)
   (if	l2
     (cons (append l1 (list (car l2)))
    (subr l1 (cdr l2))
     )
   )
 )

 (while lst
   (setq first	(list (car lst))
  tmp1	(subr first (cdr lst))
  tmp2	(cons first tmp1)
   )
   (while tmp1
     (setq tmp3 (subr (car tmp1) (cdr (member (last (car tmp1)) lst)))
    tmp1 (cdr (append tmp1 tmp3))
    tmp2 (append tmp2 tmp3)
     )
   )
   (setq ret (append ret tmp2)
  lst  (cdr lst)
   )
 )
 ret
) 

 

(combinaisons '(A B C D))

 

((A)

(A B)

(A C)

(A D)

(A B C)

(A B D)

(A C D)

(A B C D)

(B)

(B C)

(B D)

(B C D)

©

(C D)

(D)

)

 

[Edité le 2/11/2007 par (gile)]

[ElpanovEvgeniy]

:)

(defun test (l)
;; (test '("A" "B" "C" "D"))
(defun rem-nth (l i)
 ;;(rem-nth  '("A" "B" "C" "D") 2) ;=> '("A" "B" "D")
 (if l
  (if (zerop i)
   (cdr l)
   (cons (car l)(rem-nth (cdr l) (1- i))))))
(defun count-lst (i)
 ;;(count-lst 4) ;=> '(3 2 1 0)
 (if (> i 0)
  (cons (1- i)(count-lst (1- i)))))
(defun combin (a b)
 ;; (combin '("A" "B" "C" "D") '(3 2 1 0))
 (if a
  (apply 'append
         (mapcar '(lambda (x)
                   ((lambda(y)(cons y (combin y (cdr b))))(rem-nth a x))) b))
 ) ;_  if
) ;_  defun
(defun remove (l a)
 ;; (remove '(3 nil 2 1 () 2 0 0) 0)
 (if l
  (if (equal a (car l))
   (remove (cdr l)a)
   (cons (car l)(remove (cdr l)a)))))
(defun remove-nil_dupl (l)
 ;; (remove-nil_dupl '(3 nil 2 1 () 2 0 0))
 (if l
  (if (car l)
   (cons (car l)(remove-nil_dupl(remove (cdr l) (car l))))
   (remove-nil_dupl (cdr l)))))
(cons l(remove-nil_dupl (combin l (count-lst (length l)))))) 

 

(test '("A" "B" "C" "D"))
'(("A" "B" "C" "D")
("A" "B" "C")
("A" "B")
("A")
("B")
("A" "C")
("C")
("B" "C")
("A" "B" "D")
("A" "D")
("D")
("B" "D")
("A" "C" "D")
("C" "D")
("B" "C" "D")
)

[(gile)]

Evgeniy,

 

Ta routine fonctionne comme la première que je donne (réponse 2).

Elle trouve toutes les combinaisons, puis supprime les doubles, le processus est long.

La routine (réponse 6) évite directement les doubles : plus rapide.

 

_$ (setq lst '("A" "B" "C" "D"))

("A" "B" "C" "D")

_$ (benchmark '((combinaisons_rep2 lst) (combinaisons_rep6 lst) (test_evgeniy lst)))

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

 

(COMBINAISONS_REP6 LST)......1016 / 12.26

(COMBINAISONS_REP2 LST)......2281 / 5.46

(TEST_EVGENIY LST)..........12453 / 1.00

 

[Edité le 5/12/2007 par (gile)]