Office中国论坛/Access中国论坛
标题:
【算法】【原创】计算总数是由哪些数之和
[打印本页]
作者:
盗梦
时间:
2015-10-26 10:18
标题:
【算法】【原创】计算总数是由哪些数之和
本帖最后由 盗梦 于 2015-10-26 11:14 编辑
摘要
总有一些财务的朋友,拿一些数据和一个总数问:这个总数是哪些数字之和。
每次我都忍不住要翻白眼。。。
(为什么不问提供这些数据的人员呢)
于是,就尝试用代码实现这个功能。
算法思路
(源码和附件在后面,不想看思路可以跳过)
假如,现在有一组数据{1, 2, 3, 4, 5}和一个总数:6。
我想知道这个6可以是哪些数字之和。
用肉眼很明显看出 6=2+4 ,6=1+5,6=1+2+3
那么这个就涉及到排列组合中的组合,因为加法交换律,不用考虑数字的前后顺序。
但是,一个总数可能是一个数之和,也可能是两个数之和。那么就需要判断一个数之和到全部数之和的组合结果。
例如,
1个数组合:1,2,3,4,5
2个数组合:
1+2,1+3,1+4,1+5
2+3,2+4,2+5
3+4,3+5
4+5
3个数组合:
1+2+3,1+2+4,1+2+5
1+3+4,1+3+5
1+4+5
2+3+4,2+3+5
2+4+5
3+4+5
4个数组合:
1+2+3+4,1+2+3+5
1+2+4+5
1+3+4+5
2+3+4+5
5个数组合:
1+2+3+4+5
当然,这么多组合,不可能你一个一个罗列出来。那不得累死。。。
我上面来罗列的时候,是有规律的,不是随便写的。这个就涉及到我如何取数据组合的方法了
这种方法我称之为“
末尾移动法
”。(不知道有没重名,自己揣摩出来的)
例如,要在N个数中取m个数。
第1次取值,前m个数:N1,N2,...,N(m-1),N(m)
第2次取值,把最后的一个数,往前移动一位:N1,N2,...,N(m-1),N(m+1)
第3次取值,同样最后一个数继续往前移动:N1,N2,...,N(m-1),N(m+2)
...一直移到不能再移动,也就是最后一个数
第N-m+1次取值,N1,N2,...,N(m-1),N(N)
最后一个数移动完成之后,轮到倒数第二个数字移动取值。
第N-m+2次取值,N1,N2,...,N(m),N(N)
...同样一直移到不能再移动为止,如下
第2N-2m+3次取值,N1,N2,...N(N-1),N(N)
接下来,剩下几个数轮番处理,直到完成所有组合。
思路看起来有些复杂,没办法,算法就是这样,哈哈哈
源码
Option Explicit
'=============================================
'= 函数:计算总数是由哪些数之和
'= 作者:阿航
'= 参数:
'= - arrValue() 数组 数据池
'= - dblResult 双精度 总数
'= - dblFixed 双精度 偏差值(误差值)
'=============================================
Public Function GetCombo(arrValue(), dblResult As Double, Optional dblFixed As Double = 0)
Dim arrSrc As Long '元素个数上限
Dim arrCalc() '计算
Dim i As Long, iAll As Long '循环因子
Dim iCurrent As Long '正在变换第几个元素
Dim dblSum As Double '求和
Dim strExp As String '输出表达式
Dim dblCount As Double '次数
arrSrc = UBound(arrValue)
'从1个元素求和到全部元素求和
For iAll = 0 To arrSrc
'设置几项循环
ReDim arrCalc(iAll)
'初始化
For i = LBound(arrCalc) To UBound(arrCalc)
arrCalc(i) = i
Next i
dblCount = 0 '计数归零
Do
'取值求和
dblSum = 0
For i = LBound(arrCalc) To UBound(arrCalc)
dblSum = dblSum + arrValue(arrCalc(i))
Next i
dblCount = dblCount + 1 '计数累计
'判断求和是否正确
If (dblSum + dblFixed >= dblResult) And (dblSum - dblFixed <= dblResult) Then '设置偏差
'先输出结果
strExp = ""
For i = LBound(arrCalc) To UBound(arrCalc)
strExp = strExp & "+" & arrValue(arrCalc(i))
Next i
Debug.Print Right(strExp, Len(strExp) - 1) & "=" & dblSum
'Exit Function '得到一次结果,就退出(可以不先退出,一直计算)
End If
'判断当前循环数字
iCurrent = -1
For i = UBound(arrCalc) To LBound(arrCalc) Step -1
If arrSrc = (UBound(arrCalc) - i) + arrCalc(i) Then
Else
iCurrent = i
Exit For
End If
Next i
If iCurrent = -1 Then Exit Do '没有符合条件的,就是都到顶了
'当前循环因子前进一格
arrCalc(iCurrent) = arrCalc(iCurrent) + 1
'重置后面的循环因子
For i = iCurrent + 1 To UBound(arrCalc)
arrCalc(i) = arrCalc(i - 1) + 1
Next i
Loop
Debug.Print "完成" & iAll + 1 & "项求和判断,计算次数:" & dblCount
Next iAll
Debug.Print "Compelite"
End Function
'测试,在立即窗口输入 gTest ,然后敲回车,即可看到测试结果
Public Function gTest()
Dim arr()
arr() = Array(921, 831, 639, 603, 596, 884)
GetCombo arr, 2156
End Function
复制代码
我们测试一下:总数为2156,数据池是{921,831,639,603,596,884}求2156是哪些数字之和。
在立即窗口输入 gTest ,然后敲回车
[attach]57357[/attach]
我上面写的函数可以设置误差值,误差值为10,可以再得到一个结果。
[attach]57358[/attach]
附件:[attach]57359[/attach]
优化建议
:
如果你有更好的取组合方法,可以修改优化看看。
另外,如果数据池比较多。可以尝试先用快速排序法,降序排列。
每开始新的取n项组合之前,就判断第一次之和是否大于等于总数。如果为假,则不用取n项组合了。
作者:
tmtony
时间:
2015-10-26 10:19
强贴!
作者:
5988143
时间:
2015-10-26 10:24
認真學習一下~收藏精品案例~
作者:
盗梦
时间:
2015-10-26 10:37
Debug.Print Right(strExp, Len(strExp) - 1) & "=" & dblSum
打印结果这里,可以用 Join 方法合并数组的元素
作者:
做梦
时间:
2015-10-26 10:55
lihai
欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)
Powered by Discuz! X3.3