Sort Records In Memory (Update #3)

Share your advanced PureBasic knowledge/code with the community.
ppjm99
User
User
Posts: 23
Joined: Mon Jun 02, 2003 7:39 pm
Location: Canada

Sort Records In Memory (Update #3)

Post by ppjm99 »

Code updated for 5.20+

*Update 3*

Perhaps this will be helpful to anybody wishing to manage/sort record data in memory. This is the beginning of my memrec library, and includes the pbi include file and an example showing its use.

Evolving into a flat file manager, load, save, sort.

memrec.pbi

Code: Select all

Global MemIndexElements
Global MemIndexFieldWidth
Global MemIndexPointerWidth
Global MemFieldDefs$
Global NewList MemRecords.s()
MemIndexPointerWidth = 6 ;Allows for generating indexes with 6 digit recordcount

Procedure MemIndexCreate(StartPos,Length,SortOpt) ;SortOpt = 0-3 as per Sortarray function
  MemIndexFieldWidth = Length
  MemIndexElements = ListSize(MemRecords())
  Global Dim MemIndex.s(MemIndexElements)
  
  For nIdx = 1 To MemIndexElements
    SelectElement(MemRecords(),nIdx-1)
    MemIndex(nIdx) = Mid(MemRecords(),StartPos,MemIndexFieldWidth) + "," + RSet(Str(nIdx),MemIndexPointerWidth,"0")
  Next
  SortArray(MemIndex(), SortOpt)
EndProcedure

Procedure MemIndexClear()
  MemIndexElements = 0
  ReDim MemIndex.s(MemIndexElements)
EndProcedure

Procedure MemRecsProcess(ProcAddress)
  If MemIndexElements > 0 ;Process in indexed order
    For nIdx = 1 To MemIndexElements
      IndexEntry$ = MemIndex(nIdx)
      RecIdx = Val(Mid(IndexEntry$,MemIndexFieldWidth+2,MemIndexPointerWidth))
      SelectElement(MemRecords(),RecIdx-1)
      Record$ = MemRecords()
      *ProcPointer = ProcAddress
      CallFunctionFast(*ProcPointer, @Record$)
    Next
  Else ;Process in natural order
    nCount = ListSize(MemRecords())
    For nIdx = 1 To nCount
      SelectElement(MemRecords(),nIdx-1)
      Record$ = MemRecords()
      *ProcPointer = ProcAddress
      CallFunctionFast(*ProcPointer, @Record$)
    Next
  EndIf
EndProcedure

Procedure MemFieldCount()
  nPos = FindString(MemFieldDefs$,",",1)
  While nPos > 0 
    nCount + 1
    nPos = FindString(MemFieldDefs$,",",nPos+1)
  Wend
  ProcedureReturn (nCount + 1)/3
EndProcedure

Procedure.s MemFieldName(FieldPos)
  nIndex = (FieldPos - 1)*3 + 1
  sName$ = StringField(MemFieldDefs$,nIndex,",")
  ProcedureReturn sName$
EndProcedure

Procedure MemFieldStart(FieldName$)
  nIdx = 1
  sField$ = StringField(MemFieldDefs$,nIdx,",")
  While sField$ <> ""
    If sField$ = FieldName$
      nStart = nTotalSize + 1
    Else
      nTotalSize + Val(sField$)
    EndIf
    nIdx+1
    sField$ = StringField(MemFieldDefs$,nIdx,",")
  Wend
  ProcedureReturn nStart
EndProcedure

Procedure MemFieldSize(FieldName$)
  nPos = FindString(MemFieldDefs$,FieldName$,1)
  If nPos > 0 
    sRemaining$ = Mid(MemFieldDefs$,nPos,Len(MemFieldDefs$)-nPos+1)
    sSize$ = StringField(sRemaining$,2,",")
  EndIf
  ProcedureReturn Val(sSize$)
EndProcedure

Procedure.s MemFieldType(FieldName$)
  nPos = FindString(MemFieldDefs$,FieldName$,1)
  If nPos > 0 
    sRemaining$ = Mid(MemFieldDefs$,nPos,Len(MemFieldDefs$)-nPos+1)
    sType$ = StringField(sRemaining$,3,",")
  EndIf
  ProcedureReturn sType$
EndProcedure

;MFP - Short form for MemFieldPrep 
Procedure.s MFP(FieldName$,sData$)
  Select MemFieldType(FieldName$)
    Case "T" ;Left justify and pad text fields
      Result$ = LSet(sData$,MemFieldSize(FieldName$))
    Case "N" ;Right justify and zero pad number fields (for sorting)
      Result$ = RSet(sData$,MemFieldSize(FieldName$),"0")
  EndSelect
  ProcedureReturn Result$
EndProcedure

Procedure MemRecAdd(MemRecord$)
  AddElement(MemRecords())
  MemRecords() = MemRecord$
EndProcedure

Procedure MemRecsClear()
  ClearList(MemRecords())
EndProcedure

Procedure MemRecsToFile(FilePath$)
  If OpenFile(999,FilePath$)<>0
    If MemIndexElements > 0 ;Process in indexed order
      For nIdx = 1 To MemIndexElements
        IndexEntry$ = MemIndex(nIdx)
        RecIdx = Val(Mid(IndexEntry$,MemIndexFieldWidth+2,MemIndexPointerWidth))
        SelectElement(MemRecords(),RecIdx-1)
        Record$ = MemRecords()
        WriteStringN(999,Record$)
      Next
    Else ;Process in natural order
      nCount = ListSize(MemRecords())
      For nIdx = 1 To nCount
        SelectElement(MemRecords(),nIdx-1)
        Record$ = MemRecords()
        WriteStringN(999,Record$)
      Next
    EndIf
    CloseFile(999)
  EndIf
EndProcedure

Procedure MemRecsFromFile(FilePath$)
  If OpenFile(999,FilePath$)<>0
    While Eof(999)=0
      Record$=ReadString(999)
      MemRecAdd(Record$)
    Wend
    CloseFile(999)
  EndIf
EndProcedure

Procedure PrintRecord(Record.s)
  Debug Record
EndProcedure

Procedure ShowRecord(Record.s)
  MessageRequester("Show Record",Record)
EndProcedure

MemFieldDefs$ = "Name,20,T,Age,3,N" ;Fieldname,Size,Type,Fieldname,Size,Type, Etc...

MemRecAdd(MFP("Name","Bob") + MFP("Age","30"))
MemRecAdd(MFP("Name","Jim") + MFP("Age","20"))
MemRecAdd(MFP("Name","Alan") + MFP("Age","50"))

Debug "Sorted by Name Ascending"
MemIndexCreate(MemFieldStart("Name"),MemFieldSize("Name"),0) 
MemRecsProcess(@PrintRecord())
;MemRecsProcess(@ShowRecord())

Debug "Sorted by Age Ascending"
MemIndexCreate(MemFieldStart("Age"),MemFieldSize("Age"),0)
MemRecsProcess(@PrintRecord())

Debug "Sorted by order added"
MemIndexClear()
MemRecsProcess(@PrintRecord())

Debug "Save Records to file"
MemRecsToFile("Testfile.txt")

MemRecsClear()
Debug "Records Erased from memory"
MemRecsProcess(@PrintRecord())

Debug "Load records from file"
MemRecsFromFile("Testfile.txt")
MemRecsProcess(@PrintRecord())

Debug ""
There is probably plenty of room for improvement, I invite comments and suggestions and hope some of you may find it useful. I will probably post an update as it progresses if there is interest.