[VB6]活動總收獲之計算

這篇原文發表在 VB研究小站 ,小瓜瓜因為個人因素,把網站收了後,寄給我一部分檔案,我打算逐步整理一些放到個人網誌。

活動總收獲之計算
作者: Kevin (—.dynamic.hinet.net)
日期:   12-09-05 09:10

從璉大網站那兒抓來的題目,這是一位名叫 綠色之翼 問的,看來蠻有意思的,璉大用了 網流的 OKA 來解,太深奧了,所以把它搬到這裡,讓大家用一般方法來解解看,以下為題目:

三、活動總收獲之計算
一)活動排程
小英預定於星期日7:00 ~ 17:00 參加一些活動。為了不浪費時間,小英希望當天參加的活動總收獲最多。假設每一項活動有起迄時間及一正整數表示預期收獲量,每項活動全程參加之後,可得該項活動之預期收獲量。請寫一程式幫小英選擇當天應參加的活動,以達成最高收獲量(不考慮活動間之往返時間),若總收獲量相同時。以參加較少活動為最後選擇。請注意小英在每一段時間皆只能參加一項活動,且每一項活動須全程參加完畢後,才能再參加下一項活動。

二)輸入格式:
(1)第一列有一個正整數,代表活動之個數 n ,請注意 n<=10。其後有 n 列,每一列代表一項活動。
(2)每一列之資料依序為活動名稱、活動起始參加時間、結束時間、及預期收獲量。
(3)各項資料之間,以兩個空白分隔。活動名稱為英文字母(不超過10 個字母);時間為24 小時制,以4 個阿拉伯數字表示,且各時間均為整點時間(如七時、八時、九時、十時…),例如0800 表示上午八時,1400表示下午二時;預期收獲量為一個正整數。

三)輸出格式:
印出一列,依序列出可參加活動的活動名稱及其總收獲量;各項資料之間以二個空白分隔。
※ 範例(下列輸入出範例僅供了解題意參考)
輸入範例:
7
A1 0700 0800 1
A2 0800 1000 6
A3 0800 0900 3
A4 0900 1100 5
A5 1000 1600 10
A6 1200 1500 7
A7 1400 1700 8
輸出範例:
A1 A2 A5 17

Re: 活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-09-05 12:02

我的方法基本上屬於郵差送信的問題。
一般圖論是單一個體跑,像是汽車導航規畫最佳路徑,我剛好有現成的網頁模式,所以才用現成的模式回答,把有界的網流規劃轉成圖論用的命題。
用 OKA 解這個是有點大才小用了~

Re: 活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-09-05 17:11

考慮不要幫他寫作業,他想要的遞回程式碼貼在這,他好像沒來這看,貼在這應該不至於變成幫他寫作業…
把時間 xx00 簡化成 xx 。
限制開始時間需由小到大排序
文字盒內容:
—————————————–
活動,開始時間,結束時間,獲益
A1,7,8,1
A2,8,10,6
A3,8,9,3
A4,9,11,5
A5,10,16,10
A6,12,15,7
A7,14,17,8
—————————————–

Private Sub Command1_Click()
   arrActive = ConvTextToArray(Text1.Text)
   arrRoad = GetMaxActive(arrActive)
   
   strAnswer = "獲益 " & arrRoad(0) & ", 參與活動項目 "
   For ibr = 1 To UBound(arrRoad)
      strAnswer = strAnswer & arrActive(arrRoad(ibr))(0) & ", "
   Next
   MsgBox Left(strAnswer, Len(strAnswer) - 2)
End Sub

Function ConvTextToArray(ByVal strText As String)
   ' 活動, 開始, 結束, 收益
   arrLine = Split(strText, vbNewLine)
   ubr = UBound(arrLine)
   ReDim arrSplit(ubr)
   For ibr = 0 To ubr
      If Trim(arrLine(ibr)) = "" Then
         ubr = ibr - 1
         Exit For
      End If
      arrSplit(ibr) = Split(arrLine(ibr), ",")
   Next
   
   ReDim arrReturn(ubr)
   ReDim arrRow(3)
   For ibr = 1 To ubr
      arrReturn(ibr) = arrRow
      arrReturn(ibr)(0) = arrSplit(ibr)(0)
      For ibc = 1 To 3
         arrReturn(ibr)(ibc) = CLng(arrSplit(ibr)(ibc))
      Next
   Next
   
   ConvTextToArray = arrReturn
End Function

