Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Matrices/ts_gcd.adb, Revision 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