unit geompack_prb; interface uses arrtypes, geompack, geomprnt, SysUtils; procedure main(); procedure test01(); procedure test02(); procedure test03(); procedure test05(); procedure test06(); procedure test07(); procedure test08(); implementation //****************************************************************************80 procedure main(); //****************************************************************************80 // // Purpose: // // MAIN runs all tests subsequently and prints the output to a console // window. // // begin timestamp(); WriteLn(''); WriteLn('GEOMPACK_PRB'); WriteLn(' Delphi version'); WriteLn(' Test the routines in the GEOMPACK library.'); test01(); test02(); test03(); test05(); test06(); test07(); test08(); WriteLn(''); WriteLn('GEOMPACK_PRB'); WriteLn(' Normal end of execution.'); WriteLn(''); timestamp(); end; //****************************************************************************80 procedure test01(); //****************************************************************************80 // // Purpose: // // TEST01 tests POINTS_DELAUNAY_NAIVE_2D. // // Diagram: // // !....311.... // !............ // !............ // X..9......... // !.....5...... // !...........6 // !.4.2...10... // !.....8...12. // V............ // !..7......... // !......1..... // !............ // !............ // !----V----X-- // // var ntri: Integer; tri: TIntegerArray; p: TRealArray; const N: Integer = 12; DIM_NUM: Integer = 2; begin SetLength(p, N*DIM_NUM); p[0]:= 7.0; p[1]:= 3.0; p[2]:= 4.0; p[3]:= 7.0; p[4]:= 5.0; p[5]:= 13.0; p[6]:= 2.0; p[7]:= 7.0; p[8]:= 6.0; p[9]:= 9.0; p[10]:= 12.0; p[11]:= 10.0; p[12]:= 3.0; p[13]:= 4.0; p[14]:= 6.0; p[15]:= 6.0; p[16]:= 3.0; p[17]:= 10.0; p[18]:= 8.0; p[19]:= 7.0; p[20]:= 5.0; p[21]:= 13.0; p[22]:= 10.0; p[23]:= 6.0; WriteLn(''); WriteLn('TEST01'); WriteLn(' POINTS_DELAUNAY_NAIVE_2D computes the Delaunay'); WriteLn(' triangulation of a set of points.'); r8mat_transpose_print(DIM_NUM, N, p, ' The points:'); tri:= points_delaunay_naive_2d(N, p, ntri); WriteLn(''); WriteLn(Format(' Number of triangles is NTRI = %d', [ntri])); i4mat_transpose_print(3, ntri, tri, ' The Delaunay triangles:'); end; //****************************************************************************80********** procedure test02(); //****************************************************************************80********** // // Purpose: // // TEST02 tests D2VEC_PART_QUICK_A. // var a: TRealArray; b: Real; c: Real; l: Integer; r: Integer; seed: Integer; const N: Integer = 12; DIM_NUM: Integer = 2; begin SetLength(a, DIM_NUM*N); b:= 0.0; c:= 10.0; seed:= 123456789; WriteLn(''); WriteLn('TEST02'); WriteLn(' D2VEC_PART_QUICK_A reorders a D2 vector'); WriteLn(' as part of a quick sort.'); WriteLn(Format(' Using initial random number seed = %d', [seed])); r8mat_uniform(DIM_NUM, N, b, c, seed, a); r8mat_transpose_print(DIM_NUM, N, a, ' Before rearrangment:'); r82vec_part_quick_a(0, N, a, l, r); WriteLn(''); WriteLn(' Rearranged array'); WriteLn(Format(' Left index = %d', [l]));; WriteLn(Format(' Key index = %d', [l+1])); WriteLn(Format(' Right index = %d', [r])); r8mat_transpose_print(DIM_NUM, l, a, ' Left half:'); r8mat_transpose_print_some(DIM_NUM, N, a, 1, l+1, DIM_NUM, l+1, ' Key:'); r8mat_transpose_print_some(DIM_NUM, N, a, 1, r, DIM_NUM, N, ' Key:'); end; //****************************************************************************80********** procedure test03(); //****************************************************************************80********** // // Purpose: // // TEST03 tests D2VEC_SORT_QUICK_A. // var a: TRealArray; b: Real; c: Real; seed: Integer; const N: Integer = 12; DIM_NUM: Integer = 2; begin SetLength(a, DIM_NUM*N); b:= 0.0; c:= 10.0; seed:= 123456789; WriteLn(''); WriteLn('TEST03'); WriteLn(' D2VEC_SORT_QUICK_A sorts a D2 vector'); WriteLn(' as part of a quick sort.'); WriteLn(Format(' Using initial random number seed = %d', [seed])); r8mat_uniform(DIM_NUM, N, b, c, seed, a); // // For better testing, give a few elements the same first component. // a[0+2*(3-1)]:= a[0+2*(5-1)]; a[0+2*(4-1)]:= a[0+2*(12-1)]; // // Make two entries equal. // a[0+2*(7-1)]:= a[0+2*(11-1)]; a[1+2*(7-1)]:= a[1+2*(11-1)]; r8mat_transpose_print(DIM_NUM, N, a, ' Before sorting:'); r82vec_sort_quick_a(N, a); r8mat_transpose_print(DIM_NUM, N, a, ' Sorted array:'); end; //****************************************************************************80********** procedure test05(); //****************************************************************************80********** // // Purpose: // // TEST05 tests DTRIS2. // var error: Integer; nod_tri: TIntegerArray; triangle_neighbor: TIntegerArray; tri_num: Integer; g_xy: TRealArray; const DIM_NUM: Integer = 2; NODE_NUM: Integer = 9; begin SetLength(g_xy, DIM_NUM*NODE_NUM); g_xy[0]:= 0.0; g_xy[1]:= 0.0; g_xy[2]:= 0.0; g_xy[3]:= 1.0; g_xy[4]:= 0.2; g_xy[5]:= 0.5; g_xy[6]:= 0.3; g_xy[7]:= 0.6; g_xy[8]:= 0.4; g_xy[9]:= 0.5; g_xy[10]:= 0.6; g_xy[11]:= 0.4; g_xy[12]:= 0.6; g_xy[13]:= 0.5; g_xy[14]:= 1.0; g_xy[15]:= 0.0; g_xy[16]:= 1.0; g_xy[17]:= 1.0; SetLength(nod_tri, 2*NODE_NUM*3); SetLength(triangle_neighbor, 2*NODE_NUM*3); WriteLn(''); WriteLn('TEST05'); WriteLn(' DTRIS2 computes the Delaunay triangulation of a'); WriteLn(' pointset in 2D.'); // // Set up the Delaunay triangulation. // error:= dtris2(NODE_NUM, g_xy, tri_num, nod_tri, triangle_neighbor); if(error = 0) then begin WriteLn(''); WriteLn(' DTRIS2 computed the Delaunay triangulation with no'); WriteLn(' errors detected.'); end else begin WriteLn(''); WriteLn(Format(' DTRIS2 detected an error condition of index %d', [error])); exit; end; triangulation_print(NODE_NUM, g_xy, tri_num, nod_tri, triangle_neighbor); end; //****************************************************************************80********** procedure test06(); //****************************************************************************80********** // // Purpose: // // TEST06 tests TRIANGLE_CIRCUMCENTER_2D; // var center: TRealArray; i: Integer; ntest: Integer; t: TRealArray; const DIM_NUM: Integer = 2; begin ntest:= 4; SetLength(t, DIM_NUM*3); WriteLn(''); WriteLn('TEST06'); WriteLn(' For a triangle in 2D:'); WriteLn(' TRIANGLE_CIRCUMCENTER_2D computes the circumcenter.'); for i:= 1 to ntest do begin if(i = 1) then begin t[0+0*2]:= 0.0; t[1+0*2]:= 0.0; t[0+1*2]:= 1.0; t[1+1*2]:= 0.0; t[0+2*2]:= 0.0; t[1+2*2]:= 1.0; end else if (i = 2) then begin t[0+0*2]:= 0.0; t[1+0*2]:= 0.0; t[0+1*2]:= 1.0; t[1+1*2]:= 0.0; t[0+2*2]:= 0.5; t[1+2*2]:= Sqrt(3.0) / 2.0; end else if (i = 3) then begin t[0+0*2]:= 0.0; t[1+0*2]:= 0.0; t[0+1*2]:= 1.0; t[1+1*2]:= 0.0; t[0+2*2]:= 0.5; t[1+2*2]:= 10.0; end else if(i = 4) then begin t[0+0*2]:= 0.0; t[1+0*2]:= 0.0; t[0+1*2]:= 1.0; t[1+1*2]:= 0.0; t[0+2*2]:= 10.0; t[1+2*2]:= 2.0; end; r8mat_transpose_print(DIM_NUM, 3, t, ' The triangle'); center:= triangle_circumcenter_2d(t); r8vec_print(DIM_NUM, center, ' Circumcenter'); end; end; //****************************************************************************80********** procedure test07(); //****************************************************************************80********** // // Purpose: // // TEST07 tests TRIANGULATION_PLOT_EPS. // var file_name: String; g_xy: TRealArray; nod_tri: TIntegerArray; const NODE_NUM: Integer = 9; DIM_NUM: Integer = 2; TRI_NUM: Integer = 12; begin file_name:= 'triangulation_plot.eps'; SetLength(g_xy, DIM_NUM*NODE_NUM); g_xy[0]:= 0.0; g_xy[1]:= 0.0; g_xy[2]:= 0.0; g_xy[3]:= 1.0; g_xy[4]:= 0.2; g_xy[5]:= 0.5; g_xy[6]:= 0.3; g_xy[7]:= 0.6; g_xy[8]:= 0.4; g_xy[9]:= 0.5; g_xy[10]:= 0.6; g_xy[11]:= 0.4; g_xy[12]:= 0.6; g_xy[13]:= 0.5; g_xy[14]:= 1.0; g_xy[15]:= 0.0; g_xy[16]:= 1.0; g_xy[17]:= 1.0; SetLength(nod_tri, TRI_NUM*3); nod_tri[0]:= 2; nod_tri[1]:= 1; nod_tri[2]:= 3; nod_tri[3]:= 3; nod_tri[4]:= 1; nod_tri[5]:= 6; nod_tri[6]:= 2; nod_tri[7]:= 3; nod_tri[8]:= 4; nod_tri[9]:= 4; nod_tri[10]:= 3; nod_tri[11]:= 5; nod_tri[12]:= 7; nod_tri[13]:= 4; nod_tri[14]:= 5; nod_tri[15]:= 5; nod_tri[16]:= 3; nod_tri[17]:= 6; nod_tri[18]:= 7; nod_tri[19]:= 5; nod_tri[20]:= 6; nod_tri[21]:= 9; nod_tri[22]:= 4; nod_tri[23]:= 7; nod_tri[24]:= 6; nod_tri[25]:= 1; nod_tri[26]:= 8; nod_tri[27]:= 7; nod_tri[28]:= 6; nod_tri[29]:= 8; nod_tri[30]:= 7; nod_tri[31]:= 8; nod_tri[32]:= 9; nod_tri[33]:= 2; nod_tri[34]:= 4; nod_tri[35]:= 9; WriteLn(''); WriteLn('TEST07'); WriteLn(' TRIANGULATION_PLOT_EPS can plot a triangulation.'); triangulation_plot_eps(file_name, NODE_NUM, g_xy, TRI_NUM, nod_tri); WriteLn(''); WriteLn(' TRIANGULATION_PLOT_EPS has created an'); WriteLn(' Encapsulated PostScript file(EPS) containing'); WriteLn(' an image of the triangulation.'); WriteLn(''); WriteLn(' This file is called '+file_name); end; //****************************************************************************80********** procedure test08(); //****************************************************************************80********** // // Purpose: // // TEST08 tests TRIANGULATION_PRINT. // var g_xy: TRealArray; nod_tri: TIntegerArray; triangle_neighbor: TIntegerArray; const NODE_NUM: Integer = 9; DIM_NUM: Integer = 2; TRI_NUM: Integer = 12; begin SetLength(g_xy, DIM_NUM*NODE_NUM); g_xy[0]:= 0.0; g_xy[1]:= 0.0; g_xy[2]:= 0.0; g_xy[3]:= 1.0; g_xy[4]:= 0.2; g_xy[5]:= 0.5; g_xy[6]:= 0.3; g_xy[7]:= 0.6; g_xy[8]:= 0.4; g_xy[9]:= 0.5; g_xy[10]:= 0.6; g_xy[11]:= 0.4; g_xy[12]:= 0.6; g_xy[13]:= 0.5; g_xy[14]:= 1.0; g_xy[15]:= 0.0; g_xy[16]:= 1.0; g_xy[17]:= 1.0; SetLength(nod_tri, TRI_NUM*3); nod_tri[0]:= 2; nod_tri[1]:= 1; nod_tri[2]:= 3; nod_tri[3]:= 3; nod_tri[4]:= 1; nod_tri[5]:= 6; nod_tri[6]:= 2; nod_tri[7]:= 3; nod_tri[8]:= 4; nod_tri[9]:= 4; nod_tri[10]:= 3; nod_tri[11]:= 5; nod_tri[12]:= 7; nod_tri[13]:= 4; nod_tri[14]:= 5; nod_tri[15]:= 5; nod_tri[16]:= 3; nod_tri[17]:= 6; nod_tri[18]:= 7; nod_tri[19]:= 5; nod_tri[20]:= 6; nod_tri[21]:= 9; nod_tri[22]:= 4; nod_tri[23]:= 7; nod_tri[24]:= 6; nod_tri[25]:= 1; nod_tri[26]:= 8; nod_tri[27]:= 7; nod_tri[28]:= 6; nod_tri[29]:= 8; nod_tri[30]:= 7; nod_tri[31]:= 8; nod_tri[32]:= 9; nod_tri[33]:= 2; nod_tri[34]:= 4; nod_tri[35]:= 9; SetLength(triangle_neighbor, TRI_NUM*3); triangle_neighbor[0]:= -28; triangle_neighbor[1]:= 2; triangle_neighbor[2]:= 3; triangle_neighbor[3]:= 1; triangle_neighbor[4]:= 9; triangle_neighbor[5]:= 6; triangle_neighbor[6]:= 1; triangle_neighbor[7]:= 4; triangle_neighbor[8]:= 12; triangle_neighbor[9]:= 3; triangle_neighbor[10]:= 6; triangle_neighbor[11]:= 5; triangle_neighbor[12]:= 8; triangle_neighbor[13]:= 4; triangle_neighbor[14]:= 7; triangle_neighbor[15]:= 4; triangle_neighbor[16]:= 2; triangle_neighbor[17]:= 7; triangle_neighbor[18]:= 5; triangle_neighbor[19]:= 6; triangle_neighbor[20]:= 10; triangle_neighbor[21]:= 12; triangle_neighbor[22]:= 5; triangle_neighbor[23]:= 11; triangle_neighbor[24]:= 2; triangle_neighbor[25]:= -34; triangle_neighbor[26]:= 10; triangle_neighbor[27]:= 7; triangle_neighbor[28]:= 9; triangle_neighbor[29]:= 11; triangle_neighbor[30]:= 10; triangle_neighbor[31]:= -38; triangle_neighbor[32]:= 8; triangle_neighbor[33]:= 3; triangle_neighbor[34]:= 8; triangle_neighbor[35]:= -3; WriteLn(''); WriteLn('TEST08'); WriteLn(' TRIANGULATION_PRINT prints out a triangulation.'); triangulation_print(NODE_NUM, g_xy, TRI_NUM, nod_tri, triangle_neighbor); end; end.