讀檔部份省略，假設每組一列S或多列S()傳入fxx，傳回結果

F107_P11_計算含S字數
Function fnxx(ByVal s As String) As String
fnxx = ""
s = Trim(s) : ttrim(s, " ", " ")
Dim dat() = s.Split(" ")
Dim cnt = 0
For i = 0 To UBound(dat)
If InStr(dat(i), "s") > 0 Or InStr(dat(i), "S") > 0 Then cnt += 1
Next
Return dat.Length & "," & cnt
End Function
'若資料以空格隔開，可能需要將多個空白取代為單空白
Sub ttrim(ByRef s As String, ByVal a As String, ByVal b As String)
While (InStr(s, a) > 0)
s = s.Replace(a, b)
End While
End Sub

' 107年正式題 P12 井字棋
' 不會有兩人同時連線，分別判斷1及2有沒有連、否則都沒連3
' 一次傳S陣列 3列

Dim a(2, 2) As Integer
Function fxx(ByVal s$()) As String
fxx = "3"
For i = 0 To 2
For j = 0 To 2
a(i, j) = Mid(s(i), j + 1, 1)
Next
Next
If chk(1) Then Return 1
If chk(2) Then Return 2
End Function
Function chk(ByVal p As Integer) As Boolean
' 列
Dim cnt As Integer
For i = 0 To 2
cnt = 0
For j = 0 To 2
If a(i, j) = p Then cnt += 1
Next
If cnt = 3 Then Return True
Next
' 行
For i = 0 To 2
cnt = 0
For j = 0 To 2
If a(j, i) = p Then cnt += 1
Next
If cnt = 3 Then Return True
Next
If p = a(0, 0) AndAlso a(0, 0) = a(1, 1) AndAlso a(1, 1) = a(2, 2) Then Return True '\
If p = a(0, 2) AndAlso a(0, 2) = a(1, 1) AndAlso a(1, 1) = a(2, 0) Then Return True '/
Return False
End Function

' 107年正式題 P21 快樂數字
' 最大 100000 宣告一陣列，檢查是否出現過

Const MaxN As Integer = 100000 '最大的數字

Function fxx(ByVal s$) As String
fxx = ""
Dim x% = s
Dim mk(MaxN) As Boolean
mk(x) = True
Do Until x = 1
x = ss(x)
If mk(x) Then Exit Do
mk(x) = True
Loop
If x = 1 Then Return "T" Else Return "F"
End Function

Function ss(ByVal x As Integer) As Integer
ss = 0
Dim d%
Do Until x = 0
d = x Mod 10
ss += (d * d)
x \= 10
Loop
End Function

' 107年正式題 P22 排列
' 最多5個數字，全排列，由小至大問第 k 個的值

Dim plst As New ArrayList

Function fxx(ByVal s$) As String
fxx = ""
Dim dat() = s.Split(",")
Dim N% = dat(0)
Dim a(N - 1) As Integer '最多 5 個數
For i = 0 To N - 1
a(i) = dat(i + 1)
Next
Dim k% = dat(N + 1)
plst.Clear()
perm(a, 0, N)
plst.Sort()
Return plst(k - 1)

End Function

Sub perm(ByVal a%(), ByVal p%, ByVal N%)
If p = N Then '產生一組
Dim num = ""
For i = 0 To N - 1
num &= a(i)
Next
plst.Add(num)
Return
End If
' 換 p ~ N-1 , 遞迴
Dim t As Integer
For x = p To N - 1
t = a(p) : a(p) = a(x) : a(x) = t ' p換成其它的數字
perm(a, p + 1, N)
t = a(p) : a(p) = a(x) : a(x) = t ' p 換回來
Next
End Sub

' 107年正式題 P31 大數乘冪運算 M^K { 1 <= M,K <= 999 }
' 可用 BigInteger 類別，應也可以使用 Log10吧
' 專案需加入參考，再 Imports, 不確定BigInteger的位數上限，需另查

Imports System.numerics

Function fxx(ByVal s As String) As String
Dim dat() = s.Split(",")
Dim m% = dat(0), k% = dat(1)
' 算 m^k
Dim Pow As BigInteger = BigInteger.Pow(m, k)
fxx = Len(Pow.ToString) '& "," & Pow.ToString
End Function

方法2 使用Log10： Return Math.Floor(Math.Log10(M)*K)+1

' 107年正式題 P32 模數

' 應該有公式解(數論？待查) 但 a,b,m皆 1~99 ： 99^3 應可以暴力解

Function fxx(ByVal s$) As String

fxx = ""

s = Strings.Trim(s) : ttrim(s, " ", " ")

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

' fxx = s & "," & dat.Length

Dim ai% = dat(0), ax% = dat(1)

Dim bi% = dat(2), bx% = dat(3)

Dim mi% = dat(4), mx% = dat(5)

Dim cnt = 0

For k = mi To mx

Dim md = k * 100

For i = ai To ax

For j = bi To bx

If (i + j) Mod k = (i - j + md) Mod k Then cnt += 1

Return cnt

End Function

Sub ttrim(ByRef s$, ByVal a$, ByVal b$)

Do While InStr(s, a) > 0

s = s.Replace(a, b)

Loop

End Sub

' 107年正式題 P41 樹最遠的2節點長度
' 因最多 127個節點，父子為相鄰，建adj(,) 以 floyd找任2點最短路{樹沒迴路,
2點只有一種距離}, 所有2節點距中最長即是

Const MaxN% = 127
Const inf% = 99
Dim a(MaxN, MaxN) As Integer

Function fxx(ByVal s$) As String
s = Mid(s, 2)
Dim bt(MaxN) As Boolean
Dim sep() As Char = {",", "，"}
Dim dat() = s.Split(sep)
Dim m% = dat.Length '最後 node
Dim p%, v%
For k = 0 To UBound(dat)
v% = Val(dat(k))
If v% > 0 Then bt(k + 1) = True Else bt(k + 1) = False
Next
For i = 1 To m
For j = 1 To m
a(i, j) = inf 'inf
Next
Next
'建相鄰矩陣
For p = m \ 2 To 1 Step -1
Dim lch% = p * 2 '左子
Dim rch% = lch% + 1 ' 右子
If bt(lch) Then '有左子連
a(p, lch) = 1 : a(lch, p) = 1
End If
If bt(rch) Then '有右子連
a(p, rch) = 1 : a(rch, p) = 1
End If
Next
floyd(m) '最短路 {樹沒有迴圈，兩點距只有一個值}
v = 0
For i = 1 To m
For j = i + 1 To m
If a(i, j) < inf Then
v = Math.Max(v, a(i, j))
End If
Next
Next
fxx = v
End Function

Sub floyd(ByVal m%)
For k = 1 To m
For i = 1 To m
For j = 1 To m
a(i, j) = Math.Min(a(i, j), a(i, k) + a(k, j))
Next
Next
Next
End Sub

' 107年正式題 P42 循環排列
' 因最多 k=20 , 數字 1~k 找循環

Const MaxN% = 20 '最多20個 1~20
Dim a(MaxN) As Integer
Dim vst(MaxN) As Boolean
Dim cyc As New ArrayList

Function fxx(ByVal s$) As String
s = Mid(s, 2)
Dim sep() As Char = {",", "，"}
Dim dat() = s.Split(sep)
Dim k% = dat.Length 'k個數
Dim v%
fxx = ""
For i = 1 To k
v% = Val(dat(i - 1))
a(i) = v ' 第 i 個接第 v 個
Next
fxx &= "["
Dim fst As Boolean = True
Array.Clear(vst, 0, vst.Length)
For i = 1 To k
If vst(i) Then Continue For
If fst Then fst = False Else fxx &= ","
fxx &= "["
If a(i) = i Then
fxx &= i '自己接自己
Else
cyc.Clear()
dfs(i)
fxx &= cyc(0)
For j = 1 To cyc.Count - 1
fxx &= "," & cyc(j)
Next
End If
fxx &= "]"
Next
fxx &= "]"
End Function

Sub dfs(ByVal u%)
If vst(u) Then Return
cyc.Add(u) : vst(u) = True
dfs(a(u))
End Sub

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

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

二信資處程式

2018年12月15日星期六

商競程式107正式題

2018年10月12日星期五

2017青年程式(中文組)

2017年青年程式競賽(中文組)解題記錄 2018/10/12 建置

Recent Posts

Categories

Blog Archive

著作人

2018年12月15日 星期六

2018年10月12日 星期五

Recent Posts

Categories

Blog Archive

著作人

訂閱

2018年12月15日星期六

2018年10月12日星期五