七回忌

今日は祖父の七回忌でした。つまりもう丸六年になります。祖父のはこのブログを始める少し前に既に亡くなっていたので、このブログでは思い出の形でしか書かれていません。

祖父の七回忌は家族全員で、いつものお寺さんで迎えられたことを喜びつつ、祖父のことがかなり自分の中で薄れてきているのを嫌でも感じたという意味で、少し苦かった。ああ、これが現実なんだなと。

確かに丸六年もの間ずっと祖父の死を悲しんでいては何も出来ない。そこはやはり今のこの世の中について「被災していない人たちは、被災した人の分も元気にいつも通り仕事や勉強をするべき」と言う人がいたり、もしくはそれ町とか、そういう論理に似ているものがあると思う。

それは割と祖父が死んでそれほど間もない頃から意識していた。だから僕のスタンスは「祖父のことを忘れなければ良い」というものだった。それくらいのことはいくらなんでも出来るだろうと。

だが今日、お経を唱えながらわずかな時間の中でも祖父のことを思いだそうとしたが、ほぼ何もと言っていいほど、具体的なことは思い出せない。6年前の今日までの日常の中で彼がどういう立ち位置であったかなどがかなり朧気であった。

ある意味で今日祖父の死を再認識させられたような気がした。もう動かない、もう喋らない、などではなく、その人のいない日常が日常となることもまた、現実的な死の影響だと思う。

考えてみれば、人とご飯を一緒に食べて面白いと思った話を、ご飯が終わった後に列挙することすら難しいのだから、6年も関わりのない人のことなど、大部分を忘れて当然だ。ただそれでも、「忘れない≠覚えている」の意味で自分を慰めあるいは目を反らさせてきたのに、こんなに覚えていないのはショックで仕方がなかった。

それでも自分が非常に祖父に可愛がられてきたことに関しては、まだ何とか覚えている印象の中で強い。この点はなんというか、感謝するようなことではないのかもしれないけど、たまに祖父の話題を振る母に感謝をせざるを得ない感じがする。

時の流れは残酷だ。とにかくこれが言いたかった。今日もまだ4時間半弱残っているわけだし、もう少しくらい祖父のことを考えてみようと思う。

今日の日記を書くつもりが、思いの外長くなったので、かるたその他についてはもう一本エントリ書きます。

Project Euler #23 memo

後回しにしていましたがようやく出来ました。
これで胸を張ってレベル2です。

    Sub Main()
        Dim i, j, t, n, h, k, q, r, ans As Integer
        Dim extra(6966) As Integer
        n = -1
        For i = 1 To 28123
            h = 0
            q = 1
            r = 1
            t = i
            Do While t Mod 2 = 0
                t = t / 2
                h = h + 1
                q = q + 2 ^ h
            Loop
            r = r * q
            k = 1
            Do Until t = 1
                h = 0
                q = 1
                k = k + 2
                Do While t Mod k = 0
                    t = t / k
                    h = h + 1
                    q = q + k ^ h
                Loop
                If h <> 0 Then
                    r = r * q
                End If
            Loop
            If r - i > i Then
                Console.WriteLine(i)
                n = n + 1
                extra(n) = i
            End If
        Next
        ans = 0
        Console.WriteLine(" ")
        For n = 1 To 28123
            For i = 0 To 6966
                For j = i To 6966
                    If n = extra(i) + extra(j) Then
                        Exit For
                    ElseIf n < extra(i) + extra(j) Then
                        Exit For
                    End If
                Next
                If j <> 6967 Then
                    If n = extra(i) + extra(j) Then
                        Exit For
                    End If
                End If
            Next
            If i = 6967 And j = 6967 Then
                Console.WriteLine(n)
                ans = ans + n
            End If
        Next
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer")
        Console.ReadLine()
    End Sub

Project Euler #48 memo

瞬殺。

    Sub Main()
        Dim i, j As Integer
        Dim r, ans As Long
        ans = 405071317
        For i = 11 To 1000
            r = 1
            For j = 1 To i
                r = r * i
                r = r Mod 10000000000
            Next
            ans = (ans + r) Mod 10000000000
        Next
        If ans = ans Mod 1000000000 Then
            ans.ToString()
            ans = "0" & ans
        End If
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer")
        Console.ReadLine()
    End Sub

Project Euler #44 memo

