0106

       小考奇數偶數卷

        'P1-全班平均
        '開
        '輸入
        FileOpen(1, "P1.in", OpenMode.Input)
        Dim ans = ""
        Dim no() As String
        Dim chi(), eng(), mat(), ttlc, ttle, ttlm As Integer
        Dim cnt = -1
        Do While Not EOF(1)
            cnt += 1
            '動態宣告
            ReDim Preserve no(cnt), chi(cnt), eng(cnt), mat(cnt)
            Input(1, no(cnt)) : Input(1, chi(cnt)) : Input(1, eng(cnt)) : Input(1, mat(cnt))
        Loop
        '關
        FileClose()
        '處理
        For i = 0 To cnt
            ttlc += chi(i)
            ttle += eng(i)
            ttlm += mat(i)
        Next
        '輸出
        '(平均)
        Dim avgc, avge, avgm As Single
        avgc = ttlc / (cnt + 1)
        avge = ttle / (cnt + 1)
        avgm = ttlm / (cnt + 1)
        For i = 0 To cnt
            ans &= no(i) & "," & chi(i) & "," & eng(i) & "," & mat(i) & vbNewLine
        Next
        ans &= "," & Format(avgc, "##0.0") & "," & Format(avge, "##0.0") & "," & Format(avgm, "##0.0")
        Me.TextBox1.Text = ans
        My.Computer.FileSystem.WriteAllText("P1-1.out", ans, False)
 
        'P1
        '輸入
        '開
        FileOpen(1, "P1.in", OpenMode.Input)
        Dim ans, no As String
        Dim chi, eng, mat As Integer
        Do While Not EOF(1)
            Input(1, no) : Input(1, chi) : Input(1, eng) : Input(1, mat)
            Dim avg As Single
            avg = chi + eng + mat
            ans &= no & "," & Format(avg, "##0.0")     → 要寫在裡面
            ✩ans &= If(EOF(1), "", vbNewLine) → 不可多一行
        Loop
        '關
        FileClose()

        Me.TextBox2.Text = ans
        My.Computer.FileSystem.WriteAllText("P1.out", ans, False)
 
        'P2
        '開
        '輸入
        FileOpen(1, "P2.in", OpenMode.Input)
        Dim ans = ""
        Dim n As String
        Do Until EOF(1)
            Input(1, n)
            ans &= Bin(n)
            ans &= If(EOF(1), "", vbNewLine)
        Loop

        '關
        FileClose()

        '輸出
        Me.TextBox3.Text = ans
        My.Computer.FileSystem.WriteAllText("P2.out", ans, False)
 
        'P3
        '開
        '輸入
        FileOpen(1, "P3.in", OpenMode.Input)
        Dim ans = ""
        Dim s As String
        Do Until EOF(1)
            Input(1, s)
        Loop
        '關
        FileClose()
        '處理
        Dim i As Integer
        For i = 1 To s
            For j = 1 To i
                ans &= i
            Next
            ans &= If(i = s, "", vbNewLine)
        Next
        '輸出
        Me.TextBox4.Text = ans
        My.Computer.FileSystem.WriteAllText("P3.out", ans, False)
 
        'P4
        '輸入
        Dim ans = ""
        Dim a, b As Integer
        a = InputBox("a = ", "P4.求最小公倍數lcm", 0)
        b = InputBox("b = ", "P4.求最小公倍數lcm", 0)
        ans &= lcm(a, b)
        '輸出
        Me.TextBox5.Text = ans
 
        'P5
        '開
        '輸入
        FileOpen(1, "P5.in", OpenMode.Input)
        Dim ans = ""
        Dim a, b As Integer
        Do While Not EOF(1)
            Input(1, a) : Input(1, b)
            ans &= lcm(a, b)
            ans &= If(EOF(1), "", vbNewLine)
        Loop

        '關
        FileClose()
        '處理
        '輸出
        Me.TextBox6.Text = ans
        My.Computer.FileSystem.WriteAllText("P5.out", ans, False)
 
        'Q1
        '開
        '輸入
        FileOpen(1, "Q1.in", OpenMode.Input)
        Dim ans = ""
        Dim s As String
        Do Until EOF(1)
            Input(1, s)
        Loop
        '關
        FileClose()
        '處理
        Dim i As Integer
        For i = 1 To s
            For j = 1 To i
                ans &= j
            Next
            ans &= If(i = s, "", vbNewLine)
        Next
        '輸出
        Me.TextBox9.Text = ans
        My.Computer.FileSystem.WriteAllText("Q1.out", ans, False)
 
        'Q2
        '開
        '輸入
        FileOpen(1, "Q2.in", OpenMode.Input)
        Dim ans = ""
        Dim n As String
        Do Until EOF(1)
            Input(1, n)
            ans &= Quo(n)
            ans &= If(EOF(1), "", vbNewLine)
        Loop

        '關
        FileClose()
        '輸出
        Me.TextBox10.Text = ans
        My.Computer.FileSystem.WriteAllText("Q2.out", ans, False)
 
        'Q3
        '輸入
        Dim ans = ""
        Dim a, b As Integer
        a = InputBox("a = ", "Ｑ3.求GCD1", 0)
        b = InputBox("b = ", "Ｑ3.求GCD1", 0)
        ans &= GCD1(a, b)
        '輸出
        Me.TextBox8.Text = ans
 
        'Q4
        '開
        '輸入
        FileOpen(1, "Q4.in", OpenMode.Input)
        Dim ans = ""
        Dim a, b As Integer
        Do While Not EOF(1)
            Input(1, a) : Input(1, b)
            ans &= GCD1(a, b)
            ans &= If(EOF(1), "", vbNewLine)
        Loop

        '關
        FileClose()
        '處理
        '輸出
        Me.TextBox7.Text = ans
        My.Computer.FileSystem.WriteAllText("Q4.out", ans, False)

        'Q5
        '輸入
        '開
        FileOpen(1, "Q5.in", OpenMode.Input)
        Dim ans, no As String
        Dim chi, eng, mat As Integer
        Do While Not EOF(1)
            Input(1, no) : Input(1, chi) : Input(1, eng) : Input(1, mat)
            Dim avg As Single
            avg = (chi + eng + mat) / 3
            ans &= no & "," & Format(avg, "##0.0")
            ans &= If(EOF(1), "", vbNewLine)
        Loop
        '關
        FileClose()

        Me.TextBox11.Text = ans
        My.Computer.FileSystem.WriteAllText("Q5.out", ans, False)


