商競程式106正_解題記錄

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

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

讀檔寫檔

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, fnxx(s))
            Next
        Next
        End
    End Sub
   ．．．
   每一題 解題部份
   ．．．
End Class

P11 計算含有s或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 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

P12 給一個羅馬數字符號，轉為整數數字

   Dim r() As Char = {"I", "V", "X", "L", "C", "D", "M"}
    Dim d() As Integer = {1, 5, 10, 50, 100, 500, 1000}

  Function fnxx(ByVal s As String) As String
        fnxx = ""
        Dim num As Integer = 0
        For i = 1 To s.Length
            Dim ch As Char = Mid(s, i, 1)
            Dim v1 = d(Array.IndexOf(r, ch))
            num += v1
            Dim j = i + 1
            If j > s.Length Then Exit For
            ch = Mid(s, j, 1)
            Dim v2 = d(Array.IndexOf(r, ch))
            If v2 > v1 Then  '一次處理 兩字元
                num += (v2 - v1 - v1)
                i += 1
            End If
        Next
        Return num
    End Function

P21 信用卡卡號

   Function fnxx(ByVal s As String) As String

        fnxx = ""

        Dim sum As Integer = 0

        For i = 1 To s.Length

            Dim d As Integer = Mid(s, i, 1)

            If i Mod 2 = 1 Then d *= 2

            sum += (d \ 10 + d Mod 10)

        Next

        Return IIf(sum Mod 10 = 0, "T", "F")   ' IF 函數

    End Function

P22 幾A幾B

2~6個數字的排列，有三個版本 perm1, perm2, perm3

    Dim pn(720) As Integer  '排列組合的順序及值 p(1)第1個，最多 M! = 6!=720

    Dim p(720) As String  '比對 幾A幾B 以字串存 較好處理

    Dim pi As Integer  '目前有的個數

    Dim a() As Integer = {1, 2, 3, 4, 5, 6}

    Dim M As Integer ' 12, 123, 1234 , 12345 , 123456 的 M值 分別為 2~6

    Function fnxx(ByVal s As String) As String

        fnxx = ""

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

        Dim di As String = trim( d(0) )  ' 去左右空白

        Dim dj As Integer = d(1), dk As Integer = d(2)

        M = di.Length

        pi = 1  ' p從p(1)開始、 p(0)不存資料

        'perm(a, 0)  ' a陣列的數字，前 M 個 排列，完成後放入 p ，之前寫的版本、複製較多次

        'perm2(a, 0)  ' 第2版 ： a陣列的數字，前 M 個 排列，完成後放入 p

        perm3(a, 0) : Array.Sort(p, 1, pi - 1) ' 第3版 ： 交換版則完成後需再排序 

        ' Array.Sort(pn, 1, pi - 1)  '索引從1開始

        '  For i = 1 To pi - 1

        'PrintLine(3, i & ":" & p(i))

        '  Next

        ' fnxx = p(dj) & "," & p(dk) & " " '印出 第j個及第k個

        Dim An, Bn As Integer

        For J = 1 To M

            For K = 1 To M

                If Mid(p(dj), J, 1) <> Mid(p(dk), K, 1) Then Continue For

                If J = K Then An += 1 Else Bn += 1

            Next

        Next

        fnxx &= An & "A" & Bn & "B"

    End Function

  

  Sub perm(ByVal num() As Integer, ByVal n As Integer)

        If n >= M Then   '產生一個

            ' get one to p(pi)

            'Dim sum = 0

            p(pi) = ""

            For x = 0 To M - 1

                'sum = sum * 10 + num(x)

                p(pi) &= num(x) '存成字串

            Next

            ' p(pi) = sum

            '  Debug.Print(pi & ":" & sum)

            pi += 1

        Else

            Dim t(M) As Integer

            '旋轉、遞迴M-1n - 1

            For x = n To M - 1

                ' 複製一份 num - > t 遞迴用 

                For y = 0 To M - 1

                    t(y) = num(y)

                Next

                'x  旋至 n

                Dim z = t(x)   '先存最右，然後所有 n~(x-1)的右移

                For y = x - 1 To n Step -1

                    t(y + 1) = t(y)

                Next

                t(n) = z

                ' t(x) + 右邊的數字遞迴

                perm(t, n + 1)

            Next

        End If

    End Sub

   

  Sub perm2(ByVal num() As Integer, ByVal n As Integer)

        If n >= M Then   '產生一個

            p(pi) = ""

            For x = 0 To M - 1

                p(pi) &= num(x) '存成字串

            Next

            pi += 1

            Return

        End If

        Dim t(M) As Integer

        For y = 0 To M - 1 '複製一份

            t(y) = num(y)

        Next

        '旋轉、遞迴 n~M-1 各一次

        For x = n To M - 1

            ' n 旋至 x  (先n~x-1往後一格)

            For y = n To x - 1

                t(y + 1) = num(y)

            Next

            t(n) = num(x)

            perm2(t, n + 1) ' t(x) n換，右邊的數字遞迴

        Next

    End Sub

   Sub perm3(ByVal num() As Integer, ByVal n As Integer) '排列後數字大小順序不一, 需再排序

        If n >= M Then   '產生一個

            p(pi) = ""

            'pn(pi) = 0

            For x = 0 To M - 1

                p(pi) &= num(x) '存成字串

                ' pn(pi) = pn(pi) * 10 + num(x)

            Next

            pi += 1

            Return

        End If

        Dim t As Integer

        ' n~M-1 、每個數字各交換一次

        For x = n To M - 1

            t = num(n) : num(n) = num(x) : num(x) = t  ' num(x) <-> num(n)交換

            perm3(num, n + 1) ' 遞迴

            t = num(n) : num(n) = num(x) : num(x) = t  ' num(x) <-> num(n)交換

        Next

    End Sub

