用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
．．．
每一題 解題部份
．．．
End Class
P11 判斷是否為質數
Function fxx(ByVal x As Integer) As String
If x < 2 Then Return "N"
For i = 2 To Math.Sqrt(x)
If x Mod i = 0 Then Return "N"
Next
Return "Y"
End Function
P12 解二元一次聯立方程式之根
Function fxx(ByVal s As String) As String
Dim dat() = s.Split(",")
Dim a As Integer = dat(0), b As Integer = dat(1)
Dim c As Integer = dat(2), d As Integer = dat(3)
Dim ee As Integer = dat(4), f As Integer = dat(5)
Dim x As Integer = (c * ee - b * f) / (a * ee - b * d)
Dim y As Integer = (c * d - a * f) / (b * d - a * ee)
Return x & "," & y
End Function
' tbl 字串陣列宣告為同一列，因版面分為多列顯示 Dim tbl() As String = {".-", "-...", "-.-.", "-..", ".", "..-.", "--.", "....", "..", ".---", "-.-", ".-..", "--", "-.", "---", ".--.", "--.-", ".-.", "...", "-", "..-", "...-", ".--", "-..-", "-.--", "--.."}
Function fxx(ByVal s As String) As String
Dim dat() = s.Split(" ")
fxx = ""
For i = 0 To UBound(dat)
fxx &= Chr(Array.IndexOf(tbl, dat(i)) + 65)
Next
End Function
P22 凱撒密碼
Function fxx(ByVal s As String) As String
fxx = ""
For i = 1 To s.Length
Dim c As Char = Mid(s, i, 1)
If c < "A" Or c > "Z" Then Continue For
Dim k As Integer = Asc(c) - 65
k = (k + 3) Mod 26
fxx &= Chr(65 + k)
Next
End Function
P31 是否為樹
Dim adj(MaxN, MaxN) As Boolean '相鄰矩陣
Dim nds(MaxN) As Boolean '是否為節點
Dim vst(MaxN) As Boolean '是否訪過
Sub dfs(ByVal u As Integer) '由 u深訪
vst(u) = True
For v = 0 To MaxN
If adj(u, v) And Not vst(v) Then dfs(v) '相鄰且 v 未訪過
Next
End Sub
Function fxx(ByVal s As String) As String
s = Trim(s) : ttrim(s, " ", " ") : ttrim(s, ", ", ",") : ttrim(s, " ,", ",")
Dim st As Integer ' 起點
Dim egs() = s.Split(" ") '邊
Dim egcnt As Integer = egs.Length '邊數
Array.Clear(adj, 0, (MaxN + 1) * (MaxN + 1))
Array.Clear(nds, 0, MaxN + 1)
For i = 0 To UBound(egs)
Dim xy() = egs(i).Split(",") '分成 x,y
Dim x As Integer = xy(0), y As Integer = xy(1)
adj(x, y) = True : adj(y, x) = True
nds(x) = True : nds(y) = True
st = x
Next
Dim ndcnt As Integer = 0 '節點數
For i = 0 To MaxN
If nds(i) Then ndcnt += 1
Next
If ndcnt <> egcnt + 1 Then Return "F" '點、邊的數不符 樹的規定
Array.Clear(vst, 0, MaxN + 1)
dfs(st)
For i = 0 To MaxN '是節點，但未訪過，不連通就不是樹
If nds(i) And Not vst(i) Then Return "F"
Next
Return "T"
End Function
Sub ttrim(ByRef s As String, ByVal a As String, ByVal b As String)
Do While (InStr(s, a) > 0)
s = s.Replace(a, b)
Loop
End Sub
P32 樹葉至根的路徑
因每筆測資多行，將 fn 也傳入 fxx , for k=1 to n 內修改
For k = 1 To n
If k > 1 Then LineInput(fn) '兩組間有空白列
Dim m As Integer = LineInput(fn) 'm個邊，需再讀入
PrintLine(3, fxx(fn, m))
Next
Function fxx(ByVal fn As Integer, ByVal m As Integer) As String '有 m個節點及父，需讀入
Dim fa(MaxN) As Integer '父編號
Dim ch(MaxN) As Boolean '有子?
For i = 1 To m
Dim s1 As String = LineInput(fn)
' MsgBox(s1)
Dim dat() = s1.Split(",")
Dim x As Integer = dat(0), y As Integer = dat(1)
fa(x) = y
ch(y) = True
Next
'因題目規定節點編號 0~m-1，不會有空號
fxx = ""
For j = 0 To m - 1
If Not ch(j) Then ' 沒有兒子的就是葉子
Dim cnt = 0 '往上走至根之間的節點數
Dim s = "" ' 每葉輸出一列
Dim p = fa(j)
Do Until fa(p) = 99
If cnt > 0 Then s &= ("," & p) Else s &= p
cnt += 1
p = fa(p)
Loop
If cnt > 0 Then s = "{" & s & "}" Else s = "N"
fxx &= j & ":" & s & vbNewLine
End If
Next
End Function
P41 撲克牌
Dim fs(5) As Integer '0,1,2,3
Dim pt(5) As Integer ' 0,1,....12
Function stra() As Boolean ' 是否為順子
For i = 1 To 4
If pt(i) - 1 <> pt(i - 1) Then Return False
Next
Return True
End Function
Function flush() As Boolean ' 是否為同花
For i = 1 To 4
If fs(i) <> fs(i - 1) Then Return False
Next
Return True
End Function
Function fxx(ByVal s As String) As String
Dim dat() = s.Split(" ")
For i = 0 To 4
Dim j = dat(i) - 1 '減1
fs(i) = j \ 13
pt(i) = j Mod 13
Next
Array.Sort(pt, 0, 5)
Dim st As Boolean = stra()
Dim fl As Boolean = flush()
Dim pair(4) As Integer 'pair(2)對子數、 pair(3)三條數、 pair(4)四條數
Dim cnt As Integer = 1
For i = 1 To 4
If pt(i) = pt(i - 1) Then
cnt += 1
Else
pair(cnt) += 1
cnt = 1
End If
Next
pair(cnt) += 1
If (Not st And pt(0) = 0 And pt(4) = 12) Then '有可能 A 10 J Q K
pt(0) = 13
Array.Sort(pt, 0, 5)
st = stra()
End If
If fl And st Then
Return 7
ElseIf pair(4) = 1 Then
Return 6
ElseIf pair(3) = 1 And pair(2) = 1 Then
Return 5
ElseIf st Then
Return 4
ElseIf pair(3) = 1 Then
Return 3
ElseIf pair(2) = 2 Then
Return 2
ElseIf pair(2) = 1 Then
Return 1
Else
Return 0
End If
End Function
P42 樂透
因每筆測資2行，一次讀兩列傳給 fxx , for k=1 to n 內修改
For k = 1 To n
Dim s1 As String = LineInput(fn)
Dim s2 As String = LineInput(fn)
PrintLine(3, fxx(s1, s2))
Function fxx(ByVal s1 As String, ByVal s2 As String) As String
Dim dat1() = s1.Split(",")
Dim dat2() = s2.Split(",")
Dim a(5), b(5) As Integer
For i = 0 To 4
a(i) = dat1(i)
b(i) = dat2(i)
Next
Array.Sort(a, 0, 5) '可能未排序
Array.Sort(b, 0, 5) '可能未排序
Dim ai As Integer = 0, bi As Integer = 0
Dim cnt = 0
Do While ai < 5 And bi < 5
If a(ai) = b(bi) Then
cnt += 1
ai += 1 : bi += 1
ElseIf a(ai) > b(bi) Then
bi += 1
Else
ai += 1
End If
Loop
Return cnt
End Function
發表文章
0 意見:
張貼留言