2017年青年程式競賽(中文組)解題記錄 2018/10/12 建置
10/12完成 p1,p4,p5,p6,p8 ， 10/13 完成 p2 ， 10/18 完成 p3 , 10/22 完成 p7
用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, "in.txt", 1)
FileOpen(2, "out.txt", 2)
Dim s As String = LineInput(fn)
PrintLine(2, fxx(s)) '根據測資可能一次兩列或傳fn讀多行
End
End Sub
．．．
每一題 解題部份
Function fxx( s as ... ) as ...
．．．
End Class
P1 二元搜尋
每檔3行，所以在Form_Load讀三行再傳給fxx()
Dim n As Integer = LineInput(1)Dim s As String = LineInput(1)
Dim x As Integer = LineInput(1)
Function fxx(ByVal n As Integer, ByVal s As String, ByVal x As Integer) As String
Dim dat() = s.Split(",")
Dim a(n) As Integer
For i = 1 To n
a(i) = dat(i - 1)
Next
Array.Sort(a, 1, n)
Dim L As Integer = 1, U As Integer = n
Dim cnt As Integer = 0
Do Until L > U
Dim M = (L + U) \ 2
cnt += 1
' Debug.Print(cnt & "," & L & "," & U & "," & M)
' If cnt > 10 Then Return ">10"
If a(M) = x Then Return cnt
If a(M) > x Then
U = M - 1
Else
L = M + 1
End If
Loop
Return "無"
End Function
P2 質數加法分解
應該會用到遞迴吧，一個函數isp(x)是否質數、一個函數pp(y)：y是否質數或可拆成質數和
Function fxx( n As Integer ) As String
半成品
for x=n-2 to (n-1)\2
if isp(x) then
if pp(n-x) 印出
else 無{印 n?}
}
}
End Function
除了2,3,11,17之外，其餘的質數皆拆成2或三個之和
2:單 , 3:單 , 5:3+2 , 7:5+2 , 11:單 , 13:11+2 , 17:單 , 19:17+2 , 23:13+7+3 , 29:19+7+3 , 31:29+2 , 37:29+5+3 , 41:31+7+3
, 43:41+2 , 47:37+7+3 , 53:43+7+3 , 59:47+7+5 , 61:59+2 , 67:59+5+3 , 71:61+7+3
, 73:71+2 , 79:71+5+3 , 83:73+7+3 , 89:79+7+3 , 97:89+5+3 , 101:89+7+5 , 103:101+2
, 107:97+7+3 , 109:107+2 , 113:103+7+3 , 127:113+11+3 , 131:113+13+5 , 137:127+7+3
, 139:137+2 , 149:139+7+3 , 151:149+2 , 157:149+5+3 , 163:151+7+5 , 167:157+7+3
, 173:163+7+3 , 179:167+7+5 , 181:179+2 , 191:181+7+3 , 193:191+2 , 197:181+13+3
, 199:197+2 , 211:199+7+5 , 223:211+7+5 , 227:211+13+3 , 229:227+2 , 233:223+7+3
, 239:229+7+3 , 241:239+2 , 251:241+7+3 , 257:241+13+3 , 263:251+7+5 , 269:257+7+5
, 271:269+2 , 277:269+5+3 , 281:271+7+3 , 283:281+2 , 293:283+7+3 , 307:293+11+3
, 311:293+13+5 , 313:311+2 , 317:307+7+3 , 331:317+11+3 , 337:317+17+3 , 347:337+7+3
, 349:347+2 , 353:337+13+3 , 359:349+7+3 , 367:359+5+3 , 373:359+11+3 , 379:367+7+5
, 383:373+7+3 , 389:379+7+3 , 397:389+5+3 , 401:389+7+5 , 409:401+5+3 , 419:409+7+3
, 421:419+2 , 431:421+7+3 , 433:431+2 , 439:431+5+3 , 443:433+7+3 , 449:439+7+3
, 457:449+5+3 , 461:449+7+5 , 463:461+2 , 467:457+7+3 , 479:467+7+5 , 487:479+5+3
, 491:479+7+5 , 499:491+5+3 ,
Function fxx(ByVal n As Integer) As String
' Call si(n)
If n < 5 Then Return "單" '2或3直接傳回 單：2,3
Dim p2 As String = ""
For x = n - 2 To n\2+1 Step -2
If isp(x) Then 'C_isp 應較快，但數字不大沒差 ?
p2 = pp(n - x)
If p2 = "" Then Continue For
Return x & "+" & p2
End If
Next
Return "單" '11,17
End Function
Function pp(ByVal y As Integer) As String
pp = ""
If isp(y) Then Return y
Dim p2 As String = ""
For x = y - 1 To y \ 2 + 1 Step -1
If isp(x) Then 'C_isp 應較快，但數字不大沒差
p2 = pp(y - x)
If p2 = "" Then Continue For
Return x & "+" & p2
End If
Next
End Function
Function isp(ByVal x As Integer) As Boolean '判斷 x 是否為質數
If x < 2 Then Return False
For i = 2 To Math.Sqrt(x)
If x Mod i = 0 Then Return False
Next
Return True
End Function
' 以下使用篩法才需要
Function c_isp(ByVal x As Integer) As Boolean '篩版，判斷是否為質數
If Not c(x) Then Return True
Return False
End Function
Dim c(65536) As Boolean '篩法用
Dim p(8000) As Integer
Dim pcnt As Integer
Sub si(ByVal n As Integer) '篩法
pcnt = 0
Array.Clear(c, 0, c.Length)
Array.Clear(p, 0, p.Length)
c(0) = True
c(1) = True
Dim i, j As Long
For i = 2 To n
If Not c(i) Then
p(pcnt) = i
pcnt += 1
For j = i * i To n Step i
c(j) = True
Next
End If
Next
' Debug.Print(pcnt & "," & p(pcnt - 1))
End Sub
' Call si(n)
If n < 5 Then Return "單" '2或3直接傳回 單：2,3
Dim p2 As String = ""
For x = n - 2 To n\2+1 Step -2
If isp(x) Then 'C_isp 應較快，但數字不大沒差 ?
p2 = pp(n - x)
If p2 = "" Then Continue For
Return x & "+" & p2
End If
Next
Return "單" '11,17
End Function
Function pp(ByVal y As Integer) As String
pp = ""
If isp(y) Then Return y
Dim p2 As String = ""
For x = y - 1 To y \ 2 + 1 Step -1
If isp(x) Then 'C_isp 應較快，但數字不大沒差
p2 = pp(y - x)
If p2 = "" Then Continue For
Return x & "+" & p2
End If
Next
End Function
Function isp(ByVal x As Integer) As Boolean '判斷 x 是否為質數
If x < 2 Then Return False
For i = 2 To Math.Sqrt(x)
If x Mod i = 0 Then Return False
Next
Return True
End Function
' 以下使用篩法才需要
Function c_isp(ByVal x As Integer) As Boolean '篩版，判斷是否為質數
If Not c(x) Then Return True
Return False
End Function
Dim c(65536) As Boolean '篩法用
Dim p(8000) As Integer
Dim pcnt As Integer
Sub si(ByVal n As Integer) '篩法
pcnt = 0
Array.Clear(c, 0, c.Length)
Array.Clear(p, 0, p.Length)
c(0) = True
c(1) = True
Dim i, j As Long
For i = 2 To n
If Not c(i) Then
p(pcnt) = i
pcnt += 1
For j = i * i To n Step i
c(j) = True
Next
End If
Next
' Debug.Print(pcnt & "," & p(pcnt - 1))
End Sub
P3 中序轉前序 {補充後序}
有點難，下次再說
中序轉後序較普遍，所以兩個都寫，以下範例 直接兩個TextBox，二個按鈕不讀檔
'運算式 中序轉後序及前序 ，運算子只有大小寫字母，運算子只有 ( ) + - * /'中序1： (A-B)*(C+D)/E-F*G
'後序1： AB-CD+*E/FG*-
'前序1： -/*-AB+CDE*FG
'中序2： A/(B-C*(D+E))
'後序2： ABCDE+*-/
'前序2： /A-B*C+DE
'假設只有 + - * / 及 ( )
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'中序轉後序
Dim istr As String = TextBox1.Text
TextBox2.Text = in2po(istr, True)
End Sub
Dim stk(100) As Char '堆疊 ，只有字元
Dim sp As Integer = -1 '堆疊的指標(索引)
Function prio(ByVal op As Char) As Integer '傳回優先序
prio = 0
Select Case op
Case "+", "-"
Return 1
Case "%" '餘數
Return 2
Case "\" '整除
Return 3
Case "*", "/"
Return 4
Case "^" '次方
Case Else
Return 0
End Select
End Function
Function in2po(ByVal ins As String, ByVal ispo As Boolean) As String
' ispo 是否後序：True 後序 、 False 前序
Dim po As String = ""
For i = 1 To ins.Length
Dim inch As Char = Mid(ins, i, 1) '讀一個字元
Select Case inch '依讀入的字元
Case "(" '左括號，直接放入 stack
sp += 1 : stk(sp) = inch
Case "+", "-", "*", "/" '若堆內 >= 讀入，輸出 , {更多"^", "\", "%"}
' Do While sp >= 0 AndAlse (prio(stk(sp)) > prio(inch) Or (ispo And prio(stk(sp)) = prio(inch)))
Do Until sp < 0
If (prio(stk(sp)) > prio(inch) Or (ispo And prio(stk(sp)) = prio(inch))) Then
' 前序 > 、 後序 >=
po += stk(sp) : sp -= 1 ' pop to 輸出
Else '否則停
Exit Do
End If
Loop
'讀入的放入 stack
sp += 1 : stk(sp) = inch ' 輸入 push
Case ")" '遇右括號，輸出至左括號為止
Do Until stk(sp) = "("
po += stk(sp) : sp -= 1 ' pop to 輸出
Loop
sp -= 1 '但左括號不用輸出
Case Else
po += inch
End Select
Next
'輸入完，若 stack 還有資料，全輸出
Do Until sp < 0
po += stk(sp) : sp -= 1
Loop
Return po
End Function
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
'中序轉前序
' 由後往前讀入，同 中轉後輸出， 再反序輸出 括號相反
' *** 後序：堆內 >= 輸入則輸出， 前序：堆內 > 輸入則輸出 **** 前序優先序相同不輸出哦
Dim rins As String = StrReverse(TextBox1.Text)
For i = 1 To rins.Length
Dim c As Char = Mid(rins, i, 1)
If c = "(" Then
Mid(rins, i, 1) = ")"
ElseIf c = ")" Then
Mid(rins, i, 1) = "("
End If
Next
TextBox2.Text = StrReverse(in2po(rins, False)) '前序
End Sub
P4 費氏數
讀整數 n 傳給 fxx(n) 傳回答案 Function fxx(ByVal n As Integer) As String
Dim f(n) As Integer
f(0) = 0
f(1) = 1
For i = 2 To n
f(i) = f(i - 1) + f(i - 2)
Next
Return f(n)
End Function
P5 編碼
讀字串 s 傳給 fxx(s) 傳回答案 Function fxx(ByVal s As String) As String
Dim m = s.Length
fxx = ""
Dim cnt = 1
Dim c0 As Char = Mid(s, 1, 1) '第1個字
For i = 2 To m
Dim c As Char = Mid(s, i, 1)
If c = c0 Then
cnt += 1
Else '不同
fxx += (c0 & cnt)
cnt = 1
c0 = c
End If
Next
fxx += (c0 & cnt)
End Function
P6 阿姆斯壯數(水仙花)
讀字串 s 傳給 fxx(s) 傳回答案 ，在fxx將S拆成 x,y，並確認x<=y, 呼叫arms判斷Function fxx(ByVal s As String) As String
Dim dat() = s.Split(",")
Dim X As Integer = dat(0), Y As Integer = dat(1)
If X > Y Then '確認 X<=Y
Dim T = X : X = Y : Y = T
End If
Dim m = s.Length
fxx = ""
For i = X To Y
If arms(i) Then
If fxx = "" Then
fxx &= i
Else
fxx &= "," & i
End If
End If
Next
End Function
Function arms(ByVal k As Integer) As Boolean
' 若 k是 阿姆斯壯數，則 Return True, 否False
Dim m As Integer = Len(Str(k)) - 1
Dim j = k
Dim sum As Integer = 0
Do Until j = 0
sum += (j Mod 10) ^ m '每一位的 m 次方
j \= 10
If sum > k Then Return False
Loop
Return (k = sum)
End Function
P7 搜尋(Search)問題
前2列是節點數n及根節點名，在Form_Load讀入，接著不定行數，傳fn 檔案編號給fxx公用變數 n 、Nds As ArrayList 為節點的名稱：{根節點名稱先add為第1個，索引0}
假設最多 1000 個節點， chi(100,100)每個節點的兒子編號、 cnt(100)每個節點兒子數
'11 X ： F,X A,X H,F G,F C,A B,A J,G I,G E,B D B
' F:1 X:0 A:2 X:0 H:3 F:1 G:4 F:1 C:5 A:2 B:6 A:2
' J:7 G:4 I:8 G:4 E:9 B:6 D:10 B:6
Dim ndName As New ArrayList
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Hide()
FileOpen(1, "in.txt", OpenMode.Input)
FileOpen(2, "out.txt", OpenMode.Output)
Dim n As Integer = LineInput(1) ' n個 節點
Dim root As String = LineInput(1) 'root
ndName.Add(root)
PrintLine(2, fxx(1))
End
End Sub
Dim n As Integer ' 節點數
Dim r As Integer = 0 '根節點編號
Const Maxn As Integer = 1000
Dim chi(Maxn, Maxn) As Integer
Dim cnt(Maxn) As Integer
Function fxx(ByVal fn As Integer) As String
Do Until EOF(1)
Dim s As String = LineInput(fn)
Dim sep() = {","}
Dim dat() = s.Split(",")
Dim A As Integer = getid(Trim(dat(0)))
Dim B As Integer = getid(Trim(dat(1)))
chi(B, cnt(B)) = A
cnt(B) += 1
Loop
Dim que As New ArrayList '代替 Queue
Dim out As New ArrayList '輸出
que.Add(r)
out.Add(r)
Do Until que.Count = 0
Dim cur As Integer = que(0)
que.RemoveAt(0)
For i = 0 To cnt(cur) - 1
que.Add(chi(cur, i))
out.Add(chi(cur, i))
Next
Loop
fxx = ndName(0)
For i = 1 To out.Count - 1
fxx &= ("," & ndName(out(i)))
Next
End Function
Function getid(ByVal s As String) As Integer
getid = ndName.IndexOf(s)
If getid < 0 Then
getid = ndName.Count
ndName.Add(s)
End If
End Function
P8 明文/密文
讀字串 s 傳給 fxx(s) 傳回答案 Function fxx(ByVal s As String) As String
Dim m = s.Length
fxx = ""
For i = 1 To m
Dim c As Char = Mid(s, i, 1)
If c >= "A" And c <= "Z" Then
fxx += Chr((Asc(c) - 65 + 5) Mod 26 + 65)
ElseIf c >= "a" And c <= "z" Then
fxx += Chr((Asc(c) - 97 + 5) Mod 26 + 97)
Else
fxx += c
End If
Next
' A=65, B=66 ,.... Z=90
' a=97, b98 , .... z =122
End Function
發表文章
