; German forum: http://www.purebasic.fr/german/archive/viewtopic.php?t=2525&highlight=
; Author: JoRo (updated for PB 4.00 by Andre)
; Date: 10. October 2003
; OS: Windows
; Demo: Yes


; Problem: Ich habe den Eindruck, dass die im Listview angezeigten Ergebnisse
;          mit großen Ä, Ö, usw. doch nicht richtig einsortiert sind !?



; Der SortArray Befehl von PB ist superschnell, aber leider liegen die Daten
; oft in einer Liste vor.
; Für mich hatte sich das Problem ergeben, dass SortArray für englische
; sprache funktioniert, aber mit Umlauten (ä,ö,ü) und dem "ß" falsch umgeht.
; Wenn ich die Daten im Array korrigiere und dann sortiere, lassen
; sie sich nicht mehr in den ursprünglichen Zustand zurückversetzten.
;
; Nun im Code die 2 Lösungen,
; eine schnelle, die den SortArray benutzt, und eine die einen Quicksort benutzt,
; wesentlich langsamer.
; Mit diesen Methoden, eigentlich nur ein Trick, lassen sich alle möglichen Daten
; mit dem SortArray Befehl sortieren, auch mehrteilige, Strukturen und ähnliches,
; vorausgesetzt, sie befiden sich in einer LinkedList.
; Das Ergebnis ist eine zweite, nun sortierte LinkedList.
;

;- Code:
;******************************************************************
;Oktober 2003
; Sortieren von Listen mit einfachen Quicksort und drei zusätzliche Listen
; oder mit dem superschnellen sortarray
; am Beispiel deutscher Wörter, sortiert einschließlich Berücksichtigung
; der Umlaute
; Johannes Rosenberg Liw  www.liw.biz oder www.textcse.de
;*********************************************************************

; Der Zeitfresser SelectElement!
;+++++++++++++++++++++++++++++++++++++
; a=ElapsedMilliseconds()
; NewList l()
; For p=1 To 10012
; AddElement(l())
; Next
; b=ElapsedMilliseconds()
; Debug b-a
; For p=1 To 10012
;     For k=1 To 12
;       SelectElement(L(),p+k)
;     Next
; SelectElement(l(),p)
; Next
; c=ElapsedMilliseconds()
; Debug c-b
;+++++++++++++++++++++++++++++++++++++++++++
;zum Test, ergibt 120.000 Aufrufe; die Anzahl der Elemente der Liste hat erhbelichen Einfluss

Global NewList L.s()
Global NewList L2.s()
Global NewList L3.s()
Global NewList L4.s()
; hier werden die Strings erzeugt, mit ös, üs, äs und ß. groß und klein
For k=1 To 10000
  AddElement(L3())
  For p=1 To 10
    r=Random(29)
    Select r
      Case 26
        r=Asc("ö")
      Case 27
        r=Asc("ä")
      Case 28
        r=Asc("ü")
      Case 29
        r=Asc("ß")
      Default
        r=r+97
    EndSelect
    If k/2+0.5=k/2 And r<>Asc("ß")
      r=r-32
    EndIf
    L3()=L3()+Chr(r); Auffüllen der Liste L3(), die sortiert werden soll
  Next
Next
;*******************************************************************************************
;kleine Zeitmessung, was das sortieren alleine dauert
Global Dim test.s(99999)
ResetList(L3())
For p=1 To 100000
  NextElement(L3())
  test(p-1)=L3()
Next
start=ElapsedMilliseconds()
SortArray(test(),2,0,99999)
ende=ElapsedMilliseconds()
For p=1 To 99999
  If test(p-1)> test(p)
    Sortfehler+1
  EndIf
Next
MessageRequester("SortArray Zeit",Str(ende-start),0)
MessageRequester("SortArray Fehler",Str(Sortfehler),0)
;***********************************************************************************

;#########################################
;Die erste Alternative: Die Elemente einer Liste werden in überarbeiteter
;Form an eine zweite Liste übergeben.
;Anschließend wird die zweite Liste sortiert, in eine dritte Liste;
;dieser Vorgang wird parallel mit einer Vierten Liste durchgeführt, in der die
;ursrpünglichen Elemente in der neuen Sortierfogle eingetragen werden

;Bis 5000 Elemente ist die Zeit erträglich, danach eskaliert sie : Ursache sind die
;Stringvergleiche, die ließen sich optimieren, aber allein das SelectElement kostet bei
;10.000 Elemente0, das sind dann ca.128.000 Aufrufe von SelectElement, 4 Sekunden
;deshalb scheidet eine Mehtode mit Listen für große Mengen von vorneherein aus


Procedure Sortieren()
  ResetList(L3())
  While NextElement(L3())
    string$=L3()
    string$=ReplaceString(string$,"ß","ss")
    string$=LCase(string$)
    string$=ReplaceString(string$,"ä","a")
    string$=ReplaceString(string$,"ö","o")
    string$=ReplaceString(string$,"ü","u")
    AddElement(L2());             Hier wird L2() mit den sortierfähigen Daten gefüllt; das
    ;können auch ganze andere Werte sein ,z. B. Dateigröße
    L2()=string$
  Wend
  ResetList(L3())
  ResetList(L2())
  AddElement(L())
  NextElement(L2())
  L()=L2()
  AddElement(L4())
  NextElement(L3())
  L4()=L3()
  k=1:ende=1
  While NextElement(L2())
    NextElement(L3())
    h=k:t=-1:mitte=k/2;+0.5
    While   h<>mitte And t<>mitte;    ein einfacher QuickSort
      SelectElement(L(),mitte)
      z+1
      If L2()>L()
        t=mitte
        mitte=mitte+(h-t)/2;+0.5
      Else
        h=mitte
        mitte=mitte-(h-t)/2;+0.5
      EndIf
    Wend

    SelectElement(L4(),mitte)
    z+1
    If L2()>L()
      AddElement(L())
      L()=L2()
      AddElement(L4())
      L4()=L3()
    Else
      InsertElement(L())
      L()=L2()
      InsertElement(L4())
      L4()=L3()
    EndIf
    k+1
  Wend
  ;  Debug Str(z)+"   Aufrufe Select"
EndProcedure

;***************************************************************
;Alternative zwei:
; die zu sortierene Liste wird in ein Array übertragen, wobei die Elemente des Arrays
; um Zahlen ergänzt werden, die die Position in der ursprünglichen Liste wiedergeben;
; gleichzeitig wird ein zweites Array erzeugt, in dem die Originaldaten in der ursprünglichen
;Reihenfolge geschrieben werden.
; man kann den Elementen in dem zu sortierenden Array auch strings voranstellen, die z. b. die
; größe einer Datei darstellen; die Sortierung würde dann nach Dateigröße erfolgen
Procedure Sortieren2()
  a=ElapsedMilliseconds()
  anzahl=CountList(L3())
  lang=Len(Str(anzahl))
  ResetList(L3())
  Global Dim Liste.s(anzahl-1)
  Global Dim SL.s( anzahl-1)
  For p=0 To anzahl-1; auffüllern des Array mit den veränderten Elementen
    NextElement(L3())
    Liste(p)=L3(); hier werden die Originaldaten das zweite Array geschrieben
    string$=L3()
    string$=ReplaceString(string$,"ß","ss")
    string$=LCase(string$)
    string$=ReplaceString(string$,"ä","a")
    string$=ReplaceString(string$,"ö","o")
    string$=ReplaceString(string$,"ü","u")
    anh=1
    For k=1 To lang
      anh=anh*10
    Next
    string$=string$+Str(anh+p); hier wird an jedes Element ein Kennzeichner angehängt, der die
    ;Position in der ursprünglichen Liste und im zweiten Array enthält

    SL(p)=string$; hier werden die veränderten Daten in das zu sortierende Array geschrieben
  Next
  b=ElapsedMilliseconds()
  SortArray(SL(),2)
  c=ElapsedMilliseconds()
  ResetList(L4())
  For p=0 To anzahl-1;
    AddElement(L4())
    L4()=Liste(Val(Mid(SL(p),Len(SL(p))-lang+1,lang))); hier wird die der Postionsanhang ermittelt, und
    ; das Element im zweiten Array an die Ausgabeliste
    ; übergeben
  Next
  c=ElapsedMilliseconds()
  Debug c-b
  Debug b-a
EndProcedure
;*************************************************************************************************
; Der Rest ist simpel

MessageRequester("","starten",0)
start=ElapsedMilliseconds()

Sortieren2()

ende=ElapsedMilliseconds()
MessageRequester("",Str(ende-start),0)


OpenWindow(0,100,100,200,600,"",#PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
ListViewGadget(1,10,10,180,560)
ButtonGadget(2,75,580,50,20,"Ende")
ResetList(L4())
While NextElement(L4())
  AddGadgetItem(1,-1,L4())
  If L4()< ps.s
    Fehler+1
  EndIf
  ps.s=L4()
Wend
MessageRequester("Fehler",Str(Fehler),0)

Repeat
  EventID= WaitWindowEvent()
  Select EventID
    Case #PB_Event_Gadget
      If EventGadget() = 2
        End
      EndIf
  EndSelect

Until EventID = #PB_Event_CloseWindow

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
; EnableXP
; DisableDebugger