~~~~~~~~~~~~~~~~~~~~~~~模組~~~~~~~~~~~~~~~~~~~~~~~
    Function Bin(n)
        If n < 2 Then
            Return n
        Else
            Return Bin(n \ 2) & (n Mod 2)
        End If
    End Function
    'GCD
    Function GCD(a, b)
        If b = 0 Then
            Return a
        Else
            Return GCD(b, a Mod b)
        End If
    End Function
    'lcm
    Function lcm(a, b)
        Return a * b / GCD(a, b)
    End Function
    Function Quo(n)
        If n < 4 Then
            Return n
        Else
            Return Quo(n \ 4) & (n Mod 4)
        End If
    End Function
    'GCD1
    Function GCD1(a, b)
        If b = 0 Then
            Return a
        Else
            Return GCD1(b, a Mod b)
        End If
~~~~~~~~~~~~~~~~~~~~~~~結果~~~~~~~~~~~~~~~~~~~~~~~

1230

        'a001
        '開檔
            FileOpen(1, "a001.in", OpenMode.Input)
        '輸入
        '處理
        Dim s, ans As String
        Do Until EOF(1)   '一直做到檔尾
            Input(1, s)  '讀一筆
            ans &= "hello, " & s & If(EOF(1), "", vbNewLine)
        Loop
        '關檔
        FileClose()  '全關
        '輸出
        Me.TextBox1.Text = ans
        My.Computer.FileSystem.WriteAllText("a001.out", ans, False)
   
        'A7. 讀入第 A1 題的輸入檔(A1.in),由大到小排序後,依序將「奇數」輸出到輸出檔(A7.out)。
        '開檔
        FileOpen(1, "A1.in", OpenMode.Input)
        '輸入
        '處理
        Dim ans = ""
        Dim d() As Integer  '動態宣告
        Dim cnt = -1       '計數器
        Do Until EOF(1)
            cnt += 1
            ReDim Preserve d(cnt)   '調整資料大小
            Input(1, d(cnt))
        Loop
        '關檔
        FileClose()
        Array.Sort(d)
        Array.Reverse(d)    '反轉
        For i = 0 To UBound(d)
            ans &= If(d(i) Mod 2 <> 0, d(i) & vbNewLine, "")
        Next
        '輸出
        Me.TextBox2.Text = ans
        My.Computer.FileSystem.WriteAllText("A7.out", ans, False)
   
        'A5. 讀入學生成績檔(A5.csv, 不只一筆),計算所有學生的數學平均、計概平均。
        '開檔
        FileOpen(1, "A5.csv", OpenMode.Input)
        '表頭
        '輸入
        Dim tt1, tt2, tt3, tt4
        Input(1, tt1) : Input(1, tt2) : Input(1, tt3) : Input(1, tt4)
        Dim no(1000) As String   '座號
        Dim d(1000, 2) As Single '成績
        Dim cnt = -1
        Do While Not EOF(1)
            cnt += 1
            Input(1, no(cnt)) : Input(1, d(cnt, 0)) : Input(1, d(cnt, 1)) : Input(1, d(cnt, 2))
        Loop
        '關檔
        FileClose()
        '處理
        Dim mathttl As Single = 0, bccttl As Double = 0
        For i = 0 To cnt
            bccttl += d(i, 0)
            mathttl += d(i, 2)
        Next
        Dim ans = "數學平均,計概平均" & vbNewLine
        ans &= Format(mathttl / (cnt + 1), "#0.0") & "," & Format(bccttl / (cnt + 1), "#0.0")
        Me.TextBox3.Text = ans
        My.Computer.FileSystem.WriteAllText("A5-out.csv", ans, False)
   
        'A4. 利用廻圈控制指令,由輸入檔(A4.in,只有一筆)讀入整數數字,列印從 1 開始直到該數字為止之直角三角形。
        '開檔
        FileOpen(1, "A4.in", OpenMode.Input)
        '輸入
        '處理
        Dim s As String
        Dim ans = ""
        Do Until EOF(1)
            Input(1, s)
        Loop
        Dim j As Integer
        For j = 1 To s
            For i = 1 To j
                ans &= i
            Next
            ans &= vbNewLine
        Next
        '關檔
        FileClose()
        '輸出
        Me.TextBox4.Text = ans
   
        'A2. 數字轉地支
        '開檔
        FileOpen(1, "A2.in", OpenMode.Input)
        '輸入
        '處理
        Dim s As String
        Dim ans = ""
        Do Until EOF(1)
            Input(1, s)
            ans &= D2Di(s)
        Loop
        '關檔
        FileClose()
        '輸出      
        Me.TextBox5.Text = ans
 
        'B1. 利用廻圈控制指令,由輸入檔(B1.in,只有一筆)讀入整數數字,列印從 1 開始直到該數字為止之直角三角形。
        '開檔
        FileOpen(1, "B1.in", OpenMode.Input)
        '輸入
        '處理
        Dim s As String
        Dim ans = ""
        Do Until EOF(1)
            Input(1, s)
        Loop
        Dim j As Integer
        For j = 1 To s
            For i = 1 To j
                ans &= i
            Next
            ans &= vbNewLine
        Next
        '關檔
        FileClose()
        '輸出
        Me.TextBox7.Text = ans

        'B3. 數字轉天干
        '開檔
        FileOpen(1, "B3.in", OpenMode.Input)
        '處理
        Dim s As String
        Dim ans = ""
        Do Until EOF(1)
            Input(1, s)
            ans &= D2Ten(s)
        Loop
        '關檔
        FileClose()
        '輸出
        Me.TextBox6.Text = ans
   
        'A3. 算術運算+檔案
        '開檔
        FileOpen(1, "A3.in", OpenMode.Input)
        '輸入

        Dim ans = ""
        Dim a(), b() As Integer  '動態宣告
        Dim cnt = -1    '計數器
        Do Until EOF(1)
            cnt += 1
            ReDim Preserve a(cnt)
            ReDim Preserve b(cnt)
            Input(1, a(cnt))
            Input(1, b(cnt))
        Loop
        '處理
        For i = 0 To UBound(a)
            ans &= a(i) \ b(i) & ", " & Math.Abs(a(i) - b(i)) & If(i = UBound(b), "", vbNewLine)
        Next
        '關檔
        FileClose()
        '輸出
        Me.TextBox8.Text = ans
        My.Computer.FileSystem.WriteAllText("A3.out", ans, False)
 
        'A1. 讀入輸入檔(A1.in,內容為 1 至 13 之間的整數若干筆),計算各數字出現的次數。
        '開檔
        FileOpen(1, "A1.in", OpenMode.Input)
        '輸入
        Dim ans = ""
        Dim a(), b() As Integer  '動態宣告
        Dim cnt = -1    '計數器
        Do Until EOF(1)
            cnt += 1
            ReDim Preserve a(cnt)
            ReDim Preserve b(cnt)
            Input(1, a(cnt))
        Loop
        '處理
        For Each p In a  '陣列
            b(p) += 1
        Next
        '關檔
        FileClose()
        '輸出
        ans &= RSet("數字", 2) & "   " & "次數" & vbNewLine
        For i = 1 To 13
            ans &= RSet(i, 2) & "      " & b(i) & vbNewLine
        Next
        Me.TextBox9.Text = ans