P31 網段廣播位址

   Function fnxx(ByVal s As String) As String
        fnxx = ""
        Dim a, b As Integer
        Dim p As Integer = InStr(s, "/")
        Dim sa() = Mid(s, 1, p - 1).Split(".")
        Dim sb() = Mid(s, p + 1).Split(".")
        For j = 0 To 3   ' IP分4段，以．隔開
            a = sa(j)
            b = sb(j)
            If j > 0 Then fnxx &= "."
            fnxx &= (a Or 255 - b) '直接以 OR 做 bit運算
        Next
    End Function

P32 大數排序問題

  Function fnxx(ByVal s As String) As String
        fnxx = ""
        s = Trim(s) : ttrim(s, " ", "") '去掉所有空格
        Dim dat() = s.Split(",")
        Dim DLen As Integer = dat.Length
        Dim rank(DLen) As Integer '排名
        For i = 0 To DLen - 2
            For j = i + 1 To DLen - 1
                If cmp_gt(dat(i), dat(j)) Then '較大的 rank 加 1
                    rank(i) += 1
                Else
                    rank(j) += 1
                End If
            Next
        Next
        Dim fst As Boolean = True
        For i = 0 To DLen - 1
            If i > 0 Then fnxx &= ", "
            fnxx &= rank(i) + 1        '最小的 rank 為0，各加1
        Next
        ' Return
    End Function

    Function cmp_gt(ByVal x As String, ByVal y As String)  ' x 是否大於 y
        Dim xn As Integer = x.Length, yn As Integer = y.Length
        x = cut0(x, xn) : y = cut0(y, yn)
        If xn <> yn Then Return xn > yn
        For i = 1 To xn
            If Mid(x, i, 1) <> Mid(y, i, 1) Then Return Mid(x, i, 1) > Mid(y, i, 1)
        Next
        Return False
    End Function

    Function cut0(ByVal x As String, ByRef xn As Integer) As String  ' 去前導 0
        Dim xi As Integer = 1
        For xi = 1 To xn
            If Mid(x, xi, 1) <> "0" Then Exit For
        Next
        x = Mid(x, xi)
        xn = x.Length
        Return x
    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