Function GetMaxActive(ByVal arrActive, Optional ByVal sIndex As Long = 1)
   ' 傳回 Array(收益, 活動1, 活動2, ...)
   uba = UBound(arrActive)
   If sIndex = uba Then
      If arrActive(sIndex)(3) > 0 Then
         GetMaxActive = Array(arrActive(sIndex)(3), sIndex)
      End If
      Exit Function
   End If
   
   ReDim arrRoad(uba)
   xIndex = 0
   For iba = sIndex + 1 To uba
      If arrActive(iba)(1) >= arrActive(sIndex)(2) Then
         bHasOptimate = False
         For jba = 1 To iba - 1
            If IsArray(arrRoad(jba)) Then
               For kba = 1 To UBound(arrRoad(jba))
                  If iba = arrRoad(jba)(kba) Then
                     bHasOptimate = True
                     Exit For
                  End If
               Next
               If bHasOptimate Then
                  Exit For
               End If
            End If
         Next
         If Not bHasOptimate Then
            arrRoad(iba) = GetMaxActive(arrActive, iba)
            If xIndex = 0 Then
               xIndex = iba
            ElseIf arrRoad(iba)(0) > arrRoad(xIndex)(0) Then
               xIndex = iba
            ElseIf arrRoad(iba)(0) = arrRoad(xIndex)(0) Then
               If UBound(arrRoad(iba)) < UBound(arrRoad(xIndex)) Then
                  xIndex = iba
               End If
            End If
         End If
      End If
   Next
   If xIndex > 0 Then
      ReDim arrReturn(UBound(arrRoad(xIndex)) + 1)
      arrReturn(0) = arrActive(sIndex)(3) + arrRoad(xIndex)(0)
      arrReturn(1) = sIndex
      For jba = 1 To UBound(arrRoad(xIndex))
         arrReturn(jba + 1) = arrRoad(xIndex)(jba)
      Next
      GetMaxActive = arrReturn
   Else
      If arrActive(sIndex)(3) > 0 Then
         GetMaxActive = Array(arrActive(sIndex)(3), sIndex)
      End If
   End If
End Function

註:
這個程式碼並沒有保留各索引值下的最佳解,所以當樹狀結構很大的時候,末端結構可能會發生被重覆計算。
要算的快的話,可以以動態規劃觀念先反向計算,不用遞回解先從末端索引值反向推估,每個索引值只保留最佳解的情況即可。例如把最佳解填在最後,0 表示末端節點:
活動,開始時間,結束時間,獲益,最佳解,累積成本
A1,7,8,1,2,17
A2,8,10,6,5,16
A3,8,9,3,4,13
A4,9,11,5,7,13
A5,10,16,10,0,10
A6,12,15,7,0,7
A7,14,17,8,0,8

A1 -> A2 -> A5

則以動態規劃的觀念撰寫之程式碼變更為:

Private Sub Command1_Click()
   arrActive = ConvTextToArray(Text1.Text)
   arrRoad = GetMaxActive(arrActive)
   
   strAnswer = "獲益 " & arrRoad(0) & ", 參與活動項目 "
   For ibr = 1 To UBound(arrRoad)
      strAnswer = strAnswer & arrActive(arrRoad(ibr))(0) & ", "
   Next
   MsgBox Left(strAnswer, Len(strAnswer) - 2)
End Sub

Function ConvTextToArray(ByVal strText As String)
   ' 活動, 開始, 結束, 收益
   arrLine = Split(strText, vbNewLine)
   ubr = UBound(arrLine)
   ReDim arrSplit(ubr)
   For ibr = 0 To ubr
      If Trim(arrLine(ibr)) = "" Then
         ubr = ibr - 1
         Exit For
      End If
      arrSplit(ibr) = Split(arrLine(ibr), ",")
   Next
   
   ReDim arrReturn(ubr)
   ReDim arrRow(5)
   For ibr = 1 To ubr
      arrReturn(ibr) = arrRow
      arrReturn(ibr)(0) = arrSplit(ibr)(0)
      For ibc = 1 To 3
         arrReturn(ibr)(ibc) = CLng(arrSplit(ibr)(ibc))
      Next
   Next
   
   ConvTextToArray = arrReturn
End Function

Function GetMaxActive(ByVal arrActive)
   ' 傳回 Array(收益, 活動1, 活動2, ...)
   uba = UBound(arrActive)
   For iba = uba To 1 Step -1
      xIndex = 0
      For jba = iba + 1 To uba
         If arrActive(iba)(2) <= arrActive(jba)(1) Then
            If xIndex = 0 Then
               xIndex = jba
            ElseIf arrActive(jba)(5) > arrActive(xIndex)(5) Then
               xIndex = jba
            ElseIf arrActive(jba)(5) = arrActive(xIndex)(5) Then
               If UBound(GetRoad(arrActive, jba)) < UBound(GetRoad(arrActive, xIndex)) Then
                  xIndex = jba
               End If
            End If
         End If
      Next
      
      If xIndex > 0 Then
         arrActive(iba)(4) = xIndex
         arrActive(iba)(5) = arrActive(iba)(3) + arrActive(xIndex)(5)
      Else
         arrActive(iba)(4) = 0
         arrActive(iba)(5) = arrActive(iba)(3)
      End If
   Next
   
   xIndex = 1
   For iba = 2 To uba
      If arrActive(iba)(5) > arrActive(xIndex)(5) Then
         xIndex = iba
      ElseIf arrActive(iba)(5) = arrActive(xIndex)(5) Then
         If UBound(GetRoad(arrActive, iba)) < UBound(GetRoad(arrActive, xIndex)) Then
            xIndex = iba
         End If
      End If
   Next
   
   GetMaxActive = GetRoad(arrActive, xIndex)
End Function

Function GetRoad(ByVal arrActive, ByVal sIndex As Long)
   ReDim arrRoad(1)
   nCount = 1
   arrRoad(0) = arrActive(sIndex)(5)
   arrRoad(1) = sIndex
      
   Do Until arrActive(sIndex)(4) <= 0
      nCount = nCount + 1
      ReDim Preserve arrRoad(nCount)
      sIndex = arrActive(sIndex)(4)
      arrRoad(nCount) = sIndex
   Loop
   GetRoad = arrRoad
End Function

 
 Re: 活動總收獲之計算[s:●]
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-09-05 17:19

註:
我的程式碼基本上已經把組合運算盡量降低,所以不會透過組合方式算全部解,都是從區域最佳解繼續算來減少計算量
在大型的模式可以考慮動態規劃,巨型模式就要用網流規劃了~
網流規劃解 10 萬條活動的話,大概只需要幾分鐘就可以算完了。

 
 Re: 活動總收獲之計算[s:●]
作者: Kevin (—.dynamic.hinet.net)
日期:   12-09-05 17:38

哇!太棒了,感謝璉大回答!
其實,把這問題挖過來,主要是想看看有沒有哪位大大寫個漂亮程式來供欣賞學習!
璉大願意在此貼出解法來,一來沒有幫他寫作業,二來讓我們都能獲得更好的學習機會,真是感謝萬分!

 
 Re: ●活動總收獲之計算
作者: JOJO (—.adsl.static.giga.net.tw)
日期:   12-09-05 23:10

問一下各位大大
1.OKA ,動態規劃,網流規劃 是什意思阿
2.為何 璉大 的兩個程式執行出來都只有 A2,A5
 我用的原先的範例 Ssun 寫卻是 A1,A2,A5呢

 
 Re: ●活動總收獲之計算
作者: 豬頭小瓜瓜 (—.STATIC.so-net.net.tw)
日期:   12-09-05 23:31

這個問題在這裡PO過而被斬立決了
因為是kevin大大覺得有趣而轉貼
所以不好意思刪除

 
 Re: ●活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-10-05 00:07

1.
這是數學規劃裡面的名詞。
網流規劃、OKA 我有篇文章有應用:
http://tlcheng.no-ip.com/Paper/NetR99/NetR99.htm
動態規劃我沒有拿來應用,只有上課寫作業用過。這題也算是作業吧~

2.
我自己測是 獲益17, 參與活動項目 A1, A2, A5

我從本版剪貼:
1.開VB6 新的 Form1
2.拉個 TextBox, Command
3.Text1.MultiLine = True
4.複製程式碼
5.執行
6.貼上文字
—————————–
活動,開始時間,結束時間,獲益
A1,7,8,1
A2,8,10,6
A3,8,9,3
A4,9,11,5
A5,10,16,10
A6,12,15,7
A7,14,17,8
—————————–
7.按下 command1
8.跑出結果

以上兩段程式碼測試都正常。

 
 Re: ●活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-10-05 00:15

照瓜大的描述,我不想回作業,不在我那邊的討論版回,逃到這邊來也是沒用的~

 
 Re: ●活動總收獲之計算
作者: JOJO (—.adsl.static.giga.net.tw)
日期:   12-10-05 00:36

謝謝 璉大 呢
1.
剛問我老師OKA是什意思,他說不知道,搜尋奇摩,都是英文的網頁,或一些哩哩扣扣的
所以才在這兒發問的

2.
我少複製下面那一行了
>活動,開始時間,結束時間,獲益
有這行執行就正常了

 
 Re: ●活動總收獲之計算
作者: Kevin (—.dynamic.hinet.net)
日期:   12-10-05 00:42

感謝瓜大刀下留情,璉大寫的都非常有內容,留下讓其他人觀摩學習也好,反正只是一題作業而已,下次我會注意儘可能不去碰這些!

 
 Re: ●活動總收獲之計算
作者: 豬頭小瓜瓜 (—.STATIC.so-net.net.tw)
日期:   12-10-05 00:51

我的工作中是有碰過這類的問題
這個問題的解法的確是很實用
由於這個問題已經演變成討論性質
有留下來給大家作為參考的必要性

 
 Re: ●活動總收獲之計算
作者: shege (—.dynamic.hinet.net)
日期:   12-10-05 08:47

因為發問人的態度啊,一個是單純要答案,一個是以學習的態度來討論,瓜大自然手下留情。

璉大的程是以樹狀搜尋,我也會選用這樣的辦法來提升效能。

1:從第一筆資料開始當成起點。
2:設搜尋起點為開始的第二筆。
3:開始搜尋,找出可以串接第一筆的資料。
4:找到符合的資料時,記錄其累積狀況,並重設搜尋定起點為這個位置的下一筆,若還有資料則回3開始。
5:如果沒有找到,表示資料結束,判斷累積值是否較大,有的話做記錄變更。
6:搜尋起點是否到資料尾端,是則結束,否則累積起點位置,清空記錄累積狀況,回2工作。
7:結束。

 
 Re: ●活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-10-05 11:26

OKA 其實在網路上不好找~ 因為名稱類似的有太多了~
OKA (Out-of-Kilter) 是解網流規劃 (Network Flow Programming, NFP) 的一種方法,網流規劃是線性規劃的特殊情形,線性規劃是數學規劃的子集。用四邊形來比喻數學規劃的話,平行四邊形是線性規劃,正方形是網流規劃 (同時滿足矩形跟菱形的條件) 。
網流規劃的基本型跟圖論差不多,常用範例就是郵差送信,把網路剪成張成樹去替換枝 (arc) 來解,應用在車用導航就是最佳行車路線問題。但是基本型不能解決多台車的問題,比如說 A 區 1000 台車要移動到 B 區,最佳行車路線可能流通上限為 200 台車,這時可能其他車就要行駛替代路線,不能只靠一條最佳路線,只靠一條最佳路線只會大塞車。
線性規劃有簡型法 (主題演算法的一種) 、偶題法、主偶演算法、卡曼卡演算法 … 等。
網流是線性規劃的特殊解,所以也有對應演算法求解,OKA 是主偶演算法的一種,目前卡曼卡演算法好像還沒有人成功轉移到網流上。
註:卡曼卡演算法號稱目前解線性規劃平均最快的演算法,以非線性規劃解線性規劃,得到的是近似解,傳統方法得到的是解析解。

OKA 方法下面還有很多分枝,比如說我前老闆愛用現成國外模式 SuperK 。網流規劃國外都用在超大的命題上,比如說美國大河流域上的管理機構內都會有類似模式,國內基本上用的人很少,所以可參考的資訊很有限。在國際上 OKA 演算法的模式是滿值錢的,例如水利署每年付荷蘭某家公司 500 萬,取得一套網流規劃軟體的使用權,用在國內水資源分析上。不過想要賺這種錢還要名氣夠,出錢的單位敢信任你才行~ 不然這種東西算錯或有問題,非常的難追蹤。

 
 Re: ●活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-10-05 11:38

題外話:
對了,我四月去新加坡的時候,有碰上寫 Excel 增益集規劃求解的那位澳洲人跟台灣翻譯改寫的洪士吉老師,有聊到卡曼卡跟 Lindo 等,Excel 裡面的規劃求解用的是簡型法,再加上 Excel 屬直譯式,效能有限。
那位澳洲人跟洪老師本來要給我增益集的密碼,不過我自己有自己的線性規劃模式,看人家的原始碼怕會有抄襲的疑慮,所以就婉拒了~

簡型法只是線性規劃的入門方法,國內會的人還不少,管理學院大概都會教、會考,在 Excel 進階的使用說明都會介紹使用規劃求解,就知道這門學問的重要性跟商業的利益價值。

 
 Re: ●活動總收獲之計算
作者: Kevin (—.dynamic.hinet.net)
日期:   12-10-05 20:38

其實,我在測試璉大的程式時,也發生跟JOJO一樣的問題,我將其中兩個位置點改一下,就可以跑出A1來了:
1.
Function ConvTextToArray(ByVal strText As String)

 For ibr = 1 To ubr —>改成For ibr = 0 To ubr
…     ↑
End Function

2.
Function GetMaxActive(ByVal arrActive, Optional ByVal sIndex As Long = 1)
改成:                                       ↑
Function GetMaxActive(ByVal arrActive, Optional ByVal sIndex As Long = 0)

 
 Re: ●活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-10-05 23:11

0 不要改,我特意把欄名放在第 0 列,正式做成專案的話,通常會存在文字檔內,這個格式採用 csv 格式,所以副檔名存為 csv 時,檔案總管點兩下會叫 Excel 開啟,或是直接把 csv 當資料庫讀,沒有欄名在當資料庫讀時會比較麻煩。

你的狀況可能是你把 "活動,開始時間,結束時間,獲益" 沒有一起複製到文字盒內~

 
 Re: ●活動總收獲之計算
作者: Kevin (—.dynamic.hinet.net)
日期:   12-10-05 23:37

真是不好意思,正是如此,沒有複製到"活動,開始時間,結束時間,獲益"這一行!

 
 Re: ●活動總收獲之計算
作者: shege (—.dynamic.hinet.net)
日期:   12-11-05 08:38

真是佩服璉大,連整合其它軟體應用的部分都考慮週到,也讓其他學習的朋友多些認識!

 
 Re: ●活動總收獲之計算
作者: 璉璉 (—.HINET-IP.hinet.net)
日期:   12-11-05 10:34

這是習慣~ 盡量讓資料能有自我描述性~ 不然隔一陣子你就不知道你的資料在幹麻用的~
此外,有些程式可能會用到標題列來作為提示字串的組合,保留下來或許在其他應用程式會有他的價值。
我在處理 ADO/ADO.NET 時,也會特別把欄名另外處理到第 0 列,資料從第一列開始,程式只處理陣列,因為早期這樣考量,讓我從 ADO 升級到 ADO.NET 的轉換過程很輕鬆,只要改寫我中間的存取模式後,後端的應用程式碼幾乎不太需要改寫,頂多把 IsNull 改為 IsDBNull、Null 改為 DBNull.Value ,反過來說,也因為採用這樣的習慣,所以我要把 csv 轉換到資料庫內,也方便很多,例如本例傳回來的陣列在 ADO 下可以直接用:

For iba = 1 To uba
   Recordset.Add arrActive(0), arrActive(iba) ' ADO 的新增與更新收 欄名陣列, 資料陣列 作引數
Next
所以習慣在採用檔案時,保留欄名,若無特別必要,則使用 csv 或 ini 格式。
這樣自己寫的不同應用程式就不用太花時間去存取其他應用程式產生的資料檔。
習慣採用固定格式對降低自己開發成本跟時間有極大的好處,採用通用固定格式對於與他人交換檔案會方便很多。
所以目前 xml 檔案格式並不列入第一優先,因為傳統程式存取上會有點困擾,xml 格式只用在新開發且不與過去既有程式交換資料使用。
廣告
Categories: 技術分享 | 1 則迴響

文章分頁導航

One thought on “[VB6]活動總收獲之計算

  1. 子璉

    原先在我站上的討論可以參考 google 蒐集的內容:
    http://groups.google.com.tw/group/tw.bbs.comp.lang.basic/browse_thread/thread/32d9aa0f9f493b92

    按讚數

發表迴響

在下方填入你的資料或按右方圖示以社群網站登入:

WordPress.com Logo

您的留言將使用 WordPress.com 帳號。 登出 / 變更 )

Twitter picture

您的留言將使用 Twitter 帳號。 登出 / 變更 )

Facebook照片

您的留言將使用 Facebook 帳號。 登出 / 變更 )

Google+ photo

您的留言將使用 Google+ 帳號。 登出 / 變更 )

連結到 %s

在WordPress.com寫網誌.

%d 位部落客按了讚: