[第96期]换硬币[已总结]

lee1892 · 发表于 2013-7-29 19:08

本帖最后由 delete_007 于 2013-10-30 08:35 编辑

题目内容：
有一国，其国内硬币可按其面值至该国银行兑换，其面值为任一正整数[n]，银行兑换方式为返回面值为如下的三枚：[n/2], [n/3], [n/4]，当然也都取整了。另外，该银行也可用该国硬币兑换成等额的RMB。现要求编写计算器，使得输入硬币的面值（即任一正整数），而输出可获得的最大RMB数字。

例如：输入2，则可直接兑成RMB，得输出2。输入12，可先换为 [12/2]=6，[12/3]=4，[12/4]=3，再换成RMB，输出13。

答题要求：
可完形填空如下，允许添加过程或函数及公共变量：
[code=vb]Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#
' 可更改段
' 只能是Dim
' 可更改结束
aCoins = Array(12, 123, 1000,  50000, 600000, 30000000)
Redim aRes(UBound(aCoins))
t = Timer
' 可更改段
For Each nCoin In aCoins
      '....
Next
' 可更改结束
Debug.Print "ID: " & "<YOUR ID>"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub[/code]

评分规则：
1、1分钟内（超过俺就当是死机了）可获得正确结果可得1分。
2、以我的机器为准，1秒内可加1分。
3、可算10^9且低于0.1秒的可再加1分。
4、极其优秀的，超过我的预期的或可再追加1分。
5、没有按要求填空的可能会被扣1分，比如删除了原有的注释、填错了地方之类的~

知识点：
递归

提示：
可先多次换为本国硬币，再换RMB。

再以一例说明，现有面值25的硬币一枚，求最大可换回的RMB数

1、直接换得25RMB，或换得INT(25/2)=12, INT(25/3)=8, INT(25/4)=6，各一枚
2、12的硬币可直接换，得12RMB，或如前可换得6、4、3三枚硬币
   8和6的硬币也都同样有两种选择
……
如上会有多个选择分支，需要从中找出最终可得硬币面值之和最大，即为可换得的最大RMB数，此例为6+4+3+8+6=27

另3万的得数为54563，供校验。

标准答案：
不知道如何设置权限，另加~

是否参与点评与总结：
可以参与

补充内容 (2013-9-3 08:59):
总结在21楼，参考答案在32楼

大灰狼1976 · 发表于 2013-7-30 15:17

本帖最后由大灰狼1976 于 2013-8-3 21:30 编辑

12是个分水岭，看来我的结果是正确的，哈哈{:soso_e100:}
Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#, i&, d As Object, c, n As Byte
Set d = CreateObject("scripting.dictionary")
' 可更改段
' 只能是Dim
' 可更改结束
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
' 可更改段
n = 0
For Each nCoin In aCoins
   d(nCoin) = 1
   Do While Application.Max(d.keys) > 11
      For Each c In d.keys
      If c > 11 Then d(Int(c / 2)) = d(Int(c / 2)) + d(c): d(Int(c / 3)) = d(Int(c / 3)) + d(c): d(Int(c / 4)) = d(Int(c / 4)) + d(c): d.Remove (c)
      Next c
   Loop
   i = 0
   For Each c In d.keys
      i = i + c * d(c)
   Next c
   d.RemoveAll
   aRes(n) = i: n = n + 1
Next
' 可更改结束
Debug.Print "ID: " & "<YOUR ID>"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub

大灰狼1976 · 发表于 2013-7-30 15:30

本帖最后由大灰狼1976 于 2013-7-30 15:32 编辑

可是我没有用递归，有简单方法为什么不用，方法应该是灵活的，开拓思维嘛

zhyj_88 · 发表于 2013-8-3 11:25

Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#
Dim i% '新增语句
' 可更改段
' 只能是Dim
' 可更改结束
' aCoins = Array(10 ^ 9)
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
' 可更改段
For Each nCoin In aCoins
'....
aRes(i) = ExChange(CLng(nCoin)) '新增语句
i = i + 1 '新增语句
Next
' 可更改结束
Debug.Print "ID: " & "zhyj_88"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub
Function ExChange(Coin As Long) As Long
Dim i%, j&, k&
For i = 2 To 4
j = Coin \ i
If j > 11 Then
k = k + ExChange(j)
Else
k = k + j
End If
Next i
ExChange = k
End Function

复制代码

ID: zhyj_88
Result: 13, 144, 1370, 96394, 1427537, 98274986
Time: 2.125s

补充内容 (2013-8-10 12:52):
修改后的在10楼

xiaofx11 · 发表于 2013-8-4 14:12

本帖最后由 xiaofx11 于 2013-8-9 11:06 编辑

居然死机了{:soso_e101:}

Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#, i As Long
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
i = 0
For Each nCoin In aCoins
aRes(i) = xiaofx11(nCoin)
i = i + 1
Next
' 可更改结束
Debug.Print "ID: " & "xiaofx11"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub
Public Function xiaofx11(ByVal x As Long) As Long
If x \ 2 + x \ 3 + x \ 4 > x Then
xiaofx11 = xiaofx11(x \ 2) + xiaofx11(x \ 3) + xiaofx11(x \ 4)
Else
xiaofx11 = x
End If
End Function

复制代码

补充内容 (2013-8-25 20:25):
再发一个字典的

Public Function xiaofx11(ByVal x As Long) As Long
Dim temp2, temp3, temp4
If x \ 2 + x \ 3 + x \ 4 > x Then
      '----------
      If dic.Exists(x \ 2) Then
         temp2

清风_ll · 发表于 2013-8-5 16:08

本帖最后由清风_ll 于 2013-8-11 22:50 编辑

理解了好几遍，确定原来的代码是对的。{:soso_e144:} 加入保存中间数值后，速度飞快啊。

Dim d As Object
Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#
' 可更改段
' 只能是Dim
' 可更改结束
Dim i As Integer
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
' 可更改段
Set d = CreateObject("Scripting.Dictionary")
For Each nCoin In aCoins
aRes(i) = ChangeB(nCoin)
i = i + 1
Next
' 可更改结束
Debug.Print "ID: " & "<清风_ll>"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
d.RemoveAll
End Sub
Function ChangeB(ByVal n As Long) As Long
Dim n1 As Long, n2 As Long, n3 As Long
If d.Exists(CStr(n)) Then
ChangeB = d(CStr(n))
Exit Function
End If
If n >= 12 Then
n1 = Int(n / 2)
n2 = Int(n / 3)
n3 = Int(n / 4)
ChangeB = ChangeB(n1) + ChangeB(n2) + ChangeB(n3)
d.Add CStr(n), ChangeB
Else
ChangeB = n
End If
End Function

复制代码

wcymiss · 发表于 2013-8-5 22:27

本帖最后由 wcymiss 于 2013-8-6 08:52 编辑

Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#
' 可更改段
Dim i As Integer
' 只能是Dim
' 可更改结束
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
' 可更改段
For Each nCoin In aCoins
aRes(i) = F(nCoin)
i = i + 1
Next
' 可更改结束
Debug.Print "ID: " & "wcymiss"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub
Function F(ByVal aCoins As Double) As Double
Static objDic As Object
Dim i As Integer, n As Double
If objDic Is Nothing Then Set objDic = CreateObject("scripting.dictionary")
If aCoins >= 12 Then
For i = 2 To 4
n = Int(aCoins / i)
If Not objDic.exists(n) Then objDic(n) = F(n)
F = F + objDic(n)
Next
Else
F = aCoins
End If
End Function

复制代码

kuangben8 · 发表于 2013-8-7 10:42

不会VBA，就写个函数的方法吧，但是有局限性。欢迎指正拍砖。

小花鹿 · 发表于 2013-8-9 17:52

Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#
' 可更改段
Dim M, n& ' 只能是Dim
' 可更改结束
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
' 可更改段
For Each nCoin In aCoins
M = 0
If nCoin < 12 Then
M = nCoin
Else
Call DiGui(nCoin, M)
End If
aRes(n) = M
n = n + 1
Next
' 可更改结束
Debug.Print "ID: " & "小花鹿"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub
Sub DiGui(tm, M)
Dim n(2 To 4), i&
For i = 2 To 4
n(i) = Int(tm / i)
If n(i) < 12 Then
M = M + n(i)
Else
Call DiGui(n(i), M)
End If
Next i
End Sub

复制代码

zhyj_88 · 发表于 2013-8-10 11:21

Option Explicit
Dim dic As Object '新增语句
Sub ChangeCoin()
Dim aCoins(), aRes(), nCoin, t#
Dim i% '新增语句
' 可更改段
' 只能是Dim
' 可更改结束
' aCoins = Array(10 ^ 9) '新增语句
aCoins = Array(12, 123, 1000, 50000, 600000, 30000000)
ReDim aRes(UBound(aCoins))
t = Timer
' 可更改段
Set dic = CreateObject("scripting.dictionary") '新增语句
For Each nCoin In aCoins
'....
aRes(i) = ExChange(CCur(nCoin)) '新增语句
i = i + 1 '新增语句
Next
' 可更改结束
Set dic = Nothing '新增语句
Debug.Print "ID: " & "zhyj_88"
Debug.Print "Result: " & Join(aRes, ", ")
Debug.Print "Time: " & Format(Timer - t, "0.000s")
End Sub
Function ExChange(Coin As Currency) As Currency
Dim i%, j@, k@
If dic.exists(Coin) Then ExChange = dic(Coin): Exit Function
For i = 2 To 4
j = Coin \ i
If j > 11 Then
k = k + ExChange(j)
Else
k = k + j
End If
Next i
ExChange = k: dic(Coin) = k
End Function

复制代码

ID: zhyj_88
Result: 13, 144, 1370, 96394, 1427537, 98274986
Time: 0.000s

4楼无法重新编辑，只好再发一遍了。
这个应是正确答案了，因为所有数据均耗时为0秒。

		自动登录	找回密码
密码			免费注册

[Excel 程序开发] [第96期]换硬币[已总结]

点评

评分

评分

本帖子中包含更多资源

评分

评分

评分

评分

本帖子中包含更多资源

评分

评分

本帖子中包含更多资源

点评