source: trunk/demos/spectrum/3rdparty/fftreal/testapp.dpr@ 846

Last change on this file since 846 was 769, checked in by Dmitry A. Kuminov, 15 years ago

trunk: Merged in qt 4.6.3 sources from branches/vendor/nokia/qt.

File size: 3.5 KB
Line 
1program testapp;
2{$APPTYPE CONSOLE}
3uses
4 SysUtils,
5 fftreal in 'fftreal.pas',
6 Math,
7 Windows;
8
9var
10 nbr_points : longint;
11 x, f : pflt_array;
12 fft : TFFTReal;
13 i : longint;
14 PI : double;
15 areal, img : double;
16 f_abs : double;
17 buffer_size : longint;
18 nbr_tests : longint;
19 time0, time1, time2 : int64;
20 timereso : int64;
21 offset : longint;
22 t0, t1 : double;
23 nbr_s_chn : longint;
24 tempp1, tempp2 : pflt_array;
25
26begin
27 (*______________________________________________
28 *
29 * Exactness test
30 *______________________________________________
31 *)
32
33 WriteLn('Accuracy test:');
34 WriteLn;
35
36 nbr_points := 16; // Power of 2
37 GetMem(x, nbr_points * sizeof_flt);
38 GetMem(f, nbr_points * sizeof_flt);
39 fft := TFFTReal.Create(nbr_points); // FFT object initialized here
40
41 // Test signal
42 PI := ArcTan(1) * 4;
43 for i := 0 to nbr_points-1 do
44 begin
45 x^[i] := -1 + sin (3*2*PI*i/nbr_points)
46 + cos (5*2*PI*i/nbr_points) * 2
47 - sin (7*2*PI*i/nbr_points) * 3
48 + cos (8*2*PI*i/nbr_points) * 5;
49 end;
50
51 // Compute FFT and IFFT
52 fft.do_fft(f, x);
53 fft.do_ifft(f, x);
54 fft.rescale(x);
55
56 // Display the result
57 WriteLn('FFT:');
58 for i := 0 to nbr_points div 2 do
59 begin
60 areal := f^[i];
61 if (i > 0) and (i < nbr_points div 2) then
62 img := f^[i + nbr_points div 2]
63 else
64 img := 0;
65
66 f_abs := Sqrt(areal * areal + img * img);
67 WriteLn(Format('%5d: %12.6f %12.6f (%12.6f)', [i, areal, img, f_abs]));
68 end;
69
70 WriteLn;
71 WriteLn('IFFT:');
72 for i := 0 to nbr_points-1 do
73 WriteLn(Format('%5d: %f', [i, x^[i]]));
74
75 WriteLn;
76
77 FreeMem(x);
78 FreeMem(f);
79 fft.Free;
80
81
82 (*______________________________________________
83 *
84 * Speed test
85 *______________________________________________
86 *)
87
88 WriteLn('Speed test:');
89 WriteLn('Please wait...');
90 WriteLn;
91
92 nbr_points := 1024; // Power of 2
93 buffer_size := 256*nbr_points; // Number of flt_t (float or double)
94 nbr_tests := 10000;
95
96 assert(nbr_points <= buffer_size);
97 GetMem(x, buffer_size * sizeof_flt);
98 GetMem(f, buffer_size * sizeof_flt);
99 fft := TFFTReal.Create(nbr_points); // FFT object initialized here
100
101 // Test signal: noise
102 for i := 0 to nbr_points-1 do
103 x^[i] := Random($7fff) - ($7fff shr 1);
104
105 // timing
106 QueryPerformanceFrequency(timereso);
107 QueryPerformanceCounter(time0);
108
109 for i := 0 to nbr_tests-1 do
110 begin
111 offset := (i * nbr_points) and (buffer_size - 1);
112 tempp1 := f;
113 inc(tempp1, offset);
114 tempp2 := x;
115 inc(tempp2, offset);
116 fft.do_fft(tempp1, tempp2);
117 end;
118
119 QueryPerformanceCounter(time1);
120
121 for i := 0 to nbr_tests-1 do
122 begin
123 offset := (i * nbr_points) and (buffer_size - 1);
124 tempp1 := f;
125 inc(tempp1, offset);
126 tempp2 := x;
127 inc(tempp2, offset);
128 fft.do_ifft(tempp1, tempp2);
129 fft.rescale(x);
130 end;
131
132 QueryPerformanceCounter(time2);
133
134 t0 := ((time1-time0) / timereso) / nbr_tests;
135 t1 := ((time2-time1) / timereso) / nbr_tests;
136
137 WriteLn(Format('%d-points FFT : %.0f us.', [nbr_points, t0 * 1000000]));
138 WriteLn(Format('%d-points IFFT + scaling: %.0f us.', [nbr_points, t1 * 1000000]));
139
140 nbr_s_chn := Floor(nbr_points / ((t0 + t1) * 44100 * 2));
141 WriteLn(Format('Peak performance: FFT+IFFT on %d mono channels at 44.1 KHz (with overlapping)', [nbr_s_chn]));
142 WriteLn;
143
144 FreeMem(x);
145 FreeMem(f);
146 fft.Free;
147
148 WriteLn('Press [Return] key to terminate...');
149 ReadLn;
150end.
Note: See TracBrowser for help on using the repository browser.