Bresenham Algorithmus (Delphi)

thepaine91 · Verfasst: Di 04.01.11 17:28

Hi ich habe den Algorithmus in Delphi umgesetzt und wollte rein aus Interesse mal Fragen ob ihr noch etwas seht was man verbessern könnte.

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:

function getWay(sx, sy, zx, zy: integer): ArrayOfPoint;
var x,y,xd,yd,l,s,i,f: integer;
    b: Boolean;
begin
  x := zx - sx;
  y := zy - sy;
  // Stellt das Vorzeichen fest.
  if x < 0 then
    xd := -1
  else
    xd := 1;
  if y < 0 then
    yd := -1
  else
    yd := 1;
  // Stellt fest welche Entferung größer ist.
  if (x*xd) > (y*yd) then
  begin
    l := x*xd;
    s := y*yd;
    b := true;
  end else
  begin
    l := y*yd;
    s := x*xd;
    b := false;
  end;
  setlength(Result, l + 1);
  Result[0].X := sx;
  Result[0].Y := sy;
  f := l;
  // Gefällt mir nicht da sich ein Codestück wiederholt. Mir ist aber noch nichts performanteres und
  // gleichfalls eleganteres eingefallen. 
  if b then
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        Result[i].Y := Result[i-1].Y + yd;
      end else
        Result[i].Y := Result[i-1].Y;
      Result[i].X := Result[i-1].X + xd;
    end;
  end else
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        Result[i].X := Result[i-1].X + xd;
      end else
        Result[i].X := Result[i-1].X;
      Result[i].Y := Result[i-1].Y + Yd;
    end;
  end;
end;

Horst_H · Verfasst: Mi 05.01.11 10:50

Hallo,

schneller ist nicht immer schöner:

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:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:

program Untitled;
{$IFDEF FPC}
  {$MODE delphi}
  {$R- I- S-}
  {$OPTIMIZATION ON}
  {$OPTIMIZATION REGVAR}
  {$OPTIMIZATION PEEPHOLE}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
{$ENDIF}

//{$DEFINE _verbose_}


uses
  sysutils;

type
  tPoint = record
             X,Y: Longint;
           end;
  tArrayOfPoint = array of tpoint;


function getWay(sx, sy, zx, zy: integer): tArrayOfPoint;
var l,s,i,f: integer;
    pu : tPoint;
    test : integer;
begin
  with Pu do
    begin
    x := sx;
    Y := sy;
    end;

  zx := zx - sx;
  zy := zy - sy;
{$IFDEF _verbose_}
   writeln ('Dx = ',zx,' Dy = ',zy);
{$ENDIF}
  Test := 0;
  if zx < 0 then
    begin
    zx := -zx;
    inc(Test);
    end;
  if zy < 0 then
    begin
    zy := -zy;
    inc(Test,2);
    end;

  if zx > zy then
    begin
    l := zx;
    s := zy;
    end
  else
    begin
    l := zy;
    s := zx;
    inc(Test,4);
    end;
{$IFDEF _verbose_}
   writeln ('l  = ',l,' s  = ',s);
   writeln('Test  = ', Test);
{$ENDIF}
  
  setlength(Result, l + 1);
  Result[0] := pu;
  
  f := l DIV 2;
  
  case test of
    0:Begin //dx>dy ;  xd >0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y + 1;
            end;
          pu.x := pu.x+1;
          result[i] := pu;
          end
      end;
    1:Begin //dx>dy ;  xd< 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y + 1;
            end;
          pu.x := pu.x-1;
          result[i] := pu;
          end
      end;
    2:Begin //dx>dy ;  xd> 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y -1;
            end;
          pu.x := pu.x+1;
          result[i] := pu;
          end;
      end;
    3:Begin //dx>dy ;  xd< 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y -1;
            end;
          pu.x := pu.x-1;
          result[i] := pu;
          end
      end;
    4:Begin//dx<dy ;  xd> 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X + 1;
            end;
          pu.Y := pu.Y+1;
          result[i] := pu;
          end
      end;
    5:Begin//dx<dy ;  xd< 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X - 1;
            end;
          pu.Y := pu.Y+1;
          result[i] := pu;
          end
      end;
    6:Begin//dx<dy ;  xd> 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X +1;
            end;
          pu.Y := pu.Y-1;
          result[i] := pu;
          end;
      end;
    7:Begin//dx<dy ;  xd< 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X -1;
            end;
          pu.Y := pu.Y-1;
          result[i] := pu;
          end
      end;
  end;
end;
const
  vz : array[0..7,0..3] of integer =
        ( ( 0, 0,  1000, 1001),
          ( 0, 0, -1000, 1001),
          ( 0, 0, -1000,-1001),
          ( 0, 0,  1000,-1001),
          ( 0, 0,  1001, 1000),
          ( 0, 0, -1001, 1000),
          ( 0, 0, -1001,-1000),
          ( 0, 0,  1001,-1000));

  Durchlaeufe = 100000;

var
  T0,T1: TDateTime;
  i,j : integer;

begin
  T0 := time;
  For i := 1 to Durchlaeufe do
    begin
    j := i AND 7;
    getway(vz[j,0],vz[j,1],vz[j,2],vz[j,3]);
    end;

  T1 := time;
  Writeln( FormatDateTime('hh:nn:ss.zzz',T1-T0));
  readln;
end.

Gruß Horst

thepaine91 · Verfasst: Mi 05.01.11 11:48

Horst_H
Habe mal deine und meine Routine verglichen.
Das waren die Werte: (12,34,4912392,9123913)

Ergebnis alter Rechner:

Ca. 102 ms beide Funktionen. Durchlauf 11 mal.
Im durchschnitt bei 11 Durchläufen deine aber etwa um 0,5 ms schneller.

Ergebnis neuer Rechner:

Ca. 38-39 ms beide Funktionen. Durchlauf 11 mal.
Im durchschnitt bei 11 Durchläufen meine aber etwa um 1 ms schneller.

Für den Test habe ich die Prozesspriorität jeweils auf realtime gestellt gehabt.

Horst_H · Verfasst: Mi 05.01.11 15:46

Hallo,

Wie wäre eine vergleichende Messung mit unterschiedlichen Werten, sodass auch alle Fälle vorkommen.

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:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:

program Untitled;
{$IFDEF FPC}
  {$MODE delphi}
  {$R- I- S-}
  {$OPTIMIZATION ON}
  {$OPTIMIZATION REGVAR}
  {$OPTIMIZATION PEEPHOLE}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
{$ENDIF}

//{$DEFINE _verbose_}

uses
  sysutils;

type
  tPoint = record
             X,Y: Longint;
           end;
  tArrayOfPoint = array of tpoint;

function getWayOrg(sx, sy, zx, zy: integer): tArrayOfPoint;
var x,y,xd,yd,l,s,i,f: integer;
    b: Boolean;
begin
  x := zx - sx;
  y := zy - sy;
  // Stellt das Vorzeichen fest.
  if x < 0 then
    xd := -1
  else
    xd := 1;
  if y < 0 then
    yd := -1
  else
    yd := 1;
  // Stellt fest welche Entferung größer ist.
  if (x*xd) > (y*yd) then
  begin
    l := x*xd;
    s := y*yd;
    b := true;
  end else
  begin
    l := y*yd;
    s := x*xd;
    b := false;
  end;
  setlength(Result, l + 1);
  Result[0].X := sx;
  Result[0].Y := sy;
  f := l;
  // Gefällt mir nicht da sich ein Codestück wiederholt. Mir ist aber noch nichts performanteres und
  // gleichfalls eleganteres eingefallen. 
  if b then
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        Result[i].Y := Result[i-1].Y + yd;
      end else
        Result[i].Y := Result[i-1].Y;
      Result[i].X := Result[i-1].X + xd;
    end;
  end else
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        Result[i].X := Result[i-1].X + xd;
      end else
        Result[i].X := Result[i-1].X;
      Result[i].Y := Result[i-1].Y + Yd;
    end;
  end;
end;

function getWay(sx, sy, zx, zy: integer): tArrayOfPoint;
var l,s,i,f: integer;
    pu : tPoint;
    test : integer;
begin
  with Pu do
    begin
    x := sx;
    Y := sy;
    end;

  zx := zx - sx;
  zy := zy - sy;

{$IFDEF _verbose_}
   writeln ('Dx = ',zx,' Dy = ',zy);
{$ENDIF}

  Test := 0;
  if zx < 0 then
    begin
    zx := -zx;
    inc(Test);
    end;
  if zy < 0 then
    begin
    zy := -zy;
    inc(Test,2);
    end;

  if zx > zy then
    begin
    l := zx;
    s := zy;
    end
  else
    begin
    l := zy;
    s := zx;
    inc(Test,4);
    end;

{$IFDEF _verbose_}
   writeln ('l  = ',l,' s  = ',s);
   writeln('Test  = ', Test);
{$ENDIF}
  
  setlength(Result, l + 1);
  Result[0] := pu;
  
  f := l DIV 2;
  
  case test of
    0:Begin //dx>dy ;  xd >0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y + 1;
            end;
          pu.x := pu.x+1;
          result[i] := pu;
          end
      end;
    1:Begin //dx>dy ;  xd< 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y + 1;
            end;
          pu.x := pu.x-1;
          result[i] := pu;
          end
      end;
    2:Begin //dx>dy ;  xd> 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y -1;
            end;
          pu.x := pu.x+1;
          result[i] := pu;
          end;
      end;
    3:Begin //dx>dy ;  xd< 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y -1;
            end;
          pu.x := pu.x-1;
          result[i] := pu;
          end
      end;
    4:Begin//dx<dy ;  xd> 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X + 1;
            end;
          pu.Y := pu.Y+1;
          result[i] := pu;
          end
      end;
    5:Begin//dx<dy ;  xd< 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X - 1;
            end;
          pu.Y := pu.Y+1;
          result[i] := pu;
          end
      end;
    6:Begin//dx<dy ;  xd> 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X +1;
            end;
          pu.Y := pu.Y-1;
          result[i] := pu;
          end;
      end;
    7:Begin//dx<dy ;  xd< 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X -1;
            end;
          pu.Y := pu.Y-1;
          result[i] := pu;
          end
      end;
  end;
end;
const
  vz : array[0..7,0..3] of integer =
        ( ( 0, 0,  1000000, 1000001),
          ( 0, 0, -1000000, 1000001),
          ( 0, 0, -1000000,-1000001),
          ( 0, 0,  1000000,-1000001),
          ( 0, 0,  1000001, 1000000),
          ( 0, 0, -1000001, 1000000),
          ( 0, 0, -1000001,-1000000),
          ( 0, 0,  1000001,-1000000));

  Durchlaeufe = 10  *8;

var
  T0,T1: TDateTime;
  i,j : integer;

begin
  T0 := time;
  For i := 1 to Durchlaeufe do
    begin
    j := i AND 7;
    getway(vz[j,0],vz[j,1],vz[j,2],vz[j,3]);
    end;

  T1 := time;
  Writeln(' Case Version ',FormatDateTime('hh:nn:ss.zzz',T1-T0));

  T0 := time;
  For i := 1 to Durchlaeufe do
    begin
    j := i AND 7;
    getwayOrg(vz[j,0],vz[j,1],vz[j,2],vz[j,3]);
    end;
  T1 := time;
  Writeln(' Org  Version ',FormatDateTime('hh:nn:ss.zzz',T1-T0));
  readln;
end.
{Ausgabe bei mir:
 Case Version 00:00:02.282
 Org  Version 00:00:02.593
}

Groß ist der Unterschied ja nicht ~12 %

Gruß Horst

thepaine91 · Verfasst: Mi 05.01.11 18:45

So nach ein paar änderungen also erneut der Vergleich.
Button1 und Button2 aus dem Grund da es teilweise einen Unterschied macht. Wieso weis ich nicht.

Lösung von Horst_H:

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:

function TForm1.FindDirectWay2(sx, sy, zx, zy: integer): ArrayOfPoint;
var l,s,i,f: integer;
    pu : tPoint;
    test : integer;
begin
  with Pu do
    begin
    x := sx;
    Y := sy;
    end;

  zx := zx - sx;
  zy := zy - sy;
  Test := 0;
  if zx < 0 then
    begin
    zx := -zx;
    inc(Test);
    end;
  if zy < 0 then
    begin
    zy := -zy;
    inc(Test,2);
    end;

  if zx > zy then
    begin
    l := zx;
    s := zy;
    end
  else
    begin
    l := zy;
    s := zx;
    inc(Test,4);
    end;
  
  setlength(Result, l + 1);
  Result[0] := pu;
  
  f := l DIV 2;

  case test of
    0:Begin //dx>dy ;  xd >0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y + 1;
            end;
          pu.x := pu.x+1;
          result[i] := pu;
          end
      end;
    1:Begin //dx>dy ;  xd< 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y + 1;
            end;
          pu.x := pu.x-1;
          result[i] := pu;
          end
      end;
    2:Begin //dx>dy ;  xd> 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y -1;
            end;
          pu.x := pu.x+1;
          result[i] := pu;
          end;
      end;
    3:Begin //dx>dy ;  xd< 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.Y := pu.Y -1;
            end;
          pu.x := pu.x-1;
          result[i] := pu;
          end
      end;
    4:Begin//dx<dy ;  xd> 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X + 1;
            end;
          pu.Y := pu.Y+1;
          result[i] := pu;
          end
      end;
    5:Begin//dx<dy ;  xd< 0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X - 1;
            end;
          pu.Y := pu.Y+1;
          result[i] := pu;
          end
      end;
    6:Begin//dx<dy ;  xd> 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X +1;
            end;
          pu.Y := pu.Y-1;
          result[i] := pu;
          end;
      end;
    7:Begin//dx<dy ;  xd< 0; yd <0
        for i := 1 to l do
      begin
          f := f - s;
          if f <= 0 then
            begin
            f := f + l;
            pu.X := pu.X -1;
            end;
          pu.Y := pu.Y-1;
          result[i] := pu;
          end
      end;
  end;
end;

Lösung von mir:

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:

// Kleine Änderungen und den Ansatz das zwischenspeichern über TPoint zumachen von Horst_H übernommen.
function TForm1.FindDirectWay(sx, sy, zx, zy: integer): ArrayOfPoint;
var x,y,xd,yd,l,s,i,f: integer;
    tp: TPoint;
    b: Boolean;
begin
  x := zx - sx;
  y := zy - sy;
  if x < 0 then
    xd := -1
  else
    xd := 1;
  if y < 0 then
    yd := -1
  else
    yd := 1;
    x:=  x*xd;
    y:=  y*yd;
  if (x) > (y) then
  begin
    l := x;
    s := y;
    b := true;
  end else
  begin
    l := y;
    s := x;
    b := false;
  end;
  setlength(Result, l + 1);
  tp.X := sx;
  tp.Y := sy;
  f := l;
  if b then
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        tp.Y := tp.Y + yd;
      end;
      tp.X := tp.X + xd;
    end;
  end else
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        tp.X := tp.X + xd;
      end;
      tp.Y := tp.Y + yd;
      Result[i] := tp;
    end;
  end;
end;

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:

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
    start,ende,freq: int64;
    average: double;
