Sortierproblem

[sotierproblem]

Hallo,
wir sollen in der Schule ein Wörterbuch programmieren, von der Logik her müsste es richtig sein, es lässt sich auf kompilieren aber stürzt beim ausführen immer ab.

Das Program ist komplett auskommentiert und basiert auf dem Quicksortalgorithmus.

Danke schonmal im vorraus
Toni

[baumina]

Du bekommst sicher schneller Hilfe, wenn du uns nicht das ganze Auto in den Hof stellst und sagst, das klappert irgendwo irgendwas. Grenze dein Problem ein, das kannst du z.B. durch Debugging oder Fehlerabhandlungen machen. Erst wenn du dann das Problem auf 1-5 Code-Zeilen dezimieren konntest und trotzdem nicht weiter kommst, stelle die 1-5 Zeilen hier rein und dir wird sicher kompetent und zügig geholfen. Eine ZIP-Datei werde ich mir aus Sicherheitsgründen nicht herunterladen.

[sotierproblem]

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Menus;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    mDeutsch: TMemo;
    mEnglisch: TMemo;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    procedure Button1Click(Sender: TObject);      // Noch nur zu Überprüung
    procedure FormActivate(Sender: TObject);      // einlesen der Textdokumente + randomize
    procedure MenuItem2Click(Sender: TObject);    //einfügen
    procedure MenuItem3Click(Sender: TObject);    //sotieren
    procedure MenuItem4Click(Sender: TObject);    //beenden
    procedure MenuItem5Click(Sender: TObject);    //hilfe
  private
    procedure vertausche(x,y:integer);
    procedure sort(von,bis,tiefe: integer);
    procedure sort2(von,bis,stelle:integer);
    { private declarations }
  public
    { public declarations }
  end;
 
const
  laenge:integer=5; //0-5                  //Anzahl der Wörter
var
  Form1: TForm1;
    Datei : TextFile;               //
      s : string;                   //einlesen der TXT ins Array
        a:array[0..100] of string;    //Array zum bearbeiten
   german:array[0..100] of string;     //Array "german - englisch" bsp german[0] = 'Hallo - hello'
   englisch:array[0..100] of string;   //Array "englisch - german" bsp englisch[0] = 'hello - Hallo'
   i:integer;
 
 
implementation
uses Unit2;            //einbinden der Unit 2 in der Wörter hinzugefügt werden könnnen dabei wird leange um eins erhöht
 
{$R *.lfm}
 
{ TForm1 }
 
 
procedure TForm1.MenuItem5Click(Sender: TObject);  //HAUPTPROGRAM
begin
 for i:=0 to laenge do a[i]:=german[i];                 //Array german in  Array a übergeben
 sort(0,laenge,1);                                      //Sort aufrufen und von 0 bis leange nach dem 1. Buchstabe sotieren lassen
 
 sort2(0,laenge,1);                                      //sort2 aufrufen
 
 for i:=0 to laenge do german[i]:=a[i];                  //Array a in Array german zurück überschreiben
 mDeutsch.clear;
 for i:=0 to laenge do mDeutsch.Lines.Add(german[i]);   //Ausgabe
 
end;
 
 
 
 
procedure TForm1.FormActivate(Sender: TObject); //Einlesen der Textdokumente
begin
  AssignFile(Datei,'deutsch.txt');
 
   Reset(Datei);
 
   mDeutsch.Lines.Clear;
 
   i:=0;
 
   while not eof(Datei)
 
   do begin
 
      readln(Datei,s);
 
      mDeutsch.Lines.Add(s);
 
      german[i]:=s;
 
      inc(i);
 
      end;
 
   CloseFile(Datei);
 
   AssignFile(Datei,'englisch.txt');
 
   Reset(Datei);
 
   mEnglisch.Lines.Clear;
 
   i:=0;
 
   while not eof(Datei)
 
   do begin
 
      readln(Datei,s);
 
      mEnglisch.Lines.Add(s);
 
      englisch[i]:=s;
 
      inc(i);
 
      end;
 
   CloseFile(Datei);
end;
 
procedure TForm1.Button1Click(Sender: TObject); //Hilfsausgabe zum überprüfen was in german[x] gespeichert ist mit x:=strtoint(Edit1.text)
begin
  showmessage(german[strtoint(edit1.text)]);
end;
 
procedure TForm1.vertausche(x,y:integer);     //Auslagern des Vertauschen des Inhaltes von a[x] a[y]
 var hilf:string;
[b][u]begin  [/u][/b]   [b]//Programm markiert dort einen Fehler[/b]
 hilf:=a[x];
 a[x]:=a[y];
 a[y]:=hilf;
end;
 
procedure TForm1.sort(von,bis,tiefe: integer);    //ein auf der Theorie von QUICKSORT beruhender Sotieralghorithmus
  var pivot,vlnr,vrnl:integer;                    //Pivotelement, von links nach rechts, von rechts nach links
begin
if von<bis then                                   //abbruchsbedingung für Rekursion
   begin
   pivot:=ord(upcase(a[von][tiefe]));    //pivot=72(H) ascii code von a[1.Wort][1.Buchstabe]
   vlnr:=von+1;              //vlnr wird um eins erhöht
   vrnl:=bis;                //vrnl=6
    while (vlnr < vrnl+1) do    //solange vlnr links von vrnl ist soll er
	  begin while (ord(upcase(a[vlnr][tiefe])) <= pivot) do inc(vlnr); //solang vlnr erhöhen bis er ein wort findet das mit einem Buchstabe beginnt das nach dem Pivotelement im Alphabet kommt
                while (ord(upcase(a[vrnl][tiefe])) > pivot) do dec(vrnl);  //solang vrnl verringern bis er ein wort findet das mit einem Buchstabe beginnt das vor dem Pivotelement im Alphabet kommt
		if (vlnr < vrnl+1) then  begin             //wenn vlnr noch links von vrnl ist vertauschen
                                           Vertausche(vlnr,vrnl);
                                           inc(vlnr);
                                           dec(vrnl);
                                         end              //Wenn vlnr nicht mehr links von vrnl ist das Pivotelement an die richtige Stelle tauschen
                                 else Vertausche(vrnl,von);
 
          end;
    sort(von,vrnl,tiefe);               //Rekursiver Aufruf des verkleinerten Teilproblems
    sort(vrnl+1,bis,tiefe);             //Rekursiver Aufruf des verkleinerten Teilproblems
    end;
end;
 
procedure TForm1.sort2(von,Bis,stelle:integer);
{Weitere Sotierprocedure die überprüft ob es mehrere Wörter mit dem selben anfangsbuchstabe gibt
und diese dann nach dem 2., 3., 4.,... Buchstabe Sotiert}
var x:integer;
begin
x:=von; //nur damit beim ersten eintritt in die Schleife in Zeile 159 kein Fehler entsteht da x not seem to be initialized
if von<bis then begin               //Abruchsbedingung für Rekursion
 
                  for i:=von to bis do
                   begin if x<laenge+1 then x:=i+1;       //wenn er durch das erhöhen von X nicht das array verlässt x erhöhen
                                       begin
                                           [b][u] if upcase(a[i][stelle])=upcase(a[x][stelle]) then     //Überprüfen ob Wort a[i] und a[i+1] den selben Anfangsbuchstabe haben[/u][/b]  [b][u]Zweites Problem das gekennzeichnet[/u][/b]
 
                     begin
                          x:=i;
                          while ord(upcase(a[i][stelle]))=ord(upcase(a[x+1][stelle])) do inc(x);  // Wenn ja solange x erhöhen wie a[i] und a[x+1] den selben 1./2./3./.. Buchstabe haben um zu erfahren wie viele
                                                                                                 //Wörter nacheinander den selben 1./1.& 2./1.&2.&3./.. Buchtstabe haben
 
                          sort(i,x,stelle+1);   //Diese Wörter nach der Stelle des letzten gemeinsamen Buchstabe sotieren
                         sort2(i,x,stelle+1);   //rekursiv aufrufen ob diese Wörter evtl auch den selben 1.& 2./1.&2.&3./.. Buchstabe haben
                     end;
 
                                       end;
                   end;
                end;
end;
 
 
 
 
procedure TForm1.MenuItem2Click(Sender: TObject);    //einfügen von weiteren wörter dabei wird leange um 1 erhöht
begin
  Form2.Visible:=true;
  Form1.Visible:=false;
end;
 
 
 
end.

Hab die Fehler, die der Compiler zeigt, im Quelltext markiert. Verstehe das Problem jedoch weiterhin nicht und hoffe, dass mir jemand weiterhelfen kann.

[creed steiger]

showmessage(german[strtoint(edit1.text)]);

ist quatsch

[Michl]

ist quatsch

Warum???

@so(r)tierproblem:
Ich habe mir eben das Prog. runtergeladen und gestartet (geht problemlos - ps: das nächste mal brauchst Du keine .exe mit einpacken, das macht das Zip nur unnötig groß). Beim Klick auf das Sortieren stürzt das Programm in der Zeile ab:

Code: Alles auswählen

procedure TForm1.sort2(von,Bis,stelle:integer);
...
                                            if upcase(a[i][stelle])=upcase(a[x][stelle]) then     //Überprüfen ob Wort a[i] und a[i+1] den selben Anfangsbuchstabe haben

