hi
ja, ich weiß, es gibt bereits tausende sudokulöser im netzt aber ich wills eben selber machen.

hab jetzt auch code fürs lösen durch backtracking (also nix besonderes), aber bei mir gibt er einfach nur schwachsinn aus.

hab den code erst noch so, dass keine bereits eingegebenen zahlen berücksichtgt werden, er soll also einfach nur ein leeres sudoku-feld so füllen, dass keine regel verletzt wird. (werd das dann hinterher natürlich noch ändern)

also der code:

zusammenfalten · markieren

Delphi-Quellcode:

var feld:array[0..8,0..8] of integer;
    zahlen:array[1..9]of boolean;
    zahlenfest:array[0..8,0..8]of boolean;
  Form1: TForm1;

procedure anzeigen;
var i,j:integer;
begin
 for i:=0 to 8 do
 begin
  for j:=0 to 8 do
  begin
   form1.StringGrid1.Cells[i,j]:=inttostr(feld[j,j]);
  end;
 end;
 application.ProcessMessages;
end;

function reihe_spalte(x,y:integer;zahl:integer):boolean;
var i:integer;
    rueck:boolean;
begin
 rueck:=true;
 for i:=0 to 8 do
 begin
  if feld[x,i]=zahl then
  begin
   rueck:=false;
   break;
  end;
  if feld[i,y]=zahl then
  begin
   rueck:=false;
   break;
  end;
 end;
 reihe_spalte:=rueck;
end;

function quadrat(x,y:integer;zahl:integer):boolean;
var i,j,xt,yt,xm,ym:integer;
    rueck:boolean;
begin
 rueck:=true; //Bestimmung
 if x<=2 then xt:=1 //des 9x9 Unterquadrates
 else if x>=6 then xt:=3 //...
 else xt:=2; //...
 if y<=2 then yt:=1 //...
 else if y>=6 then yt:=3 //...
 else yt:=2; //...
 xm:=(xt-1)*3+2;
 ym:=(yt-1)*3+2;
 for i:=-1 to 1 do
 begin
  for j:=-1 to 1 do
  begin
   if feld[xm+i,ym+j]=zahl then rueck:=false;
  end;
 end;
 quadrat:=rueck;
end;

function nextx(x:integer):integer;
var rueck:integer;
begin
 if x<8 then rueck:=x+1
 else rueck:=0;
 nextx:=rueck;
end;

function nexty(x,y:integer):integer;
var rueck:integer;
begin
 if x<8 then rueck:=y
 else rueck:=y+1;
 nexty:=rueck;
end;

procedure zellefuellen(x,y:integer);
var i:integer;
begin
 for i:=1 to 9 do
 begin
  if (reihe_spalte(x,y,i))and(quadrat(x,y,i)) then
  begin
   feld[x,y]:=i;
   anzeigen;
   if (x<8)or(y<8) then zellefuellen(nextx(x),nexty(x,y));
  end;
 end;
 feld[x,y]:=0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 zellefuellen(0,0);
end;

ich hoffe der code is verständlich

also ich seh den fehler nicht, hoffe dass es einer von eucht tut^^

danke schon mal, mr pink

p.s.: bei veränderungsvorschlägen: ich würd gern den rekursiven teil beibehalten (ein grund warum ich das überhaupt mache)

Ui.. Such doch hier mal nach Sudoku in der DP:

Sudoku

Hier haben wir mindestens einen Thread wo etliche(!) Lösungsvorschläge u.a. glaube ich von Hagen und von Olli diskutiert werden. Ich denke da steht alles wichtige drin was Du an Infos zu Sodoku und an Lösungsansätzen benötigst.

ja, aber ich will ja wissen, wo in meinem code der fehler ist (der ansatz ist ja da. das pronzip sollte ja doch funktionieren denk ich).
es ging mir ja eben darum, NICHT das einfach irgendwo abzuschreiben.

wenn sich jemand nicht die mühe machen will, den code durchzusehen, versteh ich das, zumal der nicht besonders schön bzw sauber geschrieben ist.

aber bitte nicht auf andere lösungen verweisen..thx

Zitat von Mr. Pink:

aber bitte nicht auf andere lösungen verweisen..thx

Sorry, aber Deine Fehler wirst Du wohl selber rausfinden müssen. Ich denke hier wird sich niemand die Zeit nehmen und versuchen aus dem Code zu raten was Du Dir dabei gedacht hast.

In dem Thread den ich meinte ging es auch nicht um eine fertige Lösung sondern um eine Diskussion zu möglichen Unterschiedlichen Lösungsansätzen. Wenn Du diese Ansätze mit Deinem Ansatz vergleichst - da bin ich mir verdammt sicher - findest Du sicher schnell heraus wo bei Dir der Fehler liegt.

Um ein wenig Analyse der dahinterliegenden Algorithmen wirst Du nicht drumrum kommen, und ich denke Dein Problem liegt im Algorithmus und nicht im Code.

Hehe, guck dir Zeile 13 nochmal genauer an.
i <> j

hf NicNacMan

OMG

alles klar, danke für die hilfe!
jetzt gehts (die quadratfunction musste auch noch bisschen abgeändert werden).

das problem is nur, dass er nich bei der ersten lösung stehen bleibt, aber das wird wohl nicht die große schwierigkeit sein

werde wohl noch ne ganze menge verbessern können, aber war ja jetzt auch erstmal nur die erste idee...

danke für die hilfe, Pink