趣味思考题 黑白排列 不仅是排列组合的数量

ldy

路过棋摊，两个大人在下围棋，一个小孩在旁边，拿着 两个黑棋两个白棋在摆直线，黑黑白白、白白黑黑、黑白黑白。。。。。

小孩问我 两黑两白 一共有几种摆法。一下子答不上来，于是坐下来摆，4 个棋的排列组合不多，有6种，我给他摆了出来。

为了行文方便，用1 代表黑棋 0 代表白棋。

0011
0101
0110
1001
1010
1100

小孩似乎意犹未尽，又各拿出 一黑一白（111000 ）要我摆，我摆了10几个摆法，晕了，脑子不够用了。找了个借口回家了。

回家编了个程序算出来了 3 黑3白 （111000）  一共 20种摆法，结果就不列出来。

当我试算 9 黑9白时 耗时 3.6秒 48620种摆法

再算 10 黑10白时 居然 要 51秒 184756种摆法

请有兴趣的朋友 讨论一下，用递归可能更快，但我不会。[em04]

 

 如果仅仅是算出 排列组合的 数量，我就不用发这帖了

 关键是 列出每一种摆法

[此贴子已经被作者于2007-11-3 15:18:33编辑过]

hhzjxss

QUOTE:

以下是引用彭希仁在2007-11-4 23:29:22的发言：

此题其实也就是一个二进制的算法,递归写起来是简单,但速度一定不会快,而且所有的递归都可以转换为非递归的写法.

 

 

彭希仁啥时给我们来讲一下递归吧，这个东东早听人说了，就是不知道是什么算法！

djyjysxxs

写个递归的上来：

Public arr1(), arr2(1 To 1048575, 1 To 1)
Public dic As New Dictionary
Public l As Long
Sub test()
t = Timer
l = 1
Dim num1 As Integer, num2 As Integer
w = 10
b = 10
'dic.RemoveAll
Range("a1:a1048576").Clear
Range("a1") = w & "*" & b
ReDim arr1(1 To w + b)
For k = 1 To w + b
    arr1(k) = "w"
Next k
num1 = IIf(w > b, w, b) + 1
num2 = w + b
 Call ps(1, num1, num2)
 MsgBox Timer - t
 MsgBox dic.Count
 'Range("a2").Resize(dic.Count, 1) = Application.Transpose(dic.Keys)  '为10*10时此句出错，dic.count为184756，11*11时为745032,故改为数组
 Range("a2").Resize(1048575, 1) = arr2
End Sub
Sub ps(i As Integer, num1 As Integer, num2 As Integer)
If num2 > num1 Then
   For k = i To num1
       arr1(k) = "b"
       j1 = k + 1
       j2 = num1 + 1
      Call ps(k + 1, num1 + 1, num2)
       arr1(k) = "w"
    Next k
Else
   For k = i To num1
    arr1(k) = "b"
    s = Replace(Join(arr1), " ", "")
    arr2(l, 1) = s
    l = l + 1
   ' s = dic(s)
    arr1(k) = "w"
    Next k
End If
End Sub

djyjysxxs

说明：楼上用的是2007版，行数可达1048576

另：当用字典时，10*10的'Range("a2").Resize(dic.Count, 1) = Application.Transpose(dic.Keys) 会报错，改为数组就对了。此处的错是Application.Transpose个原因还是什么？请辅导指导！

[此贴子已经被作者于2007-11-4 0:07:15编辑过]

ldy

递归果然快，学习了[em24][em24][em24][em23][em23]

Sub hhh()
Dim d(0 To 65535) '共65536个
a = Application.Transpose(d)
'2003下如果 0 to 65536 报错
End Sub
Transpose是工作表函数，2007前的表都是65536行
没有2007，如果2007这一点还没改变，可能是考虑到兼容性问题，也许是BUG
感觉2007 应该有Transpose的升级版 才对

liyh67

如果黑白各有n个，摆法共有 =FACT(n*2)/FACT(n)/FACT(n)

不看不看

啊！！！！！！！！！

彩票的原理

mxg825

QUOTE:

以下是引用liyh67在2007-11-3 12:39:39的发言：
如果黑白各有n个，摆法共有 =FACT(n*2)/FACT(n)/FACT(n)

厉害 50多秒 让你用一个函数 就搞定

hhzjxss

长见谅了！

ldy

QUOTE:

以下是引用liyh67在2007-11-3 12:39:39的发言：
如果黑白各有n个，摆法共有 =FACT(n*2)/FACT(n)/FACT(n)

liyh67兄弟函数真不错 =FACT(2*2)/FACT(2)/FACT(2)  = 6（1100）

不知道 能不能用函数得出 每一种摆法

1001
0011
1100
0101
1010
0110

 如果仅仅是算出 排列组合的 数量，我就不用发这帖了

[此贴子已经被作者于2007-11-3 15:13:13编辑过]