Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/triangulations_io.adb, Revision 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