商競程式103正_解題記錄

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

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

8/11 12:00 完成 P11 , P31 , P32  、  8/11 15:50 完成 P12 , P21 , P22  、 
8/11 20:00 完成 p41 、 8/11 21:00 完成  p42

讀檔寫檔

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 s As String) As String
        Dim dat() = s.Split(",")
        Dim a As Integer = dat(0), b As Integer = dat(1)
        If Math.Abs(a - b) = 2 And isp(a) And isp(b) Then
            Return "Y"
        Else
            Return "N"
        End If
    End Function

    Function isp(ByVal k As Integer) As Boolean  '是否質數
        If k < 2 Then Return False ' 0, 1非質數
        For i = 2 To Math.Sqrt(k)
            If k Mod i = 0 Then Return False
        Next
        Return True
    End Function

P12 郵票


    Function fxx(ByVal s As String) As String
        Dim dt() = s.Split(",")
        Dim a As Integer = dt(0), b As Integer = dt(1)
        Dim c As Integer = dt(2), d As Integer = dt(3)
        Dim y As Integer = (d - b * a) / (c - b)
        Dim x As Integer = a - y
        Return x & "," & y
    End Function

P21 共同字母

建議兩字串各建1陣列，記錄26個字母是否出現過，然後比對兩陣列即可
因每筆測資有兩列， for k=1 to n 中一次讀兩列，傳給fxx有兩個參數
   For k = 1 To n
       Dim s1 As String = LineInput(fn)
       Dim s2 As String = LineInput(fn)
       PrintLine(3, fxx(s1, s2))
   Next k

   Function fxx(ByVal s1 As String, ByVal s2 As String) As String
        Dim mk1(26), mk2(26) As Boolean
        Set_mk(s1, mk1) : Set_mk(s2, mk2)
        fxx = ""
        For j = 0 To 25
            If mk1(j) And mk2(j) Then
                fxx += Chr(j + 97)
            End If
        Next
        If fxx = "" Then fxx = "N" '無則傳回 大寫的 N
    End Function

   Sub Set_mk(ByVal s As String, ByRef x() As Boolean)   '出現的字母
        Array.Clear(x, 0, 26) '清為 false
        For i = 1 To s.Length
            x(Asc(Mid(s, i, 1)) - 97) = True  '都是小寫字母 a~z即 0~25
        Next
    End Sub

P22 共同朋友
同上題，因每筆測資有兩列， for k=1 to n 中一次讀兩列，傳給fxx有兩個參數


   Function fxx(ByVal s1 As String, ByVal s2 As String) As String

       ttrim(s1, "  ", " ") '可能多個空白，改為1個

        Dim dat1() = s1.Split(" ")
        Dim mk(65535) As Boolean '編號最多65535，直接開陣列不需轉換
        For j = 0 To UBound(dat1)
            mk(Val(dat1(j))) = True
        Next
        Dim cnt As Integer = 0
        Dim dat2() = s2.Split(" ")
        For j = 0 To UBound(dat2)
            If mk(Val(dat2(j))) = True Then '若s1中也出現過，共同友 加1
                cnt += 1
            End If
        Next
        fxx = cnt '傳回共同朋友人數
    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

P31 撲克牌(6選5)

dim a(5)有6個數， b(4)有5個數
dim bi=0
for i=0 to 5 'i不取,6次分別不取 0,1,2,3,4,5
  for j=0 to 5
     if i=j continue for '不取  i
     b( bi ) = a(j)
     bi += 1
  next j
  ' 共有 6 次，分別取得不同的 5張牌
  ' 類似 模41 呼函式 傳回點數
  ' 記錄最大的點數

next

   Function fxx(ByVal s As String) As String
        Dim dat() = s.Split(" ")
        Dim a(5), b(4) As Integer
        For i = 0 To 5
            a(i) = dat(i) - 1  '原 1~52 改成 0~51
        Next
        Dim m As Integer = 0 '目前最高分
        For i = 0 To 5
            Dim bi As Integer = 0 ' b的索引號
            For j = 0 To 5
                If i = j Then Continue For
                b(bi) = a(j)
                bi += 1
            Next
            For j = 0 To 4
                fs(j) = b(j) \ 13  '  花色 0~3
                pt(j) = b(j) Mod 13 ' 點數 0~12
            Next
            m = Math.Max(m, chk()) '保留 6 次中　最高的
        Next
        Return m
    End Function

    REM 以下類似　模４１　判斷牌型

    Dim fs(5) As Integer '花色
    Dim pt(5) As Integer '點數
    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 flus() As Boolean  '同花
        For i = 1 To 4
            If fs(i) <> fs(i - 1) Then Return False
        Next
        Return True
    End Function
    Function chk() As Integer '根據 pt,fs傳回牌型數值 0~7
        Dim pair(4) As Integer
        Array.Sort(pt, 0, 5)
        Dim st As Boolean = stra()
        Dim fl As Boolean = flus()
        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
            pt(0) = 13
            Array.Sort(pt, 0, 5)
            st = stra()
        End If
        If st And fl 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

P32 費氏數
 題目中已給訊息最多17位 f(19)夠用，但f(19)=4181,f(20)=6765，所以求至f(20)
 f(0)=0 : f(1)=1
 for j=2 to 20  '算出所有的 f(值)
    f( j ) = f( j-1 ) + f( j-2 )
 next j 從 i=19開始往下找到 f(i)<= x < f(i+1) 的 i
 然後 for j=i to 2 step -1 '因為f(2)=1, f(1)及f(0)不用
        若 x>=f(j)則印1否則印0
        x>=f(j)則 x減f(j)
以上也可以將 f()往前移2位， f(0)=1,f(1)=2, f(2)=3 ,...參考解將移前2位

產生費氏列只要一次即可，所以在 Form_Load中呼叫 Gen_f() 一次
   Const MaxF = 18
   Dim f(MaxF) As Integer 'f(0)=1,f(2)=2,f(3)=3,...f(17)=4181,f(18)=6765, f(19)>10000
    Sub Gen_f()
        f(0) = 1 : f(1) = 2
        For i = 2 To MaxF
            f(i) = f(i - 1) + f(i - 2)
        Next
    End Sub
    Function fxx(ByVal s As String) As String
        Dim x As Integer = s  ' 1 <= x <= 10000
        Dim i As Integer = MaxF, j As Integer
        Do Until x >= f(i)
            i -= 1
        Loop
        fxx = x & "="
        For j = i To 0 Step -1
            If x >= f(j) Then
                fxx += "1"
                x -= f(j)
            Else
                fxx += "0"
            End If
        Next

    End Function

P41 凱撒密碼
  看一下密碼表，找規律， 每一編碼的倒數第2 bit 一定是 0
  所以，讀入密文遇0則再加1個 bit 即可查表找出對應的數字了，每一行2個數字，再轉字母
 {註：遇0之前的左邊不是無字元不然全是1，計算遇0之前 1出現的個數即可}

  Function fxx(ByVal s As String) As String
        ' s 有兩個2進位編碼的數字:十位數 d(0),個位數 d(1)數字
        Dim d(2) As Integer
        Dim di = 0
        Dim ones As Integer = 0 '遇到0之前 1 的個數
        For j = 1 To s.Length
          If Mid(s, j, 1) = "0" Then '遇到0，再抓右bit，連同1的個數,轉成數字0~9
               j += 1
               d(di) = ones * 2 + Val(Mid(s, j, 1))
               di += 1
               ones = 0
          Else  '還沒遇到 0 之前，計算 one 出現的個數
                ones += 1
          End If
        Next
        Dim b2k As Integer = d(0) * 10 + d(1)
        ' b2k 24:A , 25:B , 26:C , 01:D , .... 23:Z
        Return Chr((b2k + 2) Mod 26 + 65)
    End Function
  

P42 葉至根的路徑(多樹)

   類似模擬題，第多棵樹，父節點 par 以二維陣列存放，多一迴圈各樹跑1次

    每筆測資除了第1列外，尚有 m 列， 多傳 fn 給 fxx 讀檔 
 '第1列之後 有 m個節點及父資訊，需讀入
  Function fxx(ByVal fn As Integer, ByVal s1 As String) As String 
   Dim par(8, 256) As Integer '父是誰？最多8棵樹，每棵最多256節點,但root的par為999
   Dim mkv() = s1.Split(",") '每一組的第1列 m,k,v (節點數、樹數、及要詢問的節數v)
   Dim m As Integer = mkv(0), k As Integer = mkv(1), v As Integer = mkv(2)
        ' 讀 m 列，各節點的 父資訊
        For j = 1 To m
            Dim s As String = LineInput(fn) '去多餘的空格
            s = Trim(s) : ttrim(s, "  ", " ") 
            ttrim(s, " ,", ",") : ttrim(s, ", ", ",")
            Dim dat() = s.Split(" ")  '節點及其父節數資料
            Dim x As Integer = dat(0)
            For t = 1 To k  ' 某節點 nd 的 k棵樹的 父節點
                Dim y As Integer = dat(t)
                par(t, x) = y  '第 t 棵樹中 節點編號 x 的父節點編號為 y
             Next
        Next ' j=1~m
        fxx = ""
        For t = 1 To k  ' k棵樹，找出 節點 v 的路徑
            Dim cnt = 0
            Dim p = par(t, v)  ' 第 t 棵 的節點 v 的父
            Do Until p = 999   '若是 999 就停
                cnt += 1
                p = par(t, p)
            Loop
            If t > 1 Then fxx &= ","
            fxx &= cnt
        Next
 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