Autor Beitrag
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 601
Erhaltene Danke: 339

W7
Delphi 6 pro
BeitragVerfasst: Do 11.02.16 11:02 
Moin,
das Programm ermittelt alle möglichen Wege, die nach den Regeln das Bild entstehen lassen.
Mit Rekursion überlässt man die Sucharbeit dem PC.
Screen
Der angezeigte Streckenzug ist DFHGDCABDEFGECBE (5021-te Lösung)
Viel Spaß beim Studieren.
Gruß Fiete
Einloggen, um Attachments anzusehen!
_________________
Fietes Gesetz: use your brain (THINK)

Für diesen Beitrag haben gedankt: Mathematiker, No1Special
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1652
Erhaltene Danke: 243

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: Do 11.02.16 16:41 
Hallo,

schön zu sehen, dass man von D nach E genauso oft kommt, wie von E nach D ;-)
ich habe mich gefragt: Warum dauert das solange ....
Es ist einfach nur die Ausgabe auf das Memo, die so wahnsinnig bremst.
Mit Wine/Delphi7 oder Linux/Lazarus1.6RC2 etwa 15 Sekunden bei mit Ausgabe und ohne Ergebnis.Lines.Add(Zeile); nur 0.4 Sekunden.
Wenn ich die Daten nur in eine Stringliste statt direkt ins Memo packe und anschliessend dem Memo zuweise ist die Laufzeit mit Linux/Lazarus immer noch 0.4 Sekunden, unter wine/Delphi7 dauert es wieder etwa 15 Sekunden.
ausblenden Delphi-Quelltext
1:
Ergebnis.Lines := ErgList{die Stringliste};					


die Funktion Fertig habe ich mir eingespart:
ausblenden Delphi-Quelltext
1:
2:
      if N < StreckenZahl-1 then
      //if not Fertig then

Lazarus hat einen Code-Formatierer, wie praktisch!

ausblenden volle Höhe 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:
unit Nikolaus;
{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const
  PunkteZahl = 8;
  StreckenZahl = 16;//2*PunkteZahl ?

type
  TPunkt = record
    Anzahl: integer;
    Nachbar: array[1..5of integer
  end;

  TOrt = array[1..PunkteZahl] of TPunkt;

  TNiko = class(TForm)
    Aufgabe: TImage;
    Ergebnis: TMemo;
    SucheWeg: TButton;
    procedure SucheWegClick(Sender: TObject);
  private
    { Private-Deklarationen }
    Ort: TOrt;
    Loesung: array[1..StreckenZahl] of integer;
    AnzahlLoesung: integer;
    ErgList : TStringList;
    procedure Init;
    procedure Ausgabe;
    function Fertig: boolean;
    procedure Verbinde(K, N: integer);

  public
    { Public-Deklarationen }
  end;

var
  Niko: TNiko;

implementation

{$R *.dfm}
//{$R+,Q+}
const
  cOrt: TOrt =
   ((Anzahl: 2; Nachbar: (23000)), //A
    (Anzahl: 4; Nachbar: (13450)), //B
    (Anzahl: 4; Nachbar: (12450)), //C
    (Anzahl: 5; Nachbar: (23567)), //D
    (Anzahl: 5; Nachbar: (23467)), //E
    (Anzahl: 4; Nachbar: (45780)), //F
    (Anzahl: 4; Nachbar: (45680)), //G
    (Anzahl: 2; Nachbar: (67000)));//H

procedure TNiko.Init;
begin
  Ort := cOrt;
  ErgList := TStringList.Create;
  Ergebnis.Clear;
end;

procedure TNiko.Ausgabe;
var
  K: integer;
  Zeile: string;
begin
  Inc(AnzahlLoesung);
  Zeile := IntToStr(AnzahlLoesung) + '-te Loesung: ';
  for K := 1 to StreckenZahl do
    Zeile := Zeile + char(Loesung[K] + 64);
  IF AnzahlLoesung >= ErgList.count then
    ErgList.capacity := AnzahlLoesung*8 div 5+10;
  ErgList.Add(Zeile);
end;

function TNiko.Fertig: boolean;
var
  K, L: integer;
begin
  Fertig := True;
  for K := 1 to PunkteZahl do
    for L := 1 to Ort[K].Anzahl do
      if Ort[K].Nachbar[L] > 0 then
      begin
        Fertig := False;
        exit;
      end;
end;

procedure TNiko.Verbinde(K, N: integer);
var
  L, M, Inhalt, NR: integer;
begin
  for L := 1 to Ort[K].Anzahl do
  begin
    Inhalt := Ort[K].Nachbar[L];
    if Inhalt > 0 then
    begin
      Ort[K].Nachbar[L] := 0;
      Loesung[N] := K;
      for M := 1 to Ort[Inhalt].Anzahl do
        if Ort[Inhalt].Nachbar[M] = K then
        begin
          NR := M;
          Ort[Inhalt].Nachbar[M] := 0;
        end;
      if N < StreckenZahl-1 then
      //if not Fertig then
        Verbinde(Inhalt, N + 1)
      else
      begin
        Loesung[N + 1] := Inhalt;
        Ausgabe;
      end;
      Ort[K].Nachbar[L] := Inhalt;
      Ort[Inhalt].Nachbar[NR] := K;
    end;
  end;
end;

procedure TNiko.SucheWegClick(Sender: TObject);
var
  K, G: integer;
begin
  Init;
  G := 0;
  Screen.Cursor := crHourGlass;
  for K := 1 to PunkteZahl do
  begin
    AnzahlLoesung := 0;
    FillChar(Loesung, SizeOf(Loesung), 0);
    Verbinde(K, 1);
    if Loesung[StreckenZahl] = 0 then
      ErgList.Add('keine Loesung fuer Punkt ' + char(K + 64))
    else
    begin
      Inc(G, AnzahlLoesung);
      ErgList.Add(IntToStr(AnzahlLoesung) + ' Loesungen von Punkt ' +
        char(K + 64) + ' aus.');
      ErgList.Add('');
    end;
  end;
  ErgList.Add('Es gibt insgesamt ' + IntToStr(G) + ' Loesungen.');
  Screen.Cursor := crDefault;
  Ergebnis.Lines.BeginUpdate;
  Ergebnis.Lines.Capacity := ErgList.count;
  Ergebnis.Lines := ErgList;
  Ergebnis.Lines.EndUpdate;
  ErgList.Free;
end;

end.

Vielleicht sind neuere Delphi Versionen da besser

Gruß Horst
Fiete Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 601
Erhaltene Danke: 339

W7
Delphi 6 pro
BeitragVerfasst: Do 11.02.16 18:46 
Moin Horst_H,

Zitat:
Es ist einfach nur die Ausgabe auf das Memo, die so wahnsinnig bremst.

Ich arbeite noch mit Delphi 6, leicht in die Jahre gekommen.

Zitat:
die Funktion Fertig habe ich mir eingespart:

Gute Idee 8)
Gruß Fiete

_________________
Fietes Gesetz: use your brain (THINK)
gerd8888
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 205
Erhaltene Danke: 3

Win7
Delphi 10.1 Starter (kostenlos) Lazarus
BeitragVerfasst: Sa 13.02.16 19:42 
Hallo Horst,

ich habe Dein Programm getestet. 13760 Loesungen kommen da raus. Stimmt das? (Warum niemmst Du sie doppelt. Ich habe mir das nur kurz angesehen)

Gerd
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1652
Erhaltene Danke: 243

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: So 14.02.16 10:11 
Hallo,

"ich" nehme die Lösungen nicht doppelt, sondern das Programm.Das bedeutet doch nur man alle Wege von D aus in E enden und man diese auch rückwärts gehen kann.
Wenn man in meiner modifizierten unit, in der ich erst alles in einer Stringlist speichere und anschliessend an das Memo übergebe, die passende Zeile auskommentiert
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
procedure TNiko.Ausgabe;
var
....
 //  ErgList.Add(Zeile);
end;

Ergibt sich fast sofort diese Ausgabe:
ausblenden Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
keine Loesung fuer Punkt A
keine Loesung fuer Punkt B
keine Loesung fuer Punkt C
6880 Loesungen von Punkt D aus.

6880 Loesungen von Punkt E aus.

keine Loesung fuer Punkt F
keine Loesung fuer Punkt G
keine Loesung fuer Punkt H
Es gibt insgesamt 13760 Loesungen.


Du hast recht, es wäre eine hilfreich gewesen, wieviele Lösungen von welchem Punkt aus vorkommen, in einem Block auszugeben. In mehr als 13760 Zeilen kann das leicht untergehen ;-)

Gruß Horst