Rekursion: N-Dame Prinzip

XeneQ · Hält's aus hier Beiträge: 1

Hallo.
Ich brauche für ein Referat den Quelltext zu dem N-Dame Prinzip.
Wenn ihn jemand hat oder weiß wo man den herbekommt, bitte hier posten

Vielen Dank.
XeneQ

alzaimar · Verfasst: Do 27.10.05 21:03

XeneQ hat folgendes geschrieben:

Wenn ihn jemand hat oder weiß wo man den herbekommt, bitte hier posten

Gerne: "Ich haben ihn oder weiß, wo man ihn herbekommt". So war das gemeint, oder?

Im Ernst, so einfach ist das hier nicht, mit dem 'Quellcode mal eben abladen'. Könnte ja sein, das wir deine Hausaufgaben machen sollen.

_________________
Na denn, dann. Bis dann, denn.

uall@ogc · Verfasst: Do 27.10.05 21:11

mit nem 2 dim array

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:

 program damenproblem2;

{$APPTYPE CONSOLE}

// '05 von uall für seBaa

uses
  windows;

type Tschach = array[1..8,1..8] of boolean;

var schach: tschach;

function gueltig(x,y: integer): boolean;
var i: integer;
begin
  result := true;
  if schach[x,y] then
  begin
    result := false;
    exit;
  end;
  for i := 1 to 8 do
    if schach[x,i] then        // waagerechte dame im weg
  begin
    result := false;
    exit;
  end;
  for i := 1 to 8 do
    if schach[i,y] then        // senkrechte dame im weg
  begin
    result := false;
    exit;
  end;


  for i := 1 to 8 do                           // dame diagonal im weg
    if (x+i <= 8) and (y+i <= 8) then
    if schach[x+i,y+i] then
  begin
    result := false;
    exit;
  end;
  for i := 1 to 8 do
    if (x-i >= 1) and (y-i >= 1) then
    if schach[x-i,y-i] then
  begin
    result := false;
    exit;
  end;

  for i := 1 to 8 do                           // dame diagonal im weg
    if (x+i <= 8) and (y-i >= 1) then
    if schach[x+i,y-i] then
  begin
    result := false;
    exit;
  end;
  for i := 1 to 8 do
    if (x-i >= 1) and (y+i <= 8) then
    if schach[x-i,y+i] then
  begin
    result := false;
    exit;
  end;
end;

procedure loeschen;                            // initialisieren
var x,y: integer;
begin
  for x := 1 to 8 do
  for y := 1 to 8 do
  begin
    schach[x,y] := false;
  end;
end;

//var fertig : boolean = false;                 // 8 damen gesetzt?

var anzahl: integer = 0;

procedure ausgeben;                           // ausgeben der kombi
var x,y: integer;
begin
  for y := 1 to 8 do
  begin
    for x := 1 to 8 do
      write(integer(schach[x,y]));
    writeln;
  end;
end;

var schachf: array of TSchach;

function gleich(s1,s2: TSchach): boolean;
var x,y: integer;
begin
  result := true;
  for x := 1 to 8 do
  for y := 1 to 8 do
  if s1[x,y] <> s2[x,y] then
  begin
    result := false;
    exit;
  end;
end;

procedure addschach;
var x,y: integer;
begin
  for x := 1 to 8 do
  for y := 1 to 8 do
  begin
    schachf[anzahl][x,y] := schach[x,y];
  end;
end;

procedure addifnew;
var i: integer;
  r: boolean;
begin
  r := false;
  for i := 0 to anzahl-1 do
  begin
    if gleich(schachf[i],schach) then
    begin
      r := true;
      break;
    end;
  end;
  if (not r) then
  begin
    SetLength(schachf,anzahl+1);
    addschach;
    inc(anzahl);
    writeln('Anzahl gefunden: ',anzahl);
    ausgeben;
    writeln;
    //readln;
  end;
end;

procedure setzedame(i: integer);              // versuche dame nr. i zu setzen
var x,y: integer;
begin
  if i = 9 then
  begin
    addifnew;
  end else
  begin
    for x := 1 to 8 do
    for y := 1 to 8 do
    begin
      if gueltig(x,y) then
      begin
        schach[x,y] := true;
        setzedame(i+1);
        schach[x,y] := false;
      end;
    end;
  end;
end;

begin
  loeschen;
  setzedame(1);
  writeln('Lösungen: ',anzahl);
  readln;
end.

mit nem 1 dim array

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:

 program damenproblem;

{$APPTYPE CONSOLE}

// '05 von uall für seBaa

uses
  windows;

const quad = 8;

type Tschach = array[1..quad*quad] of boolean;

var schach: tschach;

function gueltig(x: integer): boolean;
var i: integer;
begin
  result := true;
  if schach[x] then
  begin
    result := false;
    exit;
  end;

  for i := 1 to quad do
    if schach[((x-1) div quad)*quad+i] then
  begin
    result := false;       // waagerechte dame im weg
    exit;
  end;

  for i := 1 to quad do
    if schach[((x-1) mod quad +1)+quad*(i-1)] then
  begin
    result := false;       // senkrechte dame im weg
    exit;
  end;

  for i := 1 to quad do                           // dame diagonal im weg
    if (x+(quad+1)*i <= quad*quad) then
    if (((x+(quad+1)*i)-1) mod quad) > (x-1) mod quad then
    if schach[x+(quad+1)*i] then
  begin
    result := false;
    exit;
  end;

  for i := 1 to quad do
    if (x-(quad+1)*i >= 1) then
    if (((x-(quad+1)*i)-1) mod quad ) < ((x-1) mod quad) then
    if schach[x-(quad+1)*i] then
  begin
    result := false;
    exit;
  end;

  for i := 1 to quad do                           // dame diagonal im weg
    if (x+(quad-1)*i <= quad*quad) then
    if (((x+(quad-1)*i)-1) mod quad ) < ((x-1) mod quad) then
    if schach[x+(quad-1)*i] then
  begin
    result := false;
    exit;
  end;

  for i := 1 to quad do
    if (x-(quad-1)*i >= 1) then
    if (((x-(quad-1)*i)-1) mod quad ) > ((x-1) mod quad) then
    if schach[x-(quad-1)*i] then
  begin
    result := false;
    exit;
  end;
end;

procedure loeschen;                            // initialisieren
var x: integer;
begin
  for x := 1 to quad*quad do
    schach[x] := false;
end;

//var fertig : boolean = false;                 // 8 damen gesetzt?

var anzahl: integer = 0;

procedure ausgeben;                           // ausgeben der kombi
var x: integer;
begin
  for x := 1 to quad*quad do
  begin
    write(integer(schach[x]));
    if x mod quad = 0 then
      writeln;
  end;
end;


var schachf: array of TSchach;

function gleich(s1,s2: TSchach): boolean;
var x: integer;
begin
  result := true;
  for x := 1 to quad*quad do
  if s1[x] <> s2[x] then
  begin
    result := false;
    exit;
  end;
end;

procedure addschach;
var x: integer;
begin
  for x := 1 to quad*quad do
  begin
    schachf[anzahl][x] := schach[x];
  end;
end;

procedure addifnew;
var i: integer;
  r: boolean;
begin
  r := false;
  for i := 0 to anzahl-1 do
  begin
    if gleich(schachf[i],schach) then
    begin
      r := true;
      break;
    end;
  end;
  if (not r) then
  begin
    SetLength(schachf,anzahl+1);
    addschach;
    inc(anzahl);
    writeln('Anzahl gefunden: ',anzahl);
    ausgeben;
    writeln;
  end;
end;

procedure setzedame(i, j: integer);              // versuche dame nr. i zu setzen
var x: integer;
begin
  if i = quad+1 then
  begin
    addifnew;
  end else
  begin
    for x := j to quad*quad do
    begin
      if gueltig(x) then
      begin
        schach[x] := true;
        setzedame(i+1,x);
        schach[x] := false;
      end;
    end;
  end;
end;

begin
  loeschen;
  setzedame(1, 1);
  writeln('Lösungen: ',anzahl);
  readln;
end.

auch wenn ich das net mag, wenns um schule geht, zufällig hatte ich den noch hier auf platte

_________________
wer andern eine grube gräbt hat ein grubengrabgerät
- oder einfach zu viel zeit

GTA-Place · Verfasst: Do 27.10.05 22:37

Ich brauch ein Gehirn für den Schuluntericht.
Wenn jemand eins übrigt hat, kann er mir es schicken.

Achja nochwas: Hat jemand die Lösung der Mathehause
auf Seite 25, Nr. 3? Ich hab kein Bock die zu machen... :roll:

*Sry, musste jetzt sein*

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme