PureBasic Forums - English

Yes another time!

I found this topic several times....but none which suited my needs.
I was always fascinated by the C qsort and bsearch runtime functions which allowed the sorting and searching with user defined functions.

Thanks to several people for their help and support to make it possible

InitLLSType ( type ) --> call this first to create an instance for the new type.

LLS (LinkedList,type,compfunc,setfunc,val ) --> use this to add an element

compfunc and setfunc are user defined functions. Both functions take 2 parameters...1st parameter is the linkedlists and the 2nd is the variable you want to add. In compfunc user is responsible to return
0 if elements are equal
1 if 1st parameter is greater than 2nd parameter
-1 if 1st parameter is greater than 1st parameter
setfunc simply assigns 2nd parameter to 1st parameter


; Sorted Linked Lists for any type with custom sort
; Thanks go to the following people
; for PureBasic 4.00
;
; Einander <-- where I started
; Froggerprogger <-- his suggestions
; Flype <-- A bloody genius
;
; KingLestat - 8/Nov/2006
;

Structure complex
name.s
surname.s
age.l
sex.s[1]
EndStructure

Macro InitLLSType ( type )
Procedure LLS_#type ( ll.type(), *CompFunc, *SetFunc, *val )
ForEach ll()
If CallFunctionFast ( *CompFunc, ll(), *val ) >= 0
InsertElement ( ll() )
CallFunctionFast ( *SetFunc, ll(), *val )
ProcedureReturn
EndIf
Next

AddElement ( ll() )
CallFunctionFast ( *SetFunc, ll(), *val ) ;....
EndProcedure
EndMacro

Macro LLS ( LinkedList,type,compfunc,setfunc,val )
LLS_#type ( LinkedList,compfunc,setfunc,val )
EndMacro

InitLLSType ( complex )

Global NewList var.complex()

Procedure.s StringElement ( tstring.s, find.s, index.l )

Protected pos.l = FindString ( tstring, find, 1 )

If pos > 0

If index = 1
ProcedureReturn Left ( tstring, ( pos - 1 ) )
Else

count.l = CountString ( tstring, find ) + 1

If index <= count

Protected i.l
Protected start.l

For i = 1 To index - 1

start = pos
pos = FindString ( tstring, find, start + 1 )

Next i

If pos = 0
pos = Len ( tstring ) + 1
EndIf

ProcedureReturn Mid ( tstring, start + Len ( find ), ( pos - start ) - 1 )

EndIf
EndIf
EndIf

ProcedureReturn tstring

EndProcedure

Procedure.l CompareComplex ( *i1.complex, *i2.complex )

Protected ret = 1

If *i1\surname = *i2\surname
If *i1\name = *i2\name
ProcedureReturn ( *i1\age - *i2\age )
ElseIf *i1\name < *i2\name
ProcedureReturn -1
EndIf

ElseIf *i1\surname < *i2\surname
ProcedureReturn -1
EndIf

ProcedureReturn ret

EndProcedure

Procedure AssignComplex ( *i1.complex, *i2.complex )
*i1\name = *i2\name
*i1\surname = *i2\surname
*i1\age = *i2\age
*i1\sex = *i2\sex
EndProcedure

vt.complex

Restore DataItems

Repeat

Read temp$
If temp$ = "="
Break
EndIf

vt\surname = StringElement ( temp$, ",", 2 )
vt\name = StringElement ( temp$, ",", 1 )
vt\age = Val ( StringElement ( temp$, ",", 3 ) )
vt\sex = StringElement ( temp$, ",", 4 )
LLS ( var(), complex, @CompareComplex(), @AssignComplex(), @vt )

ForEver

ResetList(var())

While NextElement(var())
Debug var()\Surname + " " + var()\name + " age " + Str (var()\age)
Wend


DataSection

DataItems:

Data$ "Luke,Skywalker,28,M"
Data$ "Loof,Lirpa,99,U"
Data$ "Bill,Gates,55,M"
Data$ "Margaret,Tatcher,88,F"
Data$ "Louis,Armstrong,44,M"
Data$ "Yury,Gagarin,66,M"
Data$ "Louis,Lane,56,F"
Data$ "Maria,Ustinov,80,F"
Data$ "Annekin,Skywalker,48,M"
Data$ "Leia,Skywalker,28,F"
Data$ "Loof,Lirpa,70,U"
Data$ "="

; End of code

I discoverred a bug/optimization. Apprently PureBasic already has a String function to delimit strings. Here is the updated code using StringField

; Sorted Linked Lists for any type with custom sort
; Thanks go to the following people
; for PureBasic 4.00
;
; Einander <-- where I started
; Froggerprogger <-- his suggestions
; Flype <-- A bloody genius
;
; KingLestat - 8/Nov/2006
; Updated
;

Structure complex
name.s
surname.s
age.l
sex.s[1]
EndStructure

Macro InitLLSType ( type )
Procedure LLS_#type ( ll.type(), *CompFunc, *SetFunc, *val )
ForEach ll()
If CallFunctionFast ( *CompFunc, ll(), *val ) >= 0
InsertElement ( ll() )
CallFunctionFast ( *SetFunc, ll(), *val )
ProcedureReturn
EndIf
Next

AddElement ( ll() )
CallFunctionFast ( *SetFunc, ll(), *val ) ;....
EndProcedure
EndMacro

Macro LLS ( LinkedList,type,compfunc,setfunc,val )
LLS_#type ( LinkedList,compfunc,setfunc,val )
EndMacro

InitLLSType ( complex )

Global NewList var.complex()

Procedure.l CompareComplex ( *i1.complex, *i2.complex )

Protected ret = 1

If *i1\surname = *i2\surname
If *i1\name = *i2\name
ProcedureReturn ( *i1\age - *i2\age )
ElseIf *i1\name < *i2\name
ProcedureReturn -1
EndIf

ElseIf *i1\surname < *i2\surname
ProcedureReturn -1
EndIf

ProcedureReturn ret

EndProcedure

Procedure AssignComplex ( *i1.complex, *i2.complex )
*i1\name = *i2\name
*i1\surname = *i2\surname
*i1\age = *i2\age
*i1\sex = *i2\sex
EndProcedure

vt.complex

Restore DataItems

Repeat

Read temp$
If temp$ = "="
Break
EndIf

vt\surname = StringField ( temp$, 2, "," )
vt\name = StringField ( temp$, 1, "," )
vt\age = Val ( StringField ( temp$, 3, "," ) )
vt\sex = StringField ( temp$, 4, "," )
LLS ( var(), complex, @CompareComplex(), @AssignComplex(), @vt )

ForEver

ResetList(var())

While NextElement(var())
Debug var()\Surname + " " + var()\name + " age " + Str (var()\age)
Wend


DataSection

DataItems:

Data$ "Luke,Skywalker,28,M"
Data$ "Loof,Lirpa,99,U"
Data$ "Bill,Gates,55,M"
Data$ "Margaret,Tatcher,88,F"
Data$ "Louis,Armstrong,44,M"
Data$ "Yury,Gagarin,66,M"
Data$ "Louis,Lane,56,F"
Data$ "Maria,Ustinov,80,F"
Data$ "Annekin,Skywalker,48,M"
Data$ "Leia,Skywalker,28,F"
Data$ "Loof,Lirpa,70,U"
Data$ "="

kinglestat wrote:; Thanks go to the following people
; for PureBasic 4.00
;
; Einander <-- where I started
; Froggerprogger <-- his suggestions
; Flype <-- A bloody genius

i think you wanted to say Trond for his incredible code here :
http://www.purebasic.fr/english/viewtop ... highlight=

you said:

well well
this looks like pure genius
though took me several ideas to understand

since so far I havent used tronds code I only mentioned the guys I "borrowed" from. But hey...there are several good guys here (in my perspective nearly everybody in the forum!!)

I saw that code but havent had the courage to use it as I dont truly understand it....yet

cheers

KingLestat