Autor |
Beitrag |
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Sa 22.12.18 14:06
@Schestex: Danke für den Hinweis. Ist geändert.
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
Für diesen Beitrag haben gedankt: Narses
|
|
Narses
Beiträge: 10182
Erhaltene Danke: 1255
W10ent
TP3 .. D7pro .. D10.2CE
|
Verfasst: Sa 22.12.18 15:37
_________________ There are 10 types of people - those who understand binary and those who don´t.
|
|
pzktupel
Hält's aus hier
Beiträge: 129
Erhaltene Danke: 30
|
Verfasst: Sa 22.12.18 15:59
Habe auch GDATA. Bei mir war alles friedlich. System: Windows 7 64bit
|
|
Hidden
Beiträge: 2242
Erhaltene Danke: 55
Win10
VS Code, Delphi 2010 Prof.
|
Verfasst: Sa 22.12.18 16:11
Welche Farbe der Bauer hat, ist nicht bekannt -- oder?
_________________ Centaur spears can block many spells, but no one tries to block if they see that the spell is a certain shade of green. For this purpose it is useful to know some green stunning hexes. (HPMoR)
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Sa 22.12.18 16:13
Hidden hat folgendes geschrieben : | Welche Farbe der Bauer hat, ist nicht bekannt -- oder? |
Die sechs Schachfiguren sind alle weiß. Für die Aufgabe ist das aber nicht von Bedeutung.
LG Steffen
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
Für diesen Beitrag haben gedankt: Hidden
|
|
Schestex
Hält's aus hier
Beiträge: 18
Erhaltene Danke: 6
Win10 & Debian(Server)
Perl, Bash, TCL, C, python
|
Verfasst: Sa 22.12.18 16:19
Für diesen Beitrag haben gedankt: Hidden
|
|
pzktupel
Hält's aus hier
Beiträge: 129
Erhaltene Danke: 30
|
Verfasst: Sa 22.12.18 16:33
Frage, bei dem Spiel morgen - reicht wieder nur durchrennen (wie letztes Jahr) oder muß die geforderte Anzahl eingesammelt werden ?
|
|
Hidden
Beiträge: 2242
Erhaltene Danke: 55
Win10
VS Code, Delphi 2010 Prof.
|
Verfasst: Sa 22.12.18 16:33
Schestex hat folgendes geschrieben : | Hier muss ich korregieren, da sich somit der Angriff des Bauers schon entscheidet |
Ja, genau^^
Von der Farbe würde abhängen in welche Richtung der Bauer schlagen kann. Ein weißer Bauer auf G2 wäre zum Beispiel legal, aber ein schwarzer könnte H1 oder F1 schlagen.
Wenn beides funktioniert, ist das indirekt noch ein Tipp
_________________ Centaur spears can block many spells, but no one tries to block if they see that the spell is a certain shade of green. For this purpose it is useful to know some green stunning hexes. (HPMoR)
|
|
Gausi
Beiträge: 8538
Erhaltene Danke: 475
Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
|
Verfasst: Sa 22.12.18 16:34
Mathematiker hat folgendes geschrieben : | Die sechs Schachfiguren sind alle weiß. Für die Aufgabe ist das aber nicht von Bedeutung. |
In meiner Lösung schon. Es funktioniert zwar auch mit einem schwarzen Bauern, aber dann sieht die Lösung etwas anders aus.
(Ich hoffe, das ist jetzt kein zu großer Tipp, aber Steffens Antwort könnte einige auf die falsche Fährte locken, finde ich.)
_________________ We are, we were and will not be.
Für diesen Beitrag haben gedankt: Mathematiker
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Sa 22.12.18 17:51
Gausi hat folgendes geschrieben : | ... aber Steffens Antwort könnte einige auf die falsche Fährte locken, finde ich.) |
Stimmt. Danke für den Hinweis.
Bei meiner Antwort habe ich nicht an den Bauern gedacht.
Die sechs Schachfiguren sind weiß und das ist sogar wichtig.
LG Steffen
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
|
|
Delphi-Laie
Beiträge: 1600
Erhaltene Danke: 232
Delphi 2 - RAD-Studio 10.1 Berlin
|
Verfasst: Sa 22.12.18 19:14
Ich rege an und bitte devot darum zu erwägen, ob zukünftig, falls es weitere Adventskalender geben wird, eine 48-h-Frist zur Lösung eingerichtet werden könnte, denn die 24-h-Frist empfinde ich manchmal als etwas knapp. Vielleicht geht es anderen ja auch so.
_________________ Ordnung ist das halbe Leben - und sie zu schaffen die andere Hälfte.
|
|
ub60
Beiträge: 762
Erhaltene Danke: 127
|
Verfasst: Sa 22.12.18 19:54
Delphi-Laie hat folgendes geschrieben : | Ich rege an ... ob zukünftig ... eine 48-h-Frist zur Lösung eingerichtet werden könnte ... |
Die Idee finde ich nicht so gut, denn eigentlich ist die jetzige Regelung ja schon die entschärfte Variante. Früher begann es 0 Uhr und endete 23:59 Uhr. Bei der Verlängerung auf 2 Tage müsste man noch länger auf Lösungen oder Beispiellösungen von anderen warten. Nach 2 Tagen wäre da schon ziemlich die Luft raus ...
Also mein Vorschlag: Weiter wie bisher.
PS: Das setzt natürlich voraus, dass der Mathematiker weiterhin die riesige Vorbereitungsarbeit für einen weiteren Adventskalender auf sich nimmt (BIIITTTTEEEE!).
ub60
Für diesen Beitrag haben gedankt: BenBE, Mathematiker, Narses
|
|
Hidden
Beiträge: 2242
Erhaltene Danke: 55
Win10
VS Code, Delphi 2010 Prof.
|
Verfasst: Sa 22.12.18 22:01
Für die Verlosung haben wir denke ich einen guter Kompromiss gefunden. Da man für maximale Chancen nicht alle 24 Rätsel gelöst haben muss, ist es okay wenn man ein paar nicht innerhalb der 24 Stunden schafft.
Wer versuchen will, in den Statistiken ganz oben zu stehen, für den kann es unter Umständen natürlich mal knapp sein. Man kann dann für sich entscheiden, ob man die Lösung lesen möchte oder die Posts dazu erst liest wenn man die Aufgabe gelöst hat.
Ich habe bisher zwei nicht abgegeben. Als es die 20 (Tetraeden) gab habe ich den Tag lang kein Internet gehabt (-> ergo auch kein Abruf um 23:59 + Lösungsfrist bis zum nächsten Tag).
_________________ Centaur spears can block many spells, but no one tries to block if they see that the spell is a certain shade of green. For this purpose it is useful to know some green stunning hexes. (HPMoR)
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Sa 22.12.18 23:04
Hallo,
das Kugelschieben war wohl schwieriger als erwartet. Ich habe keine schöne Lösung, da ich es nur so lange probiert habe, bis es ging. Eine Zugfolge (wahrscheinlich geht es kürzer) ist:
Lösung: lrl dur lrl rrl rrd lrl rrl lur dlr uud ul
(left, right, up, down)
LG Steffen
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
|
|
Symbroson
Beiträge: 382
Erhaltene Danke: 67
Raspbian, Ubuntu, Win10
C, C++, Python, JavaScript, Lazarus, Delphi7, Casio Basic
|
Verfasst: Sa 22.12.18 23:32
Es war auf jeden Fall hilfreich den Weg rückwärts ein Stück zurückzuvervolgen. vom Ziel ausgegangen gibt es nämlich nur wenige Möglichkeiten dorthin zu gelangen. Im Endeffekt habe ich damit ca die Hälfte des Rätsels gelöst (es wäre durchaus mehr möglich gewesen), und die andere Hälfte durch probieren, bis ich mit der richtigen Zuganzahl auf einem von mir ermittelten Felder gelangte.
Das mit der Maus schreiben hat sich allerdings als schwierigstes Problem herausgestellt...
Einloggen, um Attachments anzusehen!
_________________ most good programmers do programming not because they expect to get paid or get adulation by the public, but because it's fun to program. (Linus Torvalds)
Für diesen Beitrag haben gedankt: Delphi-Laie
|
|
Hidden
Beiträge: 2242
Erhaltene Danke: 55
Win10
VS Code, Delphi 2010 Prof.
|
Verfasst: Sa 22.12.18 23:45
Lösung zu (21) Kugel in javascript (Breitensuche):
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:
| { const level = ` x . . . x . . . . . . . . . . . . . . . . . . . . . . . . . . . . . x . x . . . . . . . . . . . . . . s . . x . . . . . . . . . . x . . f . . . . . . . . . . . . . . x . . . . . . . . . . . . . . . . . . . . . . . . . . . . x . x . x . . . . . . . . . . . `.trim().split(/\s*/g);
const moves = [ [ 1, 0], [ 0, 1], [-1, 0], [ 0, -1], ].map( ([x,y]) => x + 16 * y );
const steps = [1, 3, 5];
console.log( breadthFirstSearch(level, moves, steps, 1000) ); }
function decodeFieldIndex (i) { const x = i & 0b00000111; const y = i >> 4 & 0b00000111; return "abcdefgh"[x] + (y+1); }
function breadthFirstSearch (level, moves, steps, depthLimit) { let depth = 0; let positions = [{ index: level.indexOf("s"), history: [], }];
while (depth < depthLimit) { const phase = depth % 3; const newPositions = [];
for (const move of moves) { for (let {index, history} of positions) {
let blocked = false; for (let step = 0; step < steps[phase]; step++) { index += move; if ((index & 0x88) || level[index] === "x") { blocked = true; break; } } if (blocked) continue;
history = [...history, index];
if (level[index] === "f") { return history .map(decodeFieldIndex) .join(" "); }
newPositions.push({ index, history, }); } }
positions = newPositions; depth++; } return "failed"; } |
Output: c4 f4 a4 a5 a2 f2 e2 h2 c2 d2 g2 b2 c2 f2 f7 e7 h7 c7 d7 g7 b7 a7 a4 f4 f5 c5 h5 h4 h1 h6 h5 e5
Edit: Ich habe vergessen, ein visited Array anzulegen in dem ich für jedes Feld und jede Phase (1/3/5 Sprung) abspeichere ob diese Kombination bereits besucht wurde. An den Stellen könnte man sich das Weitersuchen dann sparen und die Laufzeit reduzieren. Die ist aber auch so schon sehr klein, weil der branching-Faktor dieses Spiels nicht sehr hoch zu sein scheint.
Edit2: 32 scheint damit tatsächlich die kürzeste Lösung zu sein, da die Breitensuche bei Tiefe 32 das erste Ergebnis findet.
Edit3: Ich hab das mal in einen Generator umgeschrieben, damit ich alle Lösungen und nicht nur die eine bekomme. Ergebnis: Die Lösung ist Eindeutig. Am Output sieht man sehr schön, dass wie gesagt der branching-Faktor sehr klein ist.
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:
| { const level = ` x . . . x . . . . . . . . . . . . . . . . . . . . . . . . . . . . . x . x . . . . . . . . . . . . . . s . . x . . . . . . . . . . x . . f . . . . . . . . . . . . . . x . . . . . . . . . . . . . . . . . . . . . . . . . . . . x . x . x . . . . . . . . . . . `.trim().split(/\s*/g);
const moves = [ [ 1, 0], [ 0, 1], [-1, 0], [ 0, -1], ].map( ([x,y]) => x + 16 * y );
const steps = [1, 3, 5];
(async () => { for await (const line of breadthFirstSearch(level, moves, steps, 1000)) { console.log(line); } })(); }
function decodeFieldIndex (i) { const x = i & 0b00000111; const y = i >> 4 & 0b00000111; return "abcdefgh"[x] + (y+1); }
async function* breadthFirstSearch (level, moves, steps, depthLimit) { let depth = 0; let positions = [{ index: level.indexOf("s"), history: [], }]; const visited = Array(level.length) .fill() .map( () => [false, false, false] );
while (positions.length && depth < depthLimit) { const phase = depth % 3; yield `depth: ${depth}, nodes: ${positions.length}`; const newPositions = [];
for (const move of moves) { for (let {index, history} of positions) {
let blocked = false; for (let step = 0; step < steps[phase]; step++) { index += move; if ((index & 0x88) || level[index] === "x") { blocked = true; break; } } if (blocked || visited[index][phase]) continue; visited[index][phase] = true;
history = [...history, index];
if (level[index] === "f") { yield history .map(decodeFieldIndex) .join(" ");
continue; }
newPositions.push({ index, history, }); } }
positions = newPositions; depth++; } yield "done"; } |
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:
| depth: 0, nodes: 1 depth: 1, nodes: 4 depth: 2, nodes: 6 depth: 3, nodes: 2 depth: 4, nodes: 6 depth: 5, nodes: 8 depth: 6, nodes: 4 depth: 7, nodes: 9 depth: 8, nodes: 5 depth: 9, nodes: 3 depth: 10, nodes: 7 depth: 11, nodes: 5 depth: 12, nodes: 2 depth: 13, nodes: 6 depth: 14, nodes: 3 depth: 15, nodes: 3 depth: 16, nodes: 3 depth: 17, nodes: 3 depth: 18, nodes: 3 depth: 19, nodes: 3 depth: 20, nodes: 2 depth: 21, nodes: 1 depth: 22, nodes: 4 depth: 23, nodes: 3 depth: 24, nodes: 1 depth: 25, nodes: 1 depth: 26, nodes: 2 depth: 27, nodes: 2 depth: 28, nodes: 3 depth: 29, nodes: 3 depth: 30, nodes: 2 depth: 31, nodes: 2
c4 f4 a4 a5 a2 f2 e2 h2 c2 d2 g2 b2 c2 f2 f7 e7 h7 c7 d7 g7 b7 a7 a4 f4 f5 c5 h5 h4 h1 h6 h5 e5
depth: 32, nodes: 1 depth: 33, nodes: 1
done |
Einloggen, um Attachments anzusehen!
_________________ Centaur spears can block many spells, but no one tries to block if they see that the spell is a certain shade of green. For this purpose it is useful to know some green stunning hexes. (HPMoR)
Zuletzt bearbeitet von Hidden am So 23.12.18 01:21, insgesamt 2-mal bearbeitet
Für diesen Beitrag haben gedankt: BenBE, Delphi-Laie, Mathematiker, Narses, Schestex, Symbroson, ub60
|
|
pzktupel
Hält's aus hier
Beiträge: 129
Erhaltene Danke: 30
|
Verfasst: So 23.12.18 00:55
Oh ja, die Kugel:
Gelöst siehe Bilder
Einloggen, um Attachments anzusehen!
Für diesen Beitrag haben gedankt: Hidden
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: So 23.12.18 02:34
Ich hab das als Breitensuche mit maximal 64 Zügen gelöst und dabei durch Optimierung folgende Varianten (jeweils im Suchraum bis dahin kürzeste Lösung) gefunden:
Quelltext 1: 2: 3: 4: 5: 6:
| Found: lrldurllrllrdduddlurldurllrrdlurldurlrlrrlrrdlrlrrllurdlruudul Found: lrldurllrllrdduddlurldurlrlrlrlrlrrlrrdlrlrrllurdlruudul Found: lrldurllrllrdduddlurldurlrlrrlrrdlrlrrllurdlruudul Found: lrldurllrrdlurldurlrlrrlrrdlrlrrllurdlruudul Found: lrldurlrlrlrlrlrrlrrdlrlrrllurdlruudul Found: lrldurlrlrrlrrdlrlrrllurdlruudul |
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:
| <?php
$f = array( array("#"," "," "," ","#"," "," "," "), array(" "," "," "," "," "," "," "," "), array(" "," ","#"," ","#"," "," "," "), array(" "," "," "," "," "," ","#"," "), array(" ","#"," "," "," "," "," "," "), array(" "," "," ","#"," "," "," "," "), array(" "," "," "," "," "," "," "," "), array("#"," ","#"," ","#"," "," "," ") );
function show($p) { static $ps = ""; if(!strlen($ps)) { $ps = str_repeat("#", 256); } if(strlen($p) < strlen($ps)) { $ps = $p; echo "Found: $p\n"; } }
function check($f, $a1, $b1, $a2, $b2) { $ca1 = min($a1, $a2); $cb1 = min($b1, $b2);
$ca2 = max($a1, $a2); $cb2 = max($b1, $b2);
if($ca1 < 0 || $cb1 < 0) { return false; }
if($ca2 > 7 || $cb2 > 7) { return false; }
for($ca = $ca1; $ca <= $ca2; $ca++) { for($cb = $cb1; $cb <= $cb2; $cb++) { if($f[$ca][$cb] == "#") { return false; } } }
return true; }
function jump($f, $a, $b, $p) { if(strlen($p) > 64) { return; }
if($a == 4 && $b == 4) { show($p); return; }
$r = strlen($p) % 3; $d = 1 + 2 * $r;
$al = $a; $bl = $b - $d;
$ar = $a; $br = $b + $d;
$au = $a - $d; $bu = $b;
$ad = $a + $d; $bd = $b;
if(check($f, $a, $b, $al, $bl)) { jump($f, $al, $bl, $p . "l"); }
if(check($f, $a, $b, $ar, $br)) { jump($f, $ar, $br, $p . "r"); }
if(check($f, $a, $b, $au, $bu)) { jump($f, $au, $bu, $p . "u"); }
if(check($f, $a, $b, $ad, $bd)) { jump($f, $ad, $bd, $p . "d"); } }
jump($f, 3, 3, ""); |
Insgesamt also recht straight forward ... Durch probieren bin ich immer nicht weit gekommen ...
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
Für diesen Beitrag haben gedankt: Hidden, Mathematiker, Narses
|
|
pzktupel
Hält's aus hier
Beiträge: 129
Erhaltene Danke: 30
|
Verfasst: So 23.12.18 09:09
Ihr seid voll krass mit programmieren. Im-MP-Forum gibts eine Aufgabe mit Preisgeld. Ein magisches Quadrat 3x3 was nur unterschiedliche Quadratzahlen enthält.
matheplanet.de/mathe...lps=1741685#v1741685
|
|
Gausi
Beiträge: 8538
Erhaltene Danke: 475
Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
|
Verfasst: So 23.12.18 09:21
Meine Lösung in Delphi: Nicht so elegant wie die vorherigen, aber mit "visited"-Array. Ohne das laufe ich (ohne Tiefenbeschränkung) bei meiner Reihenfolge der Richtungen in Kreise rein, und das Programm stürzt in Nullkommanichts ab.
Die Lösung scheint eindeutig zu sein.
Mit einer Rückwärtslösung per Paint habe ich es auch probiert, bin damit aber nicht durchgekommen.
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:
| TDirection = (dirUp, dirRight, dirDown, dirLeft); TFieldVisited = Array [1..8, 1..8, 1..5] of Boolean;
var Form1: TForm1;
Steps: Array [0..2] of Integer = (1,3,5); Spielfeld: Array [1..8, 1..8] of Integer = ( (0,1,1,1,0,1,1,1), (1,1,1,1,1,1,1,1), (1,1,0,1,0,1,1,1), (1,1,1,1,1,1,0,1), (1,0,1,1,1,1,1,1), (1,1,1,0,1,1,1,1), (1,1,1,1,1,1,1,1), (0,1,0,1,0,1,1,1) );
FieldVisited: TFieldVisited; MoveList: TStringList; curX, curY, curStep: Integer;
implementation
{$R *.dfm}
procedure OutPutPath; var i: Integer; begin for i := 0 to MoveList.Count-1 do Form1.Memo1.Lines.Add(Movelist[i]); Form1.Memo1.Lines.Add('-------'); end;
function FreeLineUp(Stepwidth: Integer): Boolean; var i: Integer; begin result := True; for i := 1 to Stepwidth do result := result AND (Spielfeld[curY-i, curX] = 1); end;
function FreeLineDown(Stepwidth: Integer): Boolean; var i: Integer; begin result := True; for i := 1 to Stepwidth do result := result AND (Spielfeld[curY+i, curX] = 1); end;
function FreeLineLeft(Stepwidth: Integer): Boolean; var i: Integer; begin result := True; for i := 1 to Stepwidth do result := result AND (Spielfeld[curY, curX-i] = 1); end;
function FreeLineRight(Stepwidth: Integer): Boolean; var i: Integer; begin result := True; for i := 1 to Stepwidth do result := result AND (Spielfeld[curY, curX+i] = 1); end;
function MovePossible(aDir: TDirection): Boolean; var currentWidth: Integer; begin currentWidth := Steps[curStep mod 3]; case aDir of dirUp : result := (curY - currentWidth >= 1) and FreeLineUp(currentWidth); dirRight : result := (curX + currentWidth <= 8) and FreeLineRight(currentWidth); dirDown : result := (curY + currentWidth <= 8) and FreeLineDown(currentWidth); dirLeft : result := (curX - currentWidth >= 1) and FreeLineLeft(currentWidth); end; end;
procedure DoMove(aDir: TDirection); var currentWidth: Integer; begin currentWidth := Steps[curStep mod 3]; case aDir of dirUp : begin curY := curY - currentWidth; MoveList.Add('Hoch'); end; dirRight : begin curX := curX + currentWidth; MoveList.Add('Rechts'); end; dirDown : begin curY := curY + currentWidth; MoveList.Add('Runter'); end; dirLeft : begin curX := curX - currentWidth; MoveList.Add('Links'); end; end; inc(curStep); end;
procedure UndoMove(aDir: TDirection); var currentWidth: Integer; begin dec(curStep); currentWidth := Steps[curStep mod 3]; case aDir of dirUp : curY := curY + currentWidth; dirRight : curX := curX - currentWidth; dirDown : curY := curY - currentWidth; dirLeft : curX := curX + currentWidth; end; MoveList.Delete(MoveList.Count - 1); end;
procedure GoOnWalking; var aDir: TDirection; currentWidth: Integer; begin currentWidth := Steps[curStep mod 3]; if FieldVisited[curX, curY, currentWidth] then exit;
if (curX = 5) and (curY = 5) then OutPutpath;
FieldVisited[curX, curY, currentWidth] := True; for aDir := Low(TDirection) to High(TDirection) do begin if MovePossible(aDir) then begin DoMove(aDir); GoOnWalking; UnDoMove(aDir); end; end; FieldVisited[curX, curY, currentWidth] := False; end;
procedure TForm1.Button1Click(Sender: TObject); var x,y, s: Integer; begin curStep := 0; curX := 4; curY := 4; Memo1.Clear;
for x := 1 to 8 do for y := 1 to 8 do for s := 1 to 5 do FieldVisited[x,y,s] := False;
MoveList := TStringList.Create; try GoOnWalking; finally MoveList.Free; end; end; |
_________________ We are, we were and will not be.
Für diesen Beitrag haben gedankt: BenBE, Hidden, Mathematiker, Narses
|
|
|