あにす #3665(2007/11/02 11:06 GMT) [ VB.net ] Rating0/0=0.00
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
Module Module1 Sub Main(ByVal args() As String) '引数に四字熟語をCRLFで区切り列挙したテキストファイルを指定。文字コードはUnicode。ファイルは複数指定可能。 Dim Ticks As Long = Now.Ticks Dim JukugoList As New List(Of String) '四字熟語のリスト '四字熟語リストの読み込みループ For Each CmdLine As String In args JukugoList.AddRange(System.IO.File.ReadAllLines(CmdLine)) Next JukugoPuzul(JukugoList) Console.WriteLine(Now.Ticks - Ticks) Console.ReadKey() End Sub Private Sub JukugoPuzul(ByVal JukugoList As List(Of String)) Dim Kouho As New List(Of String()) For Each JukugoTop As String In JukugoList '上 For Each JukugoRight As String In JukugoList '右 For Each JukugoBottom As String In JukugoList '下 For Each JukugoLeft As String In JukugoList '左 If JukugoTop.Substring(3, 1) = JukugoRight.Substring(0, 1) AndAlso _ JukugoRight.Substring(3, 1) = JukugoBottom.Substring(3, 1) AndAlso _ JukugoBottom.Substring(0, 1) = JukugoLeft.Substring(3, 1) AndAlso _ JukugoLeft.Substring(0, 1) = JukugoTop.Substring(0, 1) Then If JukugoTop.Substring(3, 1) <> JukugoBottom.Substring(0, 1) Then '右上隅の漢字と左下隅の漢字は異なるものでなければいけません。 Dim Group() As String = {JukugoTop, JukugoRight, JukugoBottom, JukugoLeft} If ChofukuCheck(Kouho, Group) Then OutPut(Group) Kouho.Add(Group) End If End If End If Next Next Next Next End Sub Private Function ChofukuCheck(ByVal List As List(Of String()), ByVal Kouho As String()) As Boolean For Each Group As String() In List Dim Count As Integer = 0 For Each Jukugo As String In Group For Each Jukugo1 As String In Kouho If Jukugo = Jukugo1 Then Count += 1 End If Next Next If Count = 4 Then Return False End If Next Return True End Function Private Sub OutPut(ByVal Group() As String) Console.WriteLine(Group(0)) Console.WriteLine(Group(3).Substring(1, 1) & " " & Group(1).Substring(1, 1)) Console.WriteLine(Group(3).Substring(2, 1) & " " & Group(1).Substring(2, 1)) Console.WriteLine(Group(2) & vbCrLf) End Sub End Module
Rating0/0=0.00-0+
1 reply [ reply ]
あにす #3666(2007/11/02 11:17 GMT) Rating0/0=0.00
やっぱりガチムチにFor Eachの4重ネストで総当り判定してるのが遅い原因でしょうか…。 まだ終わりません…。CPUは2GHz、デバッグモードで実行してます。
[ reply ]
あにす
#3665()
[
VB.net
]
Rating0/0=0.00
出力例に含まれる四字熟語を列挙したファイルでは一瞬で例と同じ出力結果が得られました。
今、ダウンロードしたサンプルを上記形式に加工したファイルを読み込ませて実行しているのですが、待てど暮らせど終わりません。もう1時間程経ってます。
VB.net一番乗り狙って投稿します。
Rating0/0=0.00-0+
1 reply [ reply ]