IsDecimalメソッドはVB.NET – 数値が小数を含むかどうかをチェックするを拝借しました。

    Sub Main()
        Dim ans, i, n As Integer
        Dim p(50000) As Integer
        p(1) = 1
        ans = 0
        n = 1
        Do While ans = 0
            p(n + 1) = (n + 1) * (3 * (n + 1) - 1) / 2
            For i = n To 1 Step -1
                If IsDecimal((1 + Sqrt(1 + 24 * (p(n + 1) - p(i)))) / 6) = False And IsDecimal((1 + Sqrt(1 + 24 * (p(n + 1) + p(i)))) / 6) = False Then
                    ans = p(n + 1) - p(i)
                    Exit For
                End If
            Next
            n = n + 1
        Loop
        Console.WriteLine(p(n) & "," & p(i))
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

3/20-22

20日

バイト。一週間ぶりに外出して目がくらんだ。

21日

高校ブラバンのOB交流会。その前に元帥と食事。久々に色々話せて楽しかった。
運営委員長として、予期している以上に大きな苦労が待ち受けているだろうし、苦労という言葉では済まない辛いことがありそう。
ただ自分はいつまでも小学生だし、中学生だし、高校生なので、アホなこととは思っていても、自分が傷つかないところまではやはり人を信じてやっていくしかないんだろうなと思った。どうしたものかね。色々話を聞いてるだけでも、辛いところはあった。

22日

かるた。間引き運転で3本目にも間に合わず、4本目だけ。
やはり1試合で調子が戻るはずもなくボロボロ。出来ることなら明日も練習に行きたいな。

Project Euler #43 memo

パンデジタル数はもう怖くない。

    Sub Main()
        Dim w(9) As String
        Dim n, r As Long
        Dim p(9) As Long
        Dim a, b, c, d, e, f, g, h, i As Integer
        n = 0
        r = 0
        w(0) = "0123456789"
        For a = 1 To 9
            p(0) = CInt(Asc(w(0).Chars(a)) - 48)
            w(1) = w(0).Remove(a, 1)
            For b = 0 To 8
                p(1) = CInt(Asc(w(1).Chars(b)) - 48)
                w(2) = w(1).Remove(b, 1)
                For c = 0 To 7
                    p(2) = CInt(Asc(w(2).Chars(c)) - 48)
                    w(3) = w(2).Remove(c, 1)
                    For d = 0 To 6
                        p(3) = CInt(Asc(w(3).Chars(d)) - 48)
                        w(4) = w(3).Remove(d, 1)
                        For e = 0 To 5
                            p(4) = CInt(Asc(w(4).Chars(e)) - 48)
                            w(5) = w(4).Remove(e, 1)
                            For f = 0 To 4
                                p(5) = CInt(Asc(w(5).Chars(f)) - 48)
                                w(6) = w(5).Remove(f, 1)
                                For g = 0 To 3
                                    p(6) = CInt(Asc(w(6).Chars(g)) - 48)
                                    w(7) = w(6).Remove(g, 1)
                                    For h = 0 To 2
                                        p(7) = CInt(Asc(w(7).Chars(h)) - 48)
                                        w(8) = w(7).Remove(h, 1)
                                        For i = 0 To 1
                                            p(8) = CInt(Asc(w(8).Chars(i)) - 48)
                                            w(9) = w(8).Remove(i, 1)
                                            p(9) = CInt(w(9))
                                            n = 1000000000 * p(0) + 100000000 * p(1) + 10000000 * p(2) + 1000000 * p(3) + 100000 * p(4) + 10000 * p(5) + 1000 * p(6) + 100 * p(7) + 10 * p(8) + p(9)
                                            Console.WriteLine(n)
                                            If (100 * p(1) + 10 * p(2) + p(3)) Mod 2 = 0 And (100 * p(2) + 10 * p(3) + p(4)) Mod 3 = 0 And (100 * p(3) + 10 * p(4) + p(5)) Mod 5 = 0 And (100 * p(4) + 10 * p(5) + p(6)) Mod 7 = 0 And (100 * p(5) + 10 * p(6) + p(7)) Mod 11 = 0 And (100 * p(6) + 10 * p(7) + p(8)) Mod 13 = 0 And (100 * p(7) + 10 * p(8) + p(9)) Mod 17 = 0 Then
                                                r = r + n
                                            End If
                                        Next
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
        Console.WriteLine(r)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #42 memo

    Sub Main()
        Dim i, j, h, k, ans As Integer
        Dim tmp As String
        Dim str As String()
        Dim triangle As Integer
        Dim txt As New System.IO.StreamReader("C:\Documents and Settings\Owner\My Documents\Visual Studio 2008\Projects\Euler\Euler\problem42.txt")
        While txt.Peek() > -1
            i = i + 1
            tmp = txt.ReadLine
        End While
        txt.Close()
        str = tmp.Split(",")
        ans = 0
        For i = 1 To str.Length
            h = 0
            For j = 0 To str(i - 1).Length - 1
                h = h + (Asc(str(i - 1).Chars(j)) - 64)
            Next
            Console.WriteLine(str(i - 1) & ":" & h)
            triangle = 0
            For k = 1 To 100
                triangle = triangle + k
                If h = triangle Then
                    ans = ans + 1
                    Exit For
                ElseIf triangle > h Then
                    Exit For
                End If
            Next
        Next
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer")
        Console.ReadLine()


    End Sub

Project Euler #39 memo

これまた案外あっさり。

    Sub Main()
        Dim a, b, c, p As Integer
        Dim n, nmax, nmaxp As Integer

        For p = 6 To 1000
            n = 0
            For c = 1 To Int(p / 2)
                a = 1
                b = p - a - c
                Do Until a > b
                    If a ^ 2 + b ^ 2 = c ^ 2 Then
                        Console.WriteLine("{" & a & "," & b & "," & c & "}")
                        n = n + 1
                    End If
                    a = a + 1
                    b = b - 1
                Loop
            Next
            Console.WriteLine("p=" & p & ", n=" & n)
            If n > nmax Then
                nmax = n
                nmaxp = p
            End If
        Next
        Console.WriteLine("nmaxp:" & nmaxp)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #38 memo

あんまり汎用的ではないけど、パンデジタル数判定のための関数部分は自作しました。

    Sub Main()
        Dim ans, i, j As Integer
        Dim t As String
        ans = 0
        For i = 1 To 9999
            t = ""
            For j = 1 To 9
                t = t & CStr(i * j)
                If t.Length > 9 Then
                    Exit For
                ElseIf t.Length = 9 Then
                    Exit For
                End If
            Next
            If t.Length = 9 And isunique(t) = True Then
                Console.WriteLine(i & "*" & j & "=" & t)
                If CInt(t) > ans Then
                    ans = CInt(t)
                End If
            End If
        Next
        Console.WriteLine("max:" & ans)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub


    Function isunique(ByVal s As String) As Boolean
        Dim i, j As Integer
        For i = 0 To 8
            If s.Chars(i) = "0" Then
                Return False
            End If
            For j = 0 To 8
                If i <> j And s.Chars(i) = s.Chars(j) Then
                    Return False
                End If
            Next
        Next
        Return True

    End Function

Project Euler #34 memo

答えはあっさりでびっくり。いいのかこれ。

    Sub Main()
        Dim a(9) As Integer
        a(0) = 1
        a(1) = 1
        a(2) = 2
        a(3) = 6
        a(4) = 24
        a(5) = 120
        a(6) = 720
        a(7) = 5040
        a(8) = 40320
        a(9) = 362880
        Dim ans, d, i, j, n, t As Integer
        ans = 0
        For i = 3 To 9999999
            d = Int(System.Math.Log10(i))
            t = i
            n = 0
            For j = d To 1 Step -1
                n = n + a(Int(t / (10 ^ j)))
                t = t Mod (10 ^ j)
            Next
            n = n + a(t)
            If n = i Then
                Console.WriteLine(i)
                ans = ans + i
            End If
        Next
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #32 memo

いかにも頭悪そうなコードですが、5秒で答え出たんで許してくだしあ。

    Sub Main()
        Dim w(8) As String
        Dim i, n, r As Integer
        Dim p(8) As Integer
        Dim a, b, c, d, e, f, g, h As Integer
        Dim ans(4000) As Integer
        n = 0
        r = 0
        w(0) = "123456789"
        For a = 0 To 8
            p(0) = CInt(Asc(w(0).Chars(a)) - 48)
            w(1) = w(0).Remove(a, 1)
            For b = 0 To 7
                p(1) = CInt(Asc(w(1).Chars(b)) - 48)
                w(2) = w(1).Remove(b, 1)
                For c = 0 To 6
                    p(2) = CInt(Asc(w(2).Chars(c)) - 48)
                    w(3) = w(2).Remove(c, 1)
                    For d = 0 To 5
                        p(3) = CInt(Asc(w(3).Chars(d)) - 48)
                        w(4) = w(3).Remove(d, 1)
                        For e = 0 To 4
                            p(4) = CInt(Asc(w(4).Chars(e)) - 48)
                            w(5) = w(4).Remove(e, 1)
                            For f = 0 To 3
                                p(5) = CInt(Asc(w(5).Chars(f)) - 48)
                                w(6) = w(5).Remove(f, 1)
                                For g = 0 To 2
                                    p(6) = CInt(Asc(w(6).Chars(g)) - 48)
                                    w(7) = w(6).Remove(g, 1)
                                    For h = 0 To 1
                                        p(7) = CInt(Asc(w(7).Chars(h)) - 48)
                                        w(8) = w(7).Remove(h, 1)
                                        p(8) = CInt(w(8))
                                        If p(0) * (1000 * p(1) + 100 * p(2) + 10 * p(3) + p(4)) = 1000 * p(5) + 100 * p(6) + 10 * p(7) + p(8) Or (10 * p(0) + p(1)) * (100 * p(2) + 10 * p(3) + p(4)) = 1000 * p(5) + 100 * p(6) + 10 * p(7) + p(8) Then
                                            For i = 0 To n
                                                If ans(i) = 1000 * p(5) + 100 * p(6) + 10 * p(7) + p(8) Then
                                                    Exit For
                                                End If
                                                If i = n Then
                                                    ans(n) = 1000 * p(5) + 100 * p(6) + 10 * p(7) + p(8)
                                                    Console.WriteLine(ans(n))
                                                    n = n + 1
                                                    Exit For
                                                End If
                                            Next
                                        End If
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
        For i = 0 To n - 1
            r = r + ans(i)
        Next
        Console.WriteLine(r)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #31 memo

頭の悪いやり方。

    Sub Main()
        Dim i, j, k, l, m, n, o, p, ans As Integer
        ans = 0
        For i = 0 To 1
            If i = 1 Then
                ans = ans + 1
                Exit For
            End If
            For j = 0 To 2
                For k = 0 To 4
                    For l = 0 To 10
                        For m = 0 To 20
                            For n = 0 To 40
                                For o = 0 To 100
                                    For p = 0 To 200
                                        If i * 200 + j * 100 + k * 50 + l * 20 + m * 10 + n * 5 + o * 2 + p * 1 = 200 Then
                                            ans = ans + 1
                                            Console.WriteLine("200*" & i & "*100*" & j & "*50*" & k & "*20*" & l & "*10*" & m & "*5*" & n & "*2*" & o & "*1*" & p)
                                        End If
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #30 memo

#29はあんなに苦労したのに、30は驚くほどあっさりクリア。

    Sub Main()
        Dim ans, d, i, j As Integer
        Dim a As Integer
        ans = 0
        For i = 2 To 9 ^ 6
            a = 0
            d = Int(System.Math.Log10(i))
            For j = 0 To d
                a = a +*1 - 48) ^ 5)
                If a > i Then
                    Exit For
                End If
                If j = d And a = i Then
                    Console.WriteLine(i)
                    ans = ans + i
                End If
            Next
        Next
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub
  1. Asc(i.ToString.Chars(j [元リンク]

Project Euler #28 memo

本当に、考えることをさせず、ただ計算をさせただけ、みたいな。電卓みたいな。だからすっきり。

    Sub Main()
        Dim i, j, n, ans As Integer
        n = 1
        j = 2
        ans = 1
        Do Until n = 1001 * 1001
            For i = 1 To 4
                n = n + j
                ans = ans + n
            Next
            j = j + 2
        Loop
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #25 memo

これも案外あっさり。求められているのが項数なのと足し算なのが二重に楽ね。

    Sub Main()
        Dim a(999) As Integer
        Dim b(999) As Integer
        Dim c(999) As Integer
        Dim i, j, h As Integer
        a(0) = 1
        b(0) = 1
        j = 2
        Do Until b(999) <> 0
            For i = 0 To 999
                c(i) = a(i) + b(i) + h
                h = (c(i) - c(i) Mod 10) / 10
                c(i) = c(i) Mod 10
            Next
            For i = 0 To 999
                a(i) = b(i)
                b(i) = c(i)
                c(i) = 0
            Next
            j = j + 1
        Loop
        Console.WriteLine(j)
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #22 memo

案外あっさり。

    Sub Main()
        Dim i, j, h, ans As Integer
        Dim tmp As String
        Dim str As String()
        Dim txt As New System.IO.StreamReader("ファイルパス")

        While txt.Peek() > -1
            i = i + 1
            tmp = txt.ReadLine
        End While
        txt.Close()
        str = tmp.Split(",")
        Array.Sort(str)
        For i = 1 To str.Length
            h = 0
            For j = 1 To str(i - 1).Length
                h = h + (Asc(str(i - 1).Chars(j - 1)) - 64)
            Next
            ans = ans + h * i
            Console.WriteLine(str(i - 1))
        Next
        Console.WriteLine(ans)
        Console.WriteLine("This is the answer")
        Console.ReadLine()
    End Sub

Project Euler #21 memo

友愛数のペアの和を求める。あんまりスマートじゃない。

    Sub Main()
        Dim i, j, k, t, h, ans, s As Integer
        Dim d(9998) As Integer
        For i = 2 To 9999
            h = 0
            t = i
            Do While t Mod 2 = 0
                t = t / 2
                h = h + 1
            Loop
            If h <> 0 Then
                For j = 0 To h
                    d(i - 1) = d(i - 1) + System.Math.Pow(2, j)
                Next
            End If
            k = 1
            Do Until t = 1
                h = 0
                k = k + 2
                Do While t Mod k = 0
                    t = t / k
                    h = h + 1
                Loop
                For j = 0 To h
                    s = s + System.Math.Pow(k, j)
                Next
                d(i - 1) = d(i - 1) * s
                s = 0
            Loop
            d(i - 1) = d(i - 1) - i
            For j = 0 To i - 2
                If d(i - 1) = j + 1 And d(j) = i Then
                    Console.WriteLine(j + 1 & "and" & i)
                    ans = ans + i + j + 1
                End If
            Next
        Next
        Console.WriteLine("sum:" & ans)
        Console.WriteLine("This is the answer")
        Console.ReadLine()
    End Sub

Project Euler Problem #20

多倍長整数とか知らないので、筆算させちゃいます。

Dim int(199) As Integer
Dim ans, i, j, d, h As Integer
Dim tmp As String


Sub Main()
    d = 0
    h = 0
    int(0) = 1
    For i = 2 To 100
        calc()
        For j = d To 0 Step -1
            tmp = tmp & CStr(int(j))
        Next
        Console.WriteLine(i & " : " & tmp)
        tmp = ""
    Next
    For i = d To 0 Step -1
        ans = ans + int(i)
    Next
    Console.WriteLine(ans)
    Console.WriteLine("This is the answer.")
    Console.ReadLine()
End Sub


Sub calc()
    For j = 0 To d
        int(j) = int(j) * i + h
        h = (int(j) - (int(j) Mod 10)) / 10
        int(j) = int(j) Mod 10
        If j = d And h <> 0 Then
            Do Until h = 0
                d = d + 1
                int(d) = h Mod 10
                h = (h - h Mod 10) / 10
            Loop
            Exit For
        End If
    Next
End Sub

Project Euler #19 memo

アルゴリズムは一瞬で浮かぶけど、動かすのは結構手こずりました。
実は戻り値を持つ関数を自分で作ったのは初めて。

    Dim y, m, d, ans As Integer

    Sub Main()
        d = 6   '1900年12月が土曜始まり
        For y = 1901 To 2000
            For m = 1 To 12
                Select Case m
                    Case 1, 2, 4, 6, 8, 9, 11
                        d = (d + 31) Mod 7
                        issundaystart()
                    Case 5, 7, 10, 12
                        d = (d + 30) Mod 7
                        issundaystart()
                    Case 3
                        d = (d + isuruu(y)) Mod 7
                        issundaystart()
                End Select
            Next
        Next
        Console.WriteLine("以上" & ans & "回")
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

    Function isuruu(ByVal year As Integer) As Integer
        If year Mod 4 = 0 Then
            Select Case year Mod 400
                Case 0
                    Return 1
                Case 100, 200, 300
                    Return 0
                Case Else
                    Return 1
            End Select
        Else
            Return 0
        End If
    End Function


    Sub issundaystart()
        If d = 0 Then
            ans = ans + 1
            Console.WriteLine(y & "年" & m & "月")
        End If
    End Sub

Project Euler #18 memo

アイデアはまーくんからいただきました。ごちゃごちゃしてるのはファイルの入力処理で、実際の処理はとても簡潔。嬉しい。
#67も14を99に、13を98に変えて、ファイルを差し替えたら、瞬殺でした。

    Sub Main()
        Dim str(14) As String
        Dim tmp(14) As String
        Dim int(14, 14) As Integer
        Dim times As Integer
        Dim txt As New System.IO.StreamReader("ファイルパス")
        Dim i As Integer = -1
        Dim s(14) As Integer
        Dim j As Integer
        While txt.Peek() > -1
            i = i + 1
            str(i) = txt.ReadLine
        End While
        txt.Close()
        For times = 0 To 14
            tmp = str(times).Split(" ")
            For i = 0 To times
                int(times, i) = CInt(tmp(i))
            Next
        Next
        For i = 0 To 14
            s(i) = int(14, i)   '最下段を和の配列に格納
        Next
        For i = 13 To 0 Step -1
            For j = 0 To i
                s(j) = int(i, j) + System.Math.Max(s(j), s(j + 1))
            Next
        Next
        Console.WriteLine(s(0))
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub

Project Euler #17 memo

結構苦労した・・・・・「five」を5文字とカウントしたり・・・・・。
あとやっぱりSelect case文嫌い。


Dim ans As Integer = 0
Dim i As Integer = 1

Sub Main()
For i = 1 To 1000
Select Case (i - (i Mod 100)) / 100
Case 1, 2, 6
Select Case i
Case 100, 200, 600
ans = ans + 10
Case Else
ans = ans + 13
ten()
End Select
Case 4, 5, 9
Select Case i
Case 400, 500, 900
ans = ans + 11
Case Else
ans = ans + 14
ten()
End Select
Case 3, 7, 8
Select Case i
Case 300, 500, 700, 800
ans = ans + 12
Case Else
ans = ans + 15
ten()
End Select
Case 10
ans = ans + 11
Exit For
Case Else
ten()
End Select
Next
Console.WriteLine(ans)
Console.WriteLine("This is the answer.")
Console.ReadLine()
End Sub

Sub ten()
Select Case*1 / 10
Case 0
one()
Case 1
oneop()
Case 4, 5, 6
ans = ans + 5
one()
Case 2, 3, 8, 9
ans = ans + 6
one()
Case 7
ans = ans + 7
one()
End Select
End Sub

Sub one()
Select Case i Mod 10
Case 1, 2, 6
ans = ans + 3
Case 4, 5, 9
ans = ans + 4
Case 3, 7, 8
ans = ans + 5
End Select
End Sub

Sub oneop()
Select Case i Mod 100
Case 10
ans = ans + 3
Case 11, 12
ans = ans + 6
Case 15, 16
ans = ans + 7
Case 13, 14, 18, 19
ans = ans + 8
Case 17
ans = ans + 9
End Select
End Sub

  1. i Mod 100) - (i Mod 10 [元リンク]

Project Euler #16 memo

繰り上がり手こずった・・・・・。


Sub Main()
Dim int(349) As Integer
Dim i, j, d, h, ans As Integer
int(0) = 2
d = 0
h = 0
For i = 2 To 1000
For j = 0 To d
If int(j) >= 5 Then
int(j) = (int(j) * 2 + h) Mod 10
h = 1
If j = d Then
d = d + 1
int(d) = 1
h = 0
Exit For
End If
Else
int(j) = (int(j) * 2 + h)
h = 0
End If
Next
Next
For j = 0 To d
ans = ans + int(j)
Next
Console.WriteLine("sum=" & ans)
Console.WriteLine("This is the answer.")
Console.ReadLine()
End Sub

Project Euler #14 memo

方針は楽に立つが、1分ルール違反ではある。どうやったらスピードアップを図れるのやら。

    Sub Main()
        Dim i, k As Integer
        Dim n As Long
        Dim ans(1) As Integer
        For i = 1 To 999999
            n = i
            k = 1
            Do Until n = 1
                If n Mod 2 = 0 Then
                    n = n / 2
                    k = k + 1
                Else
                    n = 3 * n + 1
                    k = k + 1
                End If
            Loop
            Console.WriteLine(i & ":k=" & k)
            If k > ans(0) Then
                ans(0) = k
                ans(1) = i
            End If
        Next
        Console.WriteLine("kmax=" & ans(0) & "(when i=" & ans(1) & ")")
        Console.WriteLine("This is the answer.")
        Console.ReadLine()
    End Sub