[转贴]：排列组合

eachy

http://bbs.ee.ntu.edu.tw/boards/Programming/16/7.html

2. [php]
   
3. ;|首先寫一個函數 (interleave a xs), 把 a 給插到 xs 的所有空隙.
   
4. 例如 (interleave 4 '(1 2 3))  => ((4 1 2 3) (1 4 2 3) (1 2 4 3) (1 2 3 4))
   
5. Interleave 怎麼寫呢? 用這樣的遞迴關係: 把 a 插到 xs 的每一個空隙, 其實就是
   
6. 把 a 個空隙, 或著把第一個空隙留給 (car xs), 把 a 往 (cdr xs)
   
7. 的空隙裡面插.
   
8. |;
   
9. (defun interleave (a xs)
   
10.   (if (null xs)
    
11.     (list (list a))
    
12.     (cons (cons a xs)                        ; a放第一個
    
13.           (mapcar '(lambda (ys) (cons (car xs) ys)) ;把第一個留出來
    
14.                   (interleave a (cdr xs)) ; 往(cdr xs)裡找空隙
    
15.           )
    
16.     )
    
17.   )
    
18. )
    
19. 
    
20. ;|有了 interleave, 寫所有的排列 (permutation xs) 就方便了. 如果我們
    
21. 已經算出了 (permutation (cdr xs)), 把 (car xs) 插到每一個空隙裡就可以了.
    
22. |;
    
23. (defun permutation (xs)
    
24.   (if (null xs)
    
25.     '(())
    
26.     (apply 'append
    
27.            (mapcar '(lambda (ys) (interleave (car xs) ys))
    
28.                    (permutation (cdr xs))
    
29.            )
    
30.     )
    
31.   )
    
32. )
    
33. [/php]

[php]<br /> ;|首先寫一個函數 (interleave a xs), 把 a 給插到 xs 的所有空隙.<br /> 例如 (interleave 4 '(1 2 3))  => ((4 1 2 3) (1 4 2 3) (1 2 4 3) (1 2 3 4))<br /> Interleave 怎麼寫呢? 用這樣的遞迴關係: 把 a 插到 xs 的每一個空隙, 其實就是<br /> 把 a 個空隙, 或著把第一個空隙留給 (car xs), 把 a 往 (cdr xs)<br /> 的空隙裡面插.<br /> |;<br /> (defun interleave (a xs)<br />   (if (null xs)<br />     (list (list a))<br />     (cons (cons a xs)                        ; a放第一個<br />           (mapcar '(lambda (ys) (cons (car xs) ys)) ;把第一個留出來<br />                   (interleave a (cdr xs)) ; 往(cdr xs)裡找空隙<br />           )<br />     )<br />   )<br /> )<br /> <br /> ;|有了 interleave, 寫所有的排列 (permutation xs) 就方便了. 如果我們<br /> 已經算出了 (permutation (cdr xs)), 把 (car xs) 插到每一個空隙裡就可以了.<br /> |;<br /> (defun permutation (xs)<br />   (if (null xs)<br />     '(())<br />     (apply 'append<br />            (mapcar '(lambda (ys) (interleave (car xs) ys))<br />                    (permutation (cdr xs))<br />            )<br />     )<br />   )<br /> )<br /> [/php]

aeo

写了个没用递归的.

2. 
   
3. ;;;interleave
   
4. ;;;没用递归
   
5. ;;;(test 4 '(1 2 3))  => ((4 1 2 3) (1 4 2 3) (1 2 4 3) (1 2 3 4))
   
6. (defun test(a li / j k li1)
   
7.    (setq li1(mapcar '(lambda(x)(setq x li))(setq li(cons a li))) ;4个 '(4 1 2 3)
   
8.          j  -1
   
9.          li1(mapcar
   
10.               '(lambda(x)
    
11.                 (setq j(1+ j) k -1)
    
12.                 (cdr(apply 'append(mapcar '(lambda(y)(if(= j(setq k(1+ k)))(list y a)(list y)))x)))
    
13.                )
    
14.             li1)
    
15.     )
    
16. )
    

<br /> ;;;interleave<br /> ;;;没用递归<br /> ;;;(test 4 '(1 2 3))  => ((4 1 2 3) (1 4 2 3) (1 2 4 3) (1 2 3 4))<br /> (defun test(a li / j k li1)<br />    (setq li1(mapcar '(lambda(x)(setq x li))(setq li(cons a li))) ;4个 '(4 1 2 3)<br />          j  -1 <br />          li1(mapcar <br />               '(lambda(x)<br />                 (setq j(1+ j) k -1)<br />                 (cdr(apply 'append(mapcar '(lambda(y)(if(= j(setq k(1+ k)))(list y a)(list y)))x)))<br />                )<br />             li1)<br />     )<br /> )<br />

陌生人

其实。。。。考虑简单些也挺好：）

2. 
   
3. ;(test 5 '(1 2 3 4)) -> ((5 1 2 3 4) (1 5 2 3 4) (1 2 5 3 4) (1 2 3 5 4) (1 2 3 4 5))
   
4. (defun test (a lst)
   
5.   (setq nlst (mapcar 'list lst))
   
6.   (setq nlst2 (mapcar '(lambda (x) (apply 'append (subst (append x (list a)) x  nlst))) nlst)
   
7.         nlst2 (cons (cons a lst) nlst2)
   
8.   )
   
9. )
   

<br /> ;(test 5 '(1 2 3 4)) -> ((5 1 2 3 4) (1 5 2 3 4) (1 2 5 3 4) (1 2 3 5 4) (1 2 3 4 5))<br /> (defun test (a lst)<br />   (setq nlst (mapcar 'list lst))<br />   (setq nlst2 (mapcar '(lambda (x) (apply 'append (subst (append x (list a)) x  nlst))) nlst)<br />         nlst2 (cons (cons a lst) nlst2)<br />   )<br /> )<br />

aeo

最初由 陌生人 发布
[B]其实。。。。考虑简单些也挺好：）
[code]
;(test 5 '(1 2 3 4)) -> ((5 1 2 3 4) (1 5 2 3 4) (1 2 5 3 4) (1 2 3 5 4) (1 2 3 4 5))
(defun test (a lst)
  (setq nlst (mapcar 'list lst))
  (setq nlst2 (m... [/B]

你的方法肯定是不行的.

(test 4 '(1 2 3 4))怎么办?
a和lst可以重复.而且不一定是数字.
lst里面也可以重复
(test 4 '("A""A""B""B""C") )

所以我是根据位置来的

陌生人

_$ (test 4 '(1 2 3 4))
((4 1 2 3 4) (1 4 2 3 4) (1 2 4 3 4) (1 2 3 4 4) (1 2 3 4 4))
不过下面的测试没通过
_$ (test 4 '("A""A""B""B""C") )
((4 "A" "A" "B" "B" "C") ("A" 4 "A" 4 "B" "B" "C") ("A" 4 "A" 4 "B" "B" "C") ("A" "A" "B" 4 "B" 4 "C") ("A" "A" "B" 4 "B" 4 "C") ("A" "A" "B" "B" "C" 4))

哈哈，其实上面这个只是适用与元素都不相同的情况。subst就是有这个坏毛病，大家记住啦！不过，也不是不能用啊。不同的时候还是挺多的。
如果要适用性好的。很easy。

2. 
   
3. (defun test (a lst / nlst nlst2)
   
4.   (setq nlst (mapcar '(lambda (x)  lst )lst) n -1)
   
5.   (setq nlst2 (mapcar '(lambda (x)
   
6.                          (setq n (1+ n) m -1)
   
7.                          (apply 'append (mapcar '(lambda (y) (setq m (1+ m)) (if (= n m) (list y a) (list y))) x))
   
8.                          )
   
9.                       nlst))
   
10.   (cons (cons a lst) nlst2)
    
11. )

<br /> (defun test (a lst / nlst nlst2)<br />   (setq nlst (mapcar '(lambda (x)  lst )lst) n -1)<br />   (setq nlst2 (mapcar '(lambda (x)<br />                          (setq n (1+ n) m -1)<br />                          (apply 'append (mapcar '(lambda (y) (setq m (1+ m)) (if (= n m) (list y a) (list y))) x))<br />                          )<br />                       nlst))<br />   (cons (cons a lst) nlst2)<br /> )

一？写完后发现和版主的好相像哦。呵，纯属巧合

aeo

最初由 陌生人 发布
[B]_$ (test 4 '(1 2 3 4))
((4 1 2 3 4) (1 4 2 3 4) (1 2 4 3 4) (1 2 3 4 4) (1 2 3 4 4))
不过下面的测试没通过
_$ (test 4 '("A""A""B""B""C") )
((4 "A" "A" "B" "B" "C") ("A" 4 "A" 4 "B" "B" "C") ("A" 4 ... [/B]

你的和我上面是一样的

看我的:

2. 
   
3. (defun test(a li / li2)
   
4. (mapcar '(lambda(x)(setq li2(append li2(list(car li)))li(cdr li))
   
5.             (cdr(append li2(list a)li))
   
6.           ) (setq li(cons a li)))
   
7. )
   

<br /> (defun test(a li / li2)<br /> (mapcar '(lambda(x)(setq li2(append li2(list(car li)))li(cdr li))<br />             (cdr(append li2(list a)li))<br />           ) (setq li(cons a li)))<br /> )<br />

现在简单了吧

陌生人

不错不错，这个方法巧妙

841594

我等只会用最简单函数的写法：

(defun tst(a lst / lst1 lst2)
  (repeat (1+ (length lst))
    (setq lst2 (cons (append lst1 (List a) lst) lst2)
          lst1 (append lst1 (list (car lst)))
          lst (cdr lst))
  )
  (reverse lst2)
)

还是aeo的好。