P41 樹 (加列出環cycle的節點)
' 因為只有一個 cycle ，則去掉 非cycle的邊後，cycle上所有節點的分支度恰為2
' 第1版有點亂，過一陣子補另一版本

   Const MaxN As Integer = 20 '最多20個節點
    Dim adj(MaxN, MaxN) As Boolean '相鄰矩陣
    Dim vst(MaxN) As Boolean       '是否訪過
    Dim nds(MaxN) As Boolean      '節點在這樹是否出現(目前這樹有的編號)
    Dim bra(MaxN) As Integer      '節點的分支度
    Dim ndcnt As Integer           '樹的節點數
    Dim egcnt As Integer           '邊數
    Dim st As Integer  'dfs拜訪的起點

    Function fnxx(ByVal s As String) As String
        fnxx = ""
        s = Trim(s) : ttrim(s, "  ", " ") : ttrim(s, ", ", ",") : ttrim(s, " ,", ",")
        Dim egs() = s.Split(" ")

        Array.Clear(adj, 0, (MaxN + 1) * (MaxN + 1))  '清空
        Array.Clear(nds, 0, MaxN + 1)
        Array.Clear(bra, 0, MaxN + 1)
        egcnt = egs.Length
        For i = 0 To egcnt - 1
            Dim xy() = egs(i).Split(",")
            Dim x As Integer = xy(0), y As Integer = xy(1)
            adj(x, y) = True : adj(y, x) = True
            bra(x) += 1 : bra(y) += 1
            nds(x) = True : nds(y) = True
            st = x  'dfs拜訪的起點
            '  ///    If i > 0 Then fnxx &= " : " '  印出參考
            '  ///  fnxx &= x & "-" & y         '  印出參考 
            Array.Clear(vst, 0, MaxN + 1)    '清空
            If (cyc(st, st)) Then
                Return fnxx & getcy()
            End If
        Next
        ndcnt = 0
        For i = 0 To MaxN
            If nds(i) Then ndcnt += 1
        Next
        If ndcnt = egcnt + 1 Then Return "T" Else Return "F"
    End Function
   ' dfs 看是否 cycle
    Function cyc(ByVal u As Integer, ByVal f As Integer) As Boolean  '現節點、父節點
        vst(u) = True
        For v = 0 To MaxN
            If v <> u And v <> f And adj(u, v) Then
                If vst(v) Then Return True
                If cyc(v, u) Then Return True
            End If
        Next
        Return False
    End Function

    Function getcy() As String  '取得 cycle 的節點
        ' 去掉所有 分支度為 1 的邊，最後只剩下分支度為 2 的就是 cycle
        Dim cy = ""
        Dim done As Boolean
        Do
            done = True
            For i = 0 To MaxN
                If bra(i) = 1 Then
                    bra(i) = 0             '只有一分支 不在 cycle內 
                    '  cy &= "x" & i             '只有一分支不算，刪掉這個邊
                    done = False '有 1
                    For j = 0 To MaxN
                        If adj(i, j) And bra(j) > 0 Then
                            bra(j) -= 1        '將這個邊另一節點的分支度 減1
                            '  cy &= "x" & j      '   ////
                            Exit For
                        End If
                    Next
                End If
            Next i
        Loop Until done
        ' ///''   cy &= " : "
        Dim fst As Boolean = True
        For i = 0 To MaxN
            If bra(i) = 2 Then
                If fst Then fst = False Else cy &= ", "
                cy &= i
            End If
        Next
        Return cy
    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

P42 後序運算式

   Function fnxx(ByVal s As String) As String
        fnxx = ""
        s = Trim(s) : ttrim(s, "  ", " ")  '多空取代為 單空
        Dim dat() = s.Split(" ")
        Dim num As New ArrayList  '忘了vb的stack怎麼用，以arraylist代替
                                                       ' 也可以自行用陣列模擬 stack，下一版本再補
        For i = 0 To UBound(dat)
            Dim ch As Char = Mid(dat(i), 1, 1)
            If ch >= "0" And ch <= "9" Then   '數字則放入 stack
                num.Add(Val(dat(i)))
            Else                                   ' 運算子 則取出2個數字運算後 值再放入stack
                Dim a As Integer = num(num.Count - 2), b As Integer = num(num.Count - 1)
                num.RemoveAt(num.Count - 1) : num.RemoveAt(num.Count - 1)
                Select Case ch
                    Case "+"
                        num.Add(a + b)
                    Case "-"
                        num.Add(a - b)
                    Case "*"
                        num.Add(a * b)
                    Case "/"
                        num.Add(a / b)
                End Select
            End If
        Next
        Return num(0)
    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