This first functional version of LZAE brings the advantage of its integration with the list engine. The operating principles are simple if kept in mind:
First, you have a linear parser on the array. You are browsing a dataset, which is characterized by four elements: the left cursor, the right cursor, the offset step that represents the number of elements of the array to jump at the time of the parse, and finally the current cursor. If the offset step is positive, you go from the current cursor to the right cursor, if it is negative, you go from the current cursor to the left cursor. You have two workspaces (called working set): the workingset (0) considers that the left cursor is always the first element of the array and the right cursor the last one. The workingset (1) considers that the left and right cursors are currently active ones specified by the user.
Secondly, you have several basic functions that are very useful for jobs involving dynamic memory usage: sort, search, and unique. The sort function contains four use cases: either you pass an empty list in reference and you retrieve a list sorted on the dataset, or you build an index in memory on the dataset traversed (to do loop searches, etc. ), or you pass the sort on the dataset in the array, or you construct a linear translation vector on the traversed dataset.
Thirdly, Apply functions make it possible to work on arrays by applying the linear translation vectors in various ways.
All these functions ignore the current cursor (that of the parser "manual") to not pollute the work of said parser. It works therefore taking into account the left and right sliders and offset.
The expansion of the array extension is justified by several elements:
- The functional and technical convergence possible between list and tables, especially at the programming level.
- The possibility and the need for an interface to manipulate arrays differently.
- A "real" Basic-style oriented instruction set (wich is more flexible than a collection of functions)
- A "proof of concept" on LZLE having led to consider new features (which explains the version 0.994).
Returns, suggestions and remarks will be welcome, objectives (or constraints) identified: to have a quick parser and a credible consistency check, try to optimally manage the possibilities indexing in the kinematics of use, and have an instruction set sufficiently coherent and powerful in its logic of use to help a user to design his own functions.
I hope this work will interest some, thanks for returns!
LZAE 0.60 BETA PART 1 is here :
Code: Select all
/' LZAE : LICENCE is CeCILL-C http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.txt - SUB Licence on LZLE : must be compiled using Free Basic Compiler
' Author : Etienne Carfagnini 92700 Colombes France. etienne.carfa@gmail.com
' Aext_Lcursor (element): specify a starting element in an array for being used by functions.
' Aext_Rcursor (element): specify a ending element
' Aext_SetCursor (item): set starting point for parsing
' Aext_Step (array): jump to next element (must NOT be Aext_Step (element))
' Aext_StepCursor (integer): a number of elements to jump when parsing (for example, by specifying the number of elements on a line, we parse on the column) (we can parse a dimension)
' Then more "classic" functions:
' Aext_Sort, Aext_Search, Aext_Unique but automatically taking into account Lcursor, Rcursor and StepCursor as they are settled when the function is called.
' Finally, an interesting function could be the persistence of the transposition vector of the last sorting performed: when sorting on a line, the index memorizes for each element the position of the original column. It would then be sufficient for the user to specify a vector (eg beginning and end of the second line), and then:
' Aext_Apply (array): repercutes the consequences of sorting the first line on the second line. It would be possible to propagate the consequences of a sort on a vector or array to another.
' Aext_Value : return current element value otherwise returned by Aext_Step
'/ ' END NOTICE
' ADDED : Step => aStep (Check) Or bStep (Faster), Cursors Sliding for moving(sliding) simultaneously left & right cursors : SlideCursors (Check) Or bSlideSet+bSlideCursors (Faster), NbSteps (for easy loops optimizations), WorkingSet (parser setup : increasing features) Note : critical speed properties aren't overloaded
' LZLE can be found here : https://www.freebasic.net/forum/viewtopic.php?f=8&t=26533
' Instructions set is as follow : aSet, Lcursor, Rcursor, StepCursor, SetCursor, bStepCursor, aStep, bStep, Value, SlideCursors, bSlideSet, bSlideCursors, NbSteps, WorkingSet +high end functions : Sort, Search, Unique, Apply - Everything starting with 'b' means faster but no checks while parsing
'#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZLE.bi"
'#Include once "D:\Basic\LZLE.bi" ' ------------------------------------------------------------------------------------------ CAUTION LZLE minimal requirement is 0.994 Beta ------------------------------------------------------------------------------------------
#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZLE_0.994.bi"
'ToDo : tests/sort search unique - tests Slide cursors/multi-dim arrays
'ToDo : OpenDimension, CloseDimension
'Renvoie la valeur n° Posi de la chaine STR_Values séparé par sep (;) le premier champs est indicé 0
Declare Function GetField(STR_Values As String, Posi As uInteger, sep As String=";") As String
Function GetField(STR_Values As String, Posi As uInteger, sep As String=";") As String
Dim As uInteger i, i_prev, NumField=0, NumPos=Posi+1 : Do : i_prev=i : i=Instr(i_prev+1, STR_Values, sep) : NumField +=1 : Loop Until NumField=NumPos Or i=0
If i=0 Then : i=Len(STR_Values)+1 : End If : If NumField=NumPos Then : GetField = Right( Left(STR_Values, i-1), i-i_prev-1) : Else : GetField = "" : End If
End Function
'Exception handling
CONST Er_Const00="ArrayExtension=>aSet : array setting failed !"
CONST Er_Const0="ArrayExtension=>LeftCursor : array not set."
CONST Er_Const1="ArrayExtension=>LeftCursor : assignation error."
CONST Er_Const2="ArrayExtension=>RightCursor : array not set."
CONST Er_Const3="ArrayExtension=>WorkingSet : array not set."
CONST Er_Const4="ArrayExtension=>RightCursor : assignation error."
CONST Er_Const5="ArrayExtension=>SetCursor : array not set."
CONST Er_Const6="ArrayExtension=>SetCursor : assignation error."
CONST Er_Const7="ArrayExtension=>StepCursor : array not set."
CONST Er_Const8="ArrayExtension=>StepCursor too big, would not step."
CONST Er_Const9="ArrayExtension=>StepCursor : integrity check error."
CONST Er_Const10="ArrayExtension=>WorkingSet : invalid parameter (must be 0 or 1)."
CONST Er_Const11="ArrayExtension=>(Proceed) NbSteps : array element out of working set."
CONST Er_Const12="ArrayExtension=>Search : no valid index previously created by 'sort'" & Chr(10) & " or Sort_Persistency set to 0 on last sort."
CONST Er_Const13="ArrayExtension=>Search=>integrity check error between search & transposition index."
CONST Er_Const14="ArrayExtension=>WorkingSet=>Warning : Cursor out of range set to "
CONST Er_Const15="ArrayExtension : LeftCursor>RightCursor :" & chr(10) & "=>Warning : right assignation autoreset to "
CONST Er_Const16="ArrayExtension=>(Proceed) NbSteps: integrity check error."
CONST Er_Const17="ArrayExtension=>SetCursor : not in working set assignation error."
CONST Er_Const18="ArrayExtension=>Datatype_Value : array not set or invalid Datatype."
CONST Er_Const19="ArrayExtension=>SetValue : array not set."
CONST Er_Const20="ArrayExtension=>SetValue : invalid Datatype."
CONST Er_Const21="ArrayExtension=>Sort : array not set."
CONST Er_Const22="ArrayExtension=>aStep : array not set."
CONST Er_Const23="ArrayExtension=>Sort_WriteArray : array not set."
CONST Er_Const24="ArrayExtension=>Sort_BuildVector : array not set."
CONST Er_Const25="ArrayExtension=>Sort_Persistency : array not set."
CONST Er_Const26="ArrayExtension=>Search : array not set."
CONST Er_Const27="ArrayExtension=>Unique : array not set."
CONST Er_Const28="ArrayExtension=>Apply : array not set."
CONST Er_Const29="ArrayExtension=>Apply : transposition vector empty."
CONST Er_Const30="ArrayExtension=>Apply : transposition index invalid missing entry n°"
'Shared
' Dim Shared gCollector As List
Dim Shared As Any Pointer Sh_ANY_Ptr, Sh_ANY_LastPtr
Dim Shared Sh_ArrayMask(8,1) As Integer
Dim Shared As Integer Sh_NbElements, Sh_ElementSize
Dim Shared As uByte Sh_Datatype
Type ArrayExtension
Declare Constructor() : Declare Destructor()
Private:
Dim As List SearchIndex, TranspositionIndex , WorkingIndex
Dim As Byte B_ApplySort=1, B_BuildTvector=1, B_SearchIndexPersistency=1
Dim As uByte uB_Datatype=0, uB_NbDim=0, uB_IsArraySet=0, uB_Reverse=0, uB_WorkingSet=0, uB_LastSortApplied=0, uB_HasIndex=0, uB_HasVector=0, uB_NestedCtrl, uB_ApplyByPass=0
Dim As uInteger INT_LenDataType=0, INT_NbElements=0, INT_TMP=1
Dim As Integer INT_IncPtr, ArrayMask(8,1), INT_StepCursor=1, INT_StepC=0
Dim As ANY Ptr ANY_StepPtr, ANY_LeftPtr, ANY_RightPtr, ANY_FirstPtr, ANY_LastPtr, ANY_FirstWorkingSetPtr, ANY_LastWorkingSetPtr, ANY_TestPtr, ANY_TmpPtr
Declare Property ComputeDescriptor As String ' Do not need access to real descritptor using typedefs to work around array manipulations - compute a string descriptor, set private variables
Declare Property LeftConsistency(ByRef Any_LC_Ptr As Any Ptr) As Byte ' Check : check if array set & Lcursor in array range
Declare Property CursorConsistency(ByRef Any_LC_Ptr As Any Ptr) As Byte ' Check : check if array set & CurrentCursor in array range
Declare Property RightConsistency(ByRef Any_RC_Ptr As Any Ptr) As Byte ' Check if array set & RightCursor in LeftCursor - LastElement array range
Declare Property ProceedNbSteps(ByRef Any_NbS_Ptr As Any Ptr) As uInteger
Declare Property GiveContext(ByRef str_Context As String) As Byte
Public:
'Datasets & methods to prepare a job :a array's dataset is defined by : an array, a starting element, ending element, and a step (diag parse should be possible)
Declare Property SetArray() As Byte 'ComputeDescriptor, Lcursor=>First, Current=>First, Rcursor=>Last
Declare Property Lcursor(ByRef ArrayElement As uByte) As Byte
Declare Property Lcursor(ByRef ArrayElement As uShort) As Byte
Declare Property Lcursor(ByRef ArrayElement As uLong) As Byte
Declare Property Lcursor(ByRef ArrayElement As uLongInt) As Byte
Declare Property Lcursor(ByRef ArrayElement As String) As Byte
Declare Property Lcursor(ByRef ArrayElement As Integer) As Byte
Declare Property Lcursor(ByRef ArrayElement As Single) As Byte
Declare Property Lcursor(ByRef ArrayElement As Double) As Byte
Declare Property Rcursor(ByRef ArrayElement As uByte) As Byte
Declare Property Rcursor(ByRef ArrayElement As uShort) As Byte
Declare Property Rcursor(ByRef ArrayElement As uLong) As Byte
Declare Property Rcursor(ByRef ArrayElement As uLongInt) As Byte
Declare Property Rcursor(ByRef ArrayElement As String) As Byte
Declare Property Rcursor(ByRef ArrayElement As Integer) As Byte
Declare Property Rcursor(ByRef ArrayElement As Single) As Byte
Declare Property Rcursor(ByRef ArrayElement As Double) As Byte
Declare Property StepCursor(StepCur As Integer) As Byte
Declare Property bStepCursor(StepCur As Integer) As Byte
Declare Property WorkingSet(WkgSet As Byte) As Byte
'Parsers (step & slide)
Declare Property SetCursor(ByRef ArrayElement As uByte) As uByte Ptr 'Current cursor for programmatic handling
Declare Property SetCursor(ByRef ArrayElement As uShort) As uShort Ptr
Declare Property SetCursor(ByRef ArrayElement As uLong) As uLong Ptr
Declare Property SetCursor(ByRef ArrayElement As uLongInt) As uLongInt Ptr
Declare Property SetCursor(ByRef ArrayElement As String) As String Ptr
Declare Property SetCursor(ByRef ArrayElement As Integer) As Integer Ptr
Declare Property SetCursor(ByRef ArrayElement As Single) As Single Ptr
Declare Property SetCursor(ByRef ArrayElement As Double) As Double Ptr
Declare Property aStep As Byte '
Declare Property bStep As Byte
Declare Property Value As String
Declare Property SlideCursors(SlideCur As Integer) As Byte ' (left?) & Right slide both Lcursor & Rcursor of SlideCur elements, so as user can design loops for parsing dimensions
Declare Property bSlideSet(SlideCur As Integer) As Byte ' no checks
Declare Property bSlideCursors As Byte ' no checks
'Utilities
Declare Property NbSteps As uInteger
Declare Property NbSteps(ByRef ArrayElement As uByte) As uInteger
Declare Property NbSteps(ArrayElement As uByte Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As uShort) As uInteger
Declare Property NbSteps(ArrayElement As uShort Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As uLong) As uInteger
Declare Property NbSteps(ArrayElement As uLong Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As uLongInt) As uInteger
Declare Property NbSteps(ArrayElement As uLongInt Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As String) As uInteger
Declare Property NbSteps(ArrayElement As String Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As Integer) As uInteger
Declare Property NbSteps(ArrayElement As Integer Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As Single) As uInteger
Declare Property NbSteps(ArrayElement As Single Ptr) As uInteger
Declare Property NbSteps(ByRef ArrayElement As Double) As uInteger
Declare Property NbSteps(ArrayElement As Double Ptr) As uInteger
Declare Property NbSteps(ArrayElement As Any Ptr) As uInteger
Declare Property uByte_Value As uByte
Declare Property uShort_Value As uShort
Declare Property uLng_Value As uLong
Declare Property uLngInt_Value As uLongInt
Declare Property Str_Value As String
Declare Property Int_Value As Integer
Declare Property Sng_Value As Single
Declare Property Dbl_Value As Double
Declare Property SetValue(ArrayValue As uByte) As Byte
Declare Property SetValue(ArrayValue As uShort) As Byte
Declare Property SetValue(ArrayValue As uLong) As Byte
Declare Property SetValue(ArrayValue As uLongInt) As Byte
Declare Property SetValue(ArrayValue As String) As Byte
Declare Property SetValue(ArrayValue As Integer) As Byte
Declare Property SetValue(ArrayValue As Single) As Byte
Declare Property SetValue(ArrayValue As Double) As Byte
'Db or back-end interface oriented functions
Declare Property Sort As Byte ' On current dataset
Declare Property Sort(ByRef MyList As List) As Byte ' On current dataset
Declare Property Search(ByRef MyList As List) As Byte ' On current dataset
Declare Property Unique(ByRef MyList As List) As Byte ' On current dataset
Declare Property Apply As Byte ' aArray is the translation vector from latest sort to apply on a linearised parsing dataset (Lcursor, Rcursor, StepCursor)
Declare Property Apply(aext As ArrayExtension) As Byte ' aArray is a translation vector to apply on a linearised parsing dataset (Lcursor, Rcursor, StepCursor)
Declare Property ImportVector(ByRef MyList As List) As Byte ' Replace current translation vector by MyList
Declare Property ExportVector(ByRef MyList As List) As Byte ' Return current translation vector into MyList
'Parameters for Db or back-end interface oriented functions
Declare Property Sort_WriteArray(ub As uByte) As Byte
Declare Property Sort_BuildVector(ub As uByte) As Byte
Declare Property Sort_Persistency(ub As uByte) As Byte
End Type
Constructor ArrayExtension : End Constructor
Destructor ArrayExtension
SearchIndex.GarbageFlat : SearchIndex.Recycle : gCollector.GarbageSnatch(SearchIndex)
TranspositionIndex.GarbageFlat : TranspositionIndex.Recycle : gCollector.GarbageSnatch(TranspositionIndex)
WorkingIndex.GarbageFlat : WorkingIndex.Recycle : gCollector.GarbageSnatch(WorkingIndex)
End Destructor
'Syntax overloaded entry functions
Declare Function aSet Overload (MyArray() as uByte, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as uShort, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as uLong, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as uLongInt, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as String, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as Integer, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as Single, aext As ArrayExtension) As Byte
Declare Function aSet Overload (MyArray() as Double, aext As ArrayExtension) As Byte
'===================================================================================================================================================
'TYPE ARRAY EXTENSION PRIVATE PROPERTIES
'===================================================================================================================================================
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Private use
Property ArrayExtension.ComputeDescriptor As String
Dim As String str_tmp
Return str_tmp
End Property
Property ArrayExtension.LeftConsistency(ByRef Any_LC_Ptr As Any Ptr) As Byte
If uB_Reverse=1 And uB_NestedCtrl<>1 Then : uB_NestedCtrl=1 : Return this.RightConsistency(Any_LC_Ptr) : End If : uB_NestedCtrl=0
If ANY_FirstPtr<>0 And ANY_LastPtr<>0 And uB_IsArraySet=1 Then
If ANY_FirstPtr<=Any_LC_Ptr And Any_LC_Ptr<=ANY_LastPtr Then
This.ANY_LeftPtr=Any_LC_Ptr
If This.ANY_LeftPtr > ANY_RightPtr And uB_Reverse=0 Then : ANY_RightPtr=this.ANY_LastPtr : Print Er_Const15 & "last" : End If
If This.ANY_LeftPtr < ANY_RightPtr And uB_Reverse=1 Then : ANY_RightPtr=this.ANY_LastPtr : Print Er_Const15 & "last" : End If
INT_StepC=INT_StepCursor*INT_LenDataType : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1 ' this.WorkingSet(uB_WorkingSet) :
Else : Print Er_Const1 : Return 0
End If
Else : Print Er_Const0 : Return 0
End If : Return 0
End Property
Property ArrayExtension.CursorConsistency(ByRef Any_C_Ptr As Any Ptr) As Byte
If ANY_FirstPtr<>0 And ANY_LastPtr<>0 And Ub_IsArraySet=1 Then
If uB_WorkingSet=1 Then
' If ANY_LeftPtr<=Any_C_Ptr And Any_C_Ptr<=ANY_RightPtr And uB_Reverse=0 Then : Else : Print Er_Const17 : Return 0 : End If
If uB_Reverse=1 Then : If ANY_RightPtr<=Any_C_Ptr And Any_C_Ptr<=ANY_LeftPtr Then : Else : Print Er_Const17 : Return 0 : End If :
ElseIf uB_Reverse=0 Then : If ANY_LeftPtr<=Any_C_Ptr And Any_C_Ptr<=ANY_RightPtr Then : Else : Print Er_Const17 : Return 0 : End If
End If
End If
If ANY_FirstPtr<=Any_C_Ptr And Any_C_Ptr<=ANY_LastPtr Then : This.ANY_StepPtr=Any_C_Ptr : Return 1
Else : Print Er_Const6 : Return 0
End If
Else : Print Er_Const5 : Return 0
End If : Return 0
End Property
Property ArrayExtension.RightConsistency(ByRef Any_RC_Ptr As Any Ptr) As Byte
If uB_Reverse=1 And uB_NestedCtrl<>1 Then : uB_NestedCtrl=1 : Return this.LeftConsistency(Any_RC_Ptr) : End If : uB_NestedCtrl=0
If ANY_FirstPtr<>0 And ANY_LastPtr<>0 And Ub_IsArraySet=1 Then
If ANY_LeftPtr<=Any_RC_Ptr And Any_RC_Ptr<=ANY_LastPtr And uB_Reverse=0 Then : ANY_RightPtr=Any_RC_Ptr : ANY_LastWorkingSetPtr=ANY_RightPtr : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1
ElseIf ANY_FirstPtr<=Any_RC_Ptr And Any_RC_Ptr<=ANY_LeftPtr And uB_Reverse=1 Then : ANY_RightPtr=Any_RC_Ptr : ANY_LastWorkingSetPtr=ANY_RightPtr : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1
Else : Print Er_Const4 : Return 0
End If
Else : Print Er_Const2 : Return 0 : End If
End Property
Property ArrayExtension.ProceedNbSteps(ByRef ArrayElement As Any Ptr) As uInteger
If ANY_LeftPtr<=ArrayElement And ArrayElement<=ANY_RightPtr And uB_Reverse=0 Then
ElseIf ANY_RightPtr<=ArrayElement And ArrayElement<=ANY_LeftPtr And uB_Reverse=1 Then
Else : Print Er_Const11 : Return 0 : End If
ANY_TestPtr=ANY_StepPtr
If this.CursorConsistency(ArrayElement)=1 Then
If uB_ApplyByPass=1 Then
If uB_Reverse=0 Then : INT_TMP=Fix( ABS( ( Cint(ANY_FirstWorkingSetPtr)) - Cint(ArrayElement) )/INT_StepC )
ElseIf uB_Reverse=1 Then : INT_TMP=Fix( ABS( ( Cint(ANY_FirstWorkingSetPtr)) - Cint(ArrayElement) )/-INT_StepC )
End If : ANY_StepPtr=ANY_TestPtr : Return INT_TMP
ElseIf uB_WorkingSet=0 Then
If uB_Reverse=0 Then : INT_TMP=Fix( ABS( ( Cint(ANY_LastPtr)) - Cint(ArrayElement) )/INT_StepC )
ElseIf uB_Reverse=1 Then : INT_TMP=Fix( ABS( ( Cint(ANY_FirstWorkingSetPtr)) - Cint(ArrayElement) )/-INT_StepC )
End If : ANY_StepPtr=ANY_TestPtr : Return INT_TMP
Else
If uB_Reverse=0 Then : INT_TMP=Fix( ABS( Cint( ANY_LastWorkingSetPtr) - Cint(ArrayElement) )/INT_StepC )
Else : INT_TMP=Fix( ABS( Cint(ANY_LastWorkingSetPtr) - Cint(ArrayElement) )/-INT_StepC )
End If : ANY_StepPtr=ANY_TestPtr : Return INT_TMP
End If
End If : Print Er_Const16 : Return 0
End Property
Property ArrayExtension.GiveContext(ByRef str_Context As String) As Byte ' ANY_StepPtr, ANY_FirstWorkingSetPtr, ANY_LastWorkingSetPtr, ANY_LeftPtr, ANY_RightPtr -- INT_StepCursor, INT_LenDataType, INT_StepC
str_Context=Str(ANY_StepPtr)+";"+Str(ANY_FirstWorkingSetPtr)+";"+Str(ANY_LastWorkingSetPtr)+";"+Str(ANY_LeftPtr)+";"+Str(ANY_RightPtr)+";"+Str(INT_StepCursor)+";"+Str(INT_LenDataType)+";"+Str(INT_StepC)
Return 1
End Property
'===================================================================================================================================================
'TYPE ARRAY EXTENSION PUBLIC PROPERTIES
'===================================================================================================================================================
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Private use declared Public
Property ArrayExtension.SetArray As Byte
Dim As Integer i : For i=1 To Sh_ArrayMask(0,0) : this.ArrayMask(i,0)=Sh_ArrayMask(i,0) : this.ArrayMask(i,1)=Sh_ArrayMask(i,1) : Next i
this.ANY_FirstPtr = Sh_ANY_Ptr : this.ANY_StepPtr=Sh_ANY_Ptr : this.ANY_LastPtr = Sh_ANY_LastPtr
this.ANY_LeftPtr=this.ANY_FirstPtr : this.ANY_RightPtr=this.ANY_LastPtr : ANY_FirstWorkingSetPtr=ANY_FirstPtr : ANY_LastWorkingSetPtr=ANY_LastPtr
this.INT_NbElements=Sh_NbElements : INT_IncPtr=1 : INT_LenDataType=Sh_ElementSize : this.uB_Datatype=Sh_Datatype : uB_IsArraySet=1 : uB_Reverse=0 : uB_WorkingSet=0
INT_StepCursor=1 : INT_StepC=INT_StepCursor*INT_LenDataType
Return 1
End Property
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Datasets & methods
Property ArrayExtension.Lcursor(ByRef ArrayElement As uByte) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As uShort) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As uLong) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As uLongInt) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As String) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As Integer) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As Single) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Lcursor(ByRef ArrayElement As Double) As Byte : If this.LeftConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As uByte) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As uShort) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As uLong) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As uLongInt) As Byte :If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As String) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As Integer) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As Single) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.Rcursor(ByRef ArrayElement As Double) As Byte : If this.RightConsistency(@ArrayElement)=1 Then : Return 1 : Else : Return 0 : End If : End Property
Property ArrayExtension.StepCursor(StepCur As Integer) As Byte
Dim StepCur_tmp As Integer=INT_StepCursor
If uB_IsArraySet<>1 Then : Print Er_Const7 : Return 0 : End If
If Abs(StepCur) > INT_NbElements Then : Print Er_Const8 & " : " & StepCur & " > " & INT_NbElements : Return 0 : End If
uB_NestedCtrl=1
If This.LeftConsistency(ANY_LeftPtr)=1 Then
uB_NestedCtrl=1
If This.RightConsistency(ANY_RightPtr)=1 Then
If StepCur<0 And uB_Reverse=0 Then : If ANY_LeftPtr<ANY_RightPtr Then : ANY_TestPtr=ANY_LeftPtr : ANY_LeftPtr=ANY_RightPtr : ANY_RightPtr=ANY_TestPtr : uB_Reverse=1 : Else : Print Er_Const9 : End If : End If
If StepCur>0 And uB_Reverse=1 Then : If ANY_LeftPtr>ANY_RightPtr Then : ANY_TestPtr=ANY_LeftPtr : ANY_LeftPtr=ANY_RightPtr : ANY_RightPtr=ANY_TestPtr : uB_Reverse=0 : Else : Print Er_Const9 : End If : End If
INT_StepCursor=StepCur : INT_StepC=INT_StepCursor*INT_LenDataType : Return 1
End If
End If : INT_StepCursor=StepCur_tmp : Return 0
End Property
Property ArrayExtension.bStepCursor(StepCur As Integer) As Byte : INT_StepCursor=StepCur : INT_StepC=INT_StepCursor*INT_LenDataType : Return 1 : End Property
Property ArrayExtension.WorkingSet(WkgSet As Byte) As Byte
If uB_IsArraySet=1 Then
If WkgSet=0 Then : uB_WorkingSet=0 : ANY_LastWorkingSetPtr=ANY_LastPtr : Return 1
ElseIf WkgSet=1 Then
If uB_Reverse=0 Then : If ANY_LeftPtr<=ANY_StepPtr And ANY_StepPtr<=ANY_RightPtr Then : Else : ANY_StepPtr=ANY_LeftPtr : Print Er_Const14 & "Lcursor" : End If
ElseIf uB_Reverse=1 Then : If ANY_RightPtr<=ANY_StepPtr And ANY_StepPtr<=ANY_LeftPtr Then : Else : ANY_StepPtr=ANY_LeftPtr : Print Er_Const14 & "Rcursor" : End If
End If : uB_WorkingSet=1 : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1
Else : Print Er_Const10 : Return 0 : End If
Else : Print Er_Const3 : Return 0
End If
End Property
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Parsers
Property ArrayExtension.SetCursor(ByRef ArrayElement As uByte) As uByte Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As uShort) As uShort Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As uLong) As uLong Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As uLongInt) As uLongInt Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As String) As String Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As Integer) As Integer Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As Single) As Single Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.SetCursor(ByRef ArrayElement As Double) As Double Ptr : If this.CursorConsistency(@ArrayElement)=1 Then : Return @ArrayElement : Else : Return 0 : End If : End Property
Property ArrayExtension.aStep As Byte ' Heavy check, return 0 on fail
ANY_TestPtr=ANY_StepPtr : ANY_TestPtr+=INT_StepC
If uB_IsArraySet=0 Then : Print Er_Const22 : Return 0
ElseIf uB_WorkingSet=0 Then
If ANY_FirstPtr<=ANY_TestPtr And ANY_TestPtr<=ANY_LastPtr Then : ANY_StepPtr=ANY_TestPtr : Return 1 : Else : Return 0 : End If
ElseIf uB_WorkingSet=1 Then
If uB_Reverse=0 Then : If ANY_LeftPtr<=ANY_TestPtr And ANY_TestPtr<=ANY_RightPtr Then : ANY_StepPtr=ANY_TestPtr : Return 1 : Else : Return 0 : End If
Else : If ANY_RightPtr<=ANY_TestPtr And ANY_TestPtr<=ANY_LeftPtr Then : ANY_StepPtr=ANY_TestPtr : Return 1 : Else : Return 0 : End If
End If : Return 0
End If : Return 0
End Property
Property ArrayExtension.bStep As Byte : ANY_StepPtr+=INT_StepC : Return 1 : End Property 'No check, always stepping next element, unexpected results if running out of scope
Property ArrayExtension.Value As String
Select Case As Const uB_Datatype
Case 1 : Return Str(*Cptr(uByte Ptr, Any_StepPtr))
Case 2 : Return Str(*Cptr(uShort Ptr, Any_StepPtr))
Case 3 : Return Str(*Cptr(uLong Ptr, Any_StepPtr))
Case 4 : Return Str(*Cptr(uLongInt Ptr, Any_StepPtr))
Case 5 : Return *Cptr(String Ptr, Any_StepPtr)
Case 6 : Return Str(*Cptr(Integer Ptr, Any_StepPtr))
Case 7 : Return Str(*Cptr(Single Ptr, Any_StepPtr))
Case 8 : Return Str(*Cptr(Double Ptr, Any_StepPtr))
End Select
End Property
Property ArrayExtension.SlideCursors(SlideCur As Integer) As Byte ' Heavy check, return 0 on fail
INT_TMP=SlideCur*INT_LenDataType
If ANY_FirstPtr<=ANY_LeftPtr+INT_TMP And ANY_RightPtr+INT_TMP<=ANY_LastPtr And uB_Reverse=0 Then
ANY_LeftPtr+=INT_TMP : ANY_RightPtr+=INT_TMP : ANY_FirstWorkingSetPtr=ANY_LeftPtr : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1
ElseIf ANY_FirstPtr<=ANY_RightPtr+INT_TMP And ANY_LeftPtr+INT_TMP<=ANY_LastPtr And uB_Reverse=1 Then
ANY_LeftPtr+=INT_TMP : ANY_RightPtr+=INT_TMP : ANY_FirstWorkingSetPtr=ANY_LeftPtr : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1
Else : Return 0 : End If
End Property
Property ArrayExtension.bSlideSet(SlideCur As Integer) As Byte : INT_IncPtr=SlideCur*INT_LenDataType : Return 1 : End Property 'No check, always slidding next element(s), unexpected results if running out of scope
Property ArrayExtension.bSlideCursors As Byte : ANY_LeftPtr+=INT_IncPtr : ANY_RightPtr+=INT_IncPtr : ANY_FirstWorkingSetPtr=ANY_LeftPtr : ANY_LastWorkingSetPtr=ANY_RightPtr : Return 1 : End Property
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Utilities
Property ArrayExtension.NbSteps As uInteger : Return ProceedNbSteps(Any_StepPtr) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As uByte) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As uByte Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As uShort) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As uShort Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As uLong) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As uLong Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As uLongInt) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As uLongInt Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As String) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As String Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As Integer) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As Integer Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As Single) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As Single Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ByRef ArrayElement As Double) As uInteger : Return ProceedNbSteps(@ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As Double Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.NbSteps(ArrayElement As Any Ptr) As uInteger : Return ProceedNbSteps(ArrayElement) : End Property
Property ArrayExtension.uByte_Value As uByte : If Ub_IsArraySet=1 And uB_Datatype=1 Then : Return *Cptr(uByte Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.uShort_Value As uShort : If Ub_IsArraySet=1 And uB_Datatype=2 Then : Return *Cptr(uShort Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.uLng_Value As uLong : If Ub_IsArraySet=1 And uB_Datatype=3 Then : Return *Cptr(uLong Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.uLngInt_Value As uLongInt : If Ub_IsArraySet=1 And uB_Datatype=4 Then : Return *Cptr(uLongInt Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.Str_Value As String : Return this.Value : End Property
Property ArrayExtension.Int_Value As Integer : If Ub_IsArraySet=1 And uB_Datatype=6 Then : Return *Cptr(Integer Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.Sng_Value As Single : If Ub_IsArraySet=1 And uB_Datatype=7 Then : Return *Cptr(Single Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.Dbl_Value As Double : If Ub_IsArraySet=1 And uB_Datatype=8 Then : Return *Cptr(Double Ptr, ANY_StepPtr) : Else : Print Er_Const18 : Return 0 : End If : End Property
Property ArrayExtension.SetValue(ArrayValue As uByte) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>1 Then : Print Er_Const20 : Else : *Cptr(uByte Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As uShort) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>2 Then : Print Er_Const20 : Else : *Cptr(uShort Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As uLong) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>3 Then : Print Er_Const20 : Else : *Cptr(uLong Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As uLongInt) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>4 Then : Print Er_Const20 : Else : *Cptr(uLongInt Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As String) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>5 Then : Print Er_Const20 : Else : *Cptr(String Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As Integer) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>6 Then : Print Er_Const20 : Else : *Cptr(Integer Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As Single) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>7 Then : Print Er_Const20 : Else : *Cptr(Single Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.SetValue(ArrayValue As Double) As Byte : If Ub_IsArraySet=0 Then : Print Er_Const19 : ElseIf uB_Datatype<>8 Then : Print Er_Const20 : Else : *Cptr(Double Ptr, ANY_StepPtr)=ArrayValue : Return 1 : End If : Return 0 : End Property
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Db/high level or back-end interface oriented functions
'Sort is the PIVOT POINT between Array and List : can be used to build an index for search cessions as well as to build a propagation vector for arrays as well as to propagate directly on an array dataset (ie: Lcursor, Rcursor & StepCursor)
Property ArrayExtension.Sort As Byte ' Usage : Sort WITHOUT apply on source Array just to get an index for multiple search cession on a current & specified dataset OR Sort with or without Apply to get a sorted array and/or a transposition vector to propagate to other datasets
SearchIndex.HashKeyUnique(0) : SearchIndex.HashSort(1)
Dim As Any Ptr ANY_Step=ANY_StepPtr : Dim As uInteger u, w, uInt_nbSteps, t, str_tmp_len : Dim As uByte uB_Len, uB_out=0 : Dim As String str_tmp ' , nbLoops=0
'Parsing array, loading a sorted list wich can be used by search as a persistency index (named SearchIndex)
If B_ApplySort=0 And B_BuildTvector=0 And B_SearchIndexPersistency=0 Then : Return 0 : End If
If uB_IsArraySet=0 Then : Print Er_Const21 : Return 0
ElseIf B_BuildTvector=-1 Then : TranspositionIndex.Recycle : gCollector.GarbageSnatch(TranspositionIndex) : uB_out=1
ElseIf B_SearchIndexPersistency=-1 Then : SearchIndex.Recycle : gCollector.GarbageSnatch(SearchIndex) : uB_out=1
Else : uB_ApplyByPass=1 : If uB_Reverse=1 Then : uInt_nbSteps=this.NbSteps(ANY_LeftPtr) : Else : uInt_nbSteps=this.NbSteps(ANY_RightPtr) : End If : uB_ApplyByPass=0 : ANY_StepPtr=ANY_LeftPtr
End If : If uB_out=1 Then : Return 1 : End If : SearchIndex.Recycle : SearchIndex.GarbageSnatch(gCollector)
For u=1 To uInt_nbSteps+1 : str_tmp=this.Value : SearchIndex.HashTag(str_tmp) : SearchIndex.RwTag1(str(u)) : ANY_StepPtr+=INT_StepC : Next u : gCollector.GarbageSnatch(SearchIndex)
'Writing list sort results to array
uB_LastSortApplied=0 : uB_HasIndex=1 : uB_HasVector=0
If B_ApplySort=1 Then
w=uInt_nbSteps : ANY_StepPtr=ANY_LeftPtr : uB_LastSortApplied=1 : SearchIndex.Root : u=0
If uB_Reverse=0 Then
Select Case As Const uB_Datatype
Case 1 : While SearchIndex.nKeyStep And u<w : *Cptr(uByte Ptr, ANY_StepPtr)=CuByte(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uByte Ptr, ANY_StepPtr)=CuByte(SearchIndex.HashTag)
Case 2 :While SearchIndex.nKeyStep And u<w : *Cptr(uShort Ptr, ANY_StepPtr)=CuShort(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uShort Ptr, ANY_StepPtr)=CuShort(SearchIndex.HashTag)
Case 3 :While SearchIndex.nKeyStep And u<w : *Cptr(uLong Ptr, ANY_StepPtr)=CuLng(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uLong Ptr, ANY_StepPtr)=CuLng(SearchIndex.HashTag)
Case 4 : While SearchIndex.nKeyStep And u<w : *Cptr(uLongInt Ptr, ANY_StepPtr)=CuLngInt(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uLongInt Ptr, ANY_StepPtr)=CuLngInt(SearchIndex.HashTag)
Case 5 : While SearchIndex.KeyStep And u<w : *Cptr(String Ptr, ANY_StepPtr)=SearchIndex.HashTag : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(String Ptr, ANY_StepPtr)=SearchIndex.HashTag
Case 6 : While SearchIndex.nKeyStep And u<w : *Cptr(Integer Ptr, ANY_StepPtr)=Cint(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(Integer Ptr, ANY_StepPtr)=Cint(SearchIndex.HashTag)
Case 7 : While SearchIndex.nKeyStep And u<w : *Cptr(Single Ptr, ANY_StepPtr)=cSng(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(Single Ptr, ANY_StepPtr)=cSng(SearchIndex.HashTag)
Case 8 : While SearchIndex.nKeyStep And u<w : *Cptr(Double Ptr, ANY_StepPtr)=cDbl(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(Double Ptr, ANY_StepPtr)=cDbl(SearchIndex.HashTag)
End Select
Else
Select Case As Const uB_Datatype
Case 1 : While SearchIndex.nKeyStepRev And u<w : *Cptr(uByte Ptr, ANY_StepPtr)=CuByte(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uByte Ptr, ANY_StepPtr)=CuByte(SearchIndex.HashTag)
Case 2 :While SearchIndex.nKeyStepRev And u<w : *Cptr(uShort Ptr, ANY_StepPtr)=CuShort(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uShort Ptr, ANY_StepPtr)=CuShort(SearchIndex.HashTag)
Case 3 :While SearchIndex.nKeyStepRev And u<w : *Cptr(uLong Ptr, ANY_StepPtr)=CuLng(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uLong Ptr, ANY_StepPtr)=CuLng(SearchIndex.HashTag)
Case 4 : While SearchIndex.nKeyStepRev And u<w : *Cptr(uLongInt Ptr, ANY_StepPtr)=CuLngInt(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(uLongInt Ptr, ANY_StepPtr)=CuLngInt(SearchIndex.HashTag)
Case 5 : While SearchIndex.KeyStepRev And u<w : *Cptr(String Ptr, ANY_StepPtr)=SearchIndex.HashTag : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(String Ptr, ANY_StepPtr)=SearchIndex.HashTag
Case 6 : While SearchIndex.nKeyStepRev And u<w : *Cptr(Integer Ptr, ANY_StepPtr)=Cint(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(Integer Ptr, ANY_StepPtr)=Cint(SearchIndex.HashTag)
Case 7 : While SearchIndex.nKeyStepRev And u<w : *Cptr(Single Ptr, ANY_StepPtr)=cSng(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(Single Ptr, ANY_StepPtr)=cSng(SearchIndex.HashTag)
Case 8 : While SearchIndex.nKeyStepRev And u<w : *Cptr(Double Ptr, ANY_StepPtr)=cDbl(SearchIndex.HashTag) : ANY_StepPtr+=INT_StepC : u+=1 : Wend : *Cptr(Double Ptr, ANY_StepPtr)=cDbl(SearchIndex.HashTag)
End Select
End If
End If
If B_BuildTvector=1 Then 'Building an indexed transposition vector uB_Len
TranspositionIndex.Recycle : TranspositionIndex.HashKeyUnique(1) : TranspositionIndex.HashSort(1) : uB_HasVector=1
WorkingIndex.Recycle : WorkingIndex.GarbageSnatch(gCollector) : WorkingIndex.GarbageSnatch(SearchIndex) : WorkingIndex.GarbageSnatch(TranspositionIndex)
If B_SearchIndexPersistency=1 Then
uB_ApplyByPass=1 : If uB_Reverse=1 Then : uInt_nbSteps=this.NbSteps(ANY_LeftPtr) : Else : uInt_nbSteps=this.NbSteps(ANY_RightPtr) : End If : uB_ApplyByPass=0 ' Print "uInt_nbSteps=" & uInt_nbSteps
ANY_StepPtr=ANY_LeftPtr : For u=1 To uInt_nbSteps+1 : str_tmp=this.Value : WorkingIndex.HashTag(str_tmp) : WorkingIndex.RwTag1(str(u)) : ANY_StepPtr+=INT_StepC : Next u 'Print "#" & this.Value :
Else : SearchIndex.Root : WorkingIndex.Root : While SearchIndex.fStep : WorkingIndex.Snatch(SearchIndex) : Wend
End If 'WorkingIndex.Root : While WorkingIndex.HashStep : Print " ~ " & WorkingIndex.HashTag & " <= " & WorkingIndex.Tag(1) : Wend :sleep
If uB_Datatype=5 Then : u=1 : WorkingIndex.Root : While WorkingIndex.KeyStep : WorkingIndex.RwTag2(str(u)) : u+=1 : Wend
Else : u=1 : WorkingIndex.Root : While WorkingIndex.nKeyStep : WorkingIndex.RwTag2(str(u)) : u+=1 : Wend
End If
WorkingIndex.Root : While WorkingIndex.KeyStep : If WorkingIndex.Tag(2)<>"" Then : WorkingIndex.NodeFlat : End If : Wend
TranspositionIndex.Recycle : WorkingIndex.Recycle : TranspositionIndex.GarbageSnatch(WorkingIndex) : TranspositionIndex.FlatSnatch(WorkingIndex) : TranspositionIndex.ColTags(2) :
TranspositionIndex.FlatStack : While TranspositionIndex.fStep : TranspositionIndex.RestoreHash : Wend :TranspositionIndex.ColTags(0)
TranspositionIndex.Root : gCollector.GarbageSnatch(TranspositionIndex)
Else ' If no, previous transp vector is destroyed, must be related to latest sort index
gCollector.GarbageSnatch(SearchIndex) : TranspositionIndex.Recycle : gCollector.GarbageSnatch(TranspositionIndex)
End If : If B_SearchIndexPersistency=0 Then : SearchIndex.GarbageFlat : SearchIndex.Recycle : gCollector.GarbageSnatch(SearchIndex) : End If
' TranspositionIndex.Root : While TranspositionIndex.HashStep : Print "# " & TranspositionIndex.HashTag & " <= " & TranspositionIndex.Tag(1) : Wend :sleep
ANY_StepPtr=ANY_Step : Return 1
End Property
Property ArrayExtension.Sort(ByRef MyList As List) As Byte
MyList.Recycle : MyList.GarbageSnatch(gCollector) : MyList.HashKeyUnique(0) : MyList.HashSort(1) : uB_ApplyByPass=1
Dim As Any Ptr ANY_Step=ANY_StepPtr : Dim As uInteger u, uInt_nbSteps : Dim As uByte uB_Len : Dim As String str_tmp ' , nbLoops=0
'Parsing array, loading sorted list passed ByRef
If uB_IsArraySet=0 Then : Print Er_Const21 : Return 0 : ElseIf uB_Reverse=0 Then : uInt_nbSteps=this.NbSteps(ANY_RightPtr) : Else : uInt_nbSteps=this.NbSteps(ANY_LeftPtr) : End If : ANY_StepPtr=ANY_LeftPtr
For u=1 To uInt_nbSteps+1 : str_tmp=this.Value : MyList.HashTag(str_tmp) : MyList.RwTag1(str(u)) : ANY_StepPtr+=INT_StepC : Next u
ANY_StepPtr=ANY_Step : gCollector.GarbageSnatch(MyList) : MyList.Root
Return 1
End Property
Property ArrayExtension.Search(ByRef MyList As List) As Byte ' Given a list of UNIQUES values (indexed or not) returns a list of values matching latest search index with position(s) in dataset in .Val & number of occurences in Tag1
Dim As String Str_tmp
If uB_IsArraySet=0 Then : Print Er_Const26 : Return 0 : ElseIf uB_HasIndex=0 Then : Print Er_Const12 : Return 0 : End If : If uB_HasVector=1 Then : TranspositionIndex.Root : End If
MyList.Root : MyList.GarbageSnatch(gCollector) : SearchIndex.Root : SearchIndex.SeekMethod(0)
While MyList.KeyStep
While SearchIndex.HasKey(MyList.HashTag) ' SearchIndex.SeekMethod(1) or 2 would lead to infinite loop because hasKey will always be true searching from start & looping on first valid key matched
MyList.RwTag1( Str( CuInt(MyList.Tag(1))+1) )
If uB_LastSortApplied=0 Then : MyList.Val( MyList.Val & SearchIndex.Tag(1) & ";" )
Else
If uB_HasVector=1 Then
If TranspositionIndex.HashTag( SearchIndex.Tag(1) ) Then : MyList.Val( TranspositionIndex.Tag(1) & ";" & MyList.Val )
Else : Print SearchIndex.Tag(1) & Chr(10) & " : " & Er_Const13 : Return 0
End If
End If
End If
Wend
SearchIndex.Root
Wend
SearchIndex.Root : MyList.Root : gCollector.GarbageSnatch(MyList) : Return 1
End Property
Property ArrayExtension.Unique(ByRef MyList As List) As Byte
If uB_IsArraySet=0 Then : Print Er_Const27 : Return 0 : End If
MyList.Recycle : MyList.GarbageSnatch(gCollector) : MyList.HashKeyUnique(1) : MyList.HashSort(1)
Dim As Any Ptr ANY_Step=ANY_LeftPtr : Dim As uInteger u, w : w=this.NbSteps(ANY_RightPtr)
For u=1 To w
MyList.HashTag(this.Value) : MyList.Val(MyList.Val+";"+Str(u))
ANY_Step+=INT_StepC
Next u
MyList.HashTag(this.Value) : MyList.Val(MyList.Val+";"+Str(u))
gCollector.GarbageSnatch(MyList)
Return 1
End Property
Property ArrayExtension.Apply As Byte ' ANY_StepPtr, ANY_FirstWorkingSetPtr, ANY_LastWorkingSetPtr, ANY_LeftPtr, ANY_RightPtr uB_WorkingSet_tmp=uB_WorkingSet
Dim As Any Ptr ANY_Step_tmp=ANY_StepPtr, ANY_FirstWorkingSetPtr_tmp=ANY_FirstWorkingSetPtr, ANY_LastWorkingSetPtr_tmp=ANY_LastWorkingSetPtr
Dim As Any Ptr ANY_CurPos=ANY_LeftPtr : ANY_StepPtr=ANY_LeftPtr : ANY_FirstWorkingSetPtr=ANY_LeftPtr : ANY_LastWorkingSetPtr=ANY_RightPtr
Dim As Integer uInt_Position : Dim As uInteger uInt_i, uInt_nbSteps, uInt_Reloop, uInt_Cumul=0, uInt_TotCumul=0 : Dim As uByte uB_Len : Dim As String str_tmp :
uB_ApplyByPass=1 : If uB_IsArraySet=0 Then : Print Er_Const28 : uB_ApplyByPass=0 : Return 0 : ElseIf uB_Reverse=0 Then : uInt_nbSteps=this.NbSteps(ANY_RightPtr) : Else : uInt_nbSteps=this.NbSteps(ANY_RightPtr) : End If : uB_ApplyByPass=0
If TranspositionIndex.Count<1 Then : Print Er_Const29 : Return 0 : End If : TranspositionIndex.Root
WorkingIndex.Recycle : WorkingIndex.Root : WorkingIndex.GarbageSnatch(gCollector) : WorkingIndex.NFMethod(-1) : WorkingIndex.NFRecursive(1) ': WorkingIndex.HashTag(Chr(255)+Chr(255))
For uInt_i=1 To uInt_nbSteps+1 'Print "uInt_nbSteps=" & uInt_nbSteps
uInt_Reloop=uInt_i-uInt_Cumul
If TranspositionIndex.HasHashTag(str( uInt_Reloop ))<>1 Then
uInt_Cumul+=uInt_Reloop-1 : uInt_Reloop=1
If TranspositionIndex.HasHashTag(str( uInt_Reloop ))<>1 Then : Print Er_Const30 & str( uInt_Reloop ) : sleep : End If
WorkingIndex.Recycle ': WorkingIndex.Root
End If ' Print "# " & uInt_Reloop & " i=" & uInt_i '& " cumul=" & uInt_Cumul
ANY_StepPtr=ANY_CurPos : WorkingIndex.HashTag(str( uInt_Reloop )) : WorkingIndex.RwTag1(this.Value)
If WorkingIndex.HasHashTag(TranspositionIndex.Tag(1)) Then : str_tmp= WorkingIndex.Tag(1) : WorkingIndex.NodeFlat
Else
uInt_Position= (CuInt(TranspositionIndex.Tag(1))-1+uInt_Cumul)*INT_StepCursor*INT_LenDataType
ANY_StepPtr=ANY_LeftPtr : If uB_Reverse=1 Then : ANY_StepPtr-=uInt_Position : Else : ANY_StepPtr+=uInt_Position : End If : str_tmp=this.Value
End If
Select Case As Const uB_Datatype
Case 1 : *Cptr(uByte Ptr, ANY_StepPtr)=CuByte(str_tmp)
Case 2 : *Cptr(uShort Ptr, ANY_StepPtr)=CuShort(str_tmp)
Case 3 : *Cptr(uLong Ptr, ANY_StepPtr)=CuLng(str_tmp)
Case 4 : *Cptr(uLongInt Ptr, ANY_StepPtr)=CuLngInt(str_tmp)
Case 5 : *Cptr(String Ptr, ANY_StepPtr)=str_tmp
Case 6 : *Cptr(Integer Ptr, ANY_CurPos)=Cint(str_tmp)
Case 7 : *Cptr(Single Ptr, ANY_StepPtr)=cSng(str_tmp)
Case 8 : *Cptr(Double Ptr, ANY_StepPtr)=cDbl(str_tmp)
End Select
ANY_CurPos+=INT_StepC
Next uInt_i
ANY_FirstWorkingSetPtr=ANY_FirstWorkingSetPtr_tmp : ANY_LastWorkingSetPtr=ANY_LastWorkingSetPtr_tmp : ANY_StepPtr=ANY_Step_tmp ' : uB_WorkingSet=uB_WorkingSet_tmp
WorkingIndex.Recycle : gCollector.GarbageSnatch(WorkingIndex) : WorkingIndex.Root
Return 1
End Property
Property ArrayExtension.Apply(aext As ArrayExtension) As Byte ' ANY_StepPtr, ANY_FirstWorkingSetPtr, ANY_LastWorkingSetPtr, ANY_LeftPtr, ANY_RightPtr -- INT_StepCursor, INT_LenDataType, INT_StepC
Dim As Any Ptr ANY_Step_tmp=ANY_StepPtr, ANY_FirstWorkingSetPtr_tmp=ANY_FirstWorkingSetPtr, ANY_LastWorkingSetPtr_tmp=ANY_LastWorkingSetPtr
Dim As Any Ptr ANY_LeftPtr_tmp=ANY_LeftPtr, ANY_RightPtr_tmp=ANY_RightPtr
Dim As Integer INT_StepCursor_tmp=INT_StepCursor, INT_LenDataType_tmp=INT_LenDataType, INT_StepC_tmp=INT_StepC
Dim As String str_Context="" : aext.GiveContext(str_Context)
ANY_StepPtr=Cptr(Any Ptr, Cint(GetField(str_Context,0)) ) : ANY_FirstWorkingSetPtr=Cptr(Any Ptr, Cint(GetField(str_Context,1)) ) : ANY_LastWorkingSetPtr=Cptr(Any Ptr, Cint(GetField(str_Context,2)) ) :
ANY_LeftPtr=Cptr(Any Ptr, Cint(GetField(str_Context,3)) ) : ANY_RightPtr=Cptr(Any Ptr, Cint(GetField(str_Context,4)) ) :
INT_StepCursor=Cint(GetField(str_Context,5)) : INT_LenDataType=Cint(GetField(str_Context,6)) : INT_StepC=Cint(GetField(str_Context,7))
this.Apply
ANY_StepPtr=ANY_Step_tmp : ANY_FirstWorkingSetPtr=ANY_FirstWorkingSetPtr_tmp : ANY_LastWorkingSetPtr=ANY_LastWorkingSetPtr_tmp
ANY_LeftPtr=ANY_LeftPtr_tmp : ANY_RightPtr=ANY_RightPtr_tmp
INT_StepCursor=INT_StepCursor_tmp : INT_LenDataType=INT_LenDataType_tmp : INT_StepC=INT_StepC_tmp
Return 1
End Property
Property ArrayExtension.ImportVector(ByRef MyList As List) As Byte ' Replace current translation vector by MyList
TranspositionIndex.Root : TranspositionIndex.Recycle
MyList.Root : While MyList.fStep : TranspositionIndex.Snatch(MyList) : Wend : TranspositionIndex.Root
gCollector.GarbageSnatch(TranspositionIndex) : gCollector.GarbageSnatch(MyList)
Return 1
End Property
Property ArrayExtension.ExportVector(ByRef MyList As List) As Byte ' Return current translation vector into MyList
MyList.Root : MyList.Recycle : gCollector.GarbageSnatch(MyList)
TranspositionIndex.Root : While TranspositionIndex.fStep : MyList.Snatch(TranspositionIndex) : Wend
TranspositionIndex.Root : MyList.Root :
gCollector.GarbageSnatch(TranspositionIndex) : gCollector.GarbageSnatch(MyList)
Return 1
End Property
'Parameters for SORT on array dataset
Property ArrayExtension.Sort_WriteArray(ub As uByte) As Byte : If uB_IsArraySet=0 Then : Print Er_Const23 : Return 0 : ElseIf ub=0 Or ub=1 Then : B_ApplySort=ub : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.Sort_BuildVector(ub As uByte) As Byte : If uB_IsArraySet=0 Then : Print Er_Const24 : Return 0 : ElseIf ub=0 Or ub=1 Then : B_BuildTvector=ub : Return 1 : End If : Return 0 : End Property
Property ArrayExtension.Sort_Persistency(ub As uByte) As Byte : If uB_IsArraySet=0 Then : Print Er_Const25 : Return 0 : ElseIf ub=0 Or ub=1 Then : B_SearchIndexPersistency=ub : Return 1 : End If : Return 0 : End Property