我有个数组a，个数和数值任意
现从该数组连续的三个位置取出1或0，只要连续，不一定要从第一个开始。
直到将所有数取完为止。
求最好的排列和取法（可能有N种方法是正确的）。
例如：a(0)=1,a(1)=2,a(2)=2,a(3)=3,a(4)=3
最好的排列和取法:
排列 2 3 3 2 1
取法 1 1 1
1 1 1
1 1 1
0 1 1
现从该数组连续的三个位置取出1或0，只要连续，不一定要从第一个开始。
直到将所有数取完为止。
求最好的排列和取法（可能有N种方法是正确的）。
例如：a(0)=1,a(1)=2,a(2)=2,a(3)=3,a(4)=3
最好的排列和取法:
排列 2 3 3 2 1
取法 1 1 1
1 1 1
1 1 1
0 1 1
Me.FontName = "宋体"
Me.Print xSolve("2,3,3,2,1")
Me.Print xSolve("1,1,2,2")
Me.Print xSolve("1,2,2,3,3,1")
End SubPrivate Function xSolve(strV As String) As String
Dim i As Integer, j As Integer
Dim a As Integer, b As Integer, c As Integer
Dim tS() As String, RetS As String
Dim tV() As Integer
Dim tUB As Integer
'初值……
tS = Split(strV, ",")
tUB = UBound(tS)
ReDim tV(tUB) As Integer
For i = 0 To tUB
tV(i) = Val(tS(i))
Next
Erase tS
'原题……
For i = 0 To tUB
RetS = RetS & Format(tV(i), "@@@")
Next
RetS = RetS & vbCrLf & String$((tUB + 1) * 3, "=") & vbCrLf '求解……
Do
'定位到c
b = 0
For i = 0 To tUB - 2
a = 0
For j = 0 To 2
a = a + tV(i + j)
Next
If b < a Then b = a: c = i
Next
If b = 0 Then Exit Do
'减值
RetS = RetS & String$(c * 3, " ") '前导空格
For i = c To c + 2
If tV(i) > 0 Then
tV(i) = tV(i) - 1
RetS = RetS & " 1"
Else
RetS = RetS & " 0"
End If
Next
RetS = RetS & vbCrLf
Loop While b > 0
xSolve = RetS
Erase tV
End Function
突然又想到可以这样改下～ '定位到c
b = 0
For i = 0 To tUB - 2
a = 0
For j = 0 To 2
If tV(i + j) > 0 Then a = a + 1
Next
If a > 0 And tV(i) > 0 Then
b = a
c = i
Exit For
End If
Next
If b = 0 Then Exit Do
Option ExplicitSub Main()
X "1,2,2,3,3"
X "1,1,2,2"
X "1,0,1,1,1,1"
X "1,1,2,2,2,2,2,1,1"
End SubSub X(ByVal List As String)
Dim oList As Collection
Dim a1() As Long
Dim a2() As String
Dim a3() As String
Dim lUB As Long
Dim I As Long
Dim J As Long
Set oList = Sort(List)
lUB = oList.Count - 1
ReDim a1(0 To lUB)
ReDim a2(0 To lUB)
ReDim a3(0 To lUB)
I = 0
While oList.Count
Select Case oList.Count
Case 1
a1(I) = oList(1): oList.Remove 1: a2(I) = a1(I)
Case 2
a1(I + 1) = oList(1): oList.Remove 1: a2(I + 1) = a1(I + 1)
a1(I) = oList(1): oList.Remove 1: a2(I) = a1(I)
Case Else
a1(I + 2) = oList(1): oList.Remove 1: a2(I + 2) = a1(I + 2)
a1(I + 1) = oList(1): oList.Remove 1: a2(I + 1) = a1(I + 1)
a1(I) = oList(1): oList.Remove 1: a2(I) = a1(I)
Do While oList.Count
a1(I + 2) = a1(I + 2) - a1(I)
a1(I + 1) = a1(I + 1) - a1(I)
a1(I) = 0
If a1(I + 1) > 0 Then
a1(I + 3) = oList(1): oList.Remove 1: a2(I + 3) = a1(I + 3)
I = I + 1
ElseIf a1(I + 2) > 0 Then
If I + 4 <= lUB Then
a1(I + 4) = oList(1): oList.Remove 1: a2(I + 4) = a1(I + 4)
If oList.Count = 0 Then Exit Do
End If
a1(I + 3) = oList(1): oList.Remove 1: a2(I + 3) = a1(I + 3)
I = I + 2
Else
I = I + 3
Exit Do
End If
Loop
End Select
Wend
Debug.Print String(40, "=")
Debug.Print Join(a2, vbTab)
Debug.Print String(40, "-")
I = 0
While I <= lUB
ReDim a3(0 To lUB)
For J = I To I + 2
If J <= lUB Then
If a2(J) > 0 Then
a2(J) = a2(J) - 1
a3(J) = 1
End If
Else
Exit For
End If
Next
Debug.Print Join(a3, vbTab)
J = I
Do While a2(J) = 0
J = J + 1
If J > lUB Then Exit Do
Loop
I = J
Wend
End SubFunction Sort(ByVal List As String) As Collection
Dim Result As Collection
Dim a() As String
Dim I As Long
Dim J As Long
Dim L As Long Set Result = New Collection
a = Split(List, ",")
For I = 0 To UBound(a)
L = a(I)
If Result.Count = 0 Then
Result.Add L
Else
J = 1
Do While Result(J) > L
J = J + 1
If J > Result.Count Then Exit Do
Loop
If J > Result.Count Then
Result.Add L
Else
Result.Add L, , J
End If
End If
Next
Set Sort = Result
End Function
这个题会有意思点……嗯～继续～～
一、计算次数：
我们讨论数组的排列问题无非是为了最快的把数组里的数取完，也就是用最少的计算次数把数组里的全部值减到零为止。那么计算的次数跟什么有关那？以两组数据举个例子：
A组： 1 3 4 3 1 B组： 1 1 3 3 4
1 1 1 1 1 1
1 1 1 1 1 1
1 1 1 1 1 1
1 1 1 0 1 1
0 0 1
从这个例子很容易看出，相同的数据，A组用了4次，而B组用了5次，所以当数据以正态分布的时候，计算的次数最少。二、绝对正态分布与相对正态分布：
大家都知道什么是正态分布，但在我们这道题里还要讲另外一个知识，就是正态分布跟正态分布是不一样的，比如：
A组： 1 1 4 3 3 B组：1 3 4 3 1
不确切的说，这两组数据都可以看成是正态分布，他们都遵循着 （低-高-低）规律，我们把A组数据的分布情况叫相对正态分布，B组数据的分布情况叫绝对正态分布，那么究竟哪个分布更能使计算次数更少那？答案是两者都一样。（可以换组数据试试看）
A组： 1 1 4 3 3 B组： 1 3 4 3 1
1 1 1 1 1 1
1 1 1 1 1 1
1 1 1 1 1 1
1 1 1 1 1 1
三、数据的分组：
上面的例子，只是以5个数的数组为例，其实以5个数为例是有目的的，这是因为题要求必须连续取3位，而在这种情况下要形成正态分布的最小数当然就是5了。
既然正态分布的数据减值最快（计算次数最少），那么，我们把一个很长的数组先给它分一下组，每组5个数据，而且每组内的5个数据都成正态分布（绝对为佳），然后《连续》的对每个组进行处理，这样就可以达到减值最快的效果了。
这时，有人会想到，组与组之间是如何连接处理的？很简单，每个组总体的值要比上一组大，也就是组之间成递增规律就可以了。比如下面的例子：
12321 45654 78987 这是一个有15个元素的被分完组的数组，他们被分为3组，每组5个元素，而且每组里面成绝对正态分布，组之间成递增规律。为这样的数组起名叫华组。
这就是我们想要的数组的排序！那么一个随即产生的数组究竟应该怎么处理最后才能得到华组那？很简单
一个随即数组经过下面几步就可以得到华组：
第一步：对整个数组进行排序 ： 小——>大
第二步：对整个数组进行分组 ： 每组5个
第三步：对每组里面的元素进行重新排序： 按照绝对正态分布排序
这样，我们就可以得到一个能减值最快的数组了（既华组）。程序稍后播出。
如果不是的话，有什么依据？
一点说明都没有，真晕
请仔细看,第一部分的例子意在证明,正态分布是计算次数最少的排列方法.而第二部分是说,绝对与相对都可以(只是我认为绝对更好些)//
我承认,或许这不是最好的,如果你有更好的排列方案不妨拿出来大家一起研究下.**其实,推理部分比我上面写的要多,我只把简要的写上去.
下面是我按照绝对正态分布排序的方案写的程序,这个程序已经实现,这个程序能处理长度为5的倍数的数组,楼主可以稍微改动一下,便可以处理任意长度的数组.
程序如下：
command1_click() 事件生成一个长度为１５的随机数组
command2_click() 事件对该数组做由小到大的排序
command3_click() 事件生成华组（即楼主要的减值最快的排序结果）
分为三个按钮来写这个程序目的是为了读起来方便
以下是代码部分：Dim a(14) As Integer '通用
Private Sub Command1_Click()
'生成随即数组
Print
For i = 0 To 14
Randomize
a(i) = Int(Rnd * 10)
Print a(i);
Next i
Print
End SubPrivate Sub Command2_Click()
'对随即数组的排序：小->大
Dim t As Integer
For i = 0 To 13
For j = i + 1 To 14
If a(i) > a(j) Then
t = a(i)
a(i) = a(j)
a(j) = t
End If
Next j
Print a(i);
Next i
Print a(i);
Print
End SubPrivate Sub Command3_Click()
'生成华组
Dim j As Integer
j = 3 '数组的个数
For j = 1 To 3
i = (j - 1) * 5 '设置每组数的下界
'对每数组里的数排序,按从小到大的顺序为1,5,2,4,3
'把2跟5交换
t = a(i + 1)
a(i + 1) = a(i + 4)
a(i + 4) = t
'把2跟3交换
t = a(i + 1)
a(i + 1) = a(i + 2)
a(i + 2) = t
For t = i To i + 4
Print a(t);
Next t
Print ,
Next j
End Sub
我设定取数规则为从最左边非零的数组元素开始，连续取 3 个 1（除非数组元素不足或后续元素已为零）。这就是 Sub X() 最后的 Debug.Print 开始部分，没什么好解释的。按照我的取法，其实是对数组中连续的三个元素 a, b, c
取 a 次 3 个 1，剩下的 a', b', c' 的值为 0, (b-a), (c-a)
考虑到取数规则，显然让 b<a 或 c<a 是浪费的，应该使得 b-a>=0 和 c-a>=0，这样b', c' 能够与后续元素 d 作为取数目标进入下一个取数循环。同样应该使得 c'>=b' 最好 d>= b'
所有前四个元素 a, b, c, d 的设置规则应该是
a<=b<=c
d 尽量大
考虑到排在数组后面的元素，非常可能在（从左至右的）取数过程中无法组成整 3 个取数目标，那么后面的元素就应该尽量小
今天有点事，看的还不是很明白，
刚才真好碰巧试了一个序列3，4，5，6，7，6，7，发现你的程序不适用我感觉对最佳问题类的算法除了穷举算法之外（因为穷举的严密性是不用证明的）
其它的算法都应该有严密的逻辑证明来保证结果
6 7 7 6 4 5 3
-------------------------
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 1 1
1 0 1
0 0 1
0 0 1
0 0 1这个3，4，5，6，7，6，7把3那一列去掉
结果肯定是最优的（把4换成5更直观，不会出现0）然后再加一个3进去
3应该就只能单独消除了有更好的解法么？
另外……
关于解不排序的的原始序列
除了穷举还真没有好的想法……
大家有兴趣就研究下吧～ ^ ^
看了你回复,我想问你几个问题
1 你是否知道穷举的含义? 2 以及穷举在哪方面应用?
然后,我要告诉你,此题跟穷举毫无关系.
穷举是当题的解无规律可寻的时候,要一一列举看是否符合解,这道题的关键是数的排序,你能说数之间没有规律?最主要的,一道排序问题怎么可能跟穷举联系到一起?
我已经看了 Tiger_Zhao程序,他的方法根本不是穷举法,仔细看,他是在推理数的正态分布!
3 4 5 6 7 6 7
我手工排了一次的结果要14次，还不知是不是最佳排列，
我还没编穷举的程序，看了Tiger_Zhao的说明就构造了这个试了一下
我用的较佳排列是6677543to ylsn2004:
应该是你误会了我的意思
我说的穷举的意思是列出所用可能的情况，通过比较得出最佳结果
这里的所有可能情况可以是经过理论证明最小可能排列
应该说这是计算机最适用的地方
我想数据结构中的最简单的迷宫求解到最短路径都是以这个为基础的吧（我是这么理解的）
不知我说清楚了没有
Tiger_Zhao的程序确实不是穷举，所用的最佳排列是建立在假设基础之上的对于这道题，如果用穷举的话
对任一个排列，都可以列出所有取法，来找出最好的取法
而对任一数组可以列出所有排列，找出取法最好的那些就行了我说过“不过这个问题穷举可能是最好的方法”
我只是说可能。熟归熟啊，呵呵
我说这个是因为
那天我想了之后感觉不是没有什么思路
而是完全没有思路
所以说出来看有没有同感的，就像AprilSong现在就是这种想法:)对这种算法题，总希望能总结出规律，享受其中的乐趣
当然希望有一天能找到更好的算法
Public Function GetCount(b() As Long) As Long
'返回取完指定排列所需最少步数
'b()为要取的数组
Dim i As Long
Dim BD As Long
BD = UBound(b)
For i = LBound(b) To BD - 2
If b(i) > 0 Then
GetCount = GetCount + b(i)
b(i + 1) = b(i + 1) - b(i)
b(i + 2) = b(i + 2) - b(i)
End If
Next i
If b(BD - 1) > b(BD) Then
If b(BD - 1) > 0 Then
GetCount = GetCount + b(BD - 1)
End If
Else
If b(BD) > 0 Then
GetCount = GetCount + b(BD)
End If
End If
End Function
等晚上我把穷举的最佳排列的算法也写出来算了
看例子：
1 3 4 3 1 这是一个5个元素的数组的一种排序情况，而且这种排序情况是减值最快的，也就是111能出现的几率最多的情况，这种情况就是正态分布！！！！！！！To flyingscv(zlj)
请你别编写取法了，取法是固定的，就是3最多，2次之，1最少，OK?
这个取法非常的简单，概括起来就一句话：
对于连续取值的三个数，（1）每位大于0的时候取1 ，等于0取0（2）第一位取完后，第四位补，第二位变第一位，第三位变第二位，依次往下类推。
有了宝宝难得有空，各位见谅了。接上回
设 oList 为以排序的未分配元素，用 oList.Pop() 表示取出最大元素。
生成最优数组：状态1:
c = oList.Pop() ' c 分配最大值
b = oList.Pop() ' b 分配次大值
a = oList.Pop() ' a 分配第三大值状态2:
a, b, c 作为最优数组的连续元素，可以取 a 次 3 个 1，剩余a' = a - a = 0
b' = b - a
c' = c - aIf b' <> 0 Then
状态3:
d = oList.Pop() 'd 分配剩余元素中的最大值 将 b', c', d 对照为 a, b, c；Go To 状态2
ElseIf c' <> 0 Then
状态4:
e = oList.Pop() 'e 分配剩余元素中的最大值
d = oList.Pop() 'e 分配剩余元素中的次大值 将 c', d, e 对照为 a, b, c；Go To 状态2
Else
Go To 状态1
End If其他无非就是当 oList 为空后结束分配的处理。
取6次 1,1,1
剩余 {0,1,1, , , , }
分配 { , , ,6, , , } 余 oList = {5,4,3}
取1次 1,1,1
剩余 {0,0,0,5, , , }
分配 { , , , ,4,5, } 余 oList = {3}
取4次 1,1,1
取1次 1,0,1
剩余 {0,0,0,0,0,0, }
分配 { , , , , , ,3} 余 oList = {}
取3次 1
结束优化数组为 {6,6,7,5,4,5,3}
需要取数 15 次
程序出来了，计算最佳排列使用穷举
运行需要加一个 textbox，一个commandbox3，4，5，6，7，6，7的最佳排列为3，5，6，4，7，7，6
需要13步Option Explicit
Private OriginA() As Long '数据下标基于1
Private ArrangeA() As Long '数据下标基于1
Private BestA() As Long '数据下标基于1
Private BestCount As LongPrivate Sub Command1_Click()
Dim a() As Long '用于ArrangeDistinct
Dim b() As String
Dim s As String
Dim i As Long
Dim BD As Long
b = Split(Text1.Text, ",")
BD = UBound(b) + 1
ReDim OriginA(BD)
ReDim ArrangeA(BD)
ReDim BestA(BD)
ReDim a(BD)
BestCount = 2147483647 '不考虑超过这么多次的数据
For i = 0 To UBound(b)
OriginA(i + 1) = b(i)
Next i
ArrangeDistinct a, 1
For i = 1 To BD
s = s & Str(BestA(i))
Next
Print "------------------------------------------"
Print Text1.Text & "的最佳排列为：" & s
Print "最少需要：" & BestCount & "次"
End SubPublic Function GetCount(b() As Long) As Long
'返回取完指定排列所需最少步数,下标基于1
'最佳取法原理很简单，就是开始取到尾
Dim i As Long
Dim BD As Long
BD = UBound(b)
For i = LBound(b) To BD - 2
If b(i) > 0 Then
GetCount = GetCount + b(i)
b(i + 1) = b(i + 1) - b(i)
b(i + 2) = b(i + 2) - b(i)
End If
Next i
If b(BD - 1) > b(BD) Then
If b(BD - 1) > 0 Then
GetCount = GetCount + b(BD - 1)
End If
Else
If b(BD) > 0 Then
GetCount = GetCount + b(BD)
End If
End If
End FunctionPublic Function GetBestArray(b() As Long) As LongEnd FunctionPublic Function ArrangeDistinct(b() As Long, Optional ByVal Num As Long = 1) As Long
'功能全排列数组，每次排列调用一次Arrange
'调用方法 ArrangeDistinct b
'b下标基于1
Dim BD As Long
Dim i As Long, j As Long
Dim exist As Boolean
BD = UBound(b)
If Num > BD Then
Arrange b
Else
For i = 1 To BD
b(Num) = i
exist = False
For j = 1 To Num - 1
If b(j) = i Then
exist = True
Exit For
End If
Next j
If Not exist Then
ArrangeDistinct b, Num + 1
End If
Next i
End If
End FunctionPublic Function Arrange(b() As Long) As Long
'全排列调用函数由ArrangeDistinct或者ArrangeAll调用 Dim BD As Long
Dim i As Long
Dim s As String
Dim Count As Long
BD = UBound(b)
For i = 1 To BD
ArrangeA(i) = OriginA(b(i))
Next i
Count = GetCount(ArrangeA)
If Count < BestCount Then
For i = 1 To BD
BestA(i) = OriginA(b(i))
Next i
BestCount = Count
End If
End Function
Private Sub Form_Load()
Text1.Text = "3,4,5,6,7,6,7"
End Sub
开始感觉Tiger_Zhao(VB老鸟)的算法应该可以了。没想到用穷举居然还能找到更好的解。但穷举的话太慢了，数组个数少还可以，一多就不行了。应该还有更好的方法
------------------------------------
我想这样改进也许就行了If b' <> 0 Then
状态3:
d = oList.Pop() 'd 分配剩余元素中的最大值这里不应该取最大的
我的看法（你看看啊，不知是不是说清楚了）
d = oList.Pop()
if b'>d then goto 状态1
否则
e= oList.Pop()
if d-b'<e goto 状态1
否则
swap(d,e)
goto 状态1其它状态和这个类似这样也许就是最佳了，可以用穷举验证看看
理想（可能的最小）解为 RoundUp(∑{所有元素}/3) 次，但是象数组 {5,5,5,5} 就无法用 7 次取完。
我也考虑过在出现没有取满 3 的情况下（比如猜测到 {6,6,7,5,4,5, } 时出现取数 1,0,1）进行回溯，执行有限的穷举；但是无法判断是否有必然存在无法取满 3 的情况。
-------------------------------------------------------------------------
取0或者1（每位）
那么连续取三位只有下面这个几种取法或者是其中的几个组合：
111（减3）
110，101，011（减2）
001，010，100（减1）而且，可以说取法是固定的，因为要减的最快，那么就要减3出现的几率最大，减2次之，减1最少。
---------------------------------------------------------------------------题目的解就是要使减3出现的次数最多，减2的次之，减1的最少数列的和S=Σa，取一次最多减3，所以理论上最少取的次数为ceil(S/3),3+4+5+6+7+6+7=38,所以最少要ceil(38/3)=13次
（ ceil(x)表示大于或等于x的数中最小的数 ）数列a1,a2,a3,…,an取1，1，1的过程可以当成多项式除法，比如 3，2，1，1，5
———————————
（1，1，1）∫（3，5，6，4，7，7，6）
3，3，3
-----------------------
2，3，4
2，2，2
-----------------------
1，2，7
1，1，1
-----------------------
1，6，7
1，1，1
-----------------------
5，6，6
5，5，5
------------------------
0，1，1所以我们先来看看：多项式（a1,a2,a3,…,an）能被（1，1，1）“整除”的时候，数字a1,a2,a3,…,an的特征。联想到能被11整除的数的规律：
奇数位的和 = 偶数位的和，猜想：
（a1,a2,a3,…,an）能被（1，1，1）“整除” -----------------------<1>
<=====>（a1,a2,a3,…,an）=（b1,n2,b3,…，bm）×（1，1，1） -----------------------<2>
<=====> a1+a4+a7+… = a2+a5+a8+… = a3+a6+a9+… = b1+b2+…+bm -----------------------<3>
其中 m=n-2即把a1,a2,a3,…,an分成3组，每隔2位加起来，得3个和，这3个和相等这个猜想通过数学归纳法可以推理出来,具体推理过程我就不写了（偶的表达不好*^_^*）举个例子：
（a,b,c,d,e,f）×（1，1，1）=（a,a+b,a+b+c,b+c+d,c+d+e,d+e+f,e+f,f）
a1=a
a2=a+b
a3=a+b+c
a4=b+c+d
a5=c+d+e
a6=d+e+f
a7=e+f
a8=f
a1+a4+a7 = a+b+c+d+e+f
a2+a5+a8 = a+b+c+d+e+f
a3+a6 = a+b+c+d+e+f不过 由<3>推出 <1>,要在有负数的情况下才成立，例如（2，2，1，1，1，2）÷（1，1，1）=（2，-1，2）由此可以得到一个特殊的情况下的算法：把 a1,a2,a3,…,an 平均分成 3 份，（如果n不能被3整除，则有1或2份多1个数），使每份的数的和相等，则a1,a2,a3,…,an可以在Σa /3 次内取完。不过大多数列是满足不了这个要求的，比如楼上讨论多的（3，5，6，4，7，7，6）
a1+a4+a7=3+4+6 = 13
a2+a5 =5+7 = 12
a3+a6 =6+7 = 12所以一般情况下：（a1,a2,a3,…,an）经（1，1，1）尽量取后，会留有“余数”：
情况1：余数是（……，0，x,y,……）,假设 x<y，则要先取x次（0，1，1）再取y-x次（0，0，1）
情况2：余数是（……，x，0,y,……）,假设 x<y，则要先取x次（1，0，1）再取y-x次（0，0，1）
其余情况类推偶现在就想到这么多，后面的推理我以后有空再来。找周公去也！