FreeBASIC 連想配列(containers の hashtable)

目次→フォーラム→FreeBASIC→補足→FreeBasic containers (map , vector , list , queue , stack , hashtable)←オリジナル・サイト

連想配列(containers の hashtable)　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

　このページは、VANYA さんが、掲示板で公開しているライブラリ「FreeBasic containers」の内の hashtable の部分を日本語化して紹介するものです。
　コーディングが容易で高速なので、私の推奨の連想配列(hashtable) です。

　ダウンロード：https://sourceforge.net/projects/freebasic-containers/files/
　ライブラリの hashtable 部分のマニュアル(別タブで開きます)

HashTable：内容
ClearTable
Count
Find
DeleteItem
FreeTable
Insert
Size

　注意：別に FreeBASIC 1.05 だと使える連想配列に、Dictionary Class があります。

プログラム例：
１．キーの登録とパフォーマンスを検証 (基本的な使い方例になっています)
２．英文字の出現頻度を数える
３．日本語漢字(県名)をキーにしてデータを集計する
４．品目マスタと品目オーダを照合

キーの登録とパフォーマンスを検証

　11,881,376 件の文字列を生成して、HashMap の使い方とパフォーマンスの確認を行います。

HashTableTest1.bas

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

'pTable -> insert("Key", "Value") '辞書項目を登録
'pTable -> deleteitem("Key")      '項目を個別に消去
'*pTable -> find("Key")            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
'pTable -> cleartable()           '辞書データをまとめて消去
'pTable -> freetable()            '辞書を削除
'pTable -> Count()                 '登録データ件数
'pTable -> Size()                  '使用メモリサイズ

#Include "HashTable.bi"