Wenn Dir sowas passiert, dann gehe einfach mit der Maus über die entsprechende Zeile im Quelltexteditor und schaue, welche Einträge die entsprechenden Variablen haben. In diesem Fall ist das Problem, dass a[x] = ein leerer String ist und Du mit (Stelle = 1) auf einen nicht vorhandenen Index zugreifst. Siehe http://www.delphipraxis.net/41047-tutor ... eschr.html

Ich habe mir das Programm sonst nicht weiter angeschaut, nur als Anmerkung am Rand: Schau Dir mal die Funktion "CompareStr" an, damit könntest Du Dir wahrscheinlich das Leben etwas einfacher machen.

[theo]

Schau Dir mal die Funktion "CompareStr" an, damit könntest Du Dir wahrscheinlich das Leben etwas einfacher machen.

Fragt sich halt, was die Vorgabe der Schule ist. Er könnte sich das Leben massiv vereinfachen, aber es scheint, als müsse er alles "zu Fuss" machen.

StringList.LoadFromFile
StringList.CustomSort

[creed steiger]

ist quatsch

Warum???

strtoint auf ein Edit mit beliebigen alphanumerischen Zeichen
keine Fehlerüberprüfung

[sotierproblem]

Vielen Dank für die Antworten
@creed steiger ja der Befehl ist so gesehen unnötig, wollten aber nachschauen was uns ausgegeben wird, da es nicht funktioniert hat und wir es damit nur kontrollieren wollten.
@Michl Werd ich mir merken mit der .exe fürs nächstes mal Danke und das Problem liegt darin, dass wenn man im Programm unter Datei auf Sortieren geht, dass er eine Fehlermeldung gibt. Zudem kann man leider keine Wörter einfügen und sortieren lassen, die den gleichen Anfangsbuchstaben haben. Stringlist haben wir uns auch schon überlegt, dürfen dies jedoch nicht verwenden. Unser Lehrer möchte, dass wir den Quicksort benutzen insofern ist dies leider keine Möglichkeit.

[Michl]

das Problem liegt darin, dass wenn man im Programm unter Datei auf Sortieren geht, dass er eine Fehlermeldung gibt.

Hast Du meine Antwort verstanden, warum dieser Fehler (SIGSEGV) auftritt?

Stringlist haben wir uns auch schon überlegt, dürfen dies jedoch nicht verwenden.

Das geht dann eher an theo, ich hatte davon gar nichts geschrieben.

[sotierproblem]

showmessage(german[strtoint(edit1.text)]);

ist quatsch

Das war nur eine Hilfsausgabe bei der Fehlersuche um zu gucken welche Felder des Arrays benutzt werden(und zwar german[0] bis german[7]), falls das Problem von den Arraygrenzen kommt.

Edit1 und "suchen" sind noch nicht deklariert.

[sotierproblem]

Hast Du meine Antwort verstanden, warum dieser Fehler (SIGSEGV) auftritt?

Ja ich verstehe was da deiner Meinung nach falsch ist, aber ich verstehe nicht warum? Ich gehe das Program wieder und wieder durch aber von der Logik her finde ich kein Fehler.. Ich frage immer nur von 0 bis 7 die Fekder des Arras ab und diese sind belegt.

Und mir ist bewusst, dass ich das Program nicht gegen unsinnige Fehleingaben abbruchssicher gemacht habe, dass mach ich dann sobald es funktioniert bzw ich den Fehler verstehe.


Noch als Ergänzung:
Anfangs hat das Program noch sotiert, jedoch Probleme gemacht sobald Wörter mit dem selben Buchstabe begonnen haben. Seit dem Versuch dieses Problem zu lösen kommt es immer zum Programabsturz, bei den der Debugger den Fehler meistens in

Code: Alles auswählen

   procedure TForm1.vertausche(x,y:integer);
                       var hilf:string;
     begin ← ← ← dieser
                  hilf:=a[x];
                  a[x]:=a[y];
                  a[y]:=hilf;
               end;

Zeile zeigt.
Macht also nicht wirklich Sinn.. und wie gesagt, leere Felder sollten eigentlich nicht abgeglichen werden.

[Michl]

Ich habe nur mal eine Überprüfung eingebaut, ob der entsprechende Index da ist und schon kommt es zu keinem SIGSEV mehr (einfach mal im hier geposteten Example die Zeile einfügen und testen):

Code: Alles auswählen

                                       begin
                                         if (Stelle <= Length(a[i])) and (Stelle <= Length(a[x])) and
                                            (upcase(a[i][stelle]) = upcase(a[x][stelle])) then     //Überprüfen ob Wort a[i] und a[i+1] den selben Anfangsbuchstabe haben

Wie gesagt, ich habe nicht überprüft, ob die Proceduren richtig funktionieren. Das ist auch etwas schwierig bei Deiner gewählten Formatierung!!!

Was für eine Fehlermeldung zeigt der Debugger an der besagten Stelle bei Dir an?! Dass er an einer falschen Stelle hält, wäre zwar bei deinem Beispiel ungewöhnlich, ist mir aber auch schon passiert.

[sotierproblem]

Ich habe nur mal eine Überprüfung eingebaut, ob der entsprechende Index da ist und schon kommt es zu keinem SIGSEV mehr

Danke!!
Jetzt funktioniert das Sotieren wieder, aber sobald ich ein Wort hinzufüge (zb. "Affe - monkey" in "deutsch.txt" hinzufügen und dann die const "laenge:integer=5;" um eins erhöhe)oder zB. "Nase - nose" durch "Clown - clown" ersetze hängt es sich auf..


Dann kommt es in den auf Quicksort basierenden und normalerweise funktionierenden Teil oder wieder bei "begin" zu External:SIGSEGV
Der fehler tritt dann hier auf:

Code: Alles auswählen

procedure TForm1.vertausche(x,y:integer);     //Auslagern des Vertauschen des Inhaltes von a[x] a[y]
 var hilf:string;
begin  ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ← ←entwerder hier
 hilf:=a[x];
 a[x]:=a[y];
 a[y]:=hilf;
end;
 
procedure TForm1.sort(von,bis,tiefe: integer);    //ein auf der Theorie von QUICKSORT beruhender Sotieralghorithmus
  var pivot,vlnr,vrnl:integer;                    //Pivotelement, von links nach rechts, von rechts nach links
begin
if von<bis then                                   //abbruchsbedingung für Rekursion
   begin
   pivot:=ord(upcase(a[von][tiefe]));    //pivot=72(H) ascii code von a[1.Wort][1.Buchstabe]
   vlnr:=von+1;              //vlnr wird um eins erhöht
   vrnl:=bis;                //vrnl=6
    while (vlnr < vrnl+1) do    //solange vlnr links von vrnl ist soll er
	  begin while (ord(upcase(a[vlnr][tiefe])) <= pivot) do inc(vlnr); ← ← ← ← ← ← ← ← ← ← ← ← ← oder hier← ← ← ← ← ← ← ← ← ← ← ← ← ← //inc(vlnr) bis ein Wort mit einem Buchstabe beginnt das nach dem Pivotelement im Alphabet kommt
                while (ord(upcase(a[vrnl][tiefe])) > pivot) do dec(vrnl);  //solang vrnl verringern bis er ein wort findet das mit einem Buchstabe beginnt das vor dem Pivotelement im Alphabet kommt
		if (vlnr < vrnl+1) then  begin             //wenn vlnr noch links von vrnl ist vertauschen
                                           Vertausche(vlnr,vrnl);
                                           inc(vlnr);
                                           dec(vrnl);
                                         end              //Wenn vlnr nicht mehr links von vrnl ist das Pivotelement an die richtige Stelle tauschen
                                 else Vertausche(vrnl,von);
 
          end;
    sort(von,vrnl,tiefe);               //Rekursiver Aufruf des verkleinerten Teilproblems
    sort(vrnl+1,bis,tiefe);             //Rekursiver Aufruf des verkleinerten Teilproblems
    end;
end;                 
 
 

Ich sitze hier gerade am Schulcomputer, falls der Fehler bei euch nicht auftritt liegt es am instabilen System, der Schulcomputer öffnet nicht mal Form2 mit..
Nochmal Danke für die Hilfe bis jetzt!

[Michl]

Es kommt zu einem Stapelüberlauf, da es bei deiner Rekursion zu keinem Abruch kommt.

Wenn du nicht debuggen kannst bzw. die Sprünge beim debuggen nicht mehr nachvollziehbar sind, hilft es, sich die entsprechenden Variablen ausgeben zu lassen. Eine Möglichkeit ist es, unter Projekt -> Projektienstellungen -> Konfiguration und Ziele den Haken bei "Win32-GUI-Anwendung" heraus zu nehmen (es wird dann das Consolefenster geöffnet, indem man sich zur Laufzeit etwas ausgeben lassen kann).

Nun lass dir mal die Parameter von "sort" in der Console ausgeben. Du siehst, dass mit deinem Sortieralgorithmus etwas im Argen ist:

Code: Alles auswählen

procedure TForm1.sort(von,bis,tiefe: integer);    //ein auf der Theorie von QUICKSORT beruhender Sotieralghorithmus
  var pivot,vlnr,vrnl:integer;                    //Pivotelement, von links nach rechts, von rechts nach links
begin
 
writeln('von[',von,'] bis[',bis,'] tiefe [',tiefe,']');
 
if von<bis then                                   //abbruchsbedingung für Rekursion                    
...