DataContainers ›› HashTable(連想配列)

'HashTableTest1Window9
'Check for interference in hash generation
'キーに対する Hash 生成での干渉の有無チェック
'Hash によるデータの照合チェック
'Data collation check by Hash

'　辞書項目を登録
'Sub SetValueStrHashTable(p As Any Ptr , sKey As String , anyValue As USTRING)
'　設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
'Function GetValueStrHashTable(p As Any Ptr , sKey As String) As USTRING  
'　項目を個別に消去
'Sub FreeKeyHashTable(p As Any Ptr , sKey As String , bFlagFreeMemoryStrings As Long = 0)
'　辞書データをまとめて消去
'Sub FreeHashTable(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
'　ハッシュテーブルを削除【必須】
'Sub DeleteHashTable(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)


#Include "window9.bi"

Dim p As Any Ptr = CreateHashTable()

Dim KeyString As String
Dim DataString As String
Dim As Integer Counter, i, j, k, l, m
Dim BoolVar As String
Dim As Single t1,t2,t3

'****************************************************************
'Hash generation for the key and checking for interference of the generated Hash
'キーに対する Hash 生成と、生成した Hash の干渉有無チェック
'****************************************************************
t1=Timer
Counter = 0
For i = Asc("A") To Asc("Z")
   Print Chr(i)+Space(1);
   For j = Asc("A") To Asc("Z")
      For k = Asc("A") To Asc("Z")
         For l = Asc("A") To Asc("Z")
            For m = Asc("A") To Asc("Z")
               KeyString =  Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
               DataString =  Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
               BoolVar = GetValueStrHashTable(p , KeyString) ' KeyStringの存在を確認

               If BoolVar = "" Then      '***********
                  Counter += 1
                  SetValueStrHashTable(p , KeyString, DataString)    '★★ データ追加★★★★★★★★★★
               Else
                  'キーの重複が発生したら表示する
                  Print
                  Print "Key Duplicate", Counter, KeyString
                  Sleep
               End If
            Next m
         Next l
      Next k
   Next j
Next i

Print
Print
Print "Data registration has been completed. KeyString = "; KeyString
Print "データ登録を終了しました。 KeyString = "; KeyString
Print "      Counter = 26^5(11,881,376) = "; Counter
t2=Timer
Print "Seconds for registration = ";t2 - t1
Print "登録所要秒数 = ";t2 - t1
Print
Print "*******************************************************"

'****************************************************************
'Delete and re-register data items
'データ項目を削除して再登録する
'****************************************************************

Print "Delete 26 keys."
Print "26 個のキーを削除します。"
Print
For i = Asc("A") To Asc("Z")
   KeyString =  Chr(i) + "AAAA"
   FreeKeyHashTable(p , KeyString , 1)     'キーを指定して、データ項目を個別に消去
   Print KeyString,
Next i
Print
Print "Count ="; GetSizeHashTable(p)
Print
Print "Add 26 keys."
Print "26 個のキーを追加します。"
Print
For i = Asc("A") To Asc("Z")
   KeyString =  Chr(i) + "AAAA"
   DataString =  Chr(i) + "AAAA"

   BoolVar = GetValueStrHashTable(p ,KeyString) ' KeyStringの存在を確認

   If BoolVar = "" Then      '***********
      Counter += 1
      SetValueStrHashTable(p, KeyString, DataString)    '★★ データ追加★★★★★★★★★★
      Print KeyString,
   Else
      'キーの重複が発生したら表示する
      Print
      Print "Key Duplicate", Counter, KeyString
      Sleep
   End If
Next i
Print
Print "Count ="; GetSizeHashTable(p) 

Print
Print "*******************************************************"

'****************************************************************
'Hash data collation check
'Hash によるデータの照合チェック
'****************************************************************

For i = Asc("A") To Asc("Z")
   Print Chr(i)+Space(1);
   For j = Asc("A") To Asc("Z")
      For k = Asc("A") To Asc("Z")
         For l = Asc("A") To Asc("Z")
            For m = Asc("A") To Asc("Z")
               KeyString =  Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
               DataString =  Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
               If DataString <> GetValueStrHashTable(p, KeyString) Then    ' Hash を使ってデータを照合
                  'データの不整合が発生したら表示する
                  Print
                  Print "Inconsistent data", KeyString, GetValueStrHashTable(p, KeyString)
                  Sleep
               End If
            Next m
         Next l
      Next k
   Next j
Next i

Print
t3=Timer
Print "Seconds for matching = ";t3 - t2
Print "照合所要秒数 = ";t3 - t2
Print
Print "Total seconds required = ";t3 - t1
Print "合計所要秒数 = ";t3 - t1
DeleteHashTable(p , 1)

Print "*******************************************************"
Print "Please enter any key to exit."
Print "何かキー入力すると終了します。"
Sleep

'window9HashTableTest4
'2022/05/03 作成

