讀檔部份省略，假設每組一列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年 正式題 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
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
Next
Next
Next
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
' 因最多 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
發表文章
