Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/triangulations_io.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Standard_Integer_Vectors; use Standard_Integer_Vectors;
3: with Standard_Integer_Vectors_io; use Standard_Integer_Vectors_io;
4: with Standard_Integer_VecVecs_io; use Standard_Integer_VecVecs_io;
5: with Simplices,Simplices_io; use Simplices,Simplices_io;
6:
7: package body Triangulations_io is
8:
9: procedure get ( t : in out Triangulation ) is
10: begin
11: get(Standard_Input,t);
12: end get;
13:
14: procedure get ( n,m : in natural; t : in out Triangulation ) is
15: begin
16: get(Standard_Input,n,m,t);
17: end get;
18:
19: procedure get ( file : in file_type; t : in out Triangulation ) is
20:
21: n,m : natural;
22:
23: begin
24: get(file,n); get(file,m);
25: get(file,n,m,t);
26: end get;
27:
28: procedure get ( file : in file_type; n,m : in natural;
29: t : in out Triangulation ) is
30: begin
31: for k in 1..m loop
32: declare
33: s : Simplex;
34: begin
35: get(file,n,s);
36: Construct(s,t);
37: end;
38: end loop;
39: Connect(t);
40: end get;
41:
42: procedure put ( n : in natural; t : in Triangulation ) is
43: begin
44: put(Standard_Output,n,t);
45: end put;
46:
47: procedure put ( n : in natural; t : in Triangulation; v : out natural ) is
48: begin
49: put(Standard_Output,n,t,v);
50: end put;
51:
52: procedure put ( file : in file_type;
53: n : in natural; t : in Triangulation ) is
54:
55: tmp : Triangulation := t;
56:
57: begin
58: put(file,n,1); new_line(file);
59: put(file,Length_Of(t),1); new_line(file);
60: while not Is_Null(tmp) loop
61: put(file,Head_Of(tmp)); -- write the cell
62: put(file,0,1); new_line(file); -- write refinement of cell
63: tmp := Tail_Of(tmp);
64: end loop;
65: end put;
66:
67: procedure put ( file : in file_type;
68: n : in natural; t : in Triangulation; v : out natural ) is
69:
70: tmp : Triangulation := t;
71: res,cnt : natural := 0;
72: s : Simplex;
73: vol : natural;
74:
75: begin
76: put(file,"Dimension without lifting : "); put(file,n,1); new_line(file);
77: put(file,"Number of simplices : "); put(file,Length_Of(t),1);
78: new_line(file);
79: put_line(file,"The simplices in the triangulation :");
80: while not Is_Null(tmp) loop
81: cnt := cnt + 1;
82: put(file,"Simplex "); put(file,cnt,1); put_line(file," :");
83: s := Head_Of(tmp);
84: put(file," with normal : "); put(file,Normal(s)); new_line(file);
85: put_line(file," spanned by the points :"); put(file,Vertices(s));
86: vol := Volume(s);
87: put(file," ==> volume : "); put(file,vol,1); put_line(file,".");
88: res := res + vol;
89: tmp := Tail_Of(tmp);
90: end loop;
91: v := res;
92: end put;
93:
94: function Position ( t : Triangulation; s : Simplex ) return natural is
95:
96: -- DESCRIPTION :
97: -- Returns the position number of the simplex in the triangulation.
98: -- Counting starts from one. If the simplex s does not occur in t,
99: -- then Length(t)+1 will be returned.
100:
101: res : natural := 1;
102: tmp : Triangulation := t;
103: s1 : Simplex;
104:
105: begin
106: while not Is_Null(tmp) loop
107: s1 := Head_Of(tmp);
108: if Equal(s1,s)
109: then return res;
110: else tmp := Tail_Of(tmp);
111: res := res + 1;
112: end if;
113: end loop;
114: return res;
115: end Position;
116:
117: function Connectivity ( t : Triangulation; s : Simplex ) return Vector is
118:
119: -- DESCRIPTION :
120: -- Returns the connectivity vector of the given simplex w.r.t. the
121: -- given triangulation. This connectivity vector, name it cv, is
122: -- defined as follows:
123: -- cv(i) = 0 if Neighbor(s,i) = Null_Simplex
124: -- cv(i) = k if Neighbor(s,i) /= Null_Simplex
125: -- and Position(t,Neighbor(s,i)) = k.
126:
127: res : Vector(1..Dimension(s));
128: nei : Simplex;
129:
130: begin
131: for i in res'range loop
132: nei := Neighbor(s,i);
133: if nei = Null_Simplex
134: then res(i) := 0;
135: else res(i) := Position(t,nei);
136: end if;
137: end loop;
138: return res;
139: end Connectivity;
140:
141: procedure put ( n : natural; t : in Triangulation;
142: convecs : in out List; v : out natural ) is
143: begin
144: put(Standard_Output,n,t,convecs,v);
145: end put;
146:
147: procedure put ( file : in file_type; n : natural; t : in Triangulation;
148: convecs : in out List; v : out natural ) is
149:
150: tmp : Triangulation := t;
151: s : Simplex;
152: res,cnt : natural := 0;
153: last : List;
154: vol : natural;
155:
156: begin
157: put(file,"Dimension without lifting : "); put(file,n,1); new_line(file);
158: put(file,"Number of simplices : "); put(file,Length_Of(t),1);
159: new_line(file);
160: put_line(file,"The simplices in the triangulation :");
161: while not Is_Null(tmp) loop
162: cnt := cnt + 1;
163: put(file,"Simplex "); put(file,cnt,1); put_line(file," :");
164: s := Head_Of(tmp);
165: put(file," with normal : "); put(file,Normal(s)); new_line(file);
166: put_line(file," spanned by the points :"); put(file,Vertices(s));
167: declare
168: cv : constant Vector := Connectivity(t,s);
169: lcv : Link_to_Vector := new Vector'(cv);
170: begin
171: put(file," connectivity vector : "); put(file,cv); new_line(file);
172: Append(convecs,last,lcv);
173: end;
174: vol := Volume(s);
175: put(file," ==> volume : "); put(file,vol,1); put_line(file,".");
176: res := res + vol;
177: tmp := Tail_Of(tmp);
178: end loop;
179: v := res;
180: end put;
181:
182: end Triangulations_io;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to triangulations_io.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Dynlift