Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Matrices/ts_gcd.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Standard_Random_Numbers; use Standard_Random_Numbers;
3: with Standard_Common_Divisors; use Standard_Common_Divisors;
4: with Multprec_Random_Numbers; use Multprec_Random_Numbers;
5: with Multprec_Integer_Numbers; use Multprec_Integer_Numbers;
6: with Multprec_Integer_Numbers_io; use Multprec_Integer_Numbers_io;
7: with Multprec_Common_Divisors; use Multprec_Common_Divisors;
8:
9: procedure ts_gcd is
10:
11: -- DESCRIPTION :
12: -- Interactive and random tests of gcd-computations, for standard
13: -- and multi-precision integer numbers.
14:
15: procedure Interactive_Test_Standard_GCD is
16:
17: a,b,k,l,d : integer;
18: ans : character;
19:
20: begin
21: loop
22: put("Give a : "); get(a);
23: put("Give b : "); get(b);
24: d := lcm(a,b);
25: put("lcm("); put(a,1); put(','); put(b,1); put(") = "); put(d,1);
26: new_line;
27: gcd(a,b,k,l,d);
28: put("gcd("); put(a,1); put(','); put(b,1); put(") = "); put(d,1);
29: new_line;
30: put(" k = "); put(k,1); new_line;
31: put(" l = "); put(l,1); new_line;
32: put(" k*a + l*b = "); put(k*a + l*b,1); new_line;
33: put("Do you want more tests ? (y/n) "); get(ans);
34: exit when ans /='y';
35: end loop;
36: end Interactive_Test_Standard_GCD;
37:
38: procedure Test_Standard_GCD ( low,upp : in integer ) is
39:
40: -- DESCRIPTION :
41: -- Generates two numbers between low and upp and performs the
42: -- following checks :
43: -- 1) gcd(a,b) = d, same d as in gcd(a,b,k,l,d) ?
44: -- 2) Is k*a + l*b = d, with a,b,k,l,d from gcd(a,b,k,l,d) ?
45:
46: a,b,k,l,d1,d2 : integer;
47:
48: procedure Report_Bug is
49: begin
50: put(" a : "); put(a,1); new_line;
51: put(" b : "); put(b,1); new_line;
52: end Report_Bug;
53:
54: begin
55: a := Random(low,upp);
56: b := Random(low,upp);
57: d1 := gcd(a,b);
58: gcd(a,b,k,l,d2);
59: put(k,1); put("*"); put(a,1); put("+");
60: put(l,1); put("*"); put(b,1); put("="); put(d2,1);
61: if d1 = d2 and k*a + l*b = d2
62: then put(" okay"); new_line;
63: else put(" Bug!"); Report_Bug;
64: end if;
65: end Test_Standard_GCD;
66:
67: procedure Random_Test_Standard_GCD is
68:
69: nb : natural;
70: low,upp : integer;
71:
72: begin
73: put("Give the number of tests : "); get(nb);
74: put("Give a lower bound for the numbers : "); get(low);
75: put("Give an upper bound for the numbers : "); get(upp);
76: for i in 1..nb loop
77: Test_Standard_GCD(low,upp);
78: end loop;
79: end Random_Test_Standard_GCD;
80:
81: procedure Interactive_Test_Multprec_GCD is
82:
83: a,b,k,l,d : Integer_Number;
84: ans : character;
85:
86: begin
87: loop
88: put("Give a : "); get(a);
89: put("Give b : "); get(b);
90: d := lcm(a,b);
91: put("lcm("); put(a); put(','); put(b); put(") = "); put(d);
92: new_line;
93: gcd(a,b,k,l,d);
94: put("gcd("); put(a); put(','); put(b); put(") = "); put(d);
95: new_line;
96: put(" k = "); put(k); new_line;
97: put(" l = "); put(l); new_line;
98: put(" k*a + l*b = "); put(k*a + l*b); new_line;
99: put("Do you want more tests ? (y/n) "); get(ans);
100: exit when ans /='y';
101: end loop;
102: end Interactive_Test_Multprec_GCD;
103:
104: procedure Test_Multprec_GCD ( sz1,sz2 : in natural ) is
105:
106: -- DESCRIPTION :
107: -- Generates two numbers between low and upp and performs the
108: -- following checks :
109: -- 1) gcd(a,b) = d, same d as in gcd(a,b,k,l,d) ?
110: -- 2) Is k*a + l*b = d, with a,b,k,l,d from gcd(a,b,k,l,d) ?
111:
112: a,b,k,l,d1,d2,acc1,acc2 : Integer_Number;
113:
114: procedure Report_Bug is
115: begin
116: put(" a : "); put(a); new_line;
117: put(" b : "); put(b); new_line;
118: end Report_Bug;
119:
120: begin
121: a := Random(sz1);
122: b := Random(sz2);
123: d1 := gcd(a,b);
124: gcd(a,b,k,l,d2);
125: put(k); put("*"); put(a); put("+");
126: put(l); put("*"); put(b); put("="); put(d2);
127: acc1 := k*a;
128: acc2 := l*b;
129: Add(acc1,acc2);
130: if Equal(d1,d2) and Equal(acc1,d2)
131: then put(" okay"); new_line;
132: else put(" Bug!"); Report_Bug;
133: end if;
134: Clear(a); Clear(b); Clear(d1);
135: Clear(k); Clear(l); Clear(d2);
136: Clear(acc1); Clear(acc2);
137: end Test_Multprec_GCD;
138:
139: procedure Random_Test_Multprec_GCD is
140:
141: nb,sz1,sz2 : natural;
142:
143: begin
144: put("Give the number of tests : "); get(nb);
145: put("Give the size of the 1st number : "); get(sz1);
146: put("Give the size of the 2nd number : "); get(sz2);
147: for i in 1..nb loop
148: Test_Multprec_GCD(sz1,sz2);
149: end loop;
150: end Random_Test_Multprec_GCD;
151:
152: procedure Main is
153:
154: ans : character;
155:
156: begin
157: new_line;
158: put_line("Interactive testing of gcd-computations.");
159: loop
160: new_line;
161: put_line("Choose one of the following : ");
162: put_line(" 0. exit this program.");
163: put_line(" 1. interactive gcd of standard integer numbers.");
164: put_line(" 2. gcd of randomly generated standard integer numbers.");
165: put_line(" 3. interactive gcd of multi-precision integer numbers.");
166: put_line(" 4. gcd of random multi-precision integer numbers.");
167: put("Type 0,1,2,3, or 4 to select your choice : "); get(ans);
168: exit when ans = '0';
169: case ans is
170: when '1' => Interactive_Test_Standard_GCD;
171: when '2' => Random_Test_Standard_GCD;
172: when '3' => Interactive_Test_Multprec_GCD;
173: when '4' => Random_Test_Multprec_GCD;
174: when others => null;
175: end case;
176: end loop;
177: end Main;
178:
179: begin
180: Main;
181: end ts_gcd;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_gcd.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Matrices