凑数之简化版【随机凑数】

wmy920130

太强大了，膜拜！

cqcbc

谢谢香川老师分享！太强大啦！！！！

lzqmsy

谢谢楼主,学习了

jiliyacui

谢谢香川老师分享！我正需要测试一组回馈数据！谢谢！

香川群子

liulang0808 发表于 2017-10-31 09:22
香川老师又出手了，谢谢分享

附件有更新，增加了元素个数允许范围的显示，
以及计算误差精度的设置。

请有兴趣的坛友重新下载附件。

香川群子

zpy2 发表于 2017-10-31 15:36
以逗号分隔的20个数值(1-8)

php版的算24，是什么算法原理？

递归排列组合吗？

香川群子

zpy2 发表于 2017-10-31 15:37
数据多感觉还是比较慢的。

目前是完全随机调整，计算效率是非常低的（很多次随机结果是无效的），只适合于少量数据的凑数。

可以优化一下，比如，随机调整时，
第一个数随机，但第二个数就是用遍历筛选+随机，这样效率反而高一些。

香川群子

microyip 发表于 2017-10-31 10:01
见贴要第一时间点赞

这是孤独骑士的朋友在精英培训论坛上的一个凑数要求，
原帖是灰袍法师的组合凑数效率比较低，

因为原帖主只需要任意一组随机凑数结果，
所以我就拍脑袋想出了一个随机凑数的算法，试了一下效果还可以，因此分享给大家。

…………
因为不是精心制作，所以按我的惯例，变量都没有定义。哈哈哈。

刚刚稍微升级了一下，加了个计算精度的设置。

一把小刀闯天下

zpy2 发表于 2017-10-31 15:36
以逗号分隔的20个数值(1-8)

'来个VBA的

Option Explicit
Const PRECISION = 0.000001
Const COUNT_OF_NUMBER = 4 '4个数，可以更多或更少
Const NUMBER_TO_CAL = 24 '结果可以更小或更大
Dim number(COUNT_OF_NUMBER) As Double
Dim expression(COUNT_OF_NUMBER) As String

Function Search(n) As Boolean
  Dim i As Integer, j As Integer
  If n = 1 Then
    Search = IIf((Abs(number(0) - NUMBER_TO_CAL) < PRECISION), True, False)
    Exit Function
  End If
  For i = 0 To n - 1
    For j = i + 1 To n - 1
      Dim A As Double, B As Double
      Dim expA As String, expB As String
      A = number(i): B = number(j)
      number(j) = number(n - 1)
      expA = expression(i): expB = expression(j)
      expression(j) = expression(n - 1)
      expression(i) = "(" + expA + "+" + expB + ")"
      number(i) = A + B
      If (Search(n - 1)) Then Search = True: Exit Function
      expression(i) = "(" + expA + "-" + expB + ")"
      number(i) = A - B
      If (Search(n - 1)) Then Search = True: Exit Function
      expression(i) = "(" + expB + "-" + expA + ")"
      number(i) = B - A
      If (Search(n - 1)) Then Search = True: Exit Function
      expression(i) = "(" + expA + "*" + expB + ")"
      number(i) = A * B
      If (Search(n - 1)) Then Search = True: Exit Function
      If B <> 0 Then
        expression(i) = "(" + expA + "/" + expB + ")"
        number(i) = A / B
        If (Search(n - 1)) Then Search = True: Exit Function:
      End If
      If A <> 0 Then
        expression(i) = "(" + expB + "/" + expA + ")"
        number(i) = B / A
        If (Search(n - 1)) Then Search = True: Exit Function
      End If
      number(i) = A: number(j) = B
      expression(i) = expA: expression(j) = expB
  Next j, i
  Search = False
End Function

Sub test()
  Dim x As Integer, i As Integer
  For i = 0 To COUNT_OF_NUMBER - 1
    x = InputBox("输入第" & (i + 1) & "个数", COUNT_OF_NUMBER & "个数算" & NUMBER_TO_CAL)
    number(i) = x
    expression(i) = CStr(x)
  Next
  If Search(COUNT_OF_NUMBER) Then
    MsgBox expression(0) & "=" & CStr(NUMBER_TO_CAL)
  Else
    MsgBox "无解"
  End If
End Sub

缔造者

谢谢分享。