/'
   ******************************************
   文字の出現頻度を数える
   ******************************************
   このコードは、window9 の hashtable の使用例です。
'/

'　辞書項目を登録
'Sub SetValueStrHashTable(p As Any Ptr , sKey As String , anyValue As USTRING)
'　設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
'Function GetValueStrHashTable(p As Any Ptr , sKey As String) As USTRING  
'　項目を個別に消去
'Sub FreeKeyHashTable(p As Any Ptr , sKey As String , bFlagFreeMemoryStrings As Long = 0)
'　辞書データをまとめて消去
'Sub FreeHashTable(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
'　ハッシュテーブルを削除【必須】
'Sub DeleteHashTable(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)

'****************************************************************
'' レコードの配列を文字の出現頻度順にソートする
'****************************************************************
'★★★文字列ソート★★★
Sub StringSort _
    (Array(Any) As String , _
     ByVal StartLine As Integer , _
     ByVal EndLine As Integer)

 Dim CenterLine As Integer                       'CenterLine を格納する変数
 Dim Reference As String                         'Referenceを 格納する変数
 Dim Position As Integer                         'Position
 Dim i As Integer                                'ループカウンタ

    If StartLine >= EndLine Then Exit Sub        '終了番号が開始番号以下の場合、プロシージャを抜ける
    CenterLine = (StartLine + EndLine) \ 2       'CenterLineを求める
    Reference = Array(CenterLine)                '中央の値をReferenceとする
    Array(CenterLine) = Array(StartLine)         '中央の要素に開始番号の値を格納
    Position = StartLine                         'Positionを開始番号と同じにする
    For i = (StartLine + 1) To EndLine Step 1    '開始番号の次の要素から終了番号までループ
        If Array(i) < Reference  Then            '値がReferenceより小さい場合
            Position = Position + 1              'Positionをインクリメント
            Swap Array(Position) , Array(i)
        End If
    Next
    Array(StartLine) = Array(Position)           'Array(Position) を開始番号の値にする
    Array(Position) = Reference                  'Referenceを Array(Position) に格納
    StringSort(Array(), StartLine, Position - 1) '分割された配列をクイックソート(再帰)
    StringSort(Array(), Position + 1, EndLine)   '分割された配列をクイックソート(再帰)
End Sub

'****************************************************************
#Include "window9.bi"

Dim Shared CharacterEncoding As String

Sub CountExecution
/'
   ★★★★★★★★★★★★
   辞書の使用例
'/

'' 文字と頻度の辞書を作成する
   '★CharacterIndexを作成★

   '調べたい文字列を含むファイルを入力する
'********************* Window9 のファイルを開くダイアログを使う *********************

Var FullPass = OpenFileRequester("Specify English text file",ExePath,"Text File(*.txt;*.csv;*.htm*)"_
+Chr(0)+"*.txt;*.csv;*.htm*"+Chr(0)+"All File(*.*)"+Chr(0)+"*.*"+Chr(0))


'' ソート用の配列を作る
Dim CountsCharacter(10000) As String  '99999  a ：5桁数字、空白2、文字、計8文字
Dim Filehandle As Integer
Dim TotalCountOfCharacters As LongInt
Dim Counter As Integer
Dim NumberOfCharacterTypes As Integer
Dim Number As Integer
Dim NumberString As String

Counter = 0

'レコードを処理するための辞書実装
Dim p As Any Ptr = CreateHashTable()

Dim BoolVar As String
Dim DictionaryNo As Integer
Dim CharacterSymbol As String
Dim WideCharacterSymbol As WString *100
Dim CountsOfLine As Integer
Dim CountsOfCharacter As Integer
Dim StringVariable As String
Dim WideStringVariable As WString *3000
Dim Position As Integer
Dim LineCounter As Integer

If FullPass<>"" Then
   Filehandle = FreeFile( )                 '' 有効なファイル番号を検索します

   '' ファイルを開きます。そして、ファイル番号をそれに結び付けます。エラーが有れば、抜けます。
   If( Open( FullPass For Input As #Filehandle ) ) Then
      Print "ERROR: 開こうとしたファイル名 " ; FullPass
      Sleep
      End -1
   End If

   ' テキストファイルの内容読み込み処理
   CountsOfLine = 0
   TotalCountOfCharacters = 0
   LineCounter = 0

   Filehandle = FreeFile
   'テキストファイルをオープン
   Select Case CharacterEncoding
      Case "UTF8"
         Open FullPass For Input  Encoding "utf-8" As #Filehandle
      Case "UTF16"
         Open FullPass For Input  Encoding "utf-16" As #Filehandle
      Case Else
         Open FullPass For Input As #Filehandle
   End Select

   If Lof(Filehandle) > 0 Then
      Do Until EOF(Filehandle )
         '1行読み込み

         If CharacterEncoding <>"JIS" Then
            Line Input #Filehandle, WideStringVariable
            '? WideStringVariable
            'Sleep
         Else
            Line Input #Filehandle, StringVariable
            StringVariable = Trim(StringVariable)
            WideStringVariable = WStr(StringVariable)
         EndIf
         LineCounter = LineCounter + 1

         CountsOfLine = Len(WideStringVariable)
         TotalCountOfCharacters = TotalCountOfCharacters + CountsOfLine

         If CountsOfLine >0 Then
            If LineCounter Mod 100 = 0 Then
               ?
               ? LineCounter & " 行目"
               ? "行の文字列 = " , WideStringVariable
               ? "行の文字数 = " , CountsOfLine
               ? "読み込んだ文字数 = ", TotalCountOfCharacters
               ?
               'Sleep(200)
            End If

            For Position = 1 To CountsOfLine
               WideCharacterSymbol = Mid(WideStringVariable, Position, 1)
               'ワイド文字を日本語 Ascii に変換
               CharacterSymbol = WideCharacterSymbol

               If Trim(CharacterSymbol) <> "" Then
                  '' 'キーが存在するかどうかを確認します。
                  BoolVar = GetValueStrHashTable(p ,CharacterSymbol)          '★設定済の索引のデータ取得。未登録のキーを検索すると空白を返す

                  If BoolVar = "" Then
                    ' この文字は辞書に登録されていません。辞書に追加します。
                    Counter =Counter +1
                     '? Counter ;
                     '? CharacterSymbol ;
                     SetValueStrHashTable(p ,CharacterSymbol, Str(Counter))        '★★★辞書項目を登録★★★
                     'Dim CountsCharacter(100) As String  '99999  a ：5桁数字、空白2、文字、計8文字

                     CountsCharacter(Counter) = "    1  " & CharacterSymbol
                     'Print Counter,CharacterSymbol
                     'sleep

                  Else
                     '既存の場合は文字の出現頻度を追加します
                     DictionaryNo = Val(GetValueStrHashTable(p ,CharacterSymbol))    '★設定済の索引のデータ取得。

                     Number = Val(Trim(Left(CountsCharacter(DictionaryNo),5)))
                     Number = Number + 1
                     '? CharacterSymbol;
                     '? Number;
                     '? " ";
                     NumberString = Str(Number)
                     NumberString = Space(5-Len(NumberString)) & NumberString
                     CountsCharacter(DictionaryNo) = NumberString & Space(1) & Right(CountsCharacter(DictionaryNo),2)
                     'Print DictionaryNo,CharacterSymbol,Number
                     'sleep
                  End If
               End If
            Next Position
         End If
      Loop
   Else
      GoTo HandleErrors
   End If

   ?
   ? LineCounter & " 行目"
   ?

   Close #Filehandle
   'ファイル番号を通したファイルを閉じます。

Else
   Print "メッセージ","ファイルが選択されませんでした！"
   Sleep
   End
EndIf


'配列の出現頻度を更新する
NumberOfCharacterTypes = Counter

'' レコードの配列をソートする
StringSort(CountsCharacter(),1,Counter)

''文字の出現頻度順に出現数と文字を表示します
For Counter = 0 To NumberOfCharacterTypes
  ? CountsCharacter(Counter)
Next

? "入力ファイルの総文字数 = " & TotalCountOfCharacters
?
? "文字の出現頻度順に文字と出現数を表示しました。何かキー入力でプログラムを終了します。"

DeleteHashTable(p , 1)
Sleep()
End

HandleErrors:
Print "指定ファイルが有りません。"
Sleep (1000)
End

End Sub

'****************************************************
'文字コードを選択
'****************************************************
CharacterEncoding = "JIS"

Dim As HWND hwnd
Dim As Integer event
hwnd = OpenWindow("文字コード選択",300,10,400,150)
OptionGadget(1,10,10,150,30,"Shift JIS")
SetGadgetState(1,1)
OptionGadget(2,10,40,150,30,"UTF 16")
OptionGadget(3,10,70,150,30,"UTF 8 (BOM付き)")
TextGadget(13,200,20,150,30,"Shift JIS")
ButtonGadget(11,270,70,100,30,"読込み開始")

Do
   event=WaitEvent()
   If event=EventClose Then End
   If event=eventgadget Then
      If eventNumber = 1 Then
         setgadgettext(13,"Shift JIS")
         CharacterEncoding = "JIS"
      ElseIf eventNumber = 2 Then
         setgadgettext(13,"UTF 16")
         CharacterEncoding = "UTF16"
      ElseIf eventNumber = 3 Then
         setgadgettext(13,"UTF 8 (BOM付き)")
         CharacterEncoding = "UTF8"
      ElseIf eventNumber = 11 Then
         event=EventClose
         Close_Window(hwnd)
         Exit Do
      EndIf
   EndIf
Loop

CountExecution