Thomas Kramer

IT-COW | Februar 2011

Zeilenweises Sortieren einer Datei mittels Quicksort in VBS

By Administrator at Februar 01, 2011 14:58
Filed Under: Algorithmen, Programmierung allgemein, Studium, VBScript

Ein weiterer Beitrag von mir zu meinem Studium.

 

Ergänzung 26.02.2011: Da der Benutzer thomas bei euch höchstwahrscheinlich nicht existiert, müsst Ihr die Pfade anpassen wenn Ihr das Skript benutzen wollt.

 

Das Syntax-Highlighting von blogengine.net funktioniert hier nicht korrekt.

 

Ergänzung 26.10.2011: Etwas abwegiger, aber ich will es mal verlinken: Der Quicksort-Tanz: Link.

 

Quellcode:

 

Option Explicit
' allgemein: _ bedeutet, das die darauffolgende Zeile zur vorangegangenen gehört


' bitte angeben, ob jeder Durchlauf im Quicksort ausgegeben werden soll, 1 = ja
' ACHTUNG, macht nur Sinn wenn die einzelnen Zeilen der Textdatei jeweils nur 1 Zeichen enthalten!
Const mache_ausgabe = 1
' bitte angeben, ob der Vollständigkeitscheck gemacht werden soll, 1 = ja
Const mache_vergleich = 0
' Konstante für numerischen Wert deklarieren...
Const Reading = 1

Dim fso, File, WFile, WLogFile, sText
Dim FILENAME, WRITE_FILENAME, LOG_FILENAME
Dim i, t, x
Dim Durchlaeufe, zeit_start, zeit_ende, zeit_aufwand
' ein dynamisches Array wird mit ReDim statt mit Dim angelegt

ReDim a(1)
' um einen Vollständigkeitscheck durchzuführen, brauchen wir ein zweites Array...
' dieses wird später mit dem ersten verglichen, ob auch kein Datensatz verloren
' gegangen ist

ReDim b(1)
' Dateiname fürs Einlesen, also Ursprungsdatei

FILENAME="C:\users\thomas\documents\unsortiert.txt"
' Dateiname fürs Schreiben, also sortierte Datei = Ergebnis

WRITE_FILENAME="C:\users\thomas\documents\sortiert.txt"
' Dateiname fürs stufenweise Ausgeben aller Durchläufe des Quicksort-Algorithmus

LOG_FILENAME="C:\users\thomas\documents\sortierung_log.txt"
' zuerst muss das FileSystemObject erstellt (instanziiert) werden, bevor
' seine Funktionen angewandt werden können

Set fso = CreateObject("Scripting.FileSystemObject")
' nur fortfahren, wenn die Ursprungsdatei existiert...

 

If (fso.FileExists(FILENAME)) Then
' ------------------------------------ Einlesen der Datei ----------------------------------------
  ' eigentlichen Dateizeiger erstellen, im Lese-Modus (1)

  set File = fso.OpenTextFile(FILENAME, Reading, false)
  ' Schleifen bei VBScript siehe hier:
  ' http://www.html-world.de/program/vbs_5.php

  i=0
  ' einlesen der Ursprungsdatei, bis Ende erreicht ist...
  ' Schleife mit Prüfung am Schleifenkopf

  Do while not File.AtEndOfStream
      ' zeilenweise einlesen, in Hilfsvariable

      sText = File.ReadLine()
      ' Zeile aus Hilfsvariable ins eigentliche Array kopieren

      a(i)=sText
      ' zeilenzähler um 1 erhöhen, wird benötigt um das Array richtig zu dimensionieren

      i=i+1
     
      ' dynamisches Array neu dimensionieren, wobei die Datensätze erhalten bleiben sollen -
      '   das passiert mit dem Stichwort "preserve"  
      ' http://www.aspheute.com/artikel/19990807.htm

      ReDim Preserve A(i+1)
      ' (ReDim bezieht sich auf die Arraygröße (Anzahl!), i ist dagegen ein Indexzähler, insofern muss 1
      '    dazu addiert werden (ist oben schon geschehen), um die -bisherige- Größe zu erhalten...
      '    und wir wollen nun das Array um 1 erhöhen, also nochmal +1)

  Loop
  ' Dateizeiger schließen

  File.Close
 
  ' --------------------------- Logdatei zum Schreiben öffnen --------------------------------------

  if mache_ausgabe=1 then
    Set WLogFile = fso.CreateTextFile(LOG_FILENAME, True)
    WLogFile.WriteLine("Ausgangszustand:")
  end if
 
  ' Arraygrößen von A und B müssen übereinstimmen

  ReDim B(i+1) 
 
  ' Array A nach B kopieren, für den Vollständigkeitscheck später wird das zweite Array benötigt
  ' (das kopieren in B habe ich nicht beim Einlesen gemacht um die Zeit für das laufende ReDim von B einzusparen,
  '   dabei wird das Array schließlich umkopiert)
 
  ' i ist zwar Indexzähler, wird aber oben nachträglich erhöht, deswegen bis i-1 

  for t=0 to i-1
    B(t)=A(t)
  next
  
  ' letztlich Zeiger entfernen

  Set File = nothing
 
  ' Ausgangszustand von B() (nach dem kopieren) in LogDatei schreiben

  write_in_logfile

' ----------------------- Laufzeitanalyse und Aufruf von Quicksort -------------------------------
  ' Durchlaeufe zuerst auf 0 setzen

  Durchlaeufe=0
  ' Startzeit für Sortierung nehmen

  zeit_start   = time
  ' Startzeit ausgeben (erstmal auskommentiert)
'  x=msgbox("Startzeit für Sortierung, Fenster bitte sofort wegklicken. " & zeit_start,vbOkOnly,"Sortierungsstart")
  ' eigentlicher Aufruf des Quicksort-Algorithmus, mit Übergabe der Array-Größen

  QuickSort 0, i-1
  ' Endzeit für Sortierung nehmen

  zeit_ende    = time
  ' Differenz berechnen, das ist dann die aufgewandte Zeit für die Sortierung

  zeit_aufwand = zeit_ende-zeit_start
  ' Zeitaufwand in hh:mm:ss umrechnen, mit FormatDateTime
  ' ---> mögliche Variablenwerte bei vBS siehe hier:
  ' http://www.asphelper.de/referenz/vbscript/formatdatetime.asp

  zeit_aufwand = FormatDateTime(zeit_aufwand, vbLongTime)

  ' Ergebnis der Laufzeitanalyse ausgeben - mögliche Schaltflächen für msgbox siehe hier:
  ' http://www.vbarchiv.net/commands/MsgBox.php
  ' ("Laufzeitmessung" ist der Titel der Box, der zusammengesetzte String dagegen das, was in der
  '   Box angezeigt wird. Der zweite Parameter gibt die Anzahl der angezeigten Schaltflächen an,
  '   in x wird die betätigte Schaltfläche als Integerwert zurückgegeben)

  x=MsgBox("Durchläufe: " & Durchlaeufe & _
           ", Endzeit: " & zeit_ende & _
           ", benötigte Zeit für Sortierung: " & zeit_aufwand, _
           vbOkOnly, _
           "Laufzeitmessung")
          
  ' Vollständigkeitscheck ausführen, kein Wert darf verloren gehen durch Quicksort

  if mache_Vergleich=1 then
    if Vollstaendigkeitscheck then
      msgbox("Sortiertes Array B ist vollständig")
    else
      msgbox("Fehler, Sortiertes Array B ist NICHT vollständig"
    end if 
  end if
 
  ' LogFile wieder schließen, wurde ja nur benötigt um jeden Durchlauf von Quicksort zu dokumentieren

  if mache_ausgabe=1 then
    WLogFile.Close 
  end if

' -------------------------------- sortierte Datei schreiben -------------------------------------

  Set WFile = fso.CreateTextFile(WRITE_FILENAME, True)
  For t=0 to i-1
    WFile.WriteLine(a(t))
  next
  WFile.Close
 
  ' Zeiger entfernen

  Set WLogFile = nothing
  Set WFile    = nothing
  Set fso      = nothing
end if

' -------------------------------- Quicksort-Algorithmus -----------------------------------------
' Der Quicksort wird hartkodiert auf das Array B angewandt

sub QuickSort(anfang, ende)
   dim links, rechts, mitte, h
   ' Grenzen festlegen

   links = anfang
   rechts = ende
   ' Pivot-Element in der Mitte festlegen

   mitte = b((anfang + ende) / 2)
   do
       ' finde im Array von unten nach oben das erste Element das nicht in die Ordnung passt, also größer als das
       ' Pivot-Element ist - und erhöhe bis dahin den Zeiger "links" um 1
       while b(links)<pivot
         links=links+1
       wend
       ' finde im Array von oben nach unten das erste Element das nicht in die Ordnung passt, also kleiner als das
       ' Pivot-Element ist - und verringere bis dahin den Zeiger "rechts" um 1
       while pivot<b(rechts)
         rechts=rechts-1
       wend

       ' solange sich Untergrenzen-Zeiger und Obergrenzen-Zeiger nicht kreuzen...
       if links <= rechts then
          ' ... Elemente vertauschen an den gefundenen Positionen
          h = b(links)
          b(links) = b(rechts)
          b(rechts) = h
          ' dadurch...
          ' automatisch untere Grenze erhöhen,
          ' automatisch obere Grenze verringern
          links=links+1
          rechts=rechts-1
         
          ' nach jedem Vertauschen im LogFile dokumentieren
          write_in_logfile
       end if
   ' Schleife fortfahren wie der Zeiger für die zu untersuchende Untergrenze tatsächlich kleiner
   ' als die Obergrenze ist       
   loop until links > rechts

   ' Beginn Rekursion  
   ' von Indexpositionen "anfang" (ursprünglicher Wert) bis "rechts" (errechneter Wert des letztkleineren Elements
   '  (im Vergleich zum Pivotelement)) Bereich des Arrays neu sortieren
   if anfang < rechts then
     ' Anzahl Rekursiondurchläufe berechnen
     Durchlaeufe=Durchlaeufe+1
     QuickSort anfang, rechts
   end if

   ' von Indexpositionen links (errechneter Wert des erstgrößeren Elements im Vergleich zum Pivotelement) bis ende
   ' (ursprünglicher Wert) Bereich des Arrays neu sortieren
   if links < ende then
     ' Anzahl Rekursiondurchläufe berechnen  
     Durchlaeufe=Durchlaeufe+1
     QuickSort links, ende
   end if
end sub

' -------------------- vergleiche Array B mit A auf Vollständigkeit-------------------------------
' brich mit FALSE ab, wennn eine Zeile in B nicht mehr in A enthalten ist
' ansonsten TRUE
' Aufruf mit "mache_vergleich=1" ganz oben aktivieren

' Achtung, ist durch Vorgehensweise sehr langsam. Also nur mit kleinen Datenmengen testen
function vollstaendigkeitscheck
Dim t,i, gefunden

gefunden=true
' auskommentierte Zeile, um Vollständigkeitscheck zu testen
'b(2)="abc"

' ubound liefert die höchste Indexposition des Arrays zurück
for t=0 to ubound(b)
  gefunden=false
  for i=0 to ubound(a)
    if a(i)=b(t) then
      gefunden=true
      exit for     
    end if
  next
 
  if not gefunden then
    exit for
  end if
next

Vollstaendigkeitscheck = gefunden
end function

' -------------------- Ausgabe des Zustands des Arrays in Logdatei ---------------------------------
' Aufruf dieser Funktion macht nur Sinn, wenn jede Zeile der Quelldatei nur jeweils 1 Zeichen enthält
'
' Aufruf mit "mache_ausgabe=1" ganz oben aktivieren
function write_in_logfile
Dim t

if mache_ausgabe=1 then
  for t=0 to ubound(b)
    WLogFile.Write(b(t))
  next

  WLogFile.WriteLine(" ")
  WLogFile.WriteLine(" "
end if

end function

 

Tag-Wolke

Monats-Liste