Anregung/Anstoß für ein Sudoku gesucht

[wp_xyz]

Für mich ergibt sich nun erstmal folgender Plan, Delphi in einer Virtualbox installieren und gucken und versuchen zu verstehen, dann mein C-Programm umbauen und dann mal mich an dem GUI probieren...

Warum gehtst du den Umweg über Delphi? Nimm doch gleich Lazarus. (und da brauchst du auch keine VM).

[alfware17]

Für mich ergibt sich nun erstmal folgender Plan, Delphi in einer Virtualbox installieren und gucken und versuchen zu verstehen, dann mein C-Programm umbauen und dann mal mich an dem GUI probieren...

Warum gehtst du den Umweg über Delphi? Nimm doch gleich Lazarus. (und da brauchst du auch keine VM).

Weil einige der Beispiele, die ich nun gesammelt habe und u.a. das was mir am besten gefiel, in Delphi sind. Weil ich nicht weiß, ob ich die konvertiert bekomme und weil ich neugierig bin, ob ich mein Schul-Delphi nach so vielen Jahren noch zum Laufen kriegen würde und ob die Quellen da umwandelbar sind. Aber klar, wenn ich genug gesehen habe, fange ich (richtig) gleich in Lazarus an, vielleicht geht das Delphi auch gar nicht und dann ist das erledigt.

[hum4n0id3]

Ich kenne die Diskussion, und ehrlich? Halte ich mal gar nix von.
Arrays fangen bei mir an, da von wo ich will. Basta!

Ob man was davon etwas hält oder nicht, hier gibt eigentlich der Entwickler der Sprache selbst und allgemein die Coderichtlinie an. Dein "Protest im Ehren" , aber das riecht mir nach Stümperei. Kann man machen, sollte man aber nicht.

[corpsman]

Ich hab auch mal ein Sudoku gemacht, dort wurde alles via Canvas von Hand gemalt..

Würdest du auch die Quellen angeben? Oder habe ich sie nur nicht gefunden.

Ich schau dass ich sie am We auf meinen Github Account lade werden dann unter https://github.com/PascalCorpsman/mini_projects zu finden sein

[Singlepin]

Hier mal eine Version von Delphi nach Lazarus umgewandelt.
Getestet mit Ubuntu.

[siro]

Ich habe es grade mal unter Windows 64 Bit ausprobiert.

Lazarus 3.0 (rev lazarus_3_0) FPC 3.2.2 x86_64-win64-win32/win64

Ließ sich sofort compilieren und es funktioniert auch supi.

Loesung.jpg (59.11 KiB) 3635 mal betrachtet

Beim Beenden kommen aber diverse Fehlerfenster.....

Err_01.jpg (53.47 KiB) 3635 mal betrachtet

Err_02.jpg (57.08 KiB) 3635 mal betrachtet

Nach 14 Fehler Bestätigungen ist das Programm dann beendet...

Tolle Software, gefällt mir sehr gut.

[Zvoni]

Speicher lecks.....

[Singlepin]

Der Fehler liegt in der UNDO-Funktion.

Code: Alles auswählen

destructor TSudoku.Destroy;
var
  p: Pointer;
begin
while UndoList.Count>0 do
  begin
  p:=UndoList.Objects[UndoList.Count-1];
  UndoList.Delete(UndoList.Count-1);
  FreeMem(p);
  end;
UndoList.Free;
inherited;
end;

Das sollte das Problem beheben.

[siro]

Jo, das war es, grad getestet. SUPI

[Mathias]

Ich habe es grade mal unter Windows 64 Bit ausprobiert.

Lazarus 3.0 (rev lazarus_3_0) FPC 3.2.2 x86_64-win64-win32/win64

Ließ sich sofort compilieren und es funktioniert auch supi.

Loesung.jpg

Beim Beenden kommen aber diverse Fehlerfenster.....
Err_01.jpg Err_02.jpg

Nach 14 Fehler Bestätigungen ist das Programm dann beendet...

Tolle Software, gefällt mir sehr gut.

Ich habe es auch gerade probiert, bei mir kommen keine Fehler beim beenden.

[corpsman]

Ich schau dass ich sie am We auf meinen Github Account lade werden dann unter https://github.com/PascalCorpsman/mini_projects zu finden sein

Done, aber bitte bedenkt, der Code ist 19 Jahre Alt, ursprünglich in Delphi5 geschrieben und dann nach Lazarus Portiert. Zum Glück kommt bald die Weihnachtszeit und ich habe dann hoffentlich ein bisschen Zeit das zu Refactoren. So ist der Code echt ein Grauß

[hum4n0id3]

Aber er funktioniert

[alfware17]

Hier mal eine Version von Delphi nach Lazarus umgewandelt.
Getestet mit Ubuntu.

Hallo und erstmal vielen Dank für dein Programm. Ich habe mir die ältere und auch die aktuelle Version angesehen und (so hoffe ich) einiges gelernt.
Bevor ich mein erstes GUI vorstelle, habe ich aber noch ein kleines Problem mit Testdaten, sprich einem Sudoku, das sich sehr renitent allen Algorithmen und so auch deinem wiedersetzt. Hier ist es:

Code: Alles auswählen

. 	7	. 	. 	4	. 	. 	9	. 
2	. 	. 	. 	. 	8	. 	. 	3
. 	. 	5	1	. 	. 	7	. 	. 
4	. 	. 	. 	. 	. 	. 	. 	6
. 	. 	3	. 	. 	. 	4	. 	. 
. 	9	. 	. 	. 	. 	. 	3	. 
. 	. 	. 	. 	6	. 	. 	1	. 
8	. 	. 	. 	. 	2	. 	. 	9
. 	. 	7	3	8	. 	5	. 	. 

Was ist passiert? Ich habe dieses Sudoku mal einer "Batch-Version" deines Programms/Algorithmus angeboten, ergänzt habe ich nur Ein- und Ausgabe. Wenn die Datei nicht existiert, nimmt er auch deine Testdaten und löst das Sudoku. Wenn aber die Datei doch existiert, liest er mein Sudoku , zeigt es an und kann aber nicht lösen. Keine Ahnung warum.

Deine aktuellste Online-Version kann diese Datei/dieses Sudoku lesen und lösen. Auch eines meiner anderen Batchprogramme, welches mit Backtracking arbeitet, konnte es lösen. Ich habe sogar diesem Programm (s.u.) noch nachgeschaltet ein Backtracking verpasst - keine Lösung.
Ja gut, aber deine aktuelle Online-Version kann es doch aber? Und nutzt soweit ich sehen kann, deinen gleichenAlgorithmus.
Was habe ich also falsch gemacht bzw nicht richtig mit umgesetzt? Ich bin langsam vor Versuchen fast verzweifelt.

Code: Alles auswählen

program SudokuSolver;

const MAX = 9;

type
  TSudoku = class
  private
    SIZE : Integer;
    AllowedSymbols : String;
    Feld: array[0..8, 0..8] of Integer;
    Erlaubt: array[0..MAX-1, 0..MAX-1] of set of 1..MAX;
    procedure Initialisiere;
    procedure ErmittleAusschlussNeu;
    procedure SchliesseAusVon(x, y: Integer);
    procedure Finde(var x, y, zahl: Integer);
  public
    constructor Create;
    procedure SetZahl(x, y, zahl: Integer);
    procedure LoeseSudoku;
    function Geloest: Boolean;
    function Unloesbar: Boolean;
    procedure FindeLoesung;
    procedure ZeigeFeld(warte: Boolean);
    function EinlesenAusDatei(const Dateiname: string): Boolean;
    procedure AusgebenInDatei(const Dateiname: string);
  end;

const
  SudokuFeld: array[0..MAX-1, 0..MAX-1] of Integer = (
    (5, 3, 0, 0, 7, 0, 0, 0, 0),
    (6, 0, 0, 1, 9, 5, 0, 0, 0),
    (0, 9, 8, 0, 0, 0, 0, 6, 0),
    (8, 0, 0, 0, 6, 0, 0, 0, 3),
    (4, 0, 0, 8, 0, 3, 0, 0, 1),
    (7, 0, 0, 0, 2, 0, 0, 0, 6),
    (0, 6, 0, 0, 0, 0, 2, 8, 0),
    (0, 0, 0, 4, 1, 9, 0, 0, 5),
    (0, 0, 0, 0, 8, 0, 0, 7, 9)
  );

var
  Sudoku: TSudoku;

constructor TSudoku.Create;
var
  x, y: Integer;
begin
  SIZE := 9;
  AllowedSymbols := '123456789';
  for x := 0 to SIZE-1 do
    for y := 0 to SIZE-1 do
    begin
      Feld[x, y] := SudokuFeld[x, y];
    end;
end;

procedure TSudoku.Initialisiere;
var
  x, y: Integer;
begin
  for x := 0 to SIZE-1 do
    for y := 0 to SIZE-1 do
    begin
      Erlaubt[x, y] := [1, 2, 3, 4, 5, 6, 7, 8, 9];
    end;
  ErmittleAusschlussNeu;
end;

procedure TSudoku.SetZahl(x, y, zahl: Integer);
begin
  Feld[x, y] := zahl;
  SchliesseAusVon(x, y);
end;

procedure TSudoku.SchliesseAusVon(x, y: Integer);
var
  g, i, zahl: Integer;
begin
  zahl := Feld[x, y];
  g := 3;
  for i := 0 to SIZE-1 do
  begin
    // Schließt die Zahl von der entsprechenden Zeile, Spalte und 3x3-Box aus
    Exclude(Erlaubt[x, i], zahl);
    Exclude(Erlaubt[i, y], zahl);
    Exclude(Erlaubt[g * (x div g) + i div g, g * (y div g) + i mod g], zahl);
  end;
end;

procedure TSudoku.ErmittleAusschlussNeu;
var
  x, y: Integer;
begin
  for x := 0 to SIZE-1 do
    for y := 0 to SIZE-1 do
      if Feld[x, y] > 0 then
        SchliesseAusVon(x, y);
end;

procedure TSudoku.Finde(var x, y, zahl: Integer);
   procedure zeige_erlaubt(i,j: Integer);
   var x: Integer;
   begin
      Write('[');
      for x:=1 to 9 do begin
        if x in erlaubt [i,j] then Write(x,',');
      end;
      Write(']');
   end;

var
  i, j, z: Integer;
begin
  zahl := 0;
  for z := 1 to SIZE do
  begin
    for i := 0 to SIZE-1 do
      for j := 0 to SIZE-1 do
      begin
        if (Erlaubt[i, j] = [z]) and (Feld[i, j] = 0) then
        begin
          x := i;
          y := j;
          zahl := z;
          Exit;
        end;
      end;
  end;
end;

procedure TSudoku.LoeseSudoku;
var
  x, y, zahl: Integer;
begin
  repeat
    Finde(x, y, zahl);
    if zahl > 0 then
      SetZahl(x, y, zahl);
  until zahl = 0;
end;

function TSudoku.Geloest: Boolean;
var
  x, y: Integer;
begin
  Result := True;
  for x := 0 to SIZE-1 do
    for y := 0 to SIZE-1 do
      if Feld[x, y] = 0 then
      begin
        Result := False;
        Exit;
      end;
end;

function TSudoku.Unloesbar: Boolean;
var
  x, y: Integer;
begin
  Result := True;
  for x := 0 to SIZE-1 do
    for y := 0 to SIZE-1 do
      if Erlaubt[x, y] = [] then
      begin
        Result := False;
        Exit;
      end;
end;

procedure TSudoku.FindeLoesung;
var
  x, y, z: Integer;
begin
  repeat
    Finde(x, y, z);
    if z > 0 then
      SetZahl(x, y, z);
  until Geloest or Unloesbar;
end;

procedure TSudoku.ZeigeFeld(warte: Boolean);
var
  x, y, anz: Integer;
begin
  anz := 0;
  for x := 0 to SIZE-1 do
  begin
    for y := 0 to SIZE-1 do begin
      Write(Feld[x, y]:2);
      if Feld[x, y] > 0 then inc(anz);
    end;
    Writeln;
  end;
  Writeln('Belegt: ', anz, '/', SIZE*SIZE);
  if warte
     then Readln
     else Writeln;
end;

function TSudoku.EinlesenAusDatei(const Dateiname: string) : Boolean;
var
   Datei: Text;
   i, j: Integer;
   CharBuffer: Char;
begin
   EinlesenAusDatei := True;
   Assign(Datei, Dateiname);
   {$I-} Reset(Datei); {$I+}
   if IOResult <> 0 then
   begin
      WriteLn('Kann Datei: ', Dateiname, ' nicht öffnen.');
      EinlesenAusDatei := False;
      Exit;
   end;
   for i := 0 to SIZE-1 do begin
      j := 0;
      while (j <= SIZE-1) and not Eof(Datei) do begin
         Read(Datei, CharBuffer);
         if (CharBuffer = '.') or ((SIZE = 9) and (CharBuffer = '0')) then begin
            Feld[i][j] := 0;
            Inc(j);
         end
         else if (Pos(CharBuffer, AllowedSymbols) > 0) then begin
            Feld[i][j] := Pos(CharBuffer,  AllowedSymbols);
            Inc(j);
         end
         else if CharBuffer in [' ', #9, #10, #13] then
            Continue
         else begin
            WriteLn('Fehler: Falsches Zeichen in (', i, ',', j, '): "', CharBuffer, '"');
            EinlesenAusDatei := False;
            Close(Datei);
            Exit;
         end;
      end;
      if j <= SIZE-1 then begin
         WriteLn('Fehler: Zu wenige Zeichen in Zeile: ', i);
         EinlesenAusDatei := False;
         Close(Datei);
         Exit;
      end;
   end;
   Close(Datei);
end;

procedure TSudoku.AusgebenInDatei(const Dateiname: string);
var
  Datei: TextFile;
  x, y: Integer;
begin
  AssignFile(Datei, Dateiname);
  Rewrite(Datei);

  for x := 0 to SIZE-1 do
  begin
    for y := 0 to SIZE-1 do
    begin
      if Feld[x, y] = 0 then
        Write(Datei, '. ')
      else
        Write(Datei, Feld[x, y]:2);
    end;
    WriteLn(Datei);
  end;

  CloseFile(Datei);
end;

begin
  Sudoku := TSudoku.Create;
  Sudoku.ZeigeFeld(true);

  // Einlesen aus der Datei
  Sudoku.EinlesenAusDatei('aufgabe2.txt');
  Sudoku.ZeigeFeld(true);

   // Lösung beginnen
  Sudoku.Initialisiere;

  // Lösung finden
  Sudoku.FindeLoesung;

  if Sudoku.Geloest then Writeln('Gelöst');
  if Sudoku.Unloesbar then Writeln('Unlösbar');

  // Ausgabe in die Datei
  Sudoku.AusgebenInDatei('loesung.txt');

  // Zeige das gelöste Sudoku
  Sudoku.ZeigeFeld(true);

  Sudoku.Free;
end.

[corpsman]

Also meine SW hat es rausgebracht, aber nur mit Backtracking aktiviert :/

Sudoku_1_14.png (105.83 KiB) 2768 mal betrachtet