Entwickler-Ecke

Algorithmen, Optimierung und Assembler - Rekursion: N-Dame Prinzip


XeneQ - Do 27.10.05 20:55
Titel: Rekursion: N-Dame Prinzip
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 - Do 27.10.05 21:03
Titel: Re: Rekursion: N-Dame Prinzip
user profile iconXeneQ 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.


uall@ogc - Do 27.10.05 21:11
mit nem 2 dim array


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

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


GTA-Place - 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*


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!