找硬币算法(贪婪/回溯算法).

想按自己的思路重写一些经典算法，以提高编程水平，请高手多执教。

问题：
一个小孩买了价值少于1美元的糖，并将1美元的钱交给售货员。售货员希望用数目最少的硬币找给小孩。假设提供了数目不限的面值为2 5美分、1 0美分、5美分、及1美分的硬币。售货员分步骤组成要找的零钱数，每次加入一个硬币。选择硬币时所采用的贪婪准则如下：每一次选择应使零钱数尽量增大。为保证解法的可行性（即：所给的零钱等于要找的零钱数），所选择的硬币不应使零钱总数超过最终所需的数目。

假设需要找给小孩6 7美分，首先入选的是两枚2 5美分的硬币，第三枚入选的不能是2 5美分的硬币，否则硬币的选择将不可行（零钱总数超过6 7美分），第三枚应选择1 0美分的硬币，然后是5美分的，最后加入两个1美分的硬币。

贪婪算法有种直觉的倾向，在找零钱时，直觉告诉我们应使找出的硬币数目最少（至少是接近最少的数目）。可以证明采用上述贪婪算法找零钱时所用的硬币数目的确最少（见练习1）。

<!--找钱(硬币)问题,要求找回的硬币最少-->
<%
Dim sAction
Dim sResultString '表单提交后结果信息
sAction = LCase(Trim(Request("action")))
If sAction = "do" Then
    '获取值
    Dim nMoney, nKeepMoney, sCoin
    nMoney = Trim(Request.Form("Money"))
    sCoin = Trim(Request.Form("Coin"))
    'response.write nMoney & "<br/>"
    'response.write sCoin & "<br/>"
    nKeepMoney = nMoney
    '错误处理
    If IsNumeric(nMoney) = True Then
        nMoney = CLng(nMoney)
    Else
        OutputError "[钱]必须是数字！"
    End If
    If sCoin = "" Then OutputError "[币值]不能为空！"
    
    Dim bFindSolution, aSolution() '是否找到找钱方案(boolean), 方案结果(二维数组)
    Dim aCoin, nCoinClass, nPayCoinCount '硬币币值(一维数组), 币值种类个数, 找出的硬币数量
    Dim i, t, sum '循环变量, 交换变量,累加变量
    bFindSolution = False
    nPayCoinCount = 0

    aCoin = Split(sCoin, ",")
    nCoinClass = UBound(aCoin, 1) '隔开逗号得到硬币种类个数
    ReDim aSolution(nCoinClass, 1) '定义结果为二维数组, aSolution(x,0)表示币值, aSolution(x,1)表示该币值找回的个数
    aCoin = QuickSort(aCoin) '将币值数组升序排序
    For i = 0 To nCoinClass
        If IsNumeric(aCoin(i)) = False Then OutputError "币值只能是数字，[" & aCoin(i) & "]不是数字！"
        If aCoin(i) = 0 Then OutputError "币值不能为零！"
        aSolution(i,0) = aCoin(i)
        aSolution(i,1) = 0
    Next
    
    '===============================
    '找出找回硬币最少的方案
    '===============================
    
    '每次找回的硬币记录,存在数组中
    Dim aRecord(), nRecordCount, nRecordIndex '记录数组(一维,存放币值), 数组长度(即最多找回的硬币个数或找的次数), 当前操作的数组下标
    nRecordCount = nMoney / aCoin(0) '钱/最小币值, 取得最多找回的个数
    ReDim aRecord(nRecordCount)
    nRecordIndex = 0

    i = nCoinClass '取最大币值下标
    Do While True    
        sum = 0
        Do While i>=0 And nMoney-aCoin(i)>=0 '剩余的钱比当前的币值小
            nMoney = nMoney - aCoin(i) '扣掉拿出的币值
            Call InCrease(aCoin(i)) '结果中该币值的个数加1
            nPayCoinCount = nPayCoinCount + 1 '总的拿出的硬币个数加1
            If i > 0 Then
                aRecord(nRecordIndex) = aCoin(i) '记录
                nRecordIndex = nRecordIndex + 1
                t = i '保留当前币值的下标, 以便下次循环从 这个下标-1 开始
            Else
                sum = sum + aCoin(i) '最小币值的钱累加
            End If
        Loop
        If nMoney = 0 Then
            bFindSolution = True
            Exit Do
        End If

        If i > 0 Then
            i = i - 1 '当前币值太大, 进行下次更小 币值的循环
        Else
            If CLng(aRecord(0)) = 0 Then '如果记录中不含任何币值, 表示全部回溯都已经试过仍没有方案
                bFindSolution = False
                Exit Do
            End If
            '以下做 回溯操作
            nMoney = nMoney + sum
            nMoney = nMoney + aRecord(nRecordIndex-1)
            nPayCoinCount = nPayCoinCount - 1
            Call DeCrease(aRecord(nRecordIndex-1))
            aRecord(nRecordIndex-1) = 0
        End If
    Loop

    '输出方案
    If bFindSolution = True Then
        sResultString = "<b>条件：</b>" & "<br/>" & _
                        "钱：" & nKeepMoney & "<br/>" & _
                        "币值：" & sCoin & "<br/><br/>" & _
                        "<b>找回硬币最少的方案：</b>" & "<br/>" & _
                        "最少找回个数：" & nPayCoinCount & "<br/>"
        For i = 0 To nCoinClass
            sResultString = sResultString & "&nbsp;&nbsp;&nbsp;&nbsp;" & "币值：" & aSolution(i,0) & "&nbsp;&nbsp;" & "个数：" & aSolution(i,1) & "<br/>"
        Next

    Else
        sResultString = "<b><font color='red'>不能用指定的币值找回硬币！</font></b>"
    End If
    
End If

'指定币值找回个数加1
Sub InCrease(n_Coin)
    Dim i
    For i = 0 To nCoinClass
        If CLng(aSolution(i,0)) = CLng(n_Coin) Then
            aSolution(i,1) = aSolution(i,1) + 1
            Exit Sub
        End If
    Next
End Sub

'指定币值找回个数加1
Sub DeCrease(n_Coin)
    Dim i
    For i = 0 To nCoinClass
        If CLng(aSolution(i,0)) = CLng(n_Coin) Then
            aSolution(i,1) = aSolution(i,1) - 1
            Exit Sub
        End If
    Next
End Sub

'快速排序
Function QuickSort(a_Data)
    Dim i, j
    Dim count, t
    count = UBound(a_Data, 1)

    For i = 0 To count-1
        For j = i+1 To count
            If CLng(a_Data(i)) > CLng(a_Data(j)) Then
                t = a_Data(i)
                a_Data(i) = a_Data(j)
                a_Data(j) = t
            End If
        Next
    Next

    QuickSort = a_Data
End Function

'输出错误提示
Sub OutputError(str)
    Response.Write "<script language='javascript'>alert('" & str & "');history.back();</script>"
    Response.End
End Sub
%>


<html>
<head>
<title>找钱(硬币)问题,要求找回的硬币最少</title>
</head>
<body>
<p><%=sResultString%></p>
<p align='center'>

<table border=0>
<form name="form1" method="post" action="?action=do">
    <tr><td>钱：</td><td><input type="text" name="Money" value="" size="10"></td></tr>
    <tr><td>币值：</td><td><input type="text" name="Coin" value="" size="30">&nbsp;<font color='gray'>多个以逗号隔开</font></td></tr>
    <tr><td colspan="2"><input type="submit" name="submit" value="找钱方案"></td></tr>
</form>
</table>

</p>
</body>
</html>