LZAE - New array extension - BETA 0.60 (functionnal) (Updated Mon 8 Jul, 2019)

User projects written in or related to FreeBASIC.
Lost Zergling
Posts: 259
Joined: Dec 02, 2011 22:51
Location: France

LZAE - New array extension - BETA 0.60 (functionnal) (Updated Mon 8 Jul, 2019)

Postby Lost Zergling » Jun 20, 2019 15:31

Hello everybody !

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

Last edited by Lost Zergling on Jul 09, 2019 22:05, edited 5 times in total.
Lost Zergling
Posts: 259
Joined: Dec 02, 2011 22:51
Location: France

Re: LZAE - New array extension - Draft - In progress

Postby Lost Zergling » Jun 23, 2019 13:48

LZAE 0.60 BETA PART 2 :

Code: Select all

'===================================================================================================================================================
'ARRAY EXTENSION SETTING FUNCTIONS
'===================================================================================================================================================

'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Function aSet Overload (MyArray() as uByte, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=1 : Sh_ElementSize=SizeOf(uByte) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as uShort, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=2 : Sh_ElementSize=SizeOf(uShort) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as uLong, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=3 : Sh_ElementSize=SizeOf(uLong) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as uLongInt, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=4 : Sh_ElementSize=SizeOf(uLongInt) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as String, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=5 : Sh_ElementSize=SizeOf(String) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as Integer, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i   
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=6 : Sh_ElementSize=SizeOf(Integer) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as Single, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=7 : Sh_ElementSize=SizeOf(Single) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Private Function aSet Overload (MyArray() as Double, aext As ArrayExtension) As Byte
    Dim As Integer i : Sh_ArrayMask(0,0)=Ubound(MyArray,0)
    Sh_NbElements=1 : For i=1 To Ubound(MyArray,0) : Sh_NbElements=Sh_NbElements*(Ubound(MyArray, i)-LBound(MyArray, i)+1) : Sh_ArrayMask(i,0)=LBound(MyArray, i) : Sh_ArrayMask(i,1)=UBound(MyArray, i) : Next i
    Select Case As Const Sh_ArrayMask(0,0)
    Case 1 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1))
    Case 2 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2))
    Case 3 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3))
    Case 4 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4))
    Case 5 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5))
    Case 6 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6))
    Case 7 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7))
    Case 8 : Sh_ANY_Ptr=@MyArray(Lbound(MyArray,1), Lbound(MyArray,2), Lbound(MyArray,3), Lbound(MyArray,4), Lbound(MyArray,5), Lbound(MyArray,6), Lbound(MyArray,7), Lbound(MyArray,8))
    Case Else : Print Er_Const00 : Return 0
    End Select : Sh_Datatype=8 : Sh_ElementSize=SizeOf(Double) : Sh_ANY_LastPtr=Sh_ANY_Ptr+(Sh_NbElements-1)*Sh_ElementSize : aext.SetArray : Function=1
End Function

Last edited by Lost Zergling on Jul 09, 2019 0:13, edited 1 time in total.
Lost Zergling
Posts: 259
Joined: Dec 02, 2011 22:51
Location: France

Re: LZAE - New array extension - Draft - In progress

Postby Lost Zergling » Jun 23, 2019 13:49

Exemple 1

Code: Select all

#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZAE_0.60.bi"
'Dim  aArray(50) As String
'Dim  aArray(50) As uByte
Dim  aArray(50) As Integer
Dim aext As ArrayExtension
Dim as Integer i, t
For i=0 to 50
    'aArray(i)=Str(i)
    aArray(i)=50-i
Next i

aset( aArray() , aext)
Print "**********"
aext.Sort

'aext.StepCursor(2)
'aext.StepCursor(-3)

'aext.SetCursor(aArray(50) )


aext.SetCursor(aArray(0) )
aext.StepCursor(1)
Print "========"
'aext.SetCursor(aArray(0) )
'aext.SetCursor(aArray(0)) : aext.StepCursor(1)
Print aext.Value
While aext.astep
    Print aext.Value
Wend
Print "========"
'sleep
'aext.StepCursor(-2)
aext.StepCursor(-3)

'aext.StepCursor(3)

Print "Nb Steps= " & aext.NbSteps( aArray(9) )
Print "Nb Steps= " &  aext.NbSteps( aext.SetCursor(aArray(40) ) ) :
aext.SetCursor(aArray(6) )
Print "Nb Steps= " & aext.NbSteps
Print "Nb Steps= " & aext.NbSteps( aext.SetCursor(aArray(14) ) ) :
Print "**********"
aext.Rcursor(aArray(30))
aext.Lcursor(aArray(10))
'aext.Rcursor(aArray(6))
aext.SetCursor(aArray(25) )
aext.WorkingSet(1)
'aext.WorkingSet(0)

Print "Nb steps = " & aext.NbSteps
'For i=1 to aext.NbSteps
For i=1 to aext.NbSteps( aext.SetCursor(aArray(25) ) )
    Print aext.Value
    aext.bstep
Next i
Print aext.Value
Print "##"
aext.WorkingSet(0)
sleep
aext.SetCursor(aArray(18) )
Print aext.Value
While aext.astep
    Print aext.Value
Wend

Sleep
System


Exemple 2

Code: Select all

#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZAE_0.60.bi"

'Dim  aArray(50) As uByte
'Dim  aArray(150) As String
Dim  aArray(1 to 150) As Integer

Dim aext As ArrayExtension
Dim as Integer i, t
For i=1 to 150
  '  aArray(i)=Str(150-i)
    aArray(i)=150-i
Next i


Dim MaListe As List
aset( aArray() , aext)


aext.SetCursor(aArray(1))
aext.StepCursor(1)
Print "-----------------------"
Print aext.Value
While aext.astep
    Print aext.Value
Wend
Print "-----------------------"
sleep

aext.StepCursor(-1)
'aext.Sort_WriteArray(1)
'aext.Sort_Persistency(1)
aext.Sort(MaListe)

MaListe.Root
While MaListe.HashStep
    Print MaListe.HashTag
Wend

sleep
'system

aext.Sort_WriteArray(1)
aext.Sort_BuildVector(0)
aext.Sort
aext.SetCursor(aArray(1))
aext.StepCursor(1)
Print "-----------------------"
Print aext.Value
While aext.astep
    Print aext.Value
Wend
Print "-----------------------"


Sleep
System


Exemple 3

Code: Select all


#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZAE_0.60.bi"
Dim  aArray(1 to 3, 1 To 5) As Integer
Dim As String str_tmp
Dim As Integer i=0, k=0, w


For i=1 To 3
    For k= 1 To 5       
        '-------------Alternative syntax : reverse testing
        aArray(i,k)=i*5-k+1
      '  aArray(i,5-k)=i*4-k+1
        w-=1
    Next k
Next i
aArray(1,5)=18

Print "---------------- Original values"
For i=1 To 3
    For k= 1 To 5
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i


Dim aext As ArrayExtension
aSet(aArray() , aext)

'-------------Alternative syntax : reverse testing
aext.StepCursor(1)
'aext.StepCursor(-1)

aext.Sort_WriteArray(0)
'-------------Alternative syntax : Sort_WriteArray testing
'aext.Sort_WriteArray(1)
aext.Sort_BuildVector(1)
aext.Sort_Persistency(0)

aext.Lcursor( aArray(1,1) )
aext.Rcursor( aArray(1,5) )
aext.Sort

Print "---------------- After sorting (on first line, back end)"
For i=1 To 3
    For k= 1 To 5
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i
'Sleep

aext.Apply
Print
Print "---------------- Apply on first line"
For i=1 To 3
    For k= 1 To 5
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i

'aext.SlideCursors(4)
'-------------Alternative syntax
aext.bSlideSet(5)
aext.bSlideCursors
'-------------Alternative syntax
'aext.Rcursor( aArray(2,4) )
'aext.Lcursor( aArray(2,1) )
aext.Apply
Print
Print "---------------- Apply on second line"
For i=1 To 3
    For k= 1 To 5
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i

aext.Rcursor( aArray(3,5) )
aext.Lcursor( aArray(3,1) )
aext.Apply
Print
Print "---------------- Apply on third line"
For i=1 To 3
    For k= 1 To 5
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i
Print "fin"

Sleep
System



Exemple 4

Code: Select all

#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZAE_0.60.bi"
Dim  aArray(1 to 4, 1 To 4) As Integer
Dim As String str_tmp
Dim As Integer i=0, k=0, w

For i=1 To 4
    For k= 1 To 4       
        '-------------Alternative syntax : reverse testing
        aArray(i,k)=i*4-k+1
    '    aArray(i,5-k)=i*4-k+1
        w-=1
    Next k
Next i

Print "---------------- Original values"
For i=1 To 4
    For k= 1 To 4
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i

Dim aext As ArrayExtension
aSet(aArray() , aext)


aext.SetCursor(aArray(1,1))
aext.StepCursor(1)
Print "---------------- Linear Parsing"
Print aext.Value
While aext.astep
    Print aext.Value
Wend
Print "-----------------------"
Sleep



aext.Sort_WriteArray(0)
aext.Sort_BuildVector(1)
aext.Sort_Persistency(0)

aext.Lcursor( aArray(1,1) )
aext.Rcursor( aArray(1,4) )
aext.StepCursor(1)
aext.Sort

aext.Lcursor( aArray(1,1) )
aext.Rcursor( aArray(4,4) )
aext.StepCursor(5)
aext.Apply
Print
Print "--------------- New values : back end sort vector line on 1 applied to diagonal"
For i=1 To 4
    For k= 1 To 4
        str_tmp+=Left(Str(aArray(i,k))+"    ", 4)
    Next k
    Print str_tmp
    str_tmp=""   
Next i

Print
Print "---------------+ Parsing new diagonal : StepCursor(5)=Line len+1"
aext.SetCursor( aArray(1,1) )
Print aext.Value
While aext.astep
    Print aext.Value
Wend
sleep
aext.StepCursor(4)
aext.SetCursor( aArray(1,1) )
'aext.SetCursor( aArray(1,2) )
'Print aext.Value & "?"

For k=1 to 4
    Print "---------------+ Parsing column " & k
    aext.SetCursor( aArray(1,k) )
    For i=1 to aext.NbSteps
        Print aext.Value
        aext.bstep
    Next i
    Print aext.Value   
Next k
Print "----------------"   
Sleep
System



Exemple 5

Code: Select all


#Include once "C:\FB64\FreeBASIC-1.05.0-win64\FreeBASIC-1.05.0-win64\LZAE_0.60.bi"

Dim  aArray(1 to 20) As Integer
Dim As String str_tmp
Dim As Integer i=0, k=0, w


Dim aext As ArrayExtension
aSet(aArray() , aext)

For i=1 to 40
    aArray(i)=i     
Next i

Dim MyList As List
MyList.HashTag("1") : MyList.RwTag1("2")
MyList.HashTag("2") : MyList.RwTag1("1")
MyList.Root
Print "--- Translation vector"
While MyList.HashStep
    Print MyList.HashTag & " " & MyList.Tag(1)
Wend
Print


Print "--- Fast array parsing"
aext.SetCursor( aArray(1) )
For i=1 to aext.NbSteps
    Print aext.Value
    aext.bStep
Next i
Print aext.Value

aext.ImportVector(MyList)
aext.Apply
sleep

Print "--- After translation"
aext.SetCursor( aArray(1) )
For i=1 to aext.NbSteps
    Print aext.Value
    aext.bStep
Next i
Print aext.Value

sleep
system
Last edited by Lost Zergling on Jul 09, 2019 0:21, edited 1 time in total.
Lost Zergling
Posts: 259
Joined: Dec 02, 2011 22:51
Location: France

Re: LZAE - New array extension - Draft - In progress

Postby Lost Zergling » Jun 23, 2019 13:52

Doc & exemples - Part 2
(I book place because till I know I'm going on it, it will be more easy to manage with following posts in only one topic)

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests