DouKaku?beta

Language detail: VB.net

Coverage: 31.08%
number of '+' ratings
 contribution for coverage

Unsolved challenges

show all

codes

Feed

Used modules

next >>

'('と')'の対応 (Nested Flatten)

#8098の続き。

C#で定義したCheckParenを呼び出す側です。 実行すると１行入力を読み込み、カッコの対応が取れていれば無言、不整合があれば例外を投げます。

C#、VB.netで、カッコ抜きで文字を出す良い方法があったら教えてください。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
Class StringException
    Inherits Exception
    Public Msg As String
    Public Overrides Function ToString As String
        Return Msg
    End Function
End Class

Module Vb
    Sub Main
        CheckParen.Testee = Console.ReadLine
        For Each s In CheckParen.Result
            If s <> "" Then
                Dim ex = New StringException
                ex.Msg = s
                Throw ex
            End If
        Next s
    End Sub
End Module
主にVB.netで。括弧文字の作り方を思いつかなかったのでC#さんに依頼。
協力すればどうにかなるもんです 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
==== VB.vb ====
Imports CSharp
Class ResultTrue
    Inherits Exception
End Class

Class ResultFalse
    Inherits Exception
End Class

Module Vb
    Sub MaIn
        Dim s = Console.ReadLIne
        Dim n = 0

        For Each c In s
            If c = Paren.Open Then
                n = n + 1
            Else If c = Paren.Close Then
                n = n - 1
            End If

            If n < 0 Then
                Throw New ResultFalse
            End If
        Next c

        If n <> 0 Then
            Throw New ResultFalse
        Else
            Throw New ResultTrue
        End If
    End Sub
End Module

==== CSharp.cs ====
namespace CSharp {
    public class Paren {
        public static char Open = '\x28';
        public static char Close = '\x29';
    }
}

==== コンパイル手順 ====
csc /target:library CSharp.cs
vbc /r:CSharp.dll VB.vb
漢数字で九九の表 (Nested Flatten) 
英語はみんなやってるのでローマ数字で
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Module Doukaku
    Enum Roman As Integer
        NONE
        I
        II
        III
        IV
        V
        VI
        VII
        VIII
        IX
        X
    End Enum
    Dim Japanize As String() = {"〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}
    Sub Main()
        For row As Roman = Roman.I To Roman.IX
            For col As Roman = Roman.I To Roman.IX
                Dim ans As Integer = row * col

                If ans < Roman.X Then
                    Console.Write("  ")
                    Console.Write(Japanize(ans))
                Else
                    Console.Write(Japanize(ans / Roman.X))
                    Console.Write(Japanize(ans Mod Roman.X))
                End If
                Console.Write(" ")
            Next
            Console.WriteLine("")
        Next
        Console.ReadLine()
    End Sub
End Module
α置換 (Nested Flatten) 
　まず、ソースファイルをVisualStudioで開きます。
　エディタにコードをコピペします。
　変更したい変数の宣言部で、変数名を書き替えます。
　変数の上にマウスを置くとアイコンが出るのでクリックします。
　”名前を[変数名]から[変数名]に変更します。"を選ぶとVisualStudioが全部自動でやってくれます。
指定コマンドを別プロセスで起動 (Nested Flatten)

VBScript です。 実行環境：Windows 。

1
2
3
4
5
6
7
8
9
Dim WSH, ExecObj
Set WSH = CreateObject("WScript.Shell")
Set ExecObj = WSH.Exec("hostname")
WScript.Echo "pid:" & ExecObj.processID
WScript.Echo "stdout: " & ExecObj.StdOut.ReadAll
WScript.Echo "exit: " & ExecObj.exitCode
WScript.Quit(ExecObj.exitCode)
Set ExecObj = Nothing
Set WSH = Nothing
コマンドライン引数の取得 (Nested Flatten)

VB.NETならMyがお手軽♪

1
2
3
4
5
6
7
8
Module Module1
    Sub Main( )
        For Each cmd As String In My.Application.CommandLineArgs
            Console.WriteLine(cmd)
        Next
        Console.ReadLine()
    End Sub
End Module
あみだくじ (Nested Flatten) 
適当。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Module Module1

    Sub Main()
        Dim input As String = _
            "A B C D E" & ControlChars.CrLf & _
            "| | |-| |" & ControlChars.CrLf & _
            "|-| | |-|" & ControlChars.CrLf & _
            "| |-| |-|" & ControlChars.CrLf & _
            "|-| |-| |" & ControlChars.CrLf & _
            "|-| | | |"

        Console.WriteLine(input)
        Console.WriteLine(GhostLeg(input))
        Console.ReadKey()
    End Sub

    Public Function GhostLeg(ByVal input As String) As String
        Dim inputlines As String() = input.Split(New String() {ControlChars.CrLf}, StringSplitOptions.RemoveEmptyEntries)
        Dim lines As String() = inputlines(0).Split(Nothing)
        For i As Integer = 1 To inputlines.Length - 1
            Dim bars As String() = inputlines(i).Split(New Char() {"|"c})
            For j As Integer = 1 To bars.Length - 2
                If bars(j) <> " " Then Dim s As String = lines(j) : lines(j) = lines(j - 1) : lines(j - 1) = s
            Next
        Next
        Return String.Join(" "c, lines)
    End Function


End Module
格子点の列挙 (Nested Flatten) 
少しメモリ消費量とか速度を考えて。
1000番目は(-8,16)、
1000000番目は(497,-267)、
100000000番目は(5554,-992)。
計算時間は200秒くらい。

もっと頭いい方法がありそうな。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Module Module1

    Sub Main()
        Dim e As IEnumerator(Of LatticePoint) = New LatticePointEnumerator()
        Dim i As Integer
        For i = 1 To 999
            e.MoveNext()
        Next
        e.MoveNext()
        Console.WriteLine(i.ToString() & ":" & e.Current.ToString())

        For i = 1001 To 999999
            e.MoveNext()
        Next
        e.MoveNext()
        Console.WriteLine(i.ToString() & ":" & e.Current.ToString())

        For i = 1000001 To 99999999
            e.MoveNext()
        Next
        e.MoveNext()
        Console.WriteLine(i.ToString() & ":" & e.Current.ToString())

        Console.ReadKey()
    End Sub

End Module

Public Class LatticePointEnumerator
    Implements IEnumerator(Of LatticePoint)

    Private _list As LinkedList(Of LatticePoint)
    Private _r As Integer
    Private _pointlist As List(Of LatticePoint)
    Private _enumerator As IEnumerator(Of LatticePoint)

    Public Sub New()
        _list = New LinkedList(Of LatticePoint)
        _pointlist = New List(Of LatticePoint)
        Reset()
    End Sub

    Public Sub Reset() Implements System.Collections.IEnumerator.Reset
        _list.Clear()
        _list.AddLast(New LatticePoint(0, 0))
        _list.AddLast(New LatticePoint(1, 0))
        _list.AddLast(New LatticePoint(1, 1))
        _list.AddLast(New LatticePoint(2, 0))
        _list.AddLast(New LatticePoint(2, 1))
        _list.AddLast(New LatticePoint(2, 2))
        _list.AddLast(New LatticePoint(3, 0))
        _list.AddLast(New LatticePoint(3, 1))
        _list.AddLast(New LatticePoint(3, 2))
        _list.AddLast(New LatticePoint(3, 3))
        _r = 4
        _pointlist.Clear()
        _enumerator = _pointlist.GetEnumerator()
    End Sub

    Public ReadOnly Property Current() As LatticePoint Implements System.Collections.Generic.IEnumerator(Of LatticePoint).Current
        Get
            Return _enumerator.Current
        End Get
    End Property

    Public ReadOnly Property Current1() As Object Implements System.Collections.IEnumerator.Current
        Get
            Return DirectCast(_enumerator, IEnumerator).Current
        End Get
    End Property

    Public Function MoveNext() As Boolean Implements System.Collections.IEnumerator.MoveNext
        If _enumerator.MoveNext() Then Return True

        If _list.First.Value._r2 >= _r * _r Then
            Dim node As LinkedListNode(Of LatticePoint)
            Dim p As LatticePoint
            node = _list.First
            For y As Integer = 0 To _r
                p = New LatticePoint(_r, y)
                While node IsNot Nothing AndAlso p._r2 > node.Value._r2
                    node = node.Next
                End While
                If node Is Nothing Then _list.AddLast(p) Else _list.AddBefore(node, p)
            Next
            _r += 1
        End If

        _pointlist.Clear()
        _pointlist.Add(_list.First.Value)
        _list.RemoveFirst()
        While _list.First.Value._r2 = _pointlist(0)._r2
            _pointlist.Add(_list.First.Value)
            _list.RemoveFirst()
        End While

        Dim j As Integer
        j = _pointlist.Count - 1
        If _pointlist(j).X = _pointlist(j).Y Then j -= 1
        For i As Integer = j To 0 Step -1
            _pointlist.Add(New LatticePoint(_pointlist(i).Y, _pointlist(i).X))
        Next
        j = _pointlist.Count - 1
        If _pointlist(j).X = 0 Then j -= 1
        For i As Integer = j To 0 Step -1
            _pointlist.Add(New LatticePoint(-_pointlist(i).X, _pointlist(i).Y))
        Next
        j = _pointlist.Count - 1
        If _pointlist(j).Y = 0 Then j -= 1
        For i As Integer = j To 1 Step -1
            _pointlist.Add(New LatticePoint(_pointlist(i).X, -_pointlist(i).Y))
        Next
        If _pointlist(0).Y <> 0 Then _pointlist.Add(New LatticePoint(_pointlist(0).X, -_pointlist(0).Y))

        _enumerator = _pointlist.GetEnumerator()
        _enumerator.MoveNext()

        Return True
    End Function

    Public Sub Dispose() Implements IDisposable.Dispose
    End Sub

End Class

Public Class LatticePoint
    Friend _x As Integer
    Friend _y As Integer
    Friend _r2 As Long

    Friend Sub New(ByVal x As Integer, ByVal y As Integer)
        _x = x
        _y = y
        _r2 = x * x + y * y
    End Sub

    Public ReadOnly Property X() As Integer
        Get
            Return _x
        End Get
    End Property

    Public ReadOnly Property Y() As Integer
        Get
            Return _y
        End Get
    End Property

    Public ReadOnly Property SquaredRadius() As Long
        Get
            Return _r2
        End Get
    End Property

    Public Overrides Function ToString() As String
        Return String.Format("({0}, {1}) [{2}]", _x.ToString(), _y.ToString(), _r2.ToString())
    End Function

End Class
全ての組み合わせ (Nested Flatten) 
長い…が、
VBならこんなもんなのかな？
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Module Module1

    Sub Main()
        Dim li As Integer() = New Integer() {1, 2, 3, 4, 5}
        Dim ls As Char() = New Char() {"a"c, "b"c, "c"c}

        Dim cpg As New CrossProductGenerator(li, ls)
        Dim e As IEnumerator(Of Object()) = cpg.GetEnumerator

        While e.MoveNext
            For i As Integer = 0 To e.Current.Length - 1
                Console.Write(e.Current(i))
            Next
            Console.WriteLine()
        End While

    End Sub

End Module

Public Class CrossProductGenerator
    Implements IEnumerable(Of Object())
    Private _list As IEnumerable()

    Public Sub New(ByVal ParamArray list() As IEnumerable)
        _list = list
    End Sub

    Public Function GetEnumerator() As System.Collections.Generic.IEnumerator(Of Object()) Implements IEnumerable(Of Object()).GetEnumerator
        Return New Enumerator(_list)
    End Function

    Private Function GetEnumerator1() As IEnumerator Implements IEnumerable.GetEnumerator
        Return New Enumerator(_list)
    End Function

    Private Class Enumerator
        Implements IEnumerator(Of Object())

        Private _enumerators As IEnumerator()
        Private _current As Object()
        Private _state As Integer

        Public Sub New(ByVal list As IEnumerable())
            _enumerators = New IEnumerator(list.Length - 1) {}
            For i As Integer = 0 To _enumerators.Length - 1
                _enumerators(i) = list(i).GetEnumerator()
            Next
            _state = -1
            _current = Nothing
        End Sub

        Public Sub Reset() Implements System.Collections.IEnumerator.Reset
            For i As Integer = 0 To _enumerators.Length - 1
                _enumerators(i).Reset()
            Next
            _state = -1
            _current = Nothing
        End Sub

        Public ReadOnly Property Current() As Object() Implements System.Collections.Generic.IEnumerator(Of Object()).Current
            Get
                Return _current
            End Get
        End Property

        Private ReadOnly Property Current1() As Object Implements System.Collections.IEnumerator.Current
            Get
                If _state <> 0 Then Throw New InvalidOperationException()
                Return _current
            End Get
        End Property

        Public Function MoveNext() As Boolean Implements System.Collections.IEnumerator.MoveNext
            If _state > 0 Then Return False

            If _state < 0 Then
                For i As Integer = 0 To _enumerators.Length - 1
                    If Not _enumerators(i).MoveNext() Then
                        _state = 1
                        _current = Nothing
                        Return False
                    End If
                Next
                _state = 0
            Else
                Dim i As Integer = 0
                While i < _enumerators.Length
                    If _enumerators(i).MoveNext Then Exit While
                    _enumerators(i).Reset()
                    _enumerators(i).MoveNext()
                    i += 1
                End While
                If i >= _enumerators.Length Then
                    _state = 1
                    _current = Nothing
                    Return False
                End If
            End If

            _current = New Object(_enumerators.Length - 1) {}
            For i As Integer = 0 To _enumerators.Length - 1
                _current(i) = _enumerators(i).Current
            Next

            Return True
        End Function

        Public Sub Dispose() Implements IDisposable.Dispose
        End Sub

    End Class

End Class
正整数のゲーデル数化？ (Nested Flatten) 
素数導出コードを書く気が起こりません。
無限精度整数がないのでやな感じです。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Module Module1

    Sub Main()
        Console.WriteLine(Goedel(9))
        Console.WriteLine(Goedel(81))
        Console.WriteLine(Goedel(230))
    End Sub

    Public Function Goedel(ByVal n As Integer) As Double
        If n < 0 Then Throw New ArgumentOutOfRangeException()
        Dim digits As New List(Of Integer)
        Dim primes As Integer()
        Dim r As Double

        While (n > 0)
            digits.Add(n Mod 10)
            n = n \ 10
        End While

        primes = GetPrimes(digits.Count)

        r = 1
        For i As Integer = 0 To digits.Count - 1
            r *= primes(i) ^ digits(digits.Count - i - 1)
        Next

        Return r
    End Function

    Public Function GetPrimes(ByVal count As Integer) As Integer()
        If count > 10 Then Throw New ArgumentOutOfRangeException()
        Dim r(count - 1) As Integer
        Array.Copy(PrimeSeeds, 0, r, 0, count)
        Return r
    End Function

    Private PrimeSeeds As Integer() = New Integer() {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}

End Module
フォルダパス一覧のツリー構造への変換 (Nested Flatten)

VB.NETに書き換え。

see: 貧脚レーサーのサボり日記 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
'http://ja.doukaku.org/
'http://ja.doukaku.org/102/投稿用
Imports System
Imports System.Windows.Forms

NameSpace どう書く_orgフォルダパス一覧のツリー構造への変換
    Class Program
        <STAThread> _
        Shared Sub Main(byval args() As String)
            Application.Run(new Form1())
        End Sub
    End Class

    class Form1:Inherits Form
        'treeView1
        Dim treeView1 As TreeView = New TreeView()

        '起動時引数でパス一覧のファイルを指定
        Dim pathListFilePath As String = System.Environment.GetCommandLineArgs()(1)

        Public Sub New()
            'treeView1
            treeView1.Parent = Me
            treeView1.Dock = DockStyle.Fill
        End Sub

        Private Sub Form1_Load(byval sender As object, byval e As EventArgs)handles Me.Load
            'ROOTNode
            Dim rootNode As TreeNode = New TreeNode("ROOT")
            treeView1.Nodes.Add(rootNode)

            For Each fullPath As String In System.IO.File.ReadAllLines(pathListFilePath)
                Dim addNode As TreeNode = rootNode
                For Each path As String In fullPath.Split(New char(){"\"c})
                    Dim flag As Boolean = True
                    For Each node As TreeNode in addNode.Nodes
                        If node.Text = path Then
                            addNode = node
                            flag = False
                        End If
                    Next
                    if flag Then
                        Dim newnode As TreeNode = New TreeNode(path)
                        addNode.Nodes.Add(newnode)
                        addNode = newnode
                    End If
                Next
            Next
            rootNode.ExpandAll()
        End Sub
    End Class
End NameSpace
FizzBuzz問題の一般化 (Nested Flatten)
こんなんで如何でしょう？ 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
Module Module1
    Sub Main(ByVal args() As String)
        For i As Integer = Integer.Parse(args(0)) To Integer.Parse(args(1))
            Dim Line As String = ""
            For j As Integer = 1 To args(1).Length - i.ToString.Length
                Line &= " "
            Next
            Line &= i.ToString & ":"
            Dim IsHoge As Boolean = True
            For j As Integer = 2 To args.Length - 2 Step 2
                If i Mod Integer.Parse(args(j)) = 0 Then
                    Line &= args(j + 1)
                    IsHoge = False
                End If
            Next
            If IsHoge Then
                Line &= "hoge"
            End If
            Console.WriteLine(Line)
        Next
    End Sub
End Module
変形Fizz-Buzz問題 (Nested Flatten)
こんなんでいいのかな…。 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
Module Module1

    Sub Main()
        For i As Integer = 1 To 20
            If i <= 9 Then
                Console.Write(" ")
            End If
            Console.Write(i & ":")
            If i Mod 3 = 0 Then
                Console.Write("Fizz")
            End If
            If i Mod 5 = 0 Then
                Console.Write("Buzz")
            End If
            If i Mod 3 <> 0 AndAlso i Mod 5 <> 0 Then
                Console.Write("hoge")
            End If
            Console.Write(vbCrLf)
        Next
    End Sub

End Module
ICPC2007アジア地区予選A (Nested Flatten)
n = 100000
m = 100000
k = 100000
66029
4.921875秒 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
    Private Function mamakodate(ByVal n As Integer, ByVal k As Integer, ByVal m As Integer) As Integer
        'カードを並べる
        Dim List As New List(Of Integer)
        For i As Integer = 0 To n - 1
            List.Add(i + 1)
        Next

        Dim index As Integer = m - 1
        While List.Count <> 1
            List.RemoveAt(index)

            index += k - 1
            While index > List.Count - 1
                index -= List.Count
            End While
        End While
        Return List(0)
    End Function
ウィンドウの表示 (Nested Flatten)
>jz5さんは400×300で表示させていたので、100×75で表示させました。
System.Windows.Forms
System.Drawing
を参照設定して下さい。 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
Imports System.Windows.Forms
Imports System.Drawing
Module Module1
    Sub Main()
        Dim Frm As New Form
        Frm.StartPosition = FormStartPosition.CenterScreen
        Frm.Size = New Size(100, 75)
        Frm.ShowIcon = False 'タイトルを全部表示させるために必要
        Frm.FormBorderStyle = FormBorderStyle.FixedToolWindow 'タイトルを全部表示させるために必要
        Frm.Text = "こんにちは、GUI！"
        Frm.ShowDialog()
    End Sub
End Module
文字列中のアルファベットを大文字にする (Nested Flatten)

ぶぃびぃどとねとだとこう。 

1
Dim Str As String = "abc".ToUpper
四字熟語パズルの作成 (Nested Flatten)
重複無しの8312件を食わせて走らせてみました。
OS:Windows XP Home SP2
CPU:AMD Sempron 3400+ 1.99GHz
メモリ:480MB
処理時間:507.078125秒
件数:12117件

　組み合わせた後に重複チェックをしているので、元データの重複は件数に影響しないようです。
　僕は
>四角く配置することのできる熟語の組み合わせを探すプログラム
と言うところに着目して、同じ熟語の組み合わせなら、四角に組む順番が違っても同一の組み合わせと判断して結果から除いています。
　もっと厳密に定義をすれば件数が揃うんじゃないでしょうか。
　それよりも、この桁違いの遅さは何なんでしょうorz .NETだからって極端に遅いって事も無いと思うのですが…。
　高速化しました。
サンプル(重複あり)8,582件
結果12,117件
CPU2.0GHz　610秒orz 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Module Module1

    Sub Main(ByVal args() As