'W:33
MHashTemplate(WString , ZString)
Dim As THASHTABLEwstringzstring Ptr pTable = New THASHTABLEwstringzstring
'Z:39
'MHashTemplate(ZString , ZString)
'Dim As THASHTABLEzstringzstring Ptr pTable = New THASHTABLEzstringzstring

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 生成と、生成した 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 = *pTable -> find(KeyString) ' KeyStringの存在を確認

               If BoolVar = "" Then      '***********
                  Counter += 1
                  pTable -> insert(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 "データ登録を終了しました。 KeyString = "; KeyString
Print "      Counter = 26^5(11,881,376) = "; Counter
t2=Timer
Print "登録所要秒数 = ";t2 - t1
Print
Print "*******************************************************"

'****************************************************************
'データ項目を削除して再登録する
'****************************************************************

Print "26 個のキーを削除します。"
Print
For i = Asc("A") To Asc("Z")
   KeyString =  Chr(i) + "AAAA"
   pTable -> deleteitem(KeyString)      'キーを指定して、データ項目を個別に消去
   Print KeyString,
Next i
Print
Print "Count ="; pTable -> Count()
Print "Size ="; pTable -> Size()
Print
Print "26 個のキーを追加します。"
Print
For i = Asc("A") To Asc("Z")
   KeyString =  Chr(i) + "AAAA"
   DataString =  Chr(i) + "AAAA"

   BoolVar = *pTable -> find(KeyString) ' KeyStringの存在を確認

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

'****************************************************************
'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 <> *pTable -> find(KeyString) Then    ' Hash を使ってデータを照合
                  'データの不整合が発生したら表示する
                  Print
                  Print "Inconsistent data", KeyString, *pTable -> find(KeyString)
                  Sleep
               End If
            Next m
         Next l
      Next k
   Next j
Next i

Print
t3=Timer
Print "照合所要秒数 = ";t3 - t2
Print
Print "合計所要秒数 = ";t3 - t1
pTable -> cleartable()
pTable -> freetable()

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

ページの頭に戻る

英文字の出現頻度を数える

　次の使用例は、英文のテキスト・ファイル中の文字と出現頻度を調べるものです。

　探偵小説シャーロック・ホームズシリーズの「踊る人形」では、換字暗号が使われています。
　小説の中で、シャーロック・ホームズは、英文中の文字の出現頻度から、「踊る人形」の暗号を解読します。

　「踊る人形」の解読方法
http://www.comm.tcu.ac.jp/~math/hnakai/infomath/sherlockholmes/dance_decording.html
　頻度分析 (暗号)
https://ja.wikipedia.org/wiki/%E9%A0%BB%E5%BA%A6%E5%88%86%E6%9E%90_(%E6%9A%97%E5%8F%B7)

TheAdventureOfTheDancingMen.txt ←文字列抽出に使ったファイル

HashTableTest2.bas

'HashTableTest2
'英文字の出現頻度を数える

'pTable -> insert("Key", "Value") '辞書項目を登録
'pTable -> deleteitem("Key")      '項目を個別に消去
'*pTable -> find("Key")            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
'pTable -> cleartable()           '辞書データをまとめて消去
'pTable -> freetable()            '辞書を削除
'pTable -> Count()                 '登録データ件数
'pTable -> Size()                  '使用メモリサイズ

/'
	******************************************
	文字の出現頻度を数える
	******************************************

	このコードは、containers の hashtable の使用例です。
'/

'****************************************************************
'' レコードの配列を文字の出現頻度順にソートする
'****************************************************************

'★★★文字列ソート★★★
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

'****************************************************************

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

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

   Dim FullPass As String  '対象ファイルのフルパス

   '調べたい文字列を含むファイルを入力する
'********************* Window9 のファイルを開くダイアログを使う *********************
#Include "window9.bi"
Var ddd = OpenFileRequester("Specify English text file",ExePath,"Text File(*.txt;*.csv;*.htm*)"_
+Chr(0)+"*.txt;*.csv;*.htm*"+Chr(0)+"All File(*.*)"+Chr(0)+"*.*"+Chr(0))

FullPass = Str(ddd)

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

Counter = 0

#Include "HashTable.bi"
'レコードを処理するための辞書実装
MHashTemplate(WString , Zstring)
Dim As THASHTABLEwstringzstring Ptr pTable = New THASHTABLEwstringzstring

Dim BoolVar As String
Dim DictionaryNo As Integer
Dim CharacterSymbol As String
Dim CountsOfLine As Integer
Dim CountsOfCharacter As Integer
Dim StringVariable As String
Dim Position 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

   Filehandle = FreeFile
   Open FullPass For Input As #Filehandle
   'テキストファイルのオープン

   If Lof(Filehandle) > 0 Then
      Do Until EOF(Filehandle )

         Line Input #Filehandle, StringVariable
         '1行読み込み
         StringVariable = Trim(StringVariable)
         CountsOfLine = Len(StringVariable)
         TotalCountOfCharacters = TotalCountOfCharacters + CountsOfLine

         If CountsOfLine >0 Then
            ?
            ? "行の文字列 = " , StringVariable
            ? "行の文字数 = " , CountsOfLine
            ? "読み込んだ文字数 = ", TotalCountOfCharacters
            ?
            For Position = 1 To CountsOfLine
               CharacterSymbol = Mid(StringVariable, Position, 1)
               If Trim(CharacterSymbol) <> "" Then
                  '' 'キーが存在するかどうかを確認します。

                  BoolVar = *pTable -> find(CharacterSymbol)          '★設定済の索引のデータ取得。未登録のキーを検索すると空白を返す

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

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

                  Else
                     '既存の場合は文字の出現頻度を追加します

                     DictionaryNo = Val(*pTable -> find(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 & Right(CountsCharacter(DictionaryNo),2)
                     'Print DictionaryNo,CharacterSymbol,Number
                     'sleep

                  End If
               End If
            Next Position
         End If
      Loop
   Else
           GoTo HandleErrors
   End If

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

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

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

?
? "入力を終了しました。何かキー入力で継続します。"
?
Sleep()

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

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

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

pTable ->cleartable()
pTable ->freetable()

End

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

ページの頭に戻る

日本語漢字(県名)をキーにしてデータを集計する

　サンプル・データはここでダウンロードできます。

ItemMasterJP.csv

HashTableTest3.bas

'HashTableTest3
'日本語漢字(県名)をキーにしてデータを集計する
'Data aggregation using Japanese characters (prefecture name) as a key

'pTable -> insert("Key", "Value") '辞書項目を登録
'pTable -> deleteitem("Key")      '項目を個別に消去
'*pTable -> find("Key")            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
'pTable -> cleartable()           '辞書データをまとめて消去
'pTable -> freetable()            '辞書を削除
'pTable -> Count()                 '登録データ件数
'pTable -> Size()                  '使用メモリサイズ

#Include "HashTable.bi"
MHashTemplate(WString , Zstring)
Dim As THASHTABLEwstringzstring Ptr pTable = New THASHTABLEwstringzstring

Dim STARTT As Long
Dim ENDTIME As Long
Dim Minut As Integer
Dim Shared ItemID As String
Dim Shared Region As String
Dim Shared Price As String
Dim Shared Weight As String
Dim Shared Counter As Integer
Dim i As Integer
Dim BoolVar As String
Dim QuantityString As String
Dim Amount As String
Dim Dimension As Integer
Dim cellString As String

Dim file_name As String
Dim file_num As Integer
Dim CharacterString As String

Dim Shared RegionArray(100,2) As String 'Region, weight

'****************************************************************
'****************************************************************
'Print "Read ""ItemMasterJP.csv"" and store each line in RegionArray, indexing Region."
Print """ItemMasterJP.csv"" を読み込んで、県名単位に重量項目を集計"
'****************************************************************

STARTT=Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))

Print

file_name = "ItemMasterJP.csv"
file_num = FreeFile( )                 '' 有効なファイル番号を検索します

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

Counter = 0

Do Until Eof( file_num )               '' ファイルの端に達するまで、繰り返します。
   ItemID ="": Region ="": Price ="" : Weight =""

   Line Input #file_num, CharacterString           '' テキストの行を読みます。

   ItemID = Left(CharacterString,3)
   Region = Mid(CharacterString,6,InStrRev(CharacterString,"""")-6)
   Price  = Mid(CharacterString,InStrRev(CharacterString,"""")+2,InStrRev(CharacterString,",")-InStrRev(CharacterString,"""")-2)
   Weight = Right(CharacterString,Len(CharacterString)-InStrRev(CharacterString,","))

   BoolVar = *pTable -> find(Region)        '★設定済の索引のデータ取得。未登録のキーを検索すると空白を返す

   If BoolVar = "" Then  ' New Key
      Counter = Counter + 1
      pTable -> insert(Region, Str(Counter)) '★★★ 辞書項目を登録★★★
      RegionArray(Counter,1)=Region
      RegionArray(Counter,2)=Str(Weight)

   Else
      RegionArray(Val(BoolVar),2)=Str(Val(RegionArray(Val(BoolVar),2))+Val(Weight)) '値を累積
   End If

Loop
'Print "Number of Regions = ";Counter
Print "県名の件数 = ";Counter
Print
Print "品目マスタの最後のデータの内容 : ";CharacterString  ' 画面に最終行を出力します。
Print ItemID , Region , Price ,  Weight
Print

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

'****************************************************************
'****************************************************************
'Print "Out put the results to ""RegionArray.csv"""
Print "集計結果を ""RegionArray.csv"" として出力します。"
'****************************************************************
Print

'RegionArray(100,2) 'Region, Weight
Open "RegionArray.csv"  For Output As #1
   For i = 1 To Counter
      CharacterString = ""
      For Dimension =1 To 2
         cellString = RegionArray(i,Dimension)
         If Dimension = 1 Then
            cellString = """" & cellString & """"
         EndIf
         If Dimension > 1 Then
            cellString = "," & cellString
         EndIf
         CharacterString = CharacterString & cellString
      Next Dimension

      Print #1, CharacterString

   Next i
Close #1

pTable -> cleartable()   '★★★★ 連想配列を消去
pTable -> freetable()    '★★★★ 連想配列を開放

'****************************************************************
'****************************************************************
ENDTIME = Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))
Minut=(ENDTIME-STARTT)\60
'Print Using "processing time: ## minutes ## seconds"; Minut; (ENDTIME-STARTT)-Minut*60
Print Using "処理時間: ## 分 ## 秒"; Minut; (ENDTIME-STARTT)-Minut*60
Print
'Print "Output of the sorted order aggregate has been completed."
Print "集計結果のリスト出力が完了しました。"
Print "*******************************************************"
'Print "Please enter any key to exit."
Print "何かキー入力すると終了します。"

Sleep

ページの頭に戻る

品目マスタと品目オーダを照合

　品目マスタ(15,000件)と品目オーダ(50,000件)を照合して、品目別の受注数量・金額・重量を集計する事例です。
　私のパソコン環境で、1秒以下で処理が完了しました。
　(このプログラムは、Excelマクロで作成して利用していたものを FreeBASIC に移植したものです。)

　サンプル・データはここでダウンロードできます。

ItemMaster.csv
OrderList.csv

　自分で準備する場合はこちらを参照下さい。

HashTableTest4.bas

'HashTableTest4
'品目マスタと品目オーダを照合して品目別受注量を集計
'Order sorting

'pTable -> insert("Key", "Value") '辞書項目を登録
'pTable -> deleteitem("Key")      '項目を個別に消去
'*pTable -> find("Key")            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
'pTable -> cleartable()           '辞書データをまとめて消去
'pTable -> freetable()            '辞書を削除
'pTable -> Count()                 '登録データ件数
'pTable -> Size()                  '使用メモリサイズ

#include "HashTable.bi"
MHashTemplate(WString , Zstring)
Dim As THASHTABLEwstringzstring Ptr MasterItemIDpTable = New THASHTABLEwstringzstring
Dim As THASHTABLEwstringzstring Ptr OrderItemIDpTable = New THASHTABLEwstringzstring

Dim STARTT As Long
Dim ENDTIME As Long
Dim Minut As Integer
Dim Shared ItemID As String
Dim Shared Region As String
Dim Shared Price As String
Dim Shared Weight As String
Dim Shared Counter As Integer
Dim i As Integer
Dim BoolVar As String
Dim QuantityString As String
Dim Amount As String
Dim Dimension As Integer
Dim cellString As String

Dim file_name As String
Dim file_num As Integer
Dim CharacterString As String
Dim Regions As Integer
Dim ItemMasterNo As Integer
Dim IntegratedNo As Integer
Dim Orders As Integer

Dim Shared ItemMasterArray(20000,3) As String 'Region, price, weight
Dim Shared IntegratedOrderArray(20000,5) As String 'Region, ItemID, Quantity, Amount, Weight
Dim Shared SortArray(20000) As String

'****************************************************************
'****************************************************************

'★★★多次元配列を複数列を使ってソート★★★
'How to sort datasheet (x-dim array) by a few columns (at once in 1 loop) ?
'by badidea ≫ Dec 15, 2019 21:54
'https://www.freebasic.net/forum/viewtopic.php?f=3&t=27993&start=30#p266914

'by fxm ≫ Jun 25, 2020 6:49
'https://www.freebasic.net/forum/viewtopic.php?f=3&p=273475&sid=547977eb5d3cc9cf3e6ee7323616cff3#p273475

#Include "crt/stdlib.bi"
#Include "string.bi"

'------------------------------- class: row_type -------------------------------

Type row_type
   Dim As String col(Any)
   Declare Operator Cast () As String
End Type

Operator row_type.cast () As String
   Dim As String tempStr
   For i As Integer = 1 To UBound(col)
      If i = 1 Then tempStr &= col(i) Else tempStr &= !"\t" & col(i)
   Next
   Return tempStr
End Operator

'------------------------------ class: sort_type -------------------------------

Type sort_type
   Dim As Short column
   Dim As Short direction
   Declare Constructor()
   Declare Constructor(column As Short, direction As Short)
End Type

'a stupid constructor
Constructor sort_type()
   this.column = 0
   this.direction = 0
End Constructor

'another stupid constructor
Constructor sort_type(column As Short, direction As Short)
   this.column = column
   this.direction = direction
End Constructor

'------------------------------ class: data_type -------------------------------

Type data_type
   Static As sort_type sortOrder(1 To 3)
   Dim As Integer numRows, numCols
   Dim As row_type row(Any)
   Declare Constructor(numRows As Integer, numPivotMS As Integer)
   Declare Destructor()
   Declare Sub copyTo(dst As data_type)
   Declare Sub sort(sort1st As sort_type, sort2nd As sort_type, sort3rd As sort_type)
   Declare Static Function qSortCallback Cdecl(pRow1 As row_type Ptr, pRow2 As row_type Ptr) As Long
End Type

Dim As sort_type data_type.sortOrder(1 To 3)

Constructor data_type(numRows As Integer, numCols As Integer)
   ReDim row(numRows)
   this.numCols = numCols
   For iRow As Integer = 1 To numRows
      ReDim (row(iRow).col)(numCols) 'weird syntax, compiler wants the extra ( )
   Next
End Constructor

Destructor data_type()
   For iRow As Integer = 1 To numRows
      Erase row(iRow).col
   Next
   Erase row
End Destructor

Sub data_type.sort(sort1st As sort_type, sort2nd As sort_type, sort3rd As sort_type)
   'disable invalid sort filters
   sortOrder(1) = IIf(sort1st.column < 1 Or sort1st.column >= numCols, sort_type(0,0), sort1st)
   sortOrder(2) = IIf(sort2nd.column < 1 Or sort2nd.column >= numCols, sort_type(0,0), sort2nd)
   sortOrder(3) = IIf(sort3rd.column < 1 Or sort3rd.column >= numCols, sort_type(0,0), sort3rd)
   qsort(@row(1), UBound(row), SizeOf(row_type), CPtr(Any Ptr, @qSortCallback))
End Sub

Function data_type.qSortCallback Cdecl(pRow1 As row_type Ptr, pRow2 As row_type Ptr) As Long
   For i As Integer = 1 To 3
      With sortOrder(i)
         Select Case .direction
         Case +1
            If pRow1->col(.column) < pRow2->col(.column) Then Return -1
            If pRow1->col(.column) > pRow2->col(.column) Then Return +1
         Case -1
            If pRow1->col(.column) > pRow2->col(.column) Then Return -1
            If pRow1->col(.column) < pRow2->col(.column) Then Return +1
         Case Else
            'skip, including direction = 0
         End Select
      End With
   Next
   Return 0
End Function

'****************************************************************
'****************************************************************
   'Print "Read ""ItemMaster.csv"" and store each line in ItemMasterArray, indexing ItemID."
   Print """ItemMaster.csv"" を読み込んで ItemMasterArray, indexing ItemID. に登録"
'****************************************************************
Print

file_name = "ItemMaster.csv"
file_num = FreeFile( )                 '' 有効なファイル番号を検索します

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

Counter = 0

Do Until Eof( file_num )               '' ファイルの端に達するまで、繰り返します。
   ItemID ="": Region ="": Price ="" : Weight =""

   Line Input #file_num, CharacterString           '' テキストの行を読みます。

   ItemID = Left(CharacterString,3)
   Region = Mid(CharacterString,6,InStrRev(CharacterString,"""")-6)
   Price  = Mid(CharacterString,InStrRev(CharacterString,"""")+2,InStrRev(CharacterString,",")-InStrRev(CharacterString,"""")-2)
   Weight = Right(CharacterString,Len(CharacterString)-InStrRev(CharacterString,","))

   BoolVar = *MasterItemIDpTable -> find(ItemID)       '★６★★★★★★★★★★★

'?     ItemID
'?     Region
'?     Price
'?     Weight
'?     BoolVar
'Sleep

   If BoolVar = "" Then
      Counter = Counter + 1
      MasterItemIDpTable -> insert(ItemID, Str(Counter)) '辞書項目を登録

      ItemMasterArray(Counter,1) = Region
      ItemMasterArray(Counter,2) = Price
      ItemMasterArray(Counter,3) = Weight
   Else
      Print BoolVar
      Print CharacterString                           '' キー重複を画面に出力します。
      Print ItemID , Region , Price ,  Weight
      Print Counter
      Sleep
   End If

Loop
'Print "Numbers of Item Master = ";Counter
Print "品目マスタの件数 = ";Counter
Print
Print "品目マスタの最後のデータの内容 : ";CharacterString  ' 画面に最終行を出力します。
Print ItemID , Region , Price ,  Weight
Print

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

'****************************************************************
'****************************************************************
'Print "Read ""OrderList.csv"" and compare it with ItemMasterArray to aggregate price and weight by item and region."
Print """OrderList.csv"" を読み込み、ItemMasterArray と照合して、品目毎に数量・金額・重量を集計します。"
'****************************************************************
Print

Open "OrderItemError.csv"  For Output As #1

file_name = "OrderList.csv"
file_num = FreeFile( )                 '' 有効なファイル番号を検索します

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

Counter = 0
Orders  = 0

STARTT=Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))

Do Until Eof( file_num )               '' ファイルの端に達するまで、繰り返します。
   CharacterString = "" : ItemID = "" : QuantityString = ""

   Line Input #file_num, CharacterString           '' テキストの行を読みます。
   Orders  = Orders + 1
   ItemID = Left(CharacterString,3)
   QuantityString = Right(CharacterString,Len(CharacterString)-InStrRev(CharacterString,","))

   BoolVar = *MasterItemIDpTable -> find(ItemID)            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します

   If BoolVar = "" Then      '★６★★★★★★★★★★★
      'エラー出力
      Print #1, CharacterString
   Else
      ItemMasterNo = Val(*MasterItemIDpTable -> find(ItemID))            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します
      'ItemMasterArray(20000,3)      'Region, price, weight
      'IntegratedOrderArray(20000,5) 'Region, ItemID, Quantity, Amount, Weight

      Region = ItemMasterArray(ItemMasterNo,1)
      Amount = Str(Val(QuantityString)*Val(ItemMasterArray(ItemMasterNo,2)))
      Weight = Str(Val(QuantityString)*Val(ItemMasterArray(ItemMasterNo,3)))

      BoolVar = *OrderItemIDpTable -> find(ItemID)            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します

      If BoolVar = "" Then                           '★６★★★★★★★★★★★
         Counter = Counter + 1
         OrderItemIDpTable -> insert(ItemID, Str(Counter)) '辞書項目を登録
         IntegratedOrderArray(Counter,1) = Region
         IntegratedOrderArray(Counter,2) = ItemID
         IntegratedOrderArray(Counter,3) = QuantityString
         IntegratedOrderArray(Counter,4) = Amount
         IntegratedOrderArray(Counter,5) = Weight
         'Print Counter,Region,ItemID,QuantityString,Amount,Weight
         'sleep

      Else
         IntegratedNo = Val(*OrderItemIDpTable -> find(ItemID))            '設定済の索引のデータ取得。未登録のキーを検索すると空白を返します

         IntegratedOrderArray(IntegratedNo,3) = Str(Val(IntegratedOrderArray(IntegratedNo,3))+Val(QuantityString))
         IntegratedOrderArray(IntegratedNo,4) = Str(Val(IntegratedOrderArray(IntegratedNo,4))+Val(Amount))
         IntegratedOrderArray(IntegratedNo,5) = Str(Val(IntegratedOrderArray(IntegratedNo,5))+Val(Weight))
         'Print IntegratedNo,ItemID,QuantityString,Amount,Weight
         'sleep

      End If
   End If

Loop
'Print "Number of orders in the list : ";Orders
Print "リスト中のオーダ件数 : ";Orders

Print
ENDTIME = Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))
Minut=(ENDTIME-STARTT)\60
'Print Using "processing time: ## minutes ## seconds"; Minut; (ENDTIME-STARTT)-Minut*60
Print Using "処理時間: ## 分 ## 秒"; Minut; (ENDTIME-STARTT)-Minut*60

Print

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

'****************************************************************
'****************************************************************
   'Print "Sort the totaled results by Region and ItemID."
   Print "集計結果を、地域順・品目コード順に並び替えます。"
'****************************************************************
Print

'-------------------------------- main program ---------------------------------

Dim As Integer numRows = Counter, numCols = 5

Var myData = data_type(numRows, numCols)

For iRow As Integer = 1 To Counter
   With myData.row(iRow)
      For iCol As Integer = 1 To UBound(.col)
         .col(iCol) = IntegratedOrderArray(iRow,iCol)
      Next
   End With
Next iRow

myData.sort(sort_type(1, +1), sort_type(2, +1), sort_type(0, 0))

For iRow As Integer = 1 To Counter
   With myData.row(iRow)
      For iCol As Integer = 1 To UBound(.col)
         IntegratedOrderArray(iRow,iCol) = .col(iCol)
      Next
   End With
Next iRow

'****************************************************************
'****************************************************************
   'Print "Out put the sorted results to ""OrderSorting.csv"""
   Print "集計結果を ""OrderSorting.csv"" として出力します。"
'****************************************************************
Print

'IntegratedOrderArray(20000,5) 'Region, ItemID, Quantity, Amount, Weight
Open "OrderSorting.csv"  For Output As #1
   For i = 1 To Counter
      CharacterString = ""
      For Dimension =1 To 5
         cellString = IntegratedOrderArray(i,Dimension)
         If Dimension = 1 Then
            cellString = """" & cellString & """"
         EndIf
         If Dimension > 1 Then
            cellString = "," & cellString
         EndIf
         CharacterString = CharacterString & cellString
      Next Dimension

      Print #1, CharacterString

   Next i
Close #1

'****************************************************************
'****************************************************************
'Print "Output of the sorted order aggregate has been completed."
Print "集計結果のリスト出力が完了しました。"
Print "*******************************************************"

MasterItemIDpTable -> cleartable()
MasterItemIDpTable -> freetable()

OrderItemIDpTable -> cleartable()
OrderItemIDpTable -> freetable()

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

Sleep

ページの頭に戻る

補足に戻る

←リンク元に戻る　プログラム開発関連に戻る

ページ歴史:2021-02-01
日本語翻訳：WATANABE Makoto、原文著作者：VANYA

FreeBASIC 連想配列(containers の hashtable)

連想配列(containers の hashtable) 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

キーの登録とパフォーマンスを検証

英文字の出現頻度を数える

日本語漢字(県名)をキーにしてデータを集計する

品目マスタと品目オーダを照合

連想配列(containers の hashtable)　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい