とりこらぼ。

ソートされたらいいな、をカタチにする。

のんちゃんのVBお勉強に協力する試み (1)

とりこびとなりの応援です。

でも、あったらいいな、はカタチにできません！！（キッパリ

ソートされてるかどうかを調べるくらいならできそうです。（コラｗ

Option Compare Binary
Option Explicit On
Option Infer On
Option Strict On

Imports System
Imports System.Collections.Generic

Namespace Wankuma.Festivals.SortFestival.Torikobito

    Module Program

        Sub Main()

            Dim seeds = GetSeeds(5, 0, 100000)

            Console.WriteLine("--  Before --")

            For i = 0 To seeds.Count - 1

                Console.WriteLine(seeds.Item(i).ToString)

            Next

            Sort(seeds)

            Console.WriteLine("--  After --")

            For j = 0 To seeds.Count - 1

                Console.WriteLine(seeds.Item(j).ToString)

            Next

        End Sub

        Private Function GetSeeds(ByVal count As Integer, ByVal minValue As Integer, ByVal maxValue As Integer) As List(Of Integer)

            Dim list = New List(Of Integer)(count)

            Dim r = New Random()

            For i = 0 To count - 1

                ' あ、maxValue は排他的上限値なのね…。
                Dim seed = r.Next(minValue, maxValue)
                list.Add(seed)

            Next

            Return list

        End Function

        Private Sub Sort(ByVal list As List(Of Integer))

            Dim sorted = False

            While Not sorted

                Shuffle(list)

                ' どうかソートされていますように･･･。
                sorted = True

                For i = 0 To list.Count - 2

                    If list.Item(i) > list.Item(i + 1) Then

                        ' ダメでしたか…。
                        sorted = False
                        Exit For

                    End If

                Next

            End While

        End Sub

        Private Sub Shuffle(ByVal list As List(Of Integer))

            Dim r = New Random()

            For i = 0 To list.Count - 1

                Dim value = r.Next(list.Count)
                Dim temp = list.Item(i)
                list.Item(i) = list.Item(value)
                list.Item(value) = temp

            Next

        End Sub

    End Module

End Namespace

投稿日時 : 2008年7月19日 10:06