Dec 10 23:33 1995 fig10_38.adb Page 1 -- Function "*" multiplies two matrices -- Procedure Fig10_38 is a simple test program with Ada.Text_IO, Ada.Integer_Text_IO; use Ada.Text_IO, Ada.Integer_Text_IO; procedure Fig10_38 is type Matrix is array( Integer range <>, Integer range <> ) of Integer; Matrix_Error : exception; A : Matrix( 1..2, 1..2 ) := ( ( 1, 2 ), ( 3, 4 ) ); B : Matrix( 1..2, 1..2 ) := ( ( 1, 2 ), ( 3, 4 ) ); C : Matrix( 1..2, 1..2 ); -- Multiply two matrices using standard O(N^3) algorithm -- Raise matrix error if matrices are the wrong size function "*"( A, B: Matrix ) return Matrix is C : Matrix( A'range( 1 ), B'range( 2 ) ) := ( others => ( others => 0 ) ); begin if A'First( 2 ) /= B'First( 1 ) and then A'Last( 2 ) /= B'Last( 1 ) then raise Matrix_Error; end if; for I in A'range( 1 ) loop for J in B'range( 2 ) loop for K in A'range( 2 ) loop C( I, J ) := C( I, J ) + A( I, K ) * B( K, J ); end loop; end loop; end loop; return C; end "*"; begin C := A * B; for I in C'range( 1 ) loop for J in C'range( 2 ) loop Put( C ( I, J ) ); end loop; New_Line; end loop; end Fig10_38; Jan 11 16:28 1996 fig10_40.adb Page 1 -- Procedure Fig_10_40 computes the 7th -- Fibonacci number using two algorithms with Ada.Text_IO, Ada.Integer_Text_IO; use Ada.Text_IO, Ada.Integer_Text_IO; procedure Fig10_40 is -- Compute Fibonacci numbers as described in Chapter 1 -- Assume N >= 0 -- This is an exponential algorithm function Fib( N: Natural ) return Integer is begin if N <= 1 then return 1; else return Fib( N - 1 ) + Fib( N - 2 ); end if; end Fib; -- Compute Fibonacci numbers as described in Chapter 1 -- Assume N >= 0 -- This is a linear-time algorithm function Fibonacci( N: Natural ) return Integer is Last, Next_To_Last, Answer : Natural := 1; begin if N <= 1 then return 1; end if; for I in 2..N loop Answer := Last + Next_To_Last; Next_To_Last := Last; Last := Answer; end loop; return Answer; end Fibonacci; begin Put( Fib( 7 ) ); New_Line; Put( Fibonacci( 7 ) ); New_Line; end Fig10_40; Dec 10 23:38 1995 fig10_43.adb Page 1 -- Procedure Fig10_43 calls inefficient function Eval -- Function Eval computes a recursive function -- inefficiently by using recursion with Ada.Text_IO, Ada.Float_Text_IO; use Ada.Text_IO, Ada.Float_Text_IO; procedure Fig10_43 is function Eval( N: Integer ) return Float is Sum : Float := 0.0; begin if N = 0 then return 1.0; end if; for I in 0..N-1 loop Sum := Sum + Eval( I ); end loop; return 2.0 * Sum / Float( N ) + Float( N ); end Eval; begin Put( Eval( 10 ) ); New_Line; end Fig10_43; Dec 10 23:39 1995 fig10_45.adb Page 1 -- Procedure Fig10_45 calls quadratic function Eval -- Function Eval computes a recursive function -- my storing smaller solutions in an array with Ada.Text_IO, Ada.Float_Text_IO; use Ada.Text_IO, Ada.Float_Text_IO; procedure Fig10_45 is function Eval( N: Integer ) return Float is C : array( 0..N ) of Float := ( 0 => 1.0, others => 0.0 ); Sum : Float; begin for I in 1..N loop Sum := 0.0; for J in 0..I-1 loop Sum := Sum + C( J ); end loop; C( I ) := 2.0 * Sum / Float( I ) + Float( I ); end loop; return C( N ); end Eval; begin Put( Eval( 10 ) ); New_Line; end Fig10_45; Jan 11 16:29 1996 fig10_46.adb Page 1 -- Procedure Fig10_46 is a test program for -- computing the optimal order for performing chained -- matrix multiplication with Ada.Text_IO, Ada.Integer_Text_IO; use Ada.Text_IO, Ada.Integer_Text_IO; procedure Fig10_46 is type Array_Of_Int is array( Natural range <> ) of Integer; type Two_D_Array is array( Natural range <>, Natural range <> ) of Integer; C : Array_Of_Int( 0..4 ) := ( 50, 10, 40, 30, 5 ); M, Last_Change : Two_D_Array( 1..4, 1..4 ); -- Compute optimal ordering of matrix multiplication -- C contains number of columns for each of the N matrices -- C( 0 ) is the number of rows in matrix 1 -- Minimum number of multiplications is left in M( 1, N ) -- Actual ordering can be computed via another procedure -- using Last_Change -- M and Last_Change are indexed starting at 1, instead of zero -- And must be at least ( 1..N, 1..N ) procedure Opt_Matrix( C: Array_Of_Int; M, Last_Change : in out Two_D_Array ) is Right, This_M : Integer; N : Natural := C'Last; begin M := ( others => ( others => 0 ) ); Last_Change := M; for K in 1..N-1 loop -- K is Right-Left for Left in 1..N-K loop -- For each position Right := Left + K; M( Left, Right ) := Integer'Last; for I in Left..Right-1 loop This_M := M( Left, I ) + M( I+1, Right ) + C( Left-1 ) * C( I ) * C( Right ); if This_M < M( Left, Right ) then -- Update min M( Left, Right ) := This_M; Last_Change( Left, Right ) := I; end if; end loop; end loop; end loop; end Opt_Matrix; begin Opt_Matrix( C, M, Last_Change ); for I in 1..4 loop for J in 1..4 loop Put( M( I, J ) ); end loop; New_Line; Jan 11 16:29 1996 fig10_46.adb Page 2 end loop; for I in 1..4 loop for J in 1..4 loop Put( Last_Change( I, J ) ); end loop; New_Line; end loop; end Fig10_46; Dec 10 23:46 1995 fig10_53.adb Page 1 -- Procedure Fig10_53 tests the all-pairs shortest paths algorithm with Ada.Text_IO, Ada.Integer_Text_IO; use Ada.Text_IO, Ada.Integer_Text_IO; procedure Fig10_53 is type Two_D_Array is array( Natural range <>, Natural range <> ) of Integer; A : Two_D_Array( 1..4, 1..4 ) := ( 1 => ( 0, 2, -2, 2 ), 2 => ( 1000, 0, -3, 1000 ), 3 => ( 4, 1000, 0, 1000 ), 4 => ( 1000, -2, 3, 0 ) ); D, Path: Two_D_Array( 1..4, 1..4 ); -- Compute all-shortest paths -- A contains the adjacency matrix with A( I, I ) presumed to be zero -- D contains the values of the shortest path -- A negative cycle exists iff D( i, i ) is set -- to a negative value at line 7 -- Actual path can be computed via another procedure using Path -- All indexes ranges for A and D are presumed to be identical procedure All_Pairs( A: Two_D_Array; D, Path : in out Two_D_Array ) is begin D := A; -- Initialize D and Path Path := ( others => ( others => 0 ) ); for K in D'range( 1 ) loop -- Consider each vertex as an intermediate for I in D'range( 1 ) loop for J in D'range( 1 ) loop if D( I, K ) + D( K, J ) < D( I, J ) then -- Update minimum path info D( I, J ) := D( I, K ) + D( K, J ); Path( I, J ) := K; end if; end loop; end loop; end loop; end All_Pairs; begin All_Pairs( A, D, Path ); for I in 1..4 loop for J in 1..4 loop Put( D( I, J ) ); end loop; New_Line; end loop; for I in 1..4 loop for J in 1..4 loop Put( Path( I, J ) ); end loop; Dec 10 23:46 1995 fig10_53.adb Page 2 New_Line; end loop; end Fig10_53; Dec 10 23:48 1995 random_numbers.ads Page 1 -- Package Random_Numbers implements a linear congruential generator -- Two functions are defined: -- Initialize Set inital state of the generator -- Random Return a Float between 0 and 1 (non-inclusive) package Random_Numbers is procedure Initialize( New_Seed : Positive ); function Random return Float; end Random_Numbers; Dec 10 23:51 1995 random_numbers.adb Page 1 -- Implementation of package Random_Numbers package body Random_Numbers is Seed : Positive := 1; A : constant := 48271; M : constant := 2 ** 31 - 1; Q : constant := M / A; R : constant := M mod A; -- Set Seed; do not allow 0 as the new Seed procedure Initialize( New_Seed : Positive ) is begin if Seed /= 0 then Seed := New_Seed; end if; end Initialize; -- Return a random Float between 0 and 1 -- This value is simply Seed / M (in floating point) function Random return Float is Tmp_Seed : Integer; begin Tmp_Seed := A * ( Seed mod Q ) - R * ( Seed / Q ); if Tmp_Seed > 0 then Seed := Tmp_Seed; else Seed := Tmp_Seed + M; end if; return Float( Seed ) / Float( M ); end Random; end Random_Numbers; Dec 10 23:51 1995 random_numbers_test.adb Page 1 -- Test the Random_Numbers package by outputting 20 random numbers with Random_Numbers, Ada.Text_IO, Ada.Float_Text_IO; use Random_Numbers, Ada.Text_IO, Ada.Float_Text_IO; procedure Random_Numbers_Test is P : Float; begin for I in 1..20 loop P := Random; Put( P, Exp=>0 ); New_Line; end loop; end Random_Numbers_Test; Dec 11 00:10 1995 fig10_62.adb Page 1 -- Procedure Fig10_62 is a simple program that -- calls the primality testing algorithm Test_Prime -- Test_Prime is a probabilistic algorithm; it calls -- the recursive procedure Power with Ada.Text_IO, Ada.Integer_Text_IO; use Ada.Text_IO, Ada.Integer_Text_IO; with Random_Numbers; use Random_Numbers; procedure Fig10_62 is -- Enumerate type that defines the return type of Test_Prime type Test_Result is ( Probably_Prime, Definitely_Composite ); -- Local variable for Fig10_62 procedure I : Integer; -- Return a random integer in the cloased interval Low..High function Rand_Int( Low, High: Integer ) return Integer is begin return Integer( Random * Float ( High-Low ) ) + Low; end Rand_Int; -- Compute Result = (A^P) mod N -- If at any point X^2 = 1 mod N is detected with X /= 1 and X /= N-1, -- then set What_N_Is to Definitely_Composite -- We are assuming very large integers, so this is pseudocode procedure Power( A, P, N: Natural; Result: in out Integer; What_N_Is: in out Test_Result ) is X : Natural; begin if P = 0 then -- Base case Result := 1; else Power( A, P/2, N, X, What_N_Is ); Result := ( X * X ) mod N; -- Check whether X^2 = 1 mod N and X /= 1, X /= N-1 if Result = 1 and X /= 1 and X /= N-1 then What_N_Is := Definitely_Composite; end if; if P mod 2 = 1 then -- If P is odd, we need one more A Result := ( Result * A ) mod N; end if; end if; end Power; -- Test_Prime: test whether N>=3 is prime using one value of A -- Repeat this function as many times as needed for desired error rate function Test_Prime( N: Natural ) return Test_Result is A, Result : Natural; What_N_Is : Test_Result; begin A := Rand_Int( 2, N-2 ); -- Choose A randomly from 2..N-2 What_N_Is := Probably_Prime; Dec 11 00:10 1995 fig10_62.adb Page 2 Power( A, N-1, N, Result, What_N_Is ); -- Compute A^(N-1) mod N if Result /= 1 or What_N_Is = Definitely_Composite then return Definitely_Composite; else return Probably_Prime; end if; end Test_Prime; begin -- List numbers between 101 and 199 that pass the primality test I := 101; while I < 200 loop if Test_Prime( I ) = Probably_Prime then Put( I ); New_Line; end if; I := I + 2; end loop; end Fig10_62; Jan 11 16:31 1996 tic_tac_alpha.adb Page 1 -- A very quick and dirty tic-tac-toe implementation -- It assumes that the human goes first -- The main purpose is to test the alpha-beta pruning algorithm with Ada.Text_IO, Ada.Integer_Text_IO; use Ada.Text_IO, Ada.Integer_Text_IO; procedure Tic_Tac_Alpha is type Player is ( Human, Comp, Empty ); Comp_Win : constant Integer := 1; Draw : constant Integer := 0; Comp_Loss: constant Integer := -1; type Board_Type is array( 0..9 ) of Player; Move, Bmove, Game_Val: Integer; Game_Board: Board_Type; procedure Place( Board: out Board_Type; Square: Integer; Who: Player ) is begin Board( Square ) := Who; end Place; procedure Unplace( Board: out Board_Type; Square: Integer ) is begin Board( Square ) := Empty; end Unplace; function Is_Empty( Board: Board_Type; Square: Integer ) return Boolean is begin return Board( Square ) = Empty; end Is_Empty; function Full_Board( Board: Board_Type ) return Boolean is begin for I in 1..9 loop if Board( I ) = Empty then return False; end if; end loop; return True; end Full_Board; procedure Immediate_Win( Board: in out Board_Type; Best_Move: out Integer; Side: Player ) is J : Integer; begin for I in 1..9 loop if Board( I ) = Empty then Place( Board, I, Side ); J := 1; while J <= 7 loop if Board( J )=Side and Board( J+1 )=Side and Board( J+2 )=Side then Unplace( Board, I ); Best_Move := I; return; Jan 11 16:31 1996 tic_tac_alpha.adb Page 2 end if; J := J+3; end loop; for K in 1..3 loop if Board( K )=Side and Board( K+3 )=Side and Board( K+6 )=Side then Unplace( Board, I ); Best_Move := I; return; end if; end loop; if Board( 1 )=Side and Board( 5 )=Side and Board( 9 )=Side then Unplace( Board, I ); Best_Move := I; return; end if; if Board( 3 )=Side and Board( 5 )=Side and Board( 7 )=Side then Unplace( Board, I );Best_Move := I; return; end if; Unplace( Board, I ); end if; end loop; Best_Move := 0; return; end Immediate_Win; procedure Print_Board( Board: Board_Type ) is begin Put_Line( "------------" ); for I in 1..9 loop if Board( I ) = Empty then Put( ' ' ); elsif Board( I ) = Comp then Put( 'O' ); else Put( 'X' ); end if; if I mod 3 = 0 then New_Line; end if; end loop; Put_Line( "------------" ); end Print_Board; procedure Print_Board_D( Board: Board_Type; Depth: Integer ) is begin if Depth > 2 then return; end if; for J in 0..Depth loop Put( Ascii.Ht ); end loop; Put_Line( "------------" ); for J in 0..Depth loop Put( Ascii.Ht ); end loop; for I in 1..9 loop if Board( I ) = Empty then Put( ' ' ); elsif Board( I ) = Comp then Put( 'O' ); else Put( 'X' ); end if; if I mod 3 = 0 then New_Line; for I in 0..Depth loop Put( Ascii.Ht ); Jan 11 16:31 1996 tic_tac_alpha.adb Page 3 end loop; end if; end loop; Put_Line( "------------" ); end Print_Board_D; -- Same as before, but perform alpha-beta pruning. -- The main routine should make the call with Alpha = Comp_Loss, -- Beta = Comp_Win procedure Find_Human_Move( Board: in out Board_Type; Alpha, Beta: Integer; Best_Move, Value : in out Integer ); procedure Find_Comp_Move( Board: in out Board_Type; Alpha, Beta: Integer; Best_Move, Value : in out Integer ) is Dc, Response: Integer; begin if Full_Board( Board ) then Value := Draw; return; else Immediate_Win( Board, Best_Move, Comp ); if Best_Move /= 0 then Value := Comp_Win; return; end if; end if; Value := Alpha; for I in 1..9 loop -- Try each square exit when Value >= Beta; if Is_Empty( Board, I ) then Place( Board, I, Comp ); Find_Human_Move( Board, Value, Beta, Dc, Response ); Unplace( Board, I ); -- Restore board if Response > Value then -- Update best move Value := Response; Best_Move := I; end if; end if; end loop; end Find_Comp_Move; procedure Find_Human_Move( Board: in out Board_Type; Alpha, Beta: Integer; Best_Move, Value : in out Integer ) is Dc, Response: Integer; begin if Full_Board( Board ) then Value := Draw; return; else Immediate_Win( Board, Best_Move, Human ); if Best_Move /= 0 then Value := Comp_Loss; Jan 11 16:31 1996 tic_tac_alpha.adb Page 4 return; end if; end if; Value := Beta; for I in 1..9 loop --Try each square if Value <= Alpha then exit; end if; if Is_Empty( Board, I ) then Place( Board, I, Human ); Find_Comp_Move( Board, Alpha, Value, Dc, Response ); Unplace( Board, I ); -- Restore board if Response < Value then -- Update best move Value := Response; Best_Move := I; end if; end if; end loop; end Find_Human_Move; begin -- Simple main that assumes that human goes first. -- There are no error checks for I in 1..9 loop Game_Board( I ) := Empty; end loop; loop Print_Board( Game_Board ); Put( "Enter move: " ); Get( Move ); Game_Board( Move ) := Human; if Full_Board( Game_Board ) then Put_Line( "Draw." ); exit; end if; Print_Board( Game_Board ); Immediate_Win( Game_Board, Bmove, Comp ); if Bmove /= 0 then Put( "Comp move is: " ); Put( Bmove ); New_Line; Game_Board( Bmove ) := Comp; Print_Board( Game_Board ); Put_Line( "Game over -- I win" ); exit; end if; Find_Comp_Move( Game_Board, Comp_Loss, Comp_Win, Bmove, Game_Val ); Put( "Comp move is: " ); Put( Bmove ); New_Line; Game_Board( Bmove ) := Comp; if Full_Board( Game_Board ) then Put_Line( "Draw." ); Jan 11 16:31 1996 tic_tac_alpha.adb Page 5 exit; end if; if Game_Val = Comp_Win then Put_Line( "Forced win." ); end if; end loop; end Tic_Tac_Alpha;