Sudoku Array of Array vergleichen

[Marcel2906]

Guten Morgen,

ich bräuchte mal einen Denkanstoß, ich komm einfach nicht mehr weiter.
Und zwar habe ich ein Sudokufeld (Array 0..8 of Array 0..8)
Nun habe ich 2 Routinen geschrieben zum Prüfen ob eine Zahl in einer Reihe oder in einer Spalte doppelt sind :

Bsp. Code zum Prüfen in einer Reihe:

Delphi-Quellcode:

Var
   x, y, i, j: integer;
Begin
   x := 0;
   y := 0;
   i := 1;
   Repeat
      Repeat
         Repeat
            If (aSudoku[x, y] = aSudoku[x, y + i]) And (aSudoku[x, y] > 0) Then Begin
               ShowMessage('Eine Zahl in Reihe ' + IntToStr(x + 1) + ' ist doppelt');
               i := i + 1;
            End Else
               i := i + 1;
         Until (y + i) >= 8;
         y := y + 1;
         i := 1;
      Until y >= 8;
      y := 0;
      x := x + 1;
      i := 1;
   Until x >= 9;

Nun stellt sich mir die Frage, wie Prüfe ich ob in einem Feld 3x3 eine Zahl doppelt vorkommt ??

[Bummi]

vielleicht kannst Du damit was anfangen, schnell hingetippt,nicht großartig getestet

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);

type TZCount=Array[1..9] of Integer;
var
  x,y,xx,yy:Integer;

  ZCount:TZCount;
  Procedure ClearZCount;
    var
    i:Integer;
    begin
      for I := 1 to 9 do ZCount[i]:=0;
    end;
  Procedure Doublette;
   var
    i:Integer;
    begin
      for I := 1 to 9 do if ZCount[i]>1 then Showmessage('Doublette');
    end;
  Procedure Add2Zcount(z:Integer);
    begin
      if (z>0) and (z<10) then inc(ZCount[z]);
    end;
begin
   for y := 0 to 8 do
        begin
        ClearZCount;
        for x := 0 to 8 do  Add2Zcount(sud[y,x]);
        Doublette;
        end;
   for x := 0 to 8 do
        begin
        ClearZCount;
        for y := 0 to 8 do  Add2Zcount(sud[y,x]);
        Doublette;
        end;
   for xx := 0 to 2 do
     for yy := 0 to 2 do
     begin
     ClearZCount;
     for y := yy*3 to yy*3 + 2 do
          begin
          for x := xx*3 to xx*3 + 2 do  Add2Zcount(sud[y,x]);
          end;
     Doublette;
     end;
end;

[Marcel2906]

Hey cool, funktioniert. Danke :-D

Aber kann mir das vllt mal einer genau erklären was wo gemacht wird??
Oder einfach grob die Idee die dahinter steckt erläutern :?:

[Bummi]

Du läufst die Zeilen ab
Du läufst die Spalten ab
Du läufst 3*3 die (3*3) Blöcke ab

Jedes mal wird hier eine Array für die Zahlen 1-9 mit 0 initalisiert
beim Ablaufen der o.g. Bereiche für jede Zahl das auftreten um 1 erhöht
wenn eine Zahl mehrfach vorkommt muß in dem Array irgendwo eine Zahl>1 stehen.

[Marcel2906]

Aber wenn ich mehre Fehler habe, zeigt er mir hunderte mal an, dass etwas doppelt ist. Wie kann ich das nach der ersten ShowMessage stoppen?

[himitsu]

Einzelne Schleifen kannst du mit Break abbrechen.
Wenn du die Prüffunktion in eine eigene Funktion auslagerst, kannst du die Prozedur (und damit auch mehrere Schleifeb) mit Exit verlassen.
Oder man speichert sich den Status in einer Variable und reagiert nur auf das erste Vorkommen.

[DeddyH]

Oder man ersetzt die For- durch While-Schleifen und ergänzt die Schleifenbedingung entsprechend.

Delphi-Quellcode:

i := 1;
doppelt := false;
while (i < 9) and not doppelt do
  begin
    if Array[i] > 1 then
      begin
        doppelt := true;
        ShowMessage('Dublette');
      end;
    inc(i);
  end;

[Marcel2906]

Wenn ich es mit der while schleife versuche, habe ich wieder das Problem, dann wenn z.b. Sudoku[0,0] und [0,1] gleich sind er mir 4 mal eine meldung ausspuckt. 2mal das in einer reihe etwas doppelt ist und 2 mal dass im feld eine zahl doppelt ist...

Mit break und exit hab ich schon ein wenig rumprobiert, leider es nicht geschafft, da es ja eine procedure in einer procedure ist.

Mein code sieht so aus:

Delphi-Quellcode:

Procedure TForm2.BtPruefenClick(Sender: TObject);
Type
   THilfsArray = Array[1..9] Of Integer;
Var
   x, y, xx, yy: Integer;
   HilfsArray: THilfsArray;

   //HilfsArray erstellen
   Procedure HilfsArrayLeeren;
   Var
      i: Integer;
   Begin
      For I := 1 To 9 Do
         HilfsArray[i] := 0;
   End;

   //Wenn eine Zahl doppelt, Fehlermeldung
   Procedure ZahlDoppelt(WO: String);
   Var
      i: Integer;
      doppelt: boolean;
   Begin
      // Das alte mit der for Schleife

      {     For I := 1 To 9 Do
              If HilfsArray[i] > 1 Then Begin
                 Showmessage('Zahl in' + WO + ' doppelt');
                 BtNewClick(BtNew);
              End; }

      i := 1;
      doppelt := false;
      While (i < 9) And Not doppelt Do Begin
         If HilfsArray[i] > 1 Then Begin
            doppelt := true;
            ShowMessage('Zahl in' + WO + ' doppelt');
         End;
         inc(i);
      End;
   End;

   //Zahl zum Hilfsarray hinzufügen
   Procedure AddHilfsArray(z: Integer);
   Begin
      If (z > 0) And (z < 10) Then
         inc(HilfsArray[z]);
   End;

Begin
   //Zeile prüfen
   For y := 0 To 8 Do Begin
      HilfsArrayLeeren;
      For x := 0 To 8 Do
         AddHilfsArray(aSudoku[y, x]);
      ZahlDoppelt(' einer Zeile');
   End;
   //Spalte prüfen
   For x := 0 To 8 Do Begin
      HilfsArrayLeeren;
      For y := 0 To 8 Do
         AddHilfsArray(aSudoku[y, x]);
      ZahlDoppelt(' einer Spalte');
   End;
   //Feld prüfen
   For xx := 0 To 2 Do
      For yy := 0 To 2 Do Begin
         HilfsArrayLeeren;
         For y := yy * 3 To yy * 3 + 2 Do Begin
            For x := xx * 3 To xx * 3 + 2 Do
               AddHilfsArray(aSudoku[y, x]);
         End;
         ZahlDoppelt(' einem Feld');
      End;
End;

[himitsu]

Mach aus ZahlDoppelt eine Funktion, welche dir einen Boolen zurückgibt. (False wenn nicht doppelt usw.)

Du rufst diese Funktion ja mehrmals auf und das doppelt ist bis jetzt in jedem Funktionsaufruf neu/eigenständig.
Du mußt also auch noch die nchfolgenden Funktionsaufrufe entsprechend behandeln. :zwinker:

[Marcel2906]

irgendwie hab ich ne Blockade :-P
habs jetzt so versucht:

Delphi-Quellcode:

Procedure TForm2.BtPruefenClick(Sender: TObject);
Type
   THilfsArray = Array[1..9] Of Integer;
Var
   x, y, xx, yy: Integer;
   HilfsArray: THilfsArray;

//...

   //Wenn eine Zahl doppelt, Fehlermeldung
   Function ZahlDoppelt: boolean;
   Var
      i: Integer;
      doppelt: boolean;
   Begin
      For I := 1 To 9 Do
         If HilfsArray[i] > 1 Then
            Result := true;
   End;

//...


Begin
   //Zeile prüfen
   For y := 0 To 8 Do Begin
      HilfsArrayLeeren;
      For x := 0 To 8 Do
         AddHilfsArray(aSudoku[y, x]);
      If ZahlDoppelt = true Then
         ShowMessage(' einer Zeile');
   End;
   //Spalte prüfen
   For x := 0 To 8 Do Begin
      HilfsArrayLeeren;
      For y := 0 To 8 Do
         AddHilfsArray(aSudoku[y, x]);
      If ZahlDoppelt = true Then
         ShowMessage(' einer Spalte');
   End;
   //Feld prüfen
   For xx := 0 To 2 Do
      For yy := 0 To 2 Do Begin
         HilfsArrayLeeren;
         For y := yy * 3 To yy * 3 + 2 Do Begin
            For x := xx * 3 To xx * 3 + 2 Do
               AddHilfsArray(aSudoku[y, x]);
         End;
         If ZahlDoppelt = true Then
            ShowMessage(' einem Feld');
      End;
End;

[Blup]

Delphi-Quellcode:

   Function ZahlDoppelt: boolean;
   Var
      i: Integer;
   Begin
      For i := 1 To 9 Do
      Begin
         If HilfsArray[i] > 1 Then
         Begin
            Result := True;
            Exit; // Ergebnis steht fest
         End;
      End;
      Result := False;
   End;

//... niemals einen Boolean-Wert mit True vergleichen
      If ZahlDoppelt Then
         ShowMessage(' einer Zeile');

[Sir Rufo]

Also ich würde das gesamte Konzept anders angehen :)

SuDoKu (3x3) besteht ja aus 81 Feldern, welche in (3x9) 27 Blöcken organisiert sind.
Jedes Feld ist dabei immer in 3 Blöcken enthalten ( Reihe, Spalte, Quadrant )

Wenn du beim Aufbau des Spielfeldes diese Strukturen erzeugst, dann wird die Abfrage zum Kinderspiel:

Delphi-Quellcode:

TSuDoKuBlock = class;

TSuDoKuField = class
private
  // Liste der Blöcke, zu dem dieses Feld gehört
  _Items : array[0..2] of TSuDoKuBlock;
  _Value : Integer;
  procedure SetValue( aValue : Integer );
public
  function CanSetValue( aValue : Integer ) : Boolean; override;
  property Value : Integer read _Value write _Value;  
end;

TSuDoKuBlock = class( TSuDoKuBase )
private
  // Liste der Felder, die in diesen Block gehören
  _Items : array[0..8] of TSuDoKuField;
public
  function CanSetValue( aValue : Integer ) : Boolean; override;
end;

...

function TSuDoKuBlock.CanSetValue( aValue : Integer ) : Boolean;
var
  idx : integer;
begin
  Result := True;
  if ( Value > 0 ) then
    for idx := 0 to 8 do
    begin
      Result := Result and ( _Items[ idx ].Value <> aValue );
      // Wir können aufhören, wenn wir eine Abbruchbedingung gefunden haben
      if not Result then
        Break;
    end;
end;

function TSuDoKuField.CanSetValue( aValue : Integer ) : Boolean;
var
  idx : integer;
begin
  Result := True;
  if ( Value > 0 ) then
    for idx := 0 to 2 do
    begin
      Result := Result and _Items[ idx ].CanSetValue( aValue );
      // Wir können aufhören, wenn wir eine Abbruchbedingung gefunden haben
      if not Result then
        Break;
    end;
end;

Jetzt braucht man nur noch das Feld selber fragen und bekommt die passende Antwort:

Delphi-Quellcode:

if SuDoKuGame.Field[ 3, 7 ].CanSetValue( 6 ) then
  SuDoKuGame.Field[ 3, 7 ].Value := 6;

[Bjoerk]

Sir Rufo,

was meinst du mit 27 Blöcken, sind es nicht immer 9?

[Sir Rufo]

Zitat:

Zitat von Bjoerk (Beitrag 1136996)

Sir Rufo,

was meinst du mit 27 Blöcken, sind es nicht immer 9?

Ja, 9 Reihen, 9 Spalten, 9 Quadranten ergibt 27 Blöcke ;)

[Bjoerk]

Achso, ich hatte diese Blöcke als Quadranten verstanden.

[Bjoerk]

Hab’s mal ausprobiert, allerdings etwas anders. Die Quadranten nenne ich hier Blöcke. Als Grundlage der Suche benutze ich eine Pemutliste. Geht recht flott so, < 2 sec..

Delphi-Quellcode:

function BlockToRowCol(Block, Index: integer): TPoint;
var
  VX, VY: integer;
begin
  // Block 0..8, Index 0..8
  // Result.X = Row 0..8, Result.Y = Col 0..8
  VX:= 0;
  VY:= 0;
  case Block of
    0: begin VX:= 0; VY:= 0; end;
    1: begin VX:= 3; VY:= 0; end;
    2: begin VX:= 6; VY:= 0; end;
    3: begin VX:= 0; VY:= 3; end;
    4: begin VX:= 3; VY:= 3; end;
    5: begin VX:= 6; VY:= 3; end;
    6: begin VX:= 0; VY:= 6; end;
    7: begin VX:= 3; VY:= 6; end;
    8: begin VX:= 6; VY:= 6; end;
  end;
  with Result do
  begin
    X:= 0;
    Y:= 0;
    case Index of
      0: begin X:= VY;   Y:= VX;   end;
      1: begin X:= VY;   Y:= VX+1; end;
      2: begin X:= VY;   Y:= VX+2; end;
      3: begin X:= VY+1; Y:= VX;   end;
      4: begin X:= VY+1; Y:= VX+1; end;
      5: begin X:= VY+1; Y:= VX+2; end;
      6: begin X:= VY+2; Y:= VX;   end;
      7: begin X:= VY+2; Y:= VX+1; end;
      8: begin X:= VY+2; Y:= VX+2; end;
    end;
  end;
end;

procedure TForm1.SetSudokuBlock(I: integer; Numbers: TIntegerList);
var
  Result: TIntegerList;
  J, N, Index: integer;
  T: TPoint;
  A, B, C: boolean;
begin
  Result:= TIntegerList.Create;
  try
    Result.FillUp(9);
    N:= 0;
    repeat
      A:= true;
      B:= true;
      C:= true;
      for J:= 0 to 8 do
      begin
        Index:= FPermutList.Item[N*9+J];
        Result.Item[J]:= Numbers.Item[Index];
        T:= BlockToRowCol(I, J);
        A:= A and FRow[T.X].CanHaveValue(Result.Item[J]);
        B:= B and FCol[T.Y].CanHaveValue(Result.Item[J]);
        C:= C and FBlock[I].CanHaveValue(Result.Item[J]);
      end;
      Inc(N);
    until (A and B and C);
    for J:= 0 to 8 do
    begin
      T:= BlockToRowCol(I, J);
      FRow[T.X].Item[T.Y]:= Result.Item[J];
      FCol[T.Y].Item[T.X]:= Result.Item[J];
      FBlock[I].Item[J]:= Result.Item[J];
    end;
  finally
    Result.Free;
  end;
end;

procedure TForm1.BuildSudoku;
var
  Numbers: TIntegerList;
  I, J: integer;
begin
  Numbers:= TIntegerList.Create;
  try
    Numbers.FillUp(9, 1, 1);
    Numbers.Mix;
    SudokuNull;
    for I:= 0 to 8 do // Blöcke
      SetSudokuBlock(I, Numbers);
  finally
    Numbers.Free;
  end;
end;

[Sir Rufo]

Ein Busserl umständlich mit den case-Anweisungen, geht sowas doch auch schön mit

Delphi-Quellcode:

div

und

Delphi-Quellcode:

mod

;)

[Bjoerk]

Ist mir nix Gescheites eingefallen, laß mal rüberwachen.. 8-)

[Bummi]

statt

Delphi-Quellcode:

  VX:= 0;
  VY:= 0;
  case Block of
    0: begin VX:= 0; VY:= 0; end;
    1: begin VX:= 3; VY:= 0; end;
    2: begin VX:= 6; VY:= 0; end;
    3: begin VX:= 0; VY:= 3; end;
    4: begin VX:= 3; VY:= 3; end;
    5: begin VX:= 6; VY:= 3; end;
    6: begin VX:= 0; VY:= 6; end;
    7: begin VX:= 3; VY:= 6; end;
    8: begin VX:= 6; VY:= 6; end;
  end;

beispielsweise

Delphi-Quellcode:

VX := (Block MOD 3) * 3;
VY := Block div 3 * 3;

[/delphi]

[Bjoerk]

Das sieht schon sehr viel besser aus. Danke Thomas. :cheers:

[Bjoerk]

Für die Sudoku Fans:

Delphi-Quellcode:

function BlockToRowCol(Block, Index: integer): TPoint;
begin
  // Block 0..8, Index 0..8
  // Result.X = Row 0..8, Result.Y = Col 0..8
  Result.X:= (Block div 3) * 3 + Index div 3;
  Result.Y:= (Block mod 3) * 3 + (Index + 3) mod 3;
end;

function RowColToBlock(Row, Col: integer): TPoint;
begin
  // Row 0..8, Col 0..8
  // Result.X = Block 0..8, Result.Y = Index 0..8
  Result.X:= Row div 3 mod 3 * 3 + Col div 3 mod 3;
  Result.Y:= Row mod 3 * 3 + Col mod 3;
end;

function IndexToRowCol(K: integer): TPoint;
begin
  // K 0..80
  // Result.X = Row 0..8, Result.Y = Col 0..8
  Result.X:= K div 9;
  Result.Y:= K - Result.X * 9;
end;

function RowColToIndex(Row, Col: integer): integer;
begin
  // Row 0..8, Col 0..8
  // Result = K 0..80
  Result:= Row * 9 + Col;
end;

[Raziel eats SoulCookies]

Hallo zusammen.
Ich und ein Schulkollege haben in Info eine Projektarbeit.
Wir haben uns auch für Sudoku entschieden. Wir haben hier auch schon eine menge Seiten zu diesem Thema durchgewelzt. Habe mich schließlich auch hier angemeldet um ein paar Sudokus down-zu-loaden, da wir uns das auch mal anschauen wollten.
Unser Problem besteht zum ersten darin, das hier mit vielen Funktionen und Anweisungen für Delphi programmiert wird, welche wir nicht kennen und wir aber auch nicht einfach den Quelltext kopieren können.
Zum zweiten haben wir folgenden Quelltext um das Array und Später auch das Stringrid damit zu füllen.
Es funktioniert auch bis zur 7. Zeile und 5. Spalte recht gut.
Aber dann bekommen wir einen Stacküberlauf oder eine Access Violation.
Wenn wir dann die Zelle 7/6 vom Vergleich ausklammern, kommen wir wieder ein einhalb Zeilen weiter.

Nun wollte ich mal fragen ob einer vielleicht Zeit hätte sich das mal anzuschauen und vielleicht einen Denkanstoß für das Problem hat.

---- musste den Quellcode entfernen, war der falsche.
---- richtige kommt