~~~~~~~~~~~~~~~~~~~~~~~模組~~~~~~~~~~~~~~~~~~~~~~~
    '查表
    Function D2Di(s)
        Dim c() = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
        Dim ans = ""
        '轉地支
        For i = 1 To Len(s)
            ans &= c(Val(Mid(s, i, 1)))
        Next
        Return ans
    End Function
    '查表
    Function D2Ten(s)
        Dim c() = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
        Dim ans = ""
        '轉天干
        For i = 1 To Len(s)
            ans &= c(Val(Mid(s, i, 1)))

        Next
        Return ans
    End Function

~~~~~~~~~~~~~~~~~~~~~~~結果~~~~~~~~~~~~~~~~~~~~~~~

1223

        'p37.數字轉國字大寫
        '輸入
        Dim s As String ' = InputBox("數字 = ", "數字轉國字大寫", 0)
        Try
            s = My.Computer.FileSystem.ReadAllText("p37.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '處理 依序剪下每個字元查表轉換
        '拆成列
        Dim row = Split(s, vbNewLine)
        Dim ans = ""
        For j = 0 To UBound(row)
            ans &= D2C(row(j))
            ans &= If(j = UBound(row), "", vbNewLine)
        Next
        '輸出
        Me.TextBox1.Text = ans

        'a001
        '讀入資料
        Dim fc As String
        Try
            fc = My.Computer.FileSystem.ReadAllText("a001.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '資料字串拆成列
        Dim row = Split(fc, vbNewLine)
        '處理
        Dim ans = ""
        'For Each i In row
        'ans &= "hello, " & i & vbNewLine
        'Next
        For i = 0 To UBound(row)
            ans &= "hello, " & row(i) & If(i = UBound(row), "", vbNewLine)
        Next
        '輸出
        Me.TextBox2.Text = ans
        My.Computer.FileSystem.WriteAllText("a001.out", ans, False)
 

        'A3. 算術運算+檔案
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("A3.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim ans = ""
        Dim data
        For j = 0 To UBound(row)
            data = Split(row(j), ",")
            Dim a, b As Integer
            a = data(0)
            b = data(1)
            ans &= a \ b & ", " & Math.Abs(a - b) & If(j = UBound(row), "", vbNewLine)
        Next
        '輸出
        Me.TextBox3.Text = ans
        My.Computer.FileSystem.WriteAllText("A3.out", ans, False)
 
        'A2. 數字轉地支
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("A2.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim ans = ""
        For j = 0 To UBound(row)
            ans &= D2Di(row(j))
            ans &= If(j = UBound(row), "", vbNewLine)
        Next
        '輸出
        Me.TextBox4.Text = ans
 
        'A1
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("A1.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim a(13)
        For Each p In row  '陣列
            a(p) += 1
        Next
        '輸出
        Dim ans = RSet("數字", 2) & "   " & "次數" & vbNewLine
        For i = 1 To 13
            ans &= RSet(i, 2) & "      " & a(i) & vbNewLine
        Next
        Me.TextBox5.Text = ans

        'B1
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("B1.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim ans = ""
        Dim j As Integer
        For j = 1 To s
            For i = 1 To j
                ans &= i
            Next
            ans &= vbNewLine
        Next
        '輸出
        Me.TextBox6.Text = ans
 
        'B2
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("B2.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim ans = ""
        Dim data
        For j = 0 To UBound(row)
            data = Split(row(j), ",")
            Dim a, b As Integer
            a = data(0)
            b = data(1)
            ans &= a \ b & ", " & a Mod b & If(j = UBound(row), "", vbNewLine)
        Next
        '輸出
        Me.TextBox7.Text = ans
        My.Computer.FileSystem.WriteAllText("B2.out", ans, False)
   
        'B3 數字轉天干
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("B3.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim ans = ""
        For j = 0 To UBound(row)
            ans &= D2Ten(row(j))
            ans &= If(j = UBound(row), "", vbNewLine)
        Next
        '輸出
        Me.TextBox9.Text = ans
   
        'B6
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("B6.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim a(6)
        For Each p In row  '陣列
            a(p) += 1
        Next
        '輸出
        Dim ans = RSet("數字", 2) & "   " & "次數" & vbNewLine
        For i = 1 To 6
            ans &= RSet(i, 2) & "      " & a(i) & vbNewLine
        Next
        Me.TextBox8.Text = ans
 
        'A4
        '輸入
        Dim s As String
        Try
            s = My.Computer.FileSystem.ReadAllText("A4.in")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        '拆成列
        Dim row = Split(s, vbNewLine)
        '處理
        Dim ans = ""
        Dim j As Integer
        For j = 1 To s
            For i = 1 To j
                ans &= i
            Next
            ans &= vbNewLine
        Next
        '輸出
        Me.TextBox10.Text = ans

~~~~~~~~~~~~~~~~~~~~~~~模組~~~~~~~~~~~~~~~~~~~~~~~

    '查表 陣列
    Function D2C(s)
        Dim c() = {"零", "壹", "貳", "參", "肆", "伍", "陸", "柒", "捌", "玖"}
        Dim ans = ""
        '轉國字
        For i = 1 To Len(s)
            ans &= c(Val(Mid(s, i, 1)))
        Next
        Return ans
    End Function
    '查表
    Function D2Di(s)
        Dim c() = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
        Dim ans = ""
        '轉地支
        For i = 1 To Len(s)
            ans &= c(Val(Mid(s, i, 1)))
        Next
        Return ans
    End Function
    '查表
    Function D2Ten(s)
        Dim c() = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
        Dim ans = ""
        '轉天干
        For i = 1 To Len(s)
            ans &= c(Val(Mid(s, i, 1)))
        Next
        Return ans
    End Function

~~~~~~~~~~~~~~~~~~~~~~~結果~~~~~~~~~~~~~~~~~~~~~~~