begin
  RichEdit1.Lines.Clear;
  QueryPerformanceFrequency(freq);
  freq := freq div 1000;

  RichEdit1.Lines.Add( #13 + '----------------------' + #13 + 'FindDirectWay2');
  QueryPerformanceCounter(start);
  for i := 0 to 999 do
  begin
    FindDirectWay2(0,0,100000,100001);
    FindDirectWay2(0,0,-100000,100001);
    FindDirectWay2(0,0,100000,-100001);
    FindDirectWay2(0,0,-100000,-100001);
    FindDirectWay2(0,0,100001,100000);
    FindDirectWay2(0,0,-100001,100000);
    FindDirectWay2(0,0,100001,-100000);
    FindDirectWay2(0,0,-100001,-100000);
  end;
  QueryPerformanceCounter(ende);
    average := (ende - start)/freq;
  RichEdit1.Lines.Add('Dauer gesamt: ' + floattostr(average));
  RichEdit1.Lines.Add('Durchschnitt: ' + floattostr(average/1000));

  RichEdit1.Lines.Add(#13 + '----------------------' + #13 + 'FindDirectWay');
  QueryPerformanceCounter(start);
  for i := 0 to 999 do
  begin
    FindDirectWay(0,0,100000,100001);
    FindDirectWay(0,0,-100000,100001);
    FindDirectWay(0,0,100000,-100001);
    FindDirectWay(0,0,-100000,-100001);
    FindDirectWay(0,0,100001,100000);
    FindDirectWay(0,0,-100001,100000);
    FindDirectWay(0,0,100001,-100000);
    FindDirectWay(0,0,-100001,-100000);
  end;
  QueryPerformanceCounter(ende);
  average := (ende - start)/freq;
  RichEdit1.Lines.Add('Dauer gesamt: ' + floattostr(average));
  RichEdit1.Lines.Add('Durchschnitt: ' + floattostr(average/1000));

end;

Ausgabe langsamer PC:
----------------------
FindDirectWay2
Dauer gesamt: 9073.30371612182
Durchschnitt: 9.07330371612182

----------------------
FindDirectWay
Dauer gesamt: 5770.49986029617
Durchschnitt: 5.77049986029617

Ausgabe schneller PC:
----------------------
FindDirectWay2
Dauer gesamt: 2573.19514427495
Durchschnitt: 2.57319514427495

----------------------
FindDirectWay
Dauer gesamt: 2249.42960652287
Durchschnitt: 2.24942960652287

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:

procedure TForm1.Button2Click(Sender: TObject);
var i: integer;
    start,ende,freq: int64;
    average: double;
begin
  RichEdit1.Lines.Clear;
  QueryPerformanceFrequency(freq);
  freq := freq div 1000;

  RichEdit1.Lines.Add( #13 + '----------------------' + #13 + 'FindDirectWay');
  QueryPerformanceCounter(start);
  for i := 0 to 999 do
  begin
    FindDirectWay(0,0,100000,100001);
    FindDirectWay(0,0,-100000,100001);
    FindDirectWay(0,0,100000,-100001);
    FindDirectWay(0,0,-100000,-100001);
    FindDirectWay(0,0,100001,100000);
    FindDirectWay(0,0,-100001,100000);
    FindDirectWay(0,0,100001,-100000);
    FindDirectWay(0,0,-100001,-100000);
  end;
  QueryPerformanceCounter(ende);
    average := (ende - start)/freq;
  RichEdit1.Lines.Add('Dauer gesamt: ' + floattostr(average));
  RichEdit1.Lines.Add('Durchschnitt: ' + floattostr(average/1000));

  RichEdit1.Lines.Add( #13 + '----------------------' + #13 + 'FindDirectWay2');
  QueryPerformanceCounter(start);
  for i := 0 to 999 do
  begin
    FindDirectWay2(0,0,100000,100001);
    FindDirectWay2(0,0,-100000,100001);
    FindDirectWay2(0,0,100000,-100001);
    FindDirectWay2(0,0,-100000,-100001);
    FindDirectWay2(0,0,100001,100000);
    FindDirectWay2(0,0,-100001,100000);
    FindDirectWay2(0,0,100001,-100000);
    FindDirectWay2(0,0,-100001,-100000);
  end;
  QueryPerformanceCounter(ende);
  average := (ende - start)/freq;
  RichEdit1.Lines.Add('Dauer gesamt: ' + floattostr(average));
  RichEdit1.Lines.Add('Durchschnitt: ' + floattostr(average/1000));
end;

Ausgabe langsamer PC:
----------------------
FindDirectWay
Dauer gesamt: 5802.19195305951
Durchschnitt: 5.80219195305951

----------------------
FindDirectWay2
Dauer gesamt: 9030.46214026264
Durchschnitt: 9.03046214026264

Ausgabe schneller PC:
----------------------
FindDirectWay
Dauer gesamt: 2272.2061673155
Durchschnitt: 2.2722061673155

----------------------
FindDirectWay2
Dauer gesamt: 2561.27163522748
Durchschnitt: 2.56127163522748

Horst_H · Verfasst: Mi 05.01.11 19:51

Hallo,

freepascal macht es wohl nicht so gut :-(

Mein 2,9 Ghz Ahtlon II X2 kommt nur auf

markieren

Quelltext

1:
2:
3:
4:
5:
6:

FindDirectWay2--------
Dauer gesamt: 16278,4623375299
Durchschnitt: 16,2784623375299
FindDirectWay---------
Dauer gesamt: 18404,8207027014
Durchschnitt: 18,4048207027014

Gruß Horst

Mit einem Zeiger po auf @result[i] wird dies

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

  case test of
    0:Begin //dx>dy ;  xd >0; yd >0
        for i := 1 to l do
          begin
          f := f - s;
          if f <= 0 then
            begin
            inc(pu^.Y);
            f := f + l;
            end;
          inc(pu^.x);
          inc(po);
          po^ := pu^;
//        result[i] := pu;
          end
      end;

in assembler:
case wird keine Sprungtabelle :-(

markieren

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:

[# [134] case test of
  movl  %ebx,%eax
  testl  %ebx,%ebx
  jl  .Lj151
  testl  %eax,%eax
  je  .Lj152
  decl  %eax
  je  .Lj153
  decl  %eax
  je  .Lj154
  decl  %eax
  je  .Lj155
  decl  %eax
  je  .Lj156
  decl  %eax
  je  .Lj157
  decl  %eax
  je  .Lj158
  decl  %eax
  je  .Lj159
  jmp  .Lj151
.Lj152:
# [136] for i := 1 to l do
  movl  -64(%ebp),%edi
  movl  $1,%ebx
  cmpl  %ebx,%edi
  jl  .Lj150
  decl  %ebx
  .balign 4,0x90
.Lj162:
  incl  %ebx
# [138] f := f - s;
  subl  -60(%ebp),%esi
  movl  %esi,%eax
# [139] if f <= 0 then
  testl  %eax,%eax
  jnle  .Lj166
# [141] inc(pu^.Y);
  incl  4(%edx)
# [142] f := f + l;
  movl  -64(%ebp),%eax
  addl  %esi,%eax
  movl  %eax,%esi
.Lj166:
# [144] inc(pu^.x);
  incl  (%edx)
# [145] inc(po);
  addl  $8,%ecx
# [146] po^ := pu^;
  movl  (%edx),%eax
  movl  %eax,(%ecx)
  movl  4(%edx),%eax
  movl  %eax,4(%ecx)
  cmpl  %ebx,%edi
  jg  .Lj162
  jmp  .Lj150]

Horst_H · Verfasst: Do 06.01.11 07:12

Hallo,

freepascal tut sich wohl schwer, mit dem dynamischen array.
Es wird jedesmal komplett angelegt und gelöscht, auch bei Umbau der Funktion in eine Prozedur, wenn es als out Parameter übergeben wird.
Als var Parameter wird die Größe nur zweimal angepasst, einmal auf Länge K1( = 100000) und anschließend K2 = K1+1.
Dann wird es auch so ähnlich schnell, wie es Delphi ohne Klimmzüge schafft.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

 2.82446200000000E+003 // = queryperformancefrequency/1000 
FindDirectWay2--------
Dauer gesamt: 2198,63782908037
Durchschnitt: 2,19863782908037

FindDirectWay---------
Dauer gesamt: 7535,21909659255
Durchschnitt: 7,53521909659256

Wobei der Zugriff auf ein dynamsches Array in Freepascal wohl etwas umständlich ist, warum dauert FindDirectWay denn sonst so lang.

Ich kenne Bresenham eigentlich nur mit dem Startwert f := l / 2;.Dann ist bei einer 1 Punktdifferenz der kurzen Seite der Sprung in der Mitte der Linie.

Gruß Horst

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:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:

program Untitled;
{$IFDEF FPC}
  {$MODE delphi}
  {$ALIGN 8}
  {$OPTIMIZATION ON}
  {$OPTIMIZATION REGVAR}
  {$OPTIMIZATION PEEPHOLE}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
{$ENDIF}

//{$DEFINE _verbose_}

uses
  sysutils,windows;

type
  tPoint = record
             X,Y: Longint;
           end;
  tArrayOfPoint = array of tpoint;

procedure FindDirectWay(sx, sy, zx, zy: integer;var result: tArrayOfPoint);
var x,y,xd,yd,l,s,i,f: integer;
    b: Boolean;
begin
  x := zx - sx;
  y := zy - sy;
  // Stellt das Vorzeichen fest.
  if x < 0 then
    xd := -1
  else
    xd := 1;
  if y < 0 then
    yd := -1
  else
    yd := 1;
  // Stellt fest welche Entferung größer ist.
  if (x*xd) > (y*yd) then
  begin
    l := x*xd;
    s := y*yd;
    b := true;
  end else
  begin
    l := y*yd;
    s := x*xd;
    b := false;
  end;
  setlength(Result, l + 1);
  Result[0].X := sx;
  Result[0].Y := sy;
  f := l;
  // Gefällt mir nicht da sich ein Codestück wiederholt. Mir ist aber noch nichts performanteres und
  // gleichfalls eleganteres eingefallen.
  if b then
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        Result[i].Y := Result[i-1].Y + yd;
      end else
        Result[i].Y := Result[i-1].Y;
      Result[i].X := Result[i-1].X + xd;
    end;
  end else
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        Result[i].X := Result[i-1].X + xd;
      end else
        Result[i].X := Result[i-1].X;
      Result[i].Y := Result[i-1].Y + Yd;
    end;
  end;
end;

procedure FindDirectWay2(sx, sy, zx, zy: integer;var result : tArrayOfPoint);
var l,s,i,f: integer;
    pu,po: ^tPoint;    // pu^ = Result[i-1];po^ = Result[i]
    test : integer;
begin
  zx := zx - sx;
  zy := zy - sy;
{$IFDEF _verbose_}
   writeln ('Dx = ',zx,' Dy = ',zy);
{$ENDIF}
  Test := 0;
  if zx < 0 then
    begin
    zx := -zx;
    inc(Test);
    end;
  if zy < 0 then
    begin
    zy := -zy;
    inc(Test,2);
    end;

  if zx > zy then
    begin
    l := zx;
    s := zy;
    end
  else
    begin
    l := zy;
    s := zx;
    inc(Test,4);
    end;
{$IFDEF _verbose_}
   writeln ('l  = ',l,' s  = ',s);
   writeln('Test  = ', Test);
{$ENDIF}

  setlength(Result, l + 1);
  pu := @Result[0];

//po == result[i];
  po := pu;
  with Pu^ do
    begin
    x := sx;
    Y := sy;
    end;

  f := l shl 1;
  dec(l);
  case test of
    0:Begin //dx>dy ;  xd >0; yd >0
        for i := l downto 0 do
          begin
          f := f - s;
          inc(po);    // Das verschobene
          po^ := pu^; // Hier kopieren, damit "vorangegangene"  Read Modify write abgeschlossen sind
          if f <= 0 then
            begin
            inc(po^.Y); // Read Modify write 
            f := f + l;
            end;
          inc(po^.x);// Read Modify write 
//          inc(po);  // Noch oben verschoben , damit "vorangegangene"  Read Modify write abgeschlossen sind   
//          po^ := pu^; 
          end
      end;
    1:Begin //dx>dy ;  xd< 0; yd >0
        for i := l downto 0 do
          begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            inc(po^.Y);
            f := f + l;
            end;
          dec(po^.X);
          end
      end;
    2:Begin //dx>dy ;  xd> 0; yd <0
        for i := l downto 0 do
    begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            dec(po^.Y);
            f := f + l;
            end;
          inc(po^.X);
          end;
      end;
    3:Begin //dx>dy ;  xd< 0; yd <0
        for i := l downto 0 do
          begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            dec(po^.Y);
            f := f + l;
            end;
          dec(po^.X);
          end
      end;
    4:Begin//dx<dy ;  xd> 0; yd >0
        for i := l downto 0 do
          begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            inc(po^.X);
            f := f + l;
            end;
          inc(po^.Y);
          end
      end;
    5:Begin//dx<dy ;  xd< 0; yd >0
        for i := l downto 0 do
          begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            dec(po^.X);
            f := f + l;
            end;
          inc(po^.Y);
          end
      end;
    6:Begin//dx<dy ;  xd> 0; yd <0
        for i := l downto 0 do
    begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            inc(po^.X);
            f := f + l;
            end;
          dec(po^.Y);
          end;
      end;
    7:Begin//dx<dy ;  xd< 0; yd <0
        for i := l downto 0 do
    begin
          f := f - s;
          inc(po);
          po^ := pu^;
          if f <= 0 then
            begin
            dec(po^.X);
            f := f + l;
            end;
          dec(po^.Y);
          end
      end;
  end;
end;

const
  K1 = 100000;
  K2 = k1+1;

  Durchlaeufe = 1000;

var
  i : integer;
  start,ende,frq : Int64;
  average,freq : double;
  BresenLine : tArrayOfPoint;

begin
  QueryPerformanceFrequency(frq);
  freq := frq/1000; // Umrechnung Millisekunden
  writeln(freq);

  writeln(#13 + '----------------------' + #13 + 'FindDirectWay2');

  QueryPerformanceCounter(start);
  for i := 1 to Durchlaeufe do
  begin
    FindDirectWay2(0,0, K1, K2,BresenLine);
    FindDirectWay2(0,0,-K1, K2,BresenLine);
    FindDirectWay2(0,0, K1,-K2,BresenLine);
    FindDirectWay2(0,0,-K1,-K2,BresenLine);
    FindDirectWay2(0,0, K2, K1,BresenLine);
    FindDirectWay2(0,0,-K2, K1,BresenLine);
    FindDirectWay2(0,0, K2,-K1,BresenLine);
    FindDirectWay2(0,0,-K2,-K1,BresenLine);
  end;
  QueryPerformanceCounter(ende);
  average := (ende - start)/freq;
  writeln('Dauer gesamt: ' + floattostr(average));
  writeln('Durchschnitt: ' + floattostr(average/Durchlaeufe));

  writeln(#13 + '----------------------' + #13 + 'FindDirectWay');
  QueryPerformanceCounter(start);
  for i := 1 to Durchlaeufe do
  begin
    FindDirectWay(0,0, K1, K2,BresenLine);
    FindDirectWay(0,0,-K1, K2,BresenLine);
    FindDirectWay(0,0, K1,-K2,BresenLine);
    FindDirectWay(0,0,-K1,-K2,BresenLine);
    FindDirectWay(0,0, K2, K1,BresenLine);
    FindDirectWay(0,0,-K2, K1,BresenLine);
    FindDirectWay(0,0, K2,-K1,BresenLine);
    FindDirectWay(0,0,-K2,-K1,BresenLine);
  end;
  QueryPerformanceCounter(ende);
  average := (ende - start)/freq;
  writeln('Dauer gesamt: ' + floattostr(average));
  writeln('Durchschnitt: ' + floattostr(average/Durchlaeufe));
  readln;
end.

thepaine91 · Verfasst: Do 06.01.11 22:33

Hmm ich habe nur gesehen das du die alte Version meiner Funktion verwendest.
Ich denke der Delphi Compiler optimiert auch besser.

Horst_H · Verfasst: Fr 07.01.11 10:56

Hallo,

mit Deiner neuen Version, tp: TPoint als Speicher des vorhergehenden Wertes, sind es jetzt unter freepascal.

markieren

Quelltext

1:
2:
3:
4:
5:
6:

FindDirectWay2--------
Dauer gesamt: 2028,20050466409
Durchschnitt: 2,02820050466409
FindDirectWay---------
Dauer gesamt: 2424,89890962958
Durchschnitt: 2,42489890962958

Du kannst ja mal unter Delphi meine neue Version testen.

Gruß Horst

Einloggen, um Attachments anzusehen!

thepaine91 · Verfasst: Fr 07.01.11 11:19

Hi,

also auch mit der letzten Version deiner Funktion ändert sich an der Geschwindigkeit nichts.
Das meine Funktion langsamer ist wenn du sie compilierst wundert mich auch nicht, da Delphi wie erwähnt viele dinge Optimiert wie die gleiche Multiplikation 2* usw...
Naja wäre ja auch schlimm wenn eine kostenlose Entwicklungsumgebung so gut wie die Kostenpflichtige wäre.

Ich werde das ganze mal mit D2010 Erstellen mal sehen ob sich etwas ändert.

Horst_H · Verfasst: Fr 07.01.11 14:34

Hallo,

Mal ein Vergelich der Assemblerausgabe der inneren Schleife.

Deine Variante in freepascal

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:

// i in EBX
// l in ECX und ESI ??
// f in EDX

// temp EAX 
// temp EDI
 
// s auf dem Stack -20(%ebp)
// tp auf dem Stack -4..-8(%ebp)
// yd auf dem Stack-24(%ebp)
// xd auf dem Stack-28(%ebp)

# [71] for i := 1 to l do
  movl  %ecx,%esi  // ESI = l
  movl  $1,%ebx
  cmpl  %ebx,%esi  // Warum nicht %ebx,%ecx ??? aber ist ja nur ein einziges mal 
  jl  .Lj75
  decl  %ebx
  .balign 4,0x90

.Lj76:
  incl  %ebx
# [73] f := f - s;
  subl  -20(%ebp),%edx

  movl  %edx,%eax  // braucht niemand
# [74] if f <= 0 then
  testl  %eax,%eax    // testl  %edx,%edx    waere auch gegangen siehe Zeile [143] unten 
  jnle  .Lj80
# [76] f := f + l;
  movl  %ecx,%eax  //  addl  %ecx,%edx   und fertig 
  addl  %edx,%eax
  movl  %eax,%edx
# [77] tp.X := tp.X + xd;
  movl  -8(%ebp),%eax  
  addl  -28(%ebp),%eax
  movl  %eax,-8(%ebp)
.Lj80:
# [79] tp.Y := tp.Y + yd;
  movl  -4(%ebp),%eax
  addl  -24(%ebp),%eax
  movl  %eax,-4(%ebp)
# [80] Result[i] := tp;
  movl  8(%ebp),%eax // Adresse von Result[0]
  movl  (%eax),%eax  // bestimmen

  movl  -8(%ebp),%edi      // tp.y -> EDI
  movl  %edi,(%eax,%ebx,8) // EDI -> Result[i].y
  movl  -4(%ebp),%edi      // tp.x -> EDI
  movl  %edi,4(%eax,%ebx,8) // EDI -> Result[i].y

  cmpl  %ebx,%esi // da esi = ecx ist ergibt sich eine Verschwendung von ESI           
  jg  .Lj76

Meine Variante in freepascal

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:

// i in ESI
// f in EBX 
// po in EAX
// pu in EDX
// ECX temporär zum kopieren.

// EDI ungenutzt 

// l auf dem Stack -12(%ebp)
// s auf dem Stack -8(%ebp)

# [138] for i := l downto 0 do
        // l auf < 0 testen 
  movl  -12(%ebp),%esi
  testl  %esi,%esi  
  jl  .Lj138  // l < 0 

  incl  %esi
  .balign 4,0x90
.Lj150:
  decl  %esi
# [140] f := f - s;
  subl  -8(%ebp),%ebx
# [141] inc(po);
  addl  $8,%eax
# [142] po^ := pu^;  // Result[i] := result[i-1]
  movl  (%edx),%ecx
  movl  %ecx,(%eax)
  movl  4(%edx),%ecx
  movl  %ecx,4(%eax)
# [143] if f <= 0 then
  testl  %ebx,%ebx
  jnle  .Lj156
# [145] inc(po^.Y);
  incl  4(%eax)
# [146] f := f + l;
  movl  -12(%ebp),%ecx
  addl  %ebx,%ecx   // warum nicht: addl  %ecx,%ebx und movl gespart.
  movl  %ecx,%ebx
.Lj156:
# [148] inc(po^.x);
  incl  (%eax)

  testl  %esi,%esi
  jg  .Lj150

In freepascal macht es wohl Sinn, längere Schleifen in eine eigene Prozedur/Funktion zu packen, damit alle Register genutzt werden.

Gruß Horst

Ehemaliges Mitglied Erhaltene Danke: 1

Guck mal in der Wikipedia: de.wikipedia.org/wik...resenham-Algorithmus

PS: Wenn sich ein Code wiederholt, ist das ein Zeichen, dass man den Code in eine Funktion auslagern sollte. Genauso würde ich bei der anderen Implementierung den Code in den Case-Zweigen in Funktionen auslagern. Das macht das ganze Übersichtlicher. Und wenn man die Funktionen aussagekräftig benennt, weiß man auch, was da passiert.

thepaine91 · Verfasst: Fr 07.01.11 15:01

Horst_H
Die schleife meiner Funktion sieht in Assembler dann so aus bei D6:
for i := 1 to l do
mov edx,[ebp-$0c]
test edx,edx
jle +$53
f := f - s;
sub eax,[ebp-$10]
if f <= 0 then
test eax,eax
jnle+$09
f:=f+1;
add eax,[ebp-$0c]
tp.Y := tp.Y + yd;
mov ecx,[ebp-$08]
add [ebp-$14],ecx
tp.X := tp.X + xd;
mov ecx,[ebp-$04]
add [ebp-$18],ecx
for i := 1 to l do
dec edx
jnz -$19
jmp +$38

user profile icon

Luckie
Die Idee das in eine Funktion zu packen hatte ich zuerst auch, das würde sich negativ auf die Geschwindigkeit auswirken, daher habe ich es nicht gemacht. Mir geht es hier hauptsächlich um Geschwindigkeit.

elundril · Verfasst: Fr 07.01.11 15:25

Könnte man da dann das inline für prozeduren anwenden?

_________________

This Signature-Space is intentionally left blank.
Bei Beschwerden, bitte den Beschwerdebutton (gekennzeichnet mit PN) verwenden.

jaenicke · Verfasst: Fr 07.01.11 15:31

elundril hat folgendes geschrieben :

Könnte man da dann das inline für prozeduren anwenden?

Könnte man, aber das gab es bei Delphi 6 wohl kaum schon. ;-)

elundril · Verfasst: Fr 07.01.11 17:06

Aso. Ich dachte er hat auch d2010. Stimmt, erst ab 2005 wars glaub ich dabei.

_________________

This Signature-Space is intentionally left blank.
Bei Beschwerden, bitte den Beschwerdebutton (gekennzeichnet mit PN) verwenden.

Horst_H · Verfasst: Sa 08.01.11 08:41

Hallo,

@thepaine
es fehlt in einer Zeile die Zuweisung von tp an result[i].

thepaine91 hat folgendes geschrieben :

So nach ein paar änderungen also erneut der Vergleich.
Button1 und Button2 aus dem Grund da es teilweise einen Unterschied macht. Wieso weis ich nicht.
Lösung von mir:

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:

// Kleine Änderungen und den Ansatz das zwischenspeichern über TPoint zumachen von Horst_H übernommen.
function TForm1.FindDirectWay(sx, sy, zx, zy: integer): ArrayOfPoint;
var x,y,xd,yd,l,s,i,f: integer;
    tp: TPoint;
    b: Boolean;
begin
...........
  f := l;
  if b then
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        tp.Y := tp.Y + yd;
      end;
      tp.X := tp.X + xd;
////////////////////////
      Result[i] := tp; // 
////////////////////////
    end;
  end else
  begin
    for i := 1 to l do
    begin
      f := f - s;
      if f <= 0 then
      begin
        f := f + l;
        tp.X := tp.X + xd;
      end;
      tp.Y := tp.Y + yd;
      Result[i] := tp;
    end;
  end;
end;

Das fiel mir erst in Deinem post mit dem Assemblerlisting auf.

thepaine91 hat folgendes geschrieben :

Die schleife meiner Funktion sieht in Assembler dann so aus bei D6:
for i := 1 to l do
mov edx,[ebp-$0c]
test edx,edx
jle +$53

f := f - s;
sub eax,[ebp-$10]
if f <= 0 then
test eax,eax
jnle+$09
f:=f+1;
add eax,[ebp-$0c]
tp.Y := tp.Y + yd;
mov ecx,[ebp-$08]
add [ebp-$14],ecx
tp.X := tp.X + xd;
mov ecx,[ebp-$04]
add [ebp-$18],ecx
for i := 1 to l do
dec edx
jnz -$19

jmp +$38

Da K1=100000 fast K2=100001 ist, wird die if-Teil Abfrage zu 99,999% durchlaufen.
Die Sprungvorhersage wird also gut funktionieren.
Meine Schleife braucht etwa 8 CPU-Takte pro Durchlauf, bei 16 Befehlen.

Ich habe mal rdtsc im Anhang benutzt.

Gruß Horst

Einloggen, um Attachments anzusehen!

thepaine91 · Verfasst: Sa 08.01.11 23:22

Joar tatsächlich schneller sollte es aber trotzdem sein. Werde es dann noch mal mit der Zuweisung auswerten.

Horst_H · Verfasst: So 09.01.11 16:15

Hallo,

durch die Verwendung von inc( a,b); macht freepascal es dann so gut, wie es Delphi das auch mit a:= a+b von sich aus macht.
Mit ein bisschen Trickserei zuvor, werden jetzt alle Register innerhalb der Schleife genutzt :-)

markieren

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:

EAX zum kopieren
EBX für s
ECX für pu
EDX für po

EDI für i
ESI für f

# [226] for i := l downto 0 do
  movl  -16(%ebp),%edi
  testl  %edi,%edi
  jl  .Lj188
  incl  %edi

// Hier die Hauptschleife
  .balign 4,0x90
.Lj200:
  decl  %edi
# [228] dec(f,s);
  subl  %ebx,%esi
# [229] inc(po);
  addl  $8,%edx
# [230] po^ := pu^;
  movl  (%ecx),%eax
  movl  %eax,(%edx)
  movl  4(%ecx),%eax
  movl  %eax,4(%edx)
# [231] if f <= 0 then
  testl  %esi,%esi
  jnle  .Lj204
# [233] inc(po^.Y);
  incl  4(%edx)
# [234] inc(f,l);
  addl  -16(%ebp),%esi
.Lj204:
# [236] inc(po^.x);
  incl  (%edx)
  testl  %edi,%edi
  jg  .Lj200

Das dauert jetzt um die 7 Takte pro Durchlauf.
Deine Version kann ich nur auf 9 Takte pro Schleifendurchlauf bekommen, indem ich result[i] durch einen Zeiger auf ein array ersetze

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

  tPointDummy = array[0..0] of tPoint; 
var
..
    pResult0 : ^tPointDummy;
begin
..
  pResult0  := @result[0];
  if b then
..
      inc(tp.X,xd);
      pResult0^[i] := tp;
//in asm   pResult0^[i] := tp; ist in ECX i in ESI 
asm
  movl  -8(%ebp),%edi
  movl  %edi,(%ecx,%esi,8)
  movl  -4(%ebp),%edi
  movl  %edi,4(%ecx,%esi,8)
end;
..

Jetzt hilft wohl nur noch MMX
www.asmcommunity.net...intpage;topic=8386.0 ganz unten

Gruß Horst
Leider habe ich auch vergessen den Zeiger pu zu erhöhen.
Nun denn jetzt sind beide Versionen bei etwa 9 Takten pro Punkt.
Das neue Programm (, 0 Bytes)

Einloggen, um Attachments anzusehen!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme