8月 2018 ~ 二信資處程式

試題連結 (商業類技藝技賽_104年_程式設計_正式題)

2018/8/23完成 P11 , P12 , P31 , P32  2018/8/25完成 P21 , P22
2018/8/27完成 P41 , 2018/9/13完成 P42更新

用VB10寫在Form_Load，讀檔統一如下，然後呼叫fxx，每題讀檔就不重複

讀檔寫檔

Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Me.Hide()
FileOpen(1, "in1.txt", 1)
FileOpen(2, "in2.txt", 1)
FileOpen(3, "out.txt", 2)
For fn = 1 To 2
If fn = 2 Then PrintLine(3)
Dim n As Short = LineInput(fn)
For k = 1 To n
Dim s As String = LineInput(fn)
PrintLine(3, fxx(s))
Next
Next
End
End Sub
   ．．．
每一題解題部份
Function fxx( s as ... ) as ...
．．．
End Class

P11 電梯電費
因一個資料需讀兩列，整數 x及字串 s再傳入 fxx( x, s )
For k = 1 To n
Dim x As Integer = LineInput(fn)
Dim s As String = LineInput(fn)
PrintLine(3, fxx(x, s))

Next k
...

Function fxx(ByVal x As Integer, ByVal s As String) As String

Dim dat() = s.Split(",")

Dim a As Integer = dat(0), b As Integer

Dim sum As Integer = 0

For j = 1 To x - 1

b = dat(j)

sum += (b - a) * IIf(a < b, 20, -10)

a = b

Return sum

End Function

P12 樂透
因每個檔有一列開獎號(5號)，接著才是 n筆包牌號(6號)，先讀入開獎號放a()
又每列的包牌固定6個號使用fxx即可，若不一定包 6個號可以看fxx2,呼叫comb(m選5)

Dim dat() = LineInput(fn).Split(",")

For j = 0 To 4

a(j) = dat(j)

Array.Sort(a)

For k = 1 To n

Dim s As String = LineInput(fn)

PrintLine(3, fxx2(s)) 'PrintLine(3, fxx(s))

Next k

Dim a(4) As Integer '開獎號

Dim v(4) As Integer '要核對的獎號

Dim b(9) As Integer '投注的號碼，假設最多0~9共10個 Comb(10,5) =252

Dim c(9) As Boolean '是否已選的註記

Dim cv(252, 4) As Integer ' Comb(10,5) =252

Dim cvi As Integer '目前第幾組

Function fxx(ByVal s As String) As String

Dim dat() = s.Split(",")

' Dim b(5) As Integer '投注號 6個 '若不只6個號碼選5，應使用 comb(m個選n個)

For j = 0 To 5

b(j) = dat(j)

' 迴圈六次，各排除1個，只留5個

Dim vi, v(4) As Integer

Dim cnt(5) As Integer ' 各對幾個

For j = 0 To 5

vi = 0

For k = 0 To 5

If j <> k Then

v(vi) = b(k) : vi += 1

End If

' 產生一組 5 個數字在 v 與 a 比

cnt(lotto(a, v)) += 1 '每一組各中幾個號碼，累加至 cnt陣列

' 六組個累加完一起印出

fxx = cnt(2) & "," & cnt(3) & "," & cnt(4) & "," & cnt(5)

End Function

Function lotto(ByVal a() As Integer, ByVal v() As Integer)

Dim ai = 0, vi = 0

lotto = 0

Do Until ai >= 5 Or vi >= 5

If a(ai) = v(vi) Then

ai += 1 : vi += 1

lotto += 1 ' 中獎號個數

ElseIf a(ai) > v(vi) Then

vi += 1

Else

ai += 1

End If

Loop

End Function

Function fxx2(ByVal s As String) As String

Dim dat() = s.Split(",")

Dim m As Integer = dat.Length

Dim n As Integer = 5 ' m 個選 5 個

For j = 0 To m - 1

b(j) = dat(j)

cvi = 0 '組數

comb(m, n, 0, 0)

' 迴圈C(m,n)=cvi 次，每組皆統計 cnt

Dim cnt(5) As Integer ' 各對幾個

For i = 0 To cvi - 1 ' 共有 cvi組，在 cv(,)陣列中

For j = 0 To 4 ' 產生一組 5 個數字在 v 與 a 比

v(j) = cv(i, j)

cnt(lotto(a, v)) += 1 '每一組各中幾個號碼，累加至 cnt陣列

Next i

' cvi 組個累加完一起印出

fxx2 = cnt(2) & "," & cnt(3) & "," & cnt(4) & "," & cnt(5)

End Function

Sub comb(ByVal m As Integer, ByVal n As Integer, ByVal p As Integer, ByVal k As Integer)

' b 陣列 m 個元素中挑選 n 個 ,是否挑選在c註記 ,目前處理至第 p 個，已選了 k 個

If k = n Then '已選 n 個，放入 cv(,)

Dim vi As Integer = 0

For i = 0 To m - 1

If c(i) Then

cv(cvi, vi) = b(i)

vi += 1

End If

cvi += 1 '組數

Return

End If

If p >= m Then Return

c(p) = True : comb(m, n, p + 1, k + 1)

c(p) = False : comb(m, n, p + 1, k)

End Sub

P21 排列組合
' Dim seq(720) As Integer '6!為720，若1~9則9!=362880
Dim seq(362880) As Integer
Dim sqcnt As Integer
Dim v() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim lmt() = {1, 2, 6, 24, 120, 720, 5040, 40320, 362880}

Function fxx(ByVal s As String) As String
Dim ijk() = s.Split(",")
Dim ni As Integer = ijk(0).Length ' 2~6 位數
Dim j As Integer = ijk(1), k As Integer = ijk(2)
sqcnt = 0
perm(v, 0, ni) ' 非依序版(交換)，填入後再排序
Array.Sort(seq, 1, lmt(ni - 1))
REM 將排列總表存入檔案 ou2.txt ~ ou6.txt
FileOpen(4, "ou" & ni & ".txt", OpenMode.Output)
For h = 1 To lmt(ni - 1)
Print(4, h & ":" & seq(h) & " ")
If h Mod 6 = 0 Then PrintLine(4)
Next h
FileClose(4)
Return seq(j) + seq(k) & ":" & seq(j) & "+" & seq(k) '分開印，競賽時只加總
End Function
Sub perm(ByVal v() As Integer, ByVal k As Integer, ByVal u As Integer)
If k = u Then '遞迴至 u 即完成一組，存入
Dim sum = 0
For i = 0 To u - 1
sum = sum * 10 + v(i)
Next
sqcnt += 1
seq(sqcnt) = sum
Return
End If
' 兩元素交換版
Dim t As Integer
For x = k To u - 1
t = v(k) : v(k) = v(x) : v(x) = t '交換
perm(v, k + 1, u) '遞迴: k 從0 一直加1 至 u為止
t = v(k) : v(k) = v(x) : v(x) = t '換回來
Next
End Sub

P22 最大公約數

Function fxx(ByVal s As String) As String
Dim dat() As String = s.Split(",")
Dim m = UBound(dat)
Dim g As Integer = dat(0)
For j = 1 To m
g = gcd(g, dat(j))
Next
Return g
End Function
Function gcd(ByVal a As Integer, ByVal b As Integer)
Dim r = a Mod b
Do Until r = 0
a = b
b = r
r = a Mod b
Loop
Return b
End Function

P31 計算位元為1的個數

使用Convert.ToString , 也可以自訂函式將十進位轉 X 進位(2~16)

Function fxx(ByVal s As String) As String
Dim D As Integer = s
'Dim B As String = Convert.ToString(D, 2)
Dim B As String = d2x(D, 2)
Dim cnt = 0
For i = 1 To B.Length
If Mid(B, i, 1) = "1" Then cnt += 1
Next
Return cnt
End Function

REM 自訂函式 D2X 可以轉二~十六, 內建的 Convert.ToString 好像只有2,8,16
Function d2x(ByVal d As Integer, ByVal x As Integer) As String
'將十進位整數 d 轉為 x進位字串{ 2<= x <= 16 }
Dim htbl As String = "0123456789ABCDEF"
d2x = ""
Do Until d = 0
d2x = Mid(htbl, (d Mod x) + 1, 1) & d2x
d \= x
Loop
If d2x = "" Then Return "0"
End Function
' 網路上找的資料十進位與二、八、十六的互轉
' http://ryan-tw.blogspot.com/2012/05/vbnet102816.html
'[VB.NET]10進制與2、8、16進制轉換
'10進制轉成2、8、16進制
'j=Convert.ToString(10, 2) '10進制轉2進制 j="1010"
'j=Convert.ToString(11, 8) '10進制轉8進制 j="13"
'j=Convert.ToString(254, 16) '10進制轉16進制 j="FE"

'2、8、16進制轉10進制
'i=Convert.ToInt32("1010", 2) '2進制轉10進制 i=10
'i=Convert.ToInt32("13", 8) '8進制轉10進制 i=11
'i=Convert.ToInt32("0XFE", 16) '16進制轉10進制 i=254

'

P32 矩陣乘法 AB=AXB

' 因矩陣大小最大為8 ，計算1次最多(8*8*8=512次乘法) ，
'又找出 9999 應以哪一數取代的 z為(-20 ~ 20 )之間

' 可以直接暴力解，以 -20 ~ 20 共 41次代入算出 A*B 與 AB 比對，中間可以剪枝

矩陣讀入需多行，將 fn也傳入 fxx( fn, s )

Dim A_B(2, 8, 8) As Integer, AXB(8, 8) As Integer

Dim x, row, col As Integer '9999 在A(x=0)或B(x=1) 位置為(row,col)

Function fxx(ByVal fn As Integer, ByVal s As String) As String

Dim mrn() = s.Split(",") '第1列 m r r p

Dim m As Integer = mrn(0), r As Integer = mrn(1), p As Integer = mrn(3)

' Debug.Print(m & r & p)

' 讀 A 陣列

For j = 0 To m - 1

Dim line = LineInput(fn)

ttrim(line, " ", " ")

Dim dat() = line.Split(" ")

For k = 0 To r - 1

A_B(0, j, k) = dat(k)

If A_B(0, j, k) = 9999 Then

x = 0 : row = j : col = k

End If

' 讀 B 陣列

For j = 0 To r - 1

Dim line = LineInput(fn)

ttrim(line, " ", " ")

Dim dat() = line.Split(" ")

For k = 0 To p - 1

A_B(1, j, k) = dat(k)

If A_B(1, j, k) = 9999 Then

x = 1 : row = j : col = k

End If

' 讀 AB 陣列

For j = 0 To m - 1

Dim line = LineInput(fn)

ttrim(line, " ", " ")

Dim dat() = line.Split(" ")

For k = 0 To p - 1

AXB(j, k) = dat(k)

' 試 -20 ~ 20 積正確的印出

fxx = ""

For z = -20 To 20

A_B(x, row, col) = z

If chk(m, p, r) Then

Return z

End If

End Function

Function chk(ByVal m, ByVal p, ByVal r) As Boolean

chk = True

For i = 0 To m - 1

For j = 0 To p - 1

Dim sum = 0

For k = 0 To r - 1

sum += (A_B(0, i, k) * A_B(1, k, j))

If sum <> AXB(i, j) Then Return False

End Function

Sub ttrim(ByRef s As String, ByVal a As String, ByVal b As String)

Do While InStr(s, a) > 0

s.Replace(a, b)

Loop

End Sub

P41 二元樹的後序拜訪

每一筆資料有兩列，第1列m為樹的節點數，第2列為節點值s，一次讀2列傳入 fxx(m,s)

'可以使用三個陣列(參考104模)，這裏使用 STRUCT{Class)
Class bt
Public Property lt As Integer = -1 '左樹
Public Property dt As Integer '資料
Public Property rt As Integer = -1 '左樹
End Class

Dim nd(20) As bt '最多 20 個節點

Function fxx(ByVal m As Integer, ByVal s As String) As String
Dim id() = s.Split(",")
nd(0) = New bt
nd(0).dt = id(0)
For j = 1 To m - 1
nd(j) = New bt
Dim k As Integer = id(j)
nd(j).dt = k
Dim p = 0
Do While True
If k < nd(p).dt Then '往左
If nd(p).lt = -1 Then
nd(p).lt = j
Exit Do
Else
p = nd(p).lt
End If
Else '往右
If nd(p).rt = -1 Then
nd(p).rt = j
Exit Do
Else
p = nd(p).rt
End If
End If
Loop
Next
' For j = 0 To m - 1 '這是多印的「左鏈、資料、右鏈」
'PrintLine(3, j & " " & nd(j).lt & ":" & nd(j).dt & ":" & nd(j).rt)
'Next
fxx = ""
fst = True
po_t(0, fxx)
End Function

Dim fst As Boolean '印第1個之前不用「逗號」

Sub po_t(ByVal p As Integer, ByRef ostr As String)
' 後序巡訪 Post-order travel
If nd(p).lt <> -1 Then po_t(nd(p).lt, ostr) '先左
If nd(p).rt <> -1 Then po_t(nd(p).rt, ostr) '再右
If fst Then fst = False Else ostr &= ","
ostr &= nd(p).dt '後中

End Sub

P42 最小成本生成樹

'104正式 p42 最小成本生成樹 MST ，
'本題以 uni-find 檢查 cycle ，節點數不多，可以不需判高
Const MaxM As Integer = 20 '最多20邊
Const MaxN As Integer = 26 '最多26點
Dim eg(MaxM) As String '邊
Dim ct(MaxM) As Integer '成本
Dim rt(MaxN) '此點的根
Dim ht(MaxN) '此點的高
Dim n As Integer '節點數
Dim m As Integer '邊數

Function fxx(ByVal s As String) As String
Dim egs() = s.Split(" ") '一列為一個樹，多個邊
m = egs.Length '邊數
For j = 0 To m - 1
eg(j) = Strings.Left(egs(j), 3) '一個邊
ct(j) = Val(Mid(egs(j), 5)) ' 這個邊的成本
Next
Array.Sort(ct, eg, 0, m)
'For j = 0 To m - 1
' Print(3, ct(j) & ":" & eg(j) & " ")
'Next
'PrintLine(3)
Array.Clear(ht, 0, MaxN)
For j = 0 To MaxN
rt(j) = j
Next
Dim ans = 0
fxx = ""
For j = 0 To m - 1
Dim x As Integer = Asc(Mid(eg(j), 1, 1)) - 65
Dim y As Integer = Asc(Mid(eg(j), 3, 1)) - 65
If same(x, y) Then Continue For
ans += ct(j) '不是同一根就將成本加入 ans
' rt(rt(y)) = rt(x) '不判高的話， uni直接 y併入x
uni(x, y) '將x,y合併
' fxx &= "+" & ct(j) & eg(j) & " " '測試用列印
Next
' fxx &= "ans=" & ans
Return ans
End Function
Function fdrt(ByVal x As Integer) As Integer '找 x 的根
If rt(x) = x Then Return x
rt(x) = fdrt(rt(x))
Return rt(x)
End Function
Function same(ByVal x As Integer, ByVal y As Integer)
Return (fdrt(x) = fdrt(y)) ' x,y 的根是否相同
End Function
Sub uni(ByVal x As Integer, ByVal y As Integer) '將 x樹及 y樹合成一樹
x = fdrt(x) : y = fdrt(y)
If x = y Then Return
If ht(x) < ht(y) Then
rt(x) = y
Else
rt(y) = x
If ht(x) = ht(y) Then ht(x) += 1
End If
End Sub
'in1.txt 併 in2
' 4
'A,B,6 A,E,9 B,C,3 B,D,5 C,D,7 B,F,8 D,E,10 D,F,11 A,F,12 E,F,15
'A,B,3 A,C,2 B,C,1 B,D,2 C,D,1 B,E,2 C,F,1 D,E,1 D,F,1 D,G,2 E,G,1 F,G,1
'B,A,6 B,F,8 B,D,5 D,E,10 D,F,9 A,F,12 A,E,10 E,F,15
'D,E,1 D,G,2 D,F,1 E,G,1 F,G,1
'--------------
'輸出：第1組 31 , 第2組 7 , 第3組 29 , 第4組 3
'參考
'+3B,C +5B,D +6A,B +8B,F +9A,E ans=31
'+1C,D +1D,F +1D,E +1F,G +1B,C +2A,C ans=7
'+5B,D +6B,A +8B,F +10A,E ans=29

'+1E,G +1F,G +1D,F ans=3

二信資處程式

2018年8月23日星期四

商競程式104正_解題記錄

Recent Posts

Categories

Blog Archive

著作人

2018年8月23日 星期四

Recent Posts

Categories

Blog Archive

著作人

訂閱

2018年8月23日星期四