あにす #3667(2007/11/02 12:53 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 64 65 66 67 68 69 70
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) / 10000000L & "秒") 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 '上 Dim Top() As Char = JukugoTop.ToCharArray For Each JukugoRight As String In JukugoList '右 Dim Right() As Char = JukugoRight.ToCharArray If Top(3) = Right(0) Then For Each JukugoBottom As String In JukugoList '下 Dim Bottom() As Char = JukugoBottom.ToCharArray If Right(3) = Bottom(3) Then For Each JukugoLeft As String In JukugoList '左 Dim Left() As Char = JukugoLeft.ToCharArray If Bottom(0) = Left(3) AndAlso _ Left(0) = Top(0) Then If Top(3) <> Bottom(0) 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 End If Next End If Next Next Console.WriteLine(Kouho.Count & "組の組み合わせがありました。") 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 ]
あにす
#3667()
[
VB.net
]
Rating0/0=0.00
サンプル(重複あり)8,582件
結果12,117件
CPU2.0GHz 610秒orz
Rating0/0=0.00-0+
1 reply [ reply ]