SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00031 MATH ROUTINES 1 05-28-9313:50ALL SWAG SUPPORT TEAM 3DPOINTS.PAS IMPORT 7 {π> Could someone please explain how to plot a 3-D points? How do you convertπ> a 3D XYZ value, to an XY value that can be plotted onto the screen?π}ππFunction x3d(x1, z1 : Integer) : Integer;πbeginπ x3d := Round(x1 - (z1 * Cos(Theta)));πend;ππFunction y3d(y1, z1 : Integer) : Integer;πbeginπ y3d := Round(y1 - (z1 * Sin(Theta)));πend;ππ{πSo a Function that plots a 3d pixel might look like this:ππProcedure plot3d(x, y, z : Integer);πbeginπ plot(x3d(x, z), y3d(y, z));πend;ππThe theta above is the angle on the screen on which your are "simulating"πyour z axis. This is simplistic, but should get you started. Just rememberπyou are simulating 3 dimensions on a 2 dimension media (the screen). Trigπhelps. ;-)π} 2 05-28-9313:50ALL SWAG SUPPORT TEAM CIRCLE3P.PAS IMPORT 28 Program ThreePoints_TwoPoints;π{ππ I Really appreciate ya helping me With this 3 points on aπcircle problem. The only thing is that I still can't get itπto work. I've tried the Program you gave me and it spits outπthe wrong answers. I don't know if there are parentheses in theπwrong place or what. Maybe you can find the error.π π You'll see that I've inserted True coordinates For this test.π πThank you once again...and please, when you get any more informationπon this problem...call me collect person to person or leave it on myπBBS. I get the turbo pascal echo from a California BBS and that sureπis long distance. Getting a good pascal Procedure For this isπimportant to me because I am using it in a soon to be released mathπProgram called Mr. Machinist! I've been racking my brain about thisπfor 2 weeks now and I've even been dream'in about it!π πYour help is appreciated!!!π π +π+AL+π π(716) 434-7823 Voiceπ(716) 434-1448 BBS ... if none of these, then leave Program on TP echo.π π}π πUsesπ Crt;πConstπ x1 = 4.0642982;π y1 = 0.9080732;π x2 = 1.6679862;π y2 = 2.8485684;π x3 = 4.0996421;π y3 = 0.4589868;ππVarπ Selection : Integer;πProcedure ThreePoints;πVarπ Slope1,π Slope2,π Mid1x,π Mid1y,π Mid2x,π Mid2y,π Cx,π Cy,π Radius : Real;πbeginπ ClrScr;π Writeln('3 points on a circle');π Writeln('====================');π Writeln;π Writeln('X1 -> 4.0642982');π Writeln('Y1 -> 0.9080732');π Writeln;π Writeln('X2 -> 1.6679862');π Writeln('Y2 -> 2.8485684');π Writeln('X3 -> 4.0996421');π Writeln('Y3 -> 0.4589868');π Writeln;π Slope1 := (y2 - y1) / (x2 - x1);π Slope2 := (y3 - y2) / (x3 - x2);π Mid1x := (x1 + x2) / 2;π Mid1y := (y1 + y2) / 2;π Mid2x := (x2 + x3) / 2;π Mid2y := (y2 + y3) / 2;π Slope1 := -1 * (1 / Slope1);π Slope2 := -1 * (1 / Slope2);π Cx := (Slope2 * x2 - y2 - Slope1 * x1 + y1) / (Slope1 - Slope2);π Cy := Slope1 * (Cx + x1) - y1;ππ {π I believe you missed out on using Cx and Cy in next line,π Radius := sqrt(((x1 - x2) * (x1 - x2)) + ((y1 - y2) * (y1 - y2)));π I think it should be . . .π }ππ Radius := Sqrt(Sqr((x1 - Cx) + (y1 - Cy)));π Writeln;π Writeln('X center line (Program answer) is ', Cx : 4 : 4);π Writeln('Y center line (Program answer) is ', Cy : 4 : 4);π Writeln('The radius (Program answer) is ', Radius : 4 : 4);π Writeln;π Writeln('True X center = 1.7500');π Writeln('True Y center = 0.5000');π Writeln('True Radius = 2.3500');π Writeln('Strike any key to continue . . .');π ReadKey;πend;ππProcedure Distance2Points;πVarπ x1, y1,π x2, y2,π Distance : Real;πbeginπ ClrScr;π Writeln('Distance between 2 points');π Writeln('=========================');π Writeln;π Write('X1 -> ');π Readln(x1);π Write('Y1 -> ');π Readln(y1);π Writeln;π Write('X2 -> ');π Readln(x2);π Write('Y2 -> ');π Readln(y2);π Writeln;π Writeln;π Distance := Sqrt((Sqr(x2 - x1)) + (Sqr(y2 - y1)));π Writeln('Distance between point 1 and point 2 = ', Distance : 4 : 4);π Writeln;π Writeln('Strike any key to continue . . .');ππ ReadKey;πend;ππbeginπ ClrScr;π Writeln;π Writeln;π Writeln('1) Distance between 2 points');π Writeln('2) 3 points on a circle test Program');π Writeln('0) Quit');π Writeln;π Write('Choose a menu number: ');π Readln(Selection);π Case Selection ofπ 1 : Distance2Points;π 2 : ThreePoints;π end;π ClrScr;πend.π 3 05-28-9313:50ALL SWAG SUPPORT TEAM EQUATE.PAS IMPORT 29 { Author: Gavin Peters. }ππProgram PostFixConvert;π(*π * This Program will convert a user entered expression to postfix, andπ * evaluate it simultaniously. Written by Gavin Peters, based slightlyπ * on a stack example given in Algorithms (Pascal edition), pgπ *π *)πVarπ Stack : Array[1 .. 3] of Array[0 .. 500] of LongInt;ππProcedure Push(which : Integer; p : LongInt);πbeginπ Stack[which,0] := Stack[which,0]+1;π Stack[which,Stack[which,0]] := pπend;ππFunction Pop(which : Integer) : LongInt;πbeginπ Pop := Stack[which,Stack[which,0]];π Stack[which,0] := Stack[which,0]-1πend;ππVarπ c : Char;π x,t,π bedmas : LongInt;π numbers : Boolean;ππProcedure Evaluate( ch : Char );ππ Function Power( exponent, base : LongInt ) : LongInt;π beginπ if Exponent > 0 thenπ Power := Base*Power(exponent-1, base)π ELSEπ Power := 1π end;ππbeginπ Write(ch);π if Numbers and not (ch = ' ') thenπ x := x * 10 + (Ord(c) - Ord('0'))π ELSEπ beginπ Case ch OFπ '*' : x := pop(2)*pop(2);π '+' : x := pop(2)+pop(2);π '-' : x := pop(2)-pop(2);π '/' : x := pop(2) div pop(2);π '%' : x := pop(2) MOD pop(2);π '^' : x := Power(pop(2),pop(2));π 'L' : x := pop(2) SHL pop(2);π 'R' : x := pop(2) SHR pop(2);π '|' : x := pop(2) or pop(2);π '&' : x := pop(2) and pop(2);π '$' : x := pop(2) xor pop(2);π '=' : if pop(2) = pop(2) thenπ x := 1π elseπ x := 0;π '>' : if pop(2) > pop(2) thenπ x := 1π elseπ x := 0;π '<' : if pop(2) < pop(2) thenπ x := 1π elseπ x := 0;π '0','1'..'9' :π beginπ Numbers := True;π x := Ord(c) - Ord('0');π Exitπ end;π ' ' : if not Numbers thenπ Exit;π end;ππ Numbers := False;π Push(2,x);π end;πend;ππbeginπ Writeln('Gavin''s calculator, version 1.00');π Writeln;π For x := 1 to 3 DOπ Stack[x, 0] := 0;π x := 0;π numbers := False;π Bedmas := 50;π Writeln('Enter an expression in infix:');π Repeatπ Read(c);π Case c OFπ ')' :π beginπ Bedmas := Pop(3);π Evaluate(' ');π Evaluate(Chr(pop(1)));π end;ππ '^','%','+','-','*','/','L','R','|','&','$','=','<','>' :π beginπ t := bedmas;π Case c Ofππ '>','<' : bedmas := 3;π '|','$',π '+','-' : bedmas := 2;π '%','L','R','&',π '*','/' : bedmas := 1;π '^' : bedmas := 0;π end;π if t <= bedmas thenπ beginπ Evaluate(' ');π Evaluate(Chr(pop(1)));π end;π Push(1,ord(c));π Evaluate(' ');π end;π '(' :π beginπ Push(3,bedmas);π bedmas := 50;π end;π '0','1'..'9' : Evaluate(c);π end;ππ Until Eoln;ππ While Stack[1,0] <> 0 DOπ beginπ Evaluate(' ');π Evaluate(Chr(pop(1)));π end;π Evaluate(' ');π Writeln;π Writeln;π Writeln('The result is ',Pop(2));πend.ππ{πThat's it, all. This is an evaluator, like Reuben's, With a fewπmore features, and it's shorter.ππOkay, there it is (the above comment was in the original post). I'veπnever tried it, but it looks good. :-) BTW, if it does work you mightπwant to thank Gavin Peters... after all, he wrote it. I was justπinterested when I saw it, and stored it along With a bunch of otherπsource-code tidbits I've git here...π}π 4 05-28-9313:50ALL SWAG SUPPORT TEAM FIBONACC.PAS IMPORT 5 {π>The problem is to Write a recursive Program to calculate Fibonacci numbers.π>The rules For the Fibonacci numbers are:π>π> The Nth Fib number is:π>π> 1 if N = 1 or 2π> The sum of the previous two numbers in the series if N > 2π> N must always be > 0.π}ππFunction fib(n : LongInt) : LongInt;πbeginπ if n < 2 thenπ fib := nπ elseπ fib := fib(n - 1) + fib(n - 2);πend;ππVarπ Count : Integer;ππbeginπ Writeln('Fib: ');π For Count := 1 to 15 doπ Write(Fib(Count),', ');πend. 5 05-28-9313:50ALL SWAG SUPPORT TEAM GAUSS.PAS IMPORT 121 Program Gauss_Elimination;ππUses Crt,Printer;ππ(***************************************************************************)π(* STEPHEN ABRAHAM *)π(* MCEN 3030 Comp METHODS *)π(* ASSGN #3 *)π(* DUE: 2-12-93 *)π(* *)π(* GAUSS ELIMinATION (TURBO PASCAL VERSION by STEPHEN ABRAHAM) *)π(* *)π(***************************************************************************)π{ }π{ }π{------------------VarIABLE DECLARATION and DEFinITIONS--------------------}ππConstπ MAXROW = 50; (* Maximum # of rows in a matrix *)π MAXCOL = 50; (* Maximum # of columns in a matrix *)ππTypeπ Mat_Array = Array[1..MAXROW,1..MAXCOL] of Real; (* 2-D Matrix of Reals *)π Col_Array = Array[1..MAXCOL] of Real; (* 1-D Matrix of Real numbers *)π Int_Array = Array[1..MAXCOL] of Integer; (* 1-D Matrix of Integers *)ππVarπ N_EQNS : Integer; (* User Input : Number of equations in system *)π COEFF_MAT : Mat_Array; (* User Input : Coefficient Matrix of system *)π COL_MAT : Col_Array; (* User Input : Column matrix of Constants *)π X_MAT : Col_Array; (* OutPut : Solution matrix For unknowns *)π orDER_VECT : Int_Array; (* Defined to pivot rows where necessary *)π SCALE_VECT : Col_Array; (* Defined to divide by largest element in *)π (* row For normalizing effect *)π I,J,K : Integer; (* Loop control and Array subscripts *)π Ans : Char; (* Yes/No response to check inputted matrix *)πππ{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}ππππ{^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}π{>>>>>>>>>>>>>>>>>>>>>>>>> ProcedureS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<}π{...........................................................................}πππProcedure Home; (* clears screen and positions cursor at (1,1) *)πbeginπ ClrScr;π GotoXY(1,1);πend; (* Procedure Home *)ππ{---------------------------------------------------------------------------}πππProcedure Instruct; (* provides user instructions if wanted *)ππVarπ Ans : Char; (* Yes/No answer by user For instructions or not *)ππbeginπ Home; (* calls Home Procedure *)π GotoXY(22,8); Writeln('STEVE`S GAUSSIAN ELIMinATION Program');π GotoXY(36,10); Writeln('2-12-92');π GotoXY(31,18); Write('Instructions(Y/N):');π GotoXY(31,49); readln(Ans);π if Ans in ['Y','y'] thenπ beginπ Home; (* calls Home Procedure *)π Writeln(' Welcome to Steve`s Gaussian elimination Program. With this');π Writeln('Program you will be able to enter the augmented matrix of ');π Writeln('your system of liNear equations and have returned to you the ');π Writeln('solutions For each unknown. The Computer will ask you to ');π Writeln('input the number of equations in your system and will then ');π Writeln('have you input your coefficient matrix and then your column ');π Writeln('matrix. Please remember For n unknowns, you will need to ');π Writeln('have n equations. ThereFore you should be entering a square ');π Writeln('(nxn) coefficient matrix. Have FUN!!!! ');π Writeln('(hit <enter> to continue...)'); (* Delay *)π readln;π end;πend;πππ{---------------------------------------------------------------------------}πππProcedure Initialize_Array( Var Coeff_Mat : Mat_Array ;π Var Col_Mat,X_Mat, Scale_Vect : Col_Array;π Var order_Vect : Int_Array);ππ(*** This Procedure initializes all matrices to be used in Program ***)π(*** ON ENTRY : Matrices have undefined values in them ***)π(*** ON Exit : All Matrices are zero matrices ***)πππConstπ MAXROW = 50; { maximum # of rows in matrix }π MAXCOL = 50; { maximum # of columns in matrix }ππVarπ I : Integer; { I & J are both loop control and Array subscripts }π J : Integer;ππbeginπ For I := 1 to MaxRow do { row indices }π beginπ Col_Mat[I] := 0;π X_Mat[I] := 0;π order_Vect[I] := 0;π Scale_Vect[I] := 0;π For J := 1 to MaxCol do { column indices }π Coeff_Mat[I,J] := 0;π end;πend; (* Procedure initialize_Array *)πππ{---------------------------------------------------------------------------}ππProcedure Input(Var N : Integer;π Var Coeff_Mat1 : Mat_Array;π Var Col_Mat1 : Col_Array);ππ(*** This Procedure lets the user input the number of equations and the ***)π(*** augmented matrix of their system of equations ***)π(*** ON ENTRY : N => number of equations : UNDEFinEDπ Coeff_Mat1 => coefficient matrix : UNDEFinEDπ Col_Mat1 => column matrix :UNDEFinEDπ ON Exit : N => # of equations input by userπ Coeff_Mat1 => defined coefficient matrixπ Col_Mat1 => defined column matrix input by user ***)ππππVarπ I,J : Integer; (* loop control and Array indices *)ππbeginπ Home; (* calls Procedure Home *)π Write('Enter the number of equations in your system: ');π readln(N);π Writeln;π Writeln('Now you will enter your coefficient and column matrix:');π For I := 1 to N do { row indice }π beginπ Writeln('ROW #',I);π For J := 1 to N do {column indice }π beginπ Write('a(',I,',',J,'):');π readln(Coeff_Mat1[I,J]); {input of coefficient matrix}π end;π Write('c(',I,'):');π readln(Col_Mat1[I]); {input of Constant matrix}π end;π readln;πend; (* Procedure Input *)πππ{---------------------------------------------------------------------------}πππProcedure Check_Input( Coeff_Mat1 : Mat_Array;π N : Integer; Var Ans : Char);ππ(*** This Procedure displays the user's input matrix and asks if it is ***)π(*** correct. ***)π(*** ON ENTRY : Coeff_Mat1 => inputted matrixπ N => inputted number of equationsπ Ans => UNDEFinED ***)π(*** ON Exit : Coeff_Mat1 => n/aπ N => n/aπ Ans => Y,y or N,n ***)πππVarπ I,J : Integer; (* loop control and Array indices *)ππbeginπ Home; (* calls Home Procedure *)π Writeln; Writeln('Your inputted augmented matrix is:');Writeln;Writeln;ππ For I := 1 to N do { row indice }π beginπ For J := 1 to N do { column indice }π Write(Coeff_Mat[I,J]:12:4);π Writeln(Col_Mat[I]:12:4);π end;π Writeln; Write('Is this your desired matrix?(Y/N):'); (* Gets Answer *)π readln(Ans);πend; (* Procedure Check_Input *)πππ{---------------------------------------------------------------------------}πππProcedure order(Var Scale_Vect1 : Col_Array;π Var order_Vect1 : Int_Array;π Var Coeff_Mat1 : Mat_Array;π N : Integer);ππ(*** This Procedure finds the order and scaling value For each row of theπ inputted coefficient matrix. ***)π(*** ON ENTRY : Scale_Vect1 => UNDEFinEDπ order_Vect1 => UNDEFinEDπ Coeff_Mat1 => as inputtedπ N => # of equationsπ ON Exit : Scale_Vect1 => contains highest value For each row of theπ coefficient matrixπ order_Vect1 => is assigned the row number of each row fromπ the coefficient matrix in orderπ Coeff_Mat => n/aπ N => n/a ***)πππVarπ I,J : Integer; {loop control and Array indices}ππbeginπFor I := 1 to N doπ beginπ order_Vect1[I] := I; (* ordervect gets the row number of each row *)π Scale_Vect1[I] := Abs(Coeff_Mat1[I,1]); (* gets the first number of each row *)π For J := 2 to N do { goes through the columns }π begin (* Compares values in each row of the coefficient matrix andπ stores this value in scale_vect[i] *)π if Abs(Coeff_Mat1[I,J]) > Scale_Vect1[I] thenπ Scale_Vect1[I] := Abs(Coeff_Mat1[I,J]);π end;π end;πend; (* Procedure order *)πππ{---------------------------------------------------------------------------}πππProcedure Pivot(Var Scale_Vect1 : Col_Array;π Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π K,N : Integer);ππ(*** This Procedure finds the largest number in each column after it has beenπ scaled and Compares it With the number in the corresponding diagonalπ position. For example, in column one, a(1,1) is divided by the scalingπ factor of row one. then each value in the matrix that is in column oneπ is divided by its own row's scaling vector and Compared With theπ position above it. So a(1,1)/scalevect[1] is Compared to a[2,1]/scalevect[2]π and which ever is greater has its row number stored as pivot. Once theπ highest value For a column is found, rows will be switched so that theπ leading position has the highest possible value after being scaled. ***)ππ(*** ON ENTRY : Scale_Vect1 => the normalizing value of each rowπ Coeff_Mat1 => the inputted coefficient matrixπ order_Vect1 => the row number of each row in original orderπ K => passed in from the eliminate Procedureπ N => number of equationsπ ON Exit : Scale_Vect => sameπ Coeff_Mat1 => sameπ order_Vect => contains the row number With highest scaledπ valueπ k => n/aπ N => n/a ***)ππVarπ I : Integer; {loop control and Array indice }π Pivot, Idum : Integer; {holds temporary values For pivoting }π Big,Dummy : Real; {used to Compare values of each column }πbeginπ Pivot := K;π Big := Abs(Coeff_Mat1[order_Vect1[K],K]/Scale_Vect1[order_Vect1[K]]);π For I := K+1 to N doπ beginπ Dummy := Abs(Coeff_Mat1[order_Vect1[I],K]/Scale_Vect1[order_Vect1[I]]);π if Dummy > Big thenπ beginπ Big := Dummy;π Pivot := I;π end;π end;π Idum := order_Vect1[Pivot]; { switching routine }π order_Vect1[Pivot] := order_Vect1[K];π order_Vect1[K] := Idum;πend; { Procedure pivot }πππ{---------------------------------------------------------------------------}ππProcedure Eliminate(Var Col_Mat1, Scale_Vect1 : Col_Array;π Var Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π N : Integer);πππVarπ I,J,K : Integer;π Factor : Real;ππbeginπ For K := 1 to N-1 doπ beginπ Pivot (Scale_Vect1,Coeff_Mat1,order_Vect1,K,N);π For I := K+1 to N doπ beginπ Factor := Coeff_Mat1[order_Vect1[I],K]/Coeff_Mat1[order_Vect1[K],K];π For J := K+1 to N doπ beginπ Coeff_Mat1[order_Vect1[I],J] := Coeff_Mat1[order_Vect1[I],J] -π Factor*Coeff_Mat1[order_Vect1[K],J];π end;π Col_Mat1[order_Vect1[I]] := Col_Mat1[order_Vect1[I]] - Factor*Col_Mat1[order_Vect1[K]];π end;π end;πend;πππ{---------------------------------------------------------------------------}πππProcedure Substitute(Var Col_Mat1, X_Mat1 : Col_Array;π Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π N : Integer);ππ(*** This Procedure will backsubstitute to find the solutions to yourπ system of liNear equations.π ON ENTRY : Col_Mat => your modified Constant column matrixπ X_Mat1 => UNDEFinEDπ Coeff_Mat1 => modified into upper triangular matrixπ order_Vect => contains the order of your rowsπ N => number of equationsπ ON Exit : Col_Mat => n/aπ X_MAt1 => your solutions !!!!!!!!!!!!!π Coeff_Mat1 => n/aπ order_Vect1 => who caresπ N => n/a ***)πππVarπ I, J : Integer; (* loop and indice of Array control *)π Sum : Real; (* used to sum each row's elements *)ππbeginπ X_Mat1[N] := Col_Mat1[order_Vect1[N]]/Coeff_Mat1[order_Vect1[N],N];π (***** This gives you the value of x[n] *********)ππ For I := N-1 downto 1 doπ beginπ Sum := 0.0;π For J := I+1 to N doπ Sum := Sum + Coeff_Mat1[order_Vect1[I],J]*X_Mat1[J];π X_Mat1[I] := (Col_Mat1[order_Vect1[I]] - Sum)/Coeff_Mat1[order_Vect1[I],I];π end;πend; (** Procedure substitute **)πππ{---------------------------------------------------------------------------}πππProcedure Output(X_Mat1: Col_Array; N : Integer);ππ(*** This Procedure outputs the solutions to the inputted system of ***)π(*** equations ***)π(*** ON ENTRY : X_Mat1 => the solutions to the system of equationsπ N => the number of equationsπ ON Exit : X_Mat1 => n/aπ N => n/a ***)πππVarπ I : Integer; (* loop control and Array indice *)ππbeginπ Writeln;Writeln;Writeln; (* skips lines *)π Writeln('The solutions to your sytem of equations are:');π For I := 1 to N doπ Writeln('X(',I,') := ',X_Mat1[I]);πend; (* Procedure /output *)ππππ{---------------------------------------------------------------------------}π(* *)π(* *)π(* *)π(***************************************************************************)ππbeginππ Repeatπ Instruct; (* calls Procedure Instruct *)π Initialize_Array(Coeff_Mat, Col_Mat, X_Mat, Scale_Vect, order_Vect);π (* calls Procedure Initialize_Array *)π Repeatπ Input(N_EQNS, Coeff_Mat, Col_Mat); (* calls Procedure Input *)π Check_Input(Coeff_Mat,N_EQNS,Ans); (* calls Procedure check_Input *)π Until Ans in ['Y','y']; (* loops Until user inputs correct matrix *)ππ order(Scale_Vect,order_Vect,Coeff_Mat,N_EQNS); (* calls Procedure order *)π Eliminate(Col_Mat,Scale_Vect,Coeff_Mat,order_Vect,N_EQNS); (*etc..*)π Substitute(Col_Mat,X_Mat,Coeff_Mat,order_Vect,N_EQNS); (*etc..*)π Output(X_Mat,N_EQNS); (*etc..*)ππ Writeln;π Write('Do you wish to solve another system of equations?(Y/N):');π readln(Ans);π Until Ans in ['N','n'];πππend. (*************** end of Program GAUSS_ELIMinATION *******************)π 6 05-28-9313:50ALL SWAG SUPPORT TEAM GCD.PAS IMPORT 3 {Greatest common divisor}πProgram GCD;ππVarπ x, y : Integer;ππbeginπ read(x);ππ While x <> 0 doπ beginπ read(y);ππ While x <> y doπ if x > y thenπ x := x - yπ elseπ y := y - x;ππ Write(x);π read(x);ππ end;πend.π 7 05-28-9313:50ALL SWAG SUPPORT TEAM LOGRITHM.PAS IMPORT 2 Function NlogX(X: Real; N:Real): Real;ππbeginπ NlogX = Ln(X) / Ln(N);πend;ππ 8 05-28-9313:50ALL SWAG SUPPORT TEAM MATHSPD.PAS IMPORT 10 {π> I was just wondering how to speed up some math-intensiveπ> routines I've got here. For example, I've got a Functionπ> that returns the distance between two Objects:ππ> Function Dist(X1,Y1,X2,Y2 : Integer) : Real;π> beginπ> Dist := Round(Sqrt(Sqr(X1-X2)+Sqr(Y1-Y2)));π> end;ππ> This is way to slow. I know assembly can speed it up, butπ> I know nothing about as. so theres the problem. Pleaseπ> help me out, any and all source/suggestions welcome!ππX1, Y1, X2, Y2 are all Integers. Integer math is faster than Real (justπabout anything is). Sqr and Sqrt are not Integer Functions. Try forπfun...π}ππFunction Dist( X1, Y1, X2, Y2 : Integer) : Real;πVarπ XTemp,π YTemp : Integer;π{ the allocation of these takes time. if you don't want that time taken,π make them global With care}πbeginπ XTemp := X1 - X2;π YTemp := Y1 - Y2;π Dist := Sqrt(XTemp * XTemp + YTemp * YTemp);πend;ππ{πif you have a math coprocessor or a 486dx, try using DOUBLE instead ofπReal, and make sure your compiler is set to compile For 287 (or 387).π}ππbeginπ Writeln('Distance Between (3,9) and (-2,-3) is: ', Dist(3,9,-2,-3) : 6 : 2);πend. 9 05-28-9313:50ALL SWAG SUPPORT TEAM PARSMATH.PAS IMPORT 19 │I'm writing a Program that draws equations. It's fairly easy if you putπ│the equation in a pascal Variable like Y := (X+10) * 2, but I would likeπ│the user to enter the equation, but I don't see any possible way to doπ│it.πππ ...One way of doing it is by using an "expression trees". Supposeπyou have the equation Y := 20 ÷ 2 + 3. In this equation, you can representπthe expression 20 ÷ 2 + 3 by using "full" binary trees as such:πππfigure 1 a ┌─┐π │+│ <----- root of your expressionπ └─┘π b / \π ┌─┐ ┌─┐ eπ │÷│ │3│π └─┘ └─┘π / \π c ┌──┐ ┌─┐ dπ │20│ │2│π └──┘ └─┘πππ(Note: a "leaf" is a node With no left or right children - ie: a value )ππ...The above expression are called infix arithmetic expressions; theπoperators are written in between the things on which they operate.ππIn our example, the nodes are visited in the order c, d, b, e, a, andπtheir Labels in this order are 20, 2, ÷, 3, +.πππFunction Evaluate(p: node): Integer;π{ return value of the expression represented by the tree With root p }π{ p - points to the root of the expression tree }πVarπ T1, T2: Integer;π op: Char;πbeginπ if (p^.left = nil) and (p^.right = nil) then { node is a "leaf" }π Evaluate := (p^.Value) { simple Case }π elseπ beginπ T1 := Evaluate(p^.Left);π T2 := Evaluate(p^.Right);π op := p^.Label;π { apply operation }π Case op ofπ '+': Evaluate := (T1 + T2);π '-': Evaluate := (T1 - T2);π '÷': Evaluate := (T1 div T2);π '*': Evaluate := (T1 * T2);π end;π endπend;πππ...Thus, using figure 1, we have:ππ ┌── ┌──π │ │ Evaluate(c) = 20π │ Evaluate(b) │ Evaluate(d) = 2π │ │ ApplyOp('÷',20,2) = 10π Evaluate(a)│ └──π │ Evaluate(e) = 3π │π │ ApplyOp('+',10,3) = 13π └─π 10 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA1.PAS IMPORT 8 {π> Does anyone have an idea to perform permutations With pascal 7.0 ?π> As an example finding the number of 5 card hands from a total of 52 cards.π> Any help would be greatly appreciated.ππThis Program should work fine. I tested it a few times and it seemed to work.πIt lets you call the Functions For permutation and combination just as youπwould Write them: P(n,r) and C(n,r).π}ππ{$E+,N+}πProgram CombPerm;ππVarπ Result:Extended;πFunction Factorial(Num: Integer): Extended;πVarπ Counter: Integer;π Total: Extended;πbeginπ Total:=1;π For Counter:=2 to Num doπ Total:=Total * Counter;π Factorial:=Total;πend;ππFunction P(N: Integer; R: Integer): Extended;πbeginπ P:=Factorial(N)/Factorial(N-R);πend;ππFunction C(N: Integer; R: Integer): Extended;πbeginπ C:=Factorial(N)/(Factorial(N-R)*Factorial(R));πend;ππbeginπ Writeln(P(52,5));πend. 11 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA2.PAS IMPORT 18 {πI'm working on some statistical process control Charts and amπlearning/using Pascal. The current Chart Uses permutations andπI have been successful in determing the number of combinationsπpossible, but I want to be able to choose a few of those possibleπcombinations at random For testing purposes.ππThrough some trial and error, I've written the following Programπwhich calculates the number of possible combinations of x digitsπwith a certain number of digits in each combination. For exampleπa set of 12 numbers With 6 digits in each combination gives anπanswer of 924 possible combinations. After all that, here is theπquestion: Is there a Formula which would calculate what those 924πcombinations are? (ie: 1,2,3,4,5,6 then 1,2,3,4,5,7 then 1,2,3,4,5,8π... 1,2,3,4,5,12 and so on? Any help would be appreciated and anyπcriticism will be accepted.π}ππProgram permutations;ππUses Crt;ππType hold_em_here = Array[1..15] of Integer;ππVar numbers,combs,bot2a : Integer;π ans,top,bot1,bot2b : Real;π hold_Array : hold_em_here;ππFunction permutate_this(number1 : Integer) : Real;πVar i : Integer;π a : Real;πbeginπ a := number1;π For i := (number1 - 1) doWNto 1 do a := a * i;π permutate_this := a;πend;ππProcedure input_numbers(Var hold_Array : hold_em_here; counter : Integer);πVar i,j : Integer;πbeginπ For i := 1 to counter do beginπ Write(' Input #',i:2,': ');π READLN(j);π hold_Array[i] := j;π end;πend;ππProcedure show_numbers(hold_Array : hold_em_here; counter : Integer);πVar i,j : Integer;πbeginπ WriteLN;π Write('Array looks like this: ');π For i := 1 to counter do Write(hold_Array[i]:3);π WriteLNπend;ππbeginπ ClrScr;π WriteLN;π WriteLN(' Permutations');π WriteLN;π Write(' Enter number of digits (1-15): ');π READLN(numbers);π Write('Enter number in combination (2-10): ');π READLN(combs);π top := permutate_this(numbers);π bot1 := permutate_this(combs);π bot2a := numbers - combs;π bot2b := permutate_this(bot2a);π ans := top/(bot1*bot2b);π WriteLN(' total permutations For above is: ',ans:3:0);π WriteLN;π input_numbers(hold_Array,numbers);π show_numbers(hold_Array,numbers);πEND. 12 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA3.PAS IMPORT 25 {π> I want to create all permutations.ππ Okay. I should have first asked if you Really mean permutaions.π Permutations mean possible orders. I seem to recall your orginal messageπ had to do With card hands. They usually involve combinations, notπ permutations. For example, all possible poker hands are the COMBinATIONSπ of 52 cards taken 5 at a time. Bridge hands are the combinations of 52π cards taken 13 at a time. if you master the following Program, you shouldπ be able to figure out how to create all combinations instead ofπ permutations.ππ However, if you mean permutations, here is an example Program to produceπ permutations. (You will have to alter it to your initial conditions.) Itπ involves a recursive process (a process which Uses itself). Recursiveπ processes are a little dangerous. It is easy to step on your ownπ privates writing them. They also can use a lot of stack memory. Youπ ought to be able to take the same general methods to produceπ combinations instead of permutations if need be.ππ I suggest you Compile and run the Program and see all the permutationsπ appear on the screen beFore reading further. (BTW, counts permutationsπ as well as producing them and prints out the count at the end.)ππ The Procedure Permut below rotates all possible items into the firstπ Array position. For each rotation it matches the item With all possibleπ permutations of the remaining positions. Permut does this by callingπ Permut For the Array of remaining positions, which is now one itemπ smaller. When the remaining Array is down to one position, only oneπ permutaion is possible, so the current Array is written out as one ofπ the results.ππ Once you get such a Program working, it is theoretically possible toπ convert any recursive Program to a non-recursive one. This often runsπ faster. Sometimes the conversion is not easy, however.ππ One final caution. The following Program Writes to the screen. You willπ see that as the number of items increases, the amount of outputπ increases tremendously. if you were to alter the Program to Writeπ results to a File and to allow more than 9 items, you could easilyπ create a File as big as your hard drive.π}ππProgram Permutes;ππUsesπ Crt;ππTypeπ TArry = Array[1..9] of Byte;ππVarπ Arry : TArry;π Size,X : Word;π NumbofPermutaions : LongInt;ππProcedure Permut(Arry : TArry; Position,Size : Word);πVarπ I,J : Word;π Swap: Byte;πbeginπ if Position = Size thenπ{ beginπ For I := 1 to Size doπ Write(Arry[I]:1);π} inc(NumbofPermutaions)π{ Writelnπ endπ} elseπ beginπ For J := Position to Size doπ beginπ Swap := Arry[J];π Arry[J] := Arry[Position];π Arry[Position] := Swap;π Permut(Arry,Position+1,Size)π endπ endπend;ππbeginπ ClrScr;π Write('How many elements (1 to 9)? ');π readln(Size);π ClrScr;π For X := 1 to Size doπ Arry[X] := X; {put item values in Array}π NumbofPermutaions := 0;π Permut(Arry,1,Size);π Writeln;π Writeln('Number of permutations = ',NumbofPermutaions);π Writeln('Press <Enter> to Exit.');π readlnπend.π 13 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA4.PAS IMPORT 5 {π> Does anyone have an idea to perForm permutations With pascal 7.0 ?π> As an example finding the number of 5 card hands from a total of 52 carπ> Any help would be greatly appreciated.ππ}ππFunction Permutation(things, atatime : Word) : LongInt;πVarπ i : Word;π temp : LongInt;πbeginπ temp := 1;π For i := 1 to atatime doπ beginπ temp := temp * things;π dec(things);π end;π Permutation := temp;πend;ππbeginπ Writeln('7p7 = ',Permutation(7,7));πend. 14 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA5.PAS IMPORT 11 {π>it. While I'm at it, does anyone have any ideas For an algorithm to generateπ>and test all possible combinations of a group of letters For Real Words.ππI'm sure it wouldn't take long to modify this Program I wrote, whichπproduces all combinations of "n" numbers.ππI got the idea from "Algorithms", by Robert Sedgewick. Recommended.π}πProgram ShowPerms;ππUsesπ Crt;ππConstπ digits = 4; {How many digits to permute: n digits = n! perms!}ππVarπ PermArray : Array [1..digits] of Byte; {Permutation holder}π ThisDigit : Integer;ππProcedure WritePerm;πVarπ loop : Byte;πbeginπ For loop := 1 to 4 doπ Write(PermArray[loop]);π Writeln;πend;ππProcedure PermuteAtLevel(Level : Integer);πVarπ loop : Integer;ππbeginπ inc(ThisDigit);π PermArray[Level] := ThisDigit;π if ThisDigit = digits thenπ Writeperm; {if we've accounted For all digits}π For loop := 1 to digits doπ if PermArray[loop] = 0 thenπ PermuteAtLevel(loop);π dec(ThisDigit);π PermArray[Level] := 0;πend;ππbeginπ ClrScr;π ThisDigit := -1; {Left of Left-hand-side}π FillChar (PermArray, sizeof(PermArray),#0); {Make it zeroes}π PermuteAtLevel(0); {Start at the bottom}πend.π- 15 05-28-9313:50ALL SWAG SUPPORT TEAM PI1.PAS IMPORT 13 {$N+}ππProgram CalcPI(input, output);ππ{ Not the most efficient Program I've ever written. Mostly it's quick andπ dirty. The infinite series is very effective converging very quickly.π It's much better than Pi/4 = 1 - 1/3 + 1/5 - 1/7 ... which convergesπ like molasses. }ππ{ Pi / 4 = 4 * (1/5 - 1/(3*5^3) + 1/(5*5^5) - 1/(7*5^7) + ...) -π (1/239 - 1/(3*239^3) + 1/(5*239^5) - 1/(7*239^7) + ...) }ππ{* Infinite series courtesy of Machin (1680 - 1752). I found it in myπ copy of Mathematics and the Imagination by Edward Kasner andπ James R. Newman (Simon and Schuster, New York 1940, p. 77) * }ππUsesπ Crt;πππVarπ Pi_Fourths,π Pi : Double;π Temp : Double;π ct : Integer;π num : Integer;πππFunction Power(Number, Exponent : Integer) : double;πVarπ ct : Integer;π temp : double;ππbeginπ temp := 1.00;π For ct := 1 to Exponent DOπ temp := temp * number;π Power := tempπend;ππbeginπ ClrScr;π ct := 1;π num := 1;π Pi_Fourths := 0;ππ While ct < 15 DOπ beginπ Temp := (1.0 / (Power(5, num) * num)) * 4;ππ if ct MOD 2 = 1 thenπ Pi_Fourths := Pi_Fourths + Tempπ ELSEπ Pi_Fourths := Pi_Fourths - Temp;ππ Temp := 1.0 / (Power(239, num) * num);ππ if ct MOD 2 = 1 thenπ Pi_Fourths := Pi_Fourths - Tempπ ELSEπ Pi_Fourths := Pi_Fourths + Temp;ππ ct := ct + 1;π num := num + 2;π end;ππ Pi := Pi_Fourths * 4.0;π Writeln( 'PI = ', Pi);πend.π 16 05-28-9313:50ALL SWAG SUPPORT TEAM PI2.PAS IMPORT 26 {π Here's a good (but a little slow) Program to calculate theπ decimals of Pi :πππTHIS Program CompUTES THE DIGITS of PI USinG THE ARCTANGENT ForMULAπ(1) PI/4 = 4 ARCTAN 1/5 - ARCTAN 1/239πin CONJUNCTION With THE GREGorY SERIESππ(2) ARCTAN X = SUM (-1)^N*(2N + 1)^-1*X^(2N+1) N=0 to inFinITY.ππSUBSTITUTinG into (2) A FEW VALUES of N and NESTinG WE HAVE,ππPI/4 = 1/5[4/1 + 1/25[-4/3 + 1/25[4/5 + 1/25[-4/7 + ...].].]ππ - 1/239[1/1 + 1/239^2[-1/3 + 1/239^2[1/5 + 1/239^2[-1/7 +...].].]ππUSinG THE LONG divISION ALGorITHM, THIS ( NESTED ) inFinITE SERIES CAN BEπUSED to CALCULATE PI to A LARGE NUMBER of DECIMAL PLACES in A REASONABLEπAMOUNT of TIME. A TIME Function IS inCLUDED to SHOW HOW SLOW THinGSπGET WHEN N IS LARGE. IMPROVEMENTS CAN BE MADE BY CHANGinG THE SIZE ofπTHE Array ELEMENTS HOWEVER IT GETS A BIT TRICKY.ππ}ππUsesπ Crt;ππVarπ B,C,V,P1,S,K,N,I,J,Q,M,M1,X,R,D : Integer;π P,A,T : Array[0..5000] of Integer;ππConst F1=5;πConst F2=239;πProcedure divIDE(D : Integer);π beginπ R:=0;π For J:=0 to M doπ beginπ V:= R*10+P[J];π Q:=V div D;π R:=V Mod D;π P[J]:=Q;π end;πend;πProcedure divIDEA(D : Integer);π beginπ R:=0;π For J:=0 to M doπ beginπ V:= R*10+A[J];π Q:=V div D;π R:=V Mod D;π A[J]:=Q;π end;π end;πProcedure SUBT;πbeginπB:=0;πFor J:=M Downto 0 doπ if T[J]>=A[J] then T[J]:=T[J]-A[J] elseπ beginπ T[J]:=10+T[J]-A[J];π T[J-1]:=T[J-1]-1;π end;πFor J:=0 to M doπA[J]:=T[J];πend;πProcedure SUBA;πbeginπFor J:=M Downto 0 doπ if P[J]>=A[J] then P[J]:=P[J]-A[J] elseπ beginπ P[J]:=10+P[J]-A[J];π P[J-1]:=P[J-1]-1;π end;πFor J:= M Downto 0 doπA[J]:=P[J];πend;πProcedure CLEARP;π beginπ For J:=0 to M doπ P[J]:=0;π end;πProcedure ADJUST;πbeginπP[0]:=3;πP[M]:=10;πFor J:=1 to M-1 doπP[J]:=9;πend;ππProcedure ADJUST2;πbeginπP[0]:=0;πP[M]:=10;πFor J:=1 to M-1 doπP[J]:=9;πend;ππProcedure MULT4;π beginπ C:=0;π For J:=M Downto 0 doπ beginπ P1:=4*A[J]+C;π A[J]:=P1 Mod 10;π C:=P1 div 10;π end;π end;ππProcedure SAVEA;πbeginπFor J:=0 to M doπT[J]:=A[J];πend;ππProcedure TERM1;πbeginπ I:=M+M+1;π A[0]:=4;πdivIDEA(I*25);πWhile I>3 doπbeginπI:=I-2;πCLEARP;πP[0]:=4;πdivIDE(I);πSUBA;πdivIDEA(25);πend;πCLEARP;πADJUST;πSUBA;πdivIDEA(5);πSAVEA;πend;πProcedure TERM2;πbeginπ I:=M+M+1;π A[0]:=1;πdivIDEA(I);πdivIDEA(239);πdivIDEA(239);πWhile I>3 doπbeginπI:=I-2;πCLEARP;πP[0]:=1;πdivIDE(I);πSUBA;πdivIDEA(239);πdivIDEA(239);πend;πCLEARP;πADJUST2;πSUBA;πdivIDEA(239);πSUBT;πend;ππ{MAin Program}ππ beginπ ClrScr;π WriteLn(' THE CompUTATION of PI');π WriteLn(' -----------------------------');π WriteLn('inPUT NO. DECIMAL PLACES');π READLN(M1);π M:=M1+4;π For J:=0 to M doπ beginπ A[J]:=0;π T[J]:=0;π end;π TERM1;π TERM2;π MULT4;π WriteLn;WriteLn;π Write('PI = 3.');π For J:=1 to M1 doπ beginπ Write(A[J]);π if J Mod 5 =0 then Write(' ');π if J Mod 50=0 then Write(' ');π end;π WriteLn;WriteLn;π WriteLn;πend.π 17 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES1.PAS IMPORT 12 {πSAM HASINOFFππLoopNum forget who first asked this question, but here is some code to helpπyou find your prime numbers in its entirety (tested):π}ππUsesπ Crt;ππLabelπ get_out;πVarπ LoopNum,π Count,π MinPrime,π MaxPrime,π PrimeCount : Integer;π Prime : Boolean;π max : String[20];π ECode : Integer;πbeginπ minprime := 0;π maxprime := 0;ππ ClrScr;π Write('Lower limit For prime number search [1]: ');π readln(max);π val(max, minprime, ECode);ππ if (minprime < 1) thenπ minprime := 1;π Repeatπ GotoXY(1, 2);π ClrEol;π Write('Upper limit: ');π readln(max);π val(max, maxprime, ECode);π Until (maxprime > minprime);ππ WriteLn;π PrimeCount := 0;ππ For LoopNum := minprime to maxprime doπ beginπ prime := True;π Count := 2;ππ While (Count <= (LoopNum div 2)) and (Prime) doπ beginπ if (LoopNum mod Count = 0) thenπ prime := False;π Inc(Count);π end;ππ if (Prime) thenπ beginπ Write('[');π TextColor(white);π Write(LoopNum);π TextColor(lightgray);π Write('] ');π Inc(PrimeCount);π if WhereX > 75 thenπ Write(#13#10);π end;π if WhereY = 24 thenπ beginπ Write('-- More --');π ReadKey;π ClrScr;π end;π prime := False;π end;π Write(#13#10#10);π Writeln(PrimeCount, ' primes found.', #13#10);πend.π 18 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES2.PAS IMPORT 9 {πBRIAN PAPEππ> Go to the library and look up the Sieve of Eratosthenes; it's a veryπ>interesting and easy method For "finding" prime numbers in a certainπ>range - and kinda fun to Program in Pascal, I might add...π}ππProgram aristophenses_net;π{π LCCC Computer Bowl November 1992 Team members:π Brian Pape, Mike Lazar, Brian Grammer, Kristy Reed - total time: 5:31π}ππConstπ size = 5000;πVarπ b : Array [1..size] of Boolean;π i, j,π count : Integer;ππbeginπ count := 0;π Writeln;π Write('WORKING: ', ' ' : 6, '/', size : 6);π For i := 1 to 13 doπ Write(#8);π fillChar(b, sizeof(b), 1);ππ For i := 2 to size doπ if b[i] thenπ beginπ Write(i : 6, #8#8#8#8#8#8);π For j := i + 1 to size doπ if j mod i = 0 thenπ b[j] := False;π end; { For }ππ Writeln;ππ For i := 1 to size doπ if b[i] thenπ beginπ Write(i : 8);π inc(count);π end;ππ Writeln;π Write('The number of primes from 1 to ', size, ' is ', count, '.');πend.ππ 19 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES3.PAS IMPORT 40 {π Hi, to All:ππ ...While recently "tuning up" one of my Programs I'm currentlyπ working on, I ran a little test to Compare the perfomanceπ of the different versions of Turbo Pascal from 5.0 throughπ to 7.0. The results were quite suprizing, and I thought I'dπ share this With you guys/gals.ππ Here are the results of a "sieve" Program to find all the primesπ in 1 - 100,000, running on my AMI 386SX-25 CPU desktop PC:ππ CompILER EXECUTION TIME RELATIVE TIME FACtoRπ ==================================================π TP 7.0 46.7 sec 1.00π TP 6.0 137.8 sec 2.95π TP 5.5 137.5 sec 2.94π TP 5.0 137.6 sec 2.95ππ Running the same Program to find all the primes in 1 - 10,000,π running on my 8086 - 9.54 Mhz NEC V20 CPU laptop PC:ππ CompILER EXECUTION TIME RELATIVE TIME FACtoRπ ==================================================π TP 7.0 14.1 sec 1.00π TP 6.0 28.3 sec 2.00ππ notE: This would seem to indicate that the TP 7.0 386 math-π library is kicking in when run on a 386 CPU.ππ Here is the source-code to my "seive" Program:π------------------------------------------------------------------------π}π {.$DEFinE DebugMode}π {$DEFinE SaveData}ππ {$ifDEF DebugMode}π {$ifDEF VER70}π {$ifDEF DPMI}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,P+,Q+,R+,S+,T+,V+,X-}π {$else}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X-}π {$endif}π {$else}π {$ifDEF VER60}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}π {$else}π {$A+,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V+}π {$endif}π {$endif}π {$else}π {$ifDEF VER70}π {$ifDEF DPMI}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,P-,Q-,R-,S+,T-,V-,X-}π {$else}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π {$endif}π {$else}π {$ifDEF VER60}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}π {$else}π {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S+,V-}π {$endif}π {$endif}π {$endif}ππ (* Find prime numbers - Guy McLoughlin, 1993. *)πProgram Find_Primes;ππ (***** Check if a number is prime. *)π (* *)π Function Prime({input } lo_in : LongInt) : {output} Boolean;π Varπ lo_Stop,π lo_Loop : LongInt;π beginπ if (lo_in mod 2 = 0) thenπ beginπ Prime := (lo_in = 2);π Exitπ end;π if (lo_in mod 3 = 0) thenπ beginπ Prime := (lo_in = 3);π Exitπ end;ππ if (lo_in mod 5 = 0) thenπ beginπ Prime := (lo_in = 5);π Exitπ end;π lo_Stop := 7;π While ((lo_Stop * lo_Stop) <= lo_in) doπ inc(lo_Stop, 2);π lo_Loop := 7;π While (lo_Loop < lo_Stop) doπ beginπ inc(lo_Loop, 2);π if (lo_in mod lo_Loop = 0) thenπ beginπ Prime := False;π Exitπ endπ end;π Prime := Trueπ end; (* Prime. *)ππ (***** Check For File IO errors. *)π (* *)π Procedure CheckIOerror;π Varπ by_Error : Byte;π beginπ by_Error := ioresult;π if (by_Error <> 0) thenπ beginπ Writeln('File Error = ', by_Error);π haltπ endπ end; (* CheckIOerror. *)ππVarπ bo_Temp : Boolean;π wo_PrimeCount : Word;π lo_Temp,π lo_Loop : LongInt;π fite_Data : Text;ππbeginπ lo_Temp := 100000;π {$ifDEF SaveData}π {$ifDEF VER50}π assign(fite_Data, 'PRIME.50');π {$endif}π {$ifDEF VER55}π assign(fite_Data, 'PRIME.55');π {$endif}π {$ifDEF VER60}π assign(fite_Data, 'PRIME.60');π {$endif}π {$ifDEF VER70}π assign(fite_Data, 'PRIME.70');π {$endif}π {$I-}π reWrite(fite_Data);π {$I+}π CheckIOerror;π {$endif}π wo_PrimeCount := 0;π For lo_Loop := 2 to lo_Temp doπ if Prime(lo_Loop) thenπ {$ifDEF SaveData}π beginπ Write(fite_Data, lo_Loop:6);π Write(fite_Data, ', ');π inc(wo_PrimeCount);π if ((wo_PrimeCount mod 10) = 0) thenπ Writeln(fite_Data)π end;π close(fite_Data);π CheckIOerror;π {$else}π inc(wo_PrimeCount);π {$endif}π Writeln(wo_PrimeCount, ' primes between: 1 - ', lo_Temp)πend.ππ{π ...This little test would put TP 7.0's .EXE's between 2 to 3π times faster than TP4 - TP6 .EXE's. (I've found simmilar resultsπ in testing other Programs I've written.) I guess this is one moreπ reason to upgrade to TP 7.0 .ππ ...I'd be curious to see how StonyBrook's Pascal+ 6.1 Comparesπ to TP 7.0, in terms of execution speed With this Program.ππ - Guyπ}π 20 05-28-9313:50ALL SWAG SUPPORT TEAM SQRT.PAS IMPORT 13 (***** Find the square-root of an Integer between 1..2,145,635,041 *)π(* *)πFunction FindSqrt({input} lo_in : LongInt) : {output} LongInt;ππ (***** SUB : Find square-root For numbers less than 65417. *)π (* *)π Function FS1({input } wo_in : Word) : {output} Word;π Varπ wo_Temp : Word;π beginπ wo_Temp := 1;π While ((wo_Temp * wo_Temp) < wo_in) doπ inc(wo_Temp, 11);π While((wo_Temp * wo_Temp) > wo_in) doπ dec(wo_Temp);π FS1 := wo_Tempπ end; (* SUB : FS1. *)ππ (***** SUB : Find square-root For numbers greater than 65416. *)π (* *)π Function FS2(lo_in : LongInt) : LongInt;π Varπ lo_Temp : LongInt;π beginπ lo_Temp := 1;π While ((lo_Temp * lo_Temp) < lo_in) doπ inc(lo_Temp, 24);π While((lo_Temp * lo_Temp) > lo_in) doπ dec(lo_Temp);π FS2 := lo_Tempπ end; (* SUB : FS2. *)ππbeginπ if (lo_in < 64517) thenπ FindSqrt := FS1(lo_in)π elseπ FindSqrt := FS2(lo_in)πend; (* FindSqrt. *)ππ{π ...I've now re-written the "seive" Program, and it appears to nowπ run about twice as fast. I'll post the new improved source-code inπ another message.π} 21 05-31-9308:04ALL FLOOR NAAIJKENS Trig & Calc Functions IMPORT 133 ==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3162 [101] PASCALπSubj: CALC (1) Status: Publicπ------------------------------------------------------------------------------π{$O+}π{π F i l e I n f o r m a t i o nππ* DESCRIPTIONπSupplies missing trigonometric functions for Turbo Pascal 5.5. Alsoπprovides hyperbolic, logarithmic, power, and root functions. All trigπfunctions accessibile by radians, decimal degrees, degrees-minutes-secondsπand a global DegreeType.ππ}πunit PTD_Calc;ππ(* PTD_Calc - Supplies missing trigonometric functions for Turbo Pascal 5.5π * Also provides hyperbolic, logarithmic, power, and root functions.π * All trig functions accessible by radians, decimal degrees,π * degrees-minutes-seconds, and a global DegreeType. Conversionsπ * between these are supplied.π *π *)ππinterfaceππtypeπ DegreeType = recordπ Degrees, Minutes, Seconds : real;π end;πconstπ Infinity = 9.9999999999E+37;ππ{ Radians }π{ sin, cos, and arctan are predefined }ππfunction Tan( Radians : real ) : real;πfunction ArcSin( InValue : real ) : real;πfunction ArcCos( InValue : real ) : real;ππ{ Degrees, expressed as a real number }ππfunction DegreesToRadians( Degrees : real ) : real;πfunction RadiansToDegrees( Radians : real ) : real;πfunction Sin_Degree( Degrees : real ) : real;πfunction Cos_Degree( Degrees : real ) : real;πfunction Tan_Degree( Degrees : real ) : real;πfunction ArcSin_Degree( Degrees : real ) : real;πfunction ArcCos_Degree( Degrees : real ) : real;πfunction ArcTan_Degree( Degrees : real ) : real;ππ{ Degrees, in Degrees, Minutes, and Seconds, as real numbers }ππfunction DegreePartsToDegrees( Degrees, Minutes, Seconds : real ) : real;πfunction DegreePartsToRadians( Degrees, Minutes, Seconds : real ) : real;πprocedure DegreesToDegreeParts( DegreesIn : real;π var Degrees, Minutes, Seconds : real );πprocedure RadiansToDegreeParts( Radians : real;π var Degrees, Minutes, Seconds : real );πfunction Sin_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction Cos_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction Tan_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction ArcSin_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction ArcCos_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction ArcTan_DegreeParts( Degrees, Minutes, Seconds : real ) : real;ππ{ Degrees, expressed as DegreeType ( reals in record ) }ππfunction DegreeTypeToDegrees( DegreeVar : DegreeType ) : real;πfunction DegreeTypeToRadians( DegreeVar : DegreeType ) : real;πprocedure DegreeTypeToDegreeParts( DegreeVar : DegreeType;π var Degrees, Minutes, Seconds : real );πprocedure DegreesToDegreeType( Degrees : real; var DegreeVar : DegreeType );πprocedure RadiansToDegreeType( Radians : real; var DegreeVar : DegreeType );πprocedure DegreePartsToDegreeType( Degrees, Minutes, Seconds : real;π var DegreeVar : DegreeType );πfunction Sin_DegreeType( DegreeVar : DegreeType ) : real;πfunction Cos_DegreeType( DegreeVar : DegreeType ) : real;πfunction Tan_DegreeType( DegreeVar : DegreeType ) : real;πfunction ArcSin_DegreeType( DegreeVar : DegreeType ) : real;πfunction ArcCos_DegreeType( DegreeVar : DegreeType ) : real;πfunction ArcTan_DegreeType( DegreeVar : DegreeType ) : real;ππ{ Hyperbolic functions }ππfunction Sinh( Invalue : real ) : real;πfunction Cosh( Invalue : real ) : real;πfunction Tanh( Invalue : real ) : real;πfunction Coth( Invalue : real ) : real;πfunction Sech( Invalue : real ) : real;πfunction Csch( Invalue : real ) : real;πfunction ArcSinh( Invalue : real ) : real;πfunction ArcCosh( Invalue : real ) : real;πfunction ArcTanh( Invalue : real ) : real;πfunction ArcCoth( Invalue : real ) : real;πfunction ArcSech( Invalue : real ) : real;πfunction ArcCsch( Invalue : real ) : real;ππ{ Logarithms, Powers, and Roots }ππ{ e to the x is exp() }π{ natural log is ln() }πfunction Log10( InNumber : real ) : real;πfunction Log( Base, InNumber : real ) : real; { log of any base }πfunction Power( InNumber, Exponent : real ) : real;πfunction Root( InNumber, TheRoot : real ) : real;πππ{----------------------------------------------------------------------}πimplementationππconstπ RadiansPerDegree = 0.017453292520;π DegreesPerRadian = 57.295779513;π MinutesPerDegree = 60.0;π SecondsPerDegree = 3600.0;π SecondsPerMinute = 60.0;π LnOf10 = 2.3025850930;ππ{-----------}π{ Radians }π{-----------}ππ{ sin, cos, and arctan are predefined }ππfunction Tan { ( Radians : real ) : real };π { note: returns Infinity where appropriate }π varπ CosineVal : real;π TangentVal : real;π beginπ CosineVal := cos( Radians );π if CosineVal = 0.0 thenπ Tan := Infinityπ elseπ beginπ TangentVal := sin( Radians ) / CosineVal;π if ( TangentVal < -Infinity ) or ( TangentVal > Infinity ) thenπ Tan := Infinityπ elseπ Tan := TangentVal;π end;π end;ππfunction ArcSin{ ( InValue : real ) : real };π { notes: 1) exceeding input range of -1 through +1 will cause runtime error }π { 2) only returns principal values }π { ( -pi/2 through pi/2 radians ) ( -90 through +90 degrees ) }π beginπ if abs( InValue ) = 1.0 thenπ ArcSin := pi / 2.0π elseπ ArcSin := arctan( InValue / sqrt( 1 - InValue * InValue ) );π end;ππfunction ArcCos{ ( InValue : real ) : real };π { notes: 1) exceeding input range of -1 through +1 will cause runtime error }π { 2) only returns principal values }π { ( 0 through pi radians ) ( 0 through +180 degrees ) }π varπ Result : real;π beginπ if InValue = 0.0 thenπ ArcCos := pi / 2.0π elseπ beginπ Result := arctan( sqrt( 1 - InValue * InValue ) / InValue );π if InValue < 0.0 thenπ ArcCos := Result + piπ elseπ ArcCos := Result;π end;π end;ππ{---------------------------------------}π{ Degrees, expressed as a real number }π{---------------------------------------}ππfunction DegreesToRadians{ ( Degrees : real ) : real };π beginπ DegreesToRadians := Degrees * RadiansPerDegree;π end;ππfunction RadiansToDegrees{ ( Radians : real ) : real };π beginπ RadiansToDegrees := Radians * DegreesPerRadian;π end;ππfunction Sin_Degree{ ( Degrees : real ) : real };π beginπ Sin_Degree := sin( DegreesToRadians( Degrees ) );π end;ππfunction Cos_Degree{ ( Degrees : real ) : real };π beginπ Cos_Degree := cos( DegreesToRadians( Degrees ) );π end;ππfunction Tan_Degree{ ( Degrees : real ) : real };π beginπ Tan_Degree := Tan( DegreesToRadians( Degrees ) );ππ<ORIGINAL MESSAGE OVER 200 LINES, SPLIT IN 2 OR MORE>π==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3163 [101] PASCALπSubj: CALC (1) <CONT> Status: Publicπ------------------------------------------------------------------------------π end;ππfunction ArcSin_Degree{ ( Degrees : real ) : real };π beginπ ArcSin_Degree := ArcSin( DegreesToRadians( Degrees ) );π end;ππfunction ArcCos_Degree{ ( Degrees : real ) : real };π beginπ ArcCos_Degree := ArcCos( DegreesToRadians( Degrees ) );π end;ππfunction ArcTan_Degree{ ( Degrees : real ) : real };π beginπ ArcTan_Degree := arctan( DegreesToRadians( Degrees ) );π end;ππ--- D'Bridge 1.30 demo/922115π * Origin: EURO-ONLINE Home of The Fast Commander (2:500/233)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3164 [101] PASCALπSubj: CALC (2) Status: Publicπ------------------------------------------------------------------------------ππ{--------------------------------------------------------------}π{ Degrees, in Degrees, Minutes, and Seconds, as real numbers }π{--------------------------------------------------------------}ππfunction DegreePartsToDegrees{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ DegreePartsToDegrees := Degrees + ( Minutes / MinutesPerDegree ) +π ( Seconds / SecondsPerDegree );π end;ππfunction DegreePartsToRadians{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ DegreePartsToRadians := DegreesToRadians( DegreePartsToDegrees( Degrees,π Minutes, Seconds ) );π end;ππprocedure DegreesToDegreeParts{ ( DegreesIn : real;π var Degrees, Minutes, Seconds : real ) };π beginπ Degrees := int( DegreesIn );π Minutes := ( DegreesIn - Degrees ) * MinutesPerDegree;π Seconds := frac( Minutes );π Minutes := int( Minutes );π Seconds := Seconds * SecondsPerMinute;π end;ππprocedure RadiansToDegreeParts{ ( Radians : real;π var Degrees, Minutes, Seconds : real ) };π beginπ DegreesToDegreeParts( RadiansToDegrees( Radians ),π Degrees, Minutes, Seconds );π end;ππfunction Sin_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ Sin_DegreeParts := sin( DegreePartsToRadians( Degrees, Minutes, Seconds ) );π end;ππfunction Cos_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ Cos_DegreeParts := cos( DegreePartsToRadians( Degrees, Minutes, Seconds ) );π end;ππfunction Tan_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ Tan_DegreeParts := Tan( DegreePartsToRadians( Degrees, Minutes, Seconds ) );π end;ππfunction ArcSin_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ ArcSin_DegreeParts := ArcSin( DegreePartsToRadians( Degrees,π Minutes, Seconds ) );π end;ππfunction ArcCos_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ ArcCos_DegreeParts := ArcCos( DegreePartsToRadians( Degrees,π Minutes, Seconds ) );π end;ππfunction ArcTan_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ ArcTan_DegreeParts := arctan( DegreePartsToRadians( Degrees,π Minutes, Seconds ) );π end;ππ{-------------------------------------------------------}π{ Degrees, expressed as DegreeType ( reals in record ) }π{-------------------------------------------------------}ππfunction DegreeTypeToDegrees{ ( DegreeVar : DegreeType ) : real };π beginπ DegreeTypeToDegrees := DegreePartsToDegrees( DegreeVar.Degrees,π DegreeVar.Minutes, DegreeVar.Seconds );π end;ππfunction DegreeTypeToRadians{ ( DegreeVar : DegreeType ) : real };π beginπ DegreeTypeToRadians := DegreesToRadians( DegreeTypeToDegrees( DegreeVar ) );π end;ππprocedure DegreeTypeToDegreeParts{ ( DegreeVar : DegreeType;π var Degrees, Minutes, Seconds : real ) };π beginπ Degrees := DegreeVar.Degrees;π Minutes := DegreeVar.Minutes;π Seconds := DegreeVar.Seconds;π end;ππprocedure DegreesToDegreeType{ ( Degrees : real; var DegreeVar : DegreeType )};π beginπ DegreesToDegreeParts( Degrees, DegreeVar.Degrees,π DegreeVar.Minutes, DegreeVar.Seconds );π end;ππprocedure RadiansToDegreeType{ ( Radians : real; var DegreeVar : DegreeType )};π beginπ DegreesToDegreeParts( RadiansToDegrees( Radians ), DegreeVar.Degrees,π DegreeVar.Minutes, DegreeVar.Seconds );π end;ππprocedure DegreePartsToDegreeType{ ( Degrees, Minutes, Seconds : real;π var DegreeVar : DegreeType ) };π beginπ DegreeVar.Degrees := Degrees;π DegreeVar.Minutes := Minutes;π DegreeVar.Seconds := Seconds;π end;ππfunction Sin_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ Sin_DegreeType := sin( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction Cos_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ Cos_DegreeType := cos( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction Tan_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ Tan_DegreeType := Tan( DegreeTypeToRadians( DegreeVar ) );π end;ππ--- D'Bridge 1.30 demo/922115π * Origin: EURO-ONLINE Home of The Fast Commander (2:500/233)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3165 [101] PASCALπSubj: CALC (3) Status: Publicπ------------------------------------------------------------------------------πfunction ArcSin_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ ArcSin_DegreeType := ArcSin( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction ArcCos_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ ArcCos_DegreeType := ArcCos( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction ArcTan_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ ArcTan_DegreeType := arctan( DegreeTypeToRadians( DegreeVar ) );π end;ππ{------------------------}π{ Hyperbolic functions }π{------------------------}ππfunction Sinh{ ( Invalue : real ) : real };π constπ MaxValue = 88.029691931; { exceeds standard turbo precision }π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π if Invalue > MaxValue thenπ Sinh := Infinityπ elseπ Sinh := ( exp( Invalue ) - exp( -Invalue ) ) / 2.0 * Sign;π end;ππfunction Cosh{ ( Invalue : real ) : real };π constπ MaxValue = 88.029691931; { exceeds standard turbo precision }π beginπ Invalue := abs( Invalue );π if Invalue > MaxValue thenπ Cosh := Infinityπ elseπ Cosh := ( exp( Invalue ) + exp( -Invalue ) ) / 2.0;π end;ππfunction Tanh{ ( Invalue : real ) : real };π beginπ Tanh := Sinh( Invalue ) / Cosh( Invalue );π end;ππfunction Coth{ ( Invalue : real ) : real };π beginπ Coth := Cosh( Invalue ) / Sinh( Invalue );π end;ππfunction Sech{ ( Invalue : real ) : real };π beginπ Sech := 1.0 / Cosh( Invalue );π end;ππfunction Csch{ ( Invalue : real ) : real };π beginπ Csch := 1.0 / Sinh( Invalue );π end;ππfunction ArcSinh{ ( Invalue : real ) : real };π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π ArcSinh := ln( Invalue + sqrt( Invalue*Invalue + 1 ) ) * Sign;π end;ππfunction ArcCosh{ ( Invalue : real ) : real };π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π ArcCosh := ln( Invalue + sqrt( Invalue*Invalue - 1 ) ) * Sign;π end;ππfunction ArcTanh{ ( Invalue : real ) : real };π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π ArcTanh := ln( ( 1 + Invalue ) / ( 1 - Invalue ) ) / 2.0 * Sign;π end;ππfunction ArcCoth{ ( Invalue : real ) : real };π beginπ ArcCoth := ArcTanh( 1.0 / Invalue );π end;ππfunction ArcSech{ ( Invalue : real ) : real };π beginπ ArcSech := ArcCosh( 1.0 / Invalue );π end;ππfunction ArcCsch{ ( Invalue : real ) : real };π beginπ ArcCsch := ArcSinh( 1.0 / Invalue );π end;ππ{---------------------------------}π{ Logarithms, Powers, and Roots }π{---------------------------------}ππ{ e to the x is exp() }π{ natural log is ln() }ππfunction Log10{ ( InNumber : real ) : real };π beginπ Log10 := ln( InNumber ) / LnOf10;π end;ππfunction Log{ ( Base, InNumber : real ) : real }; { log of any base }π beginπ Log := ln( InNumber ) / ln( Base );π end;ππfunction Power{ ( InNumber, Exponent : real ) : real };π beginπ if InNumber > 0.0 thenπ Power := exp( Exponent * ln( InNumber ) )π else if InNumber = 0.0 thenπ Power := 1.0π else { WE DON'T force a runtime error, we define a function to provideπ negative logarithms! }π If Exponent=Trunc(Exponent) Thenπ Power := (-2*(Trunc(Exponent) Mod 2)+1) * Exp(Exponent * Ln( -InNumber ) )π Else Power := Trunc(1/(Exponent-Exponent));π { NOW WE generate a runtime error }π end;ππfunction Root{ ( InNumber, TheRoot : real ) : real };π beginπ Root := Power( InNumber, ( 1.0 / TheRoot ) );π end;ππend. { unit PTD_Calc }ππππππP.S. Enjoy yourself!ππ--- D'Bridge 1.30 demo/922115π * Origin: EURO-ONLINE Home of The Fast Commander (2:500/233)π 22 06-22-9309:14ALL SWAG SUPPORT TEAM Factoral Program IMPORT 35 PROGRAM Fact;π{************************************************π* FACTOR - Lookup table demonstration using the *π* factorial series. *π* *π*************************************************}ππ{$N+,E+} {Set so you can use other real types}πUSES Crt,Dos,Timer; { t1Start, t1Get, t1Format }πCONSTπ BigFact = 500; {largest factorial is for 1754}πTYPE {defined type for file definition later}π TableType = ARRAY [0..BigFact] OF Extended;πVARπ Table : TableType;ππ{************************************************π* factorial - compute the factorial of a number *π* *π* INP: i - the # to compute the factorial of *π* OUT: The factorial of the number, unless a *π* number greater than BIG_FACT or less *π* than zero is passed in (which results *π* in 0.0). *π*************************************************}ππFUNCTION Factorial(I: Integer): Extended;πVARπ K : Integer;π F : Extended;πBEGINπ IF I = 0 THENπ F := 1π ELSEπ BEGINπ IF (I > 0) AND (I <= BigFact) THENπ BEGINπ F := 1;π FOR K := 1 TO I DOπ F := F * Kπ ENDπ ELSEπ F := 0π END;π Factorial := FπEND;ππ{************************************************π* Main - generate & save table of factorials *π*************************************************}ππVARπ I, J, N : Integer;π F : Extended;π T1, T2, T3 : Longint;π Facts : FILE OF TableType;πBEGINπ { STEP 1 - compute each factorial 5 times }π ClrScr;π WriteLn('Now computing each factorial 5 times');π T1 := tStart;π FOR I :=0 TO 4 DOπ FOR J := 0 TO BigFact DOπ F := Factorial(J); { f=j! }π T2 := tGet;π WriteLn('Computing all factorials from 0..n ');π WriteLn('5 times took ',tFormat(T1,T2),π ' secs.');π WriteLn;π { STEP 2 - compute the table, then look upπ each factorial 5 times. }π WriteLn('Now compute table and look up each ',π 'factorial 5 times.');π T1 := tStart;π FOR I := 0 TO BigFact DOπ Table[I] := Factorial(I);π T2 := tGet;π FOR I := 0 TO 4 DOπ FOR J :=0 TO BigFact DOπ F := Table[J]; { f=j! }π T3 := tGet;π WriteLn('Computing table took ',tFormat(T1,T2),π ' seconds');π WriteLn('Looking up each factorial 5 times to',π 'ok ',tFormat(T2,T3),' seconds');π WriteLn('Total: ',tFormat(T1,T3),' seconds');π WriteLn;π{STEP 3 - Compute each factorial as it is needed}π WriteLn('Clearing the table,',π ' and computing each ');π WriteLn('factorial as it is needed',π ' (for 5) lookups.');π WriteLn;π T1 := tStart;π FOR I := 0 TO BigFact DOπ Table[I] := -1; { unknown Val }π FOR I := 0 TO 4 DOπ FOR J := 0 TO BigFact DOπ BEGINπ F := Table[J];π IF F < 0 THENπ BEGINπ F := Factorial(J);π Table[J] := F { F = J! }π ENDπ END;π T2 := tGet;π WriteLn('Clearing table and computing each');π WriteLn(' factorial as it was needed for 5');π WriteLn('lookups took ',tFormat(T1,T2),π ' secs.');π { STEP 4 - write the table to disk (we areπ not timing this step, because if you areπ loading it from disk, you presumably do notπ care how long it took to compute it. }π Assign(Facts,'Fact_tbl.tmp');π Rewrite(Facts);π Write(Facts,Table);π Close(Facts);π { Flush the disk buffer, so that the timeπ is not affected by having the data in aπ disk buffer. }π Exec('C:\COMMAND.COM','/C CHKDSK');π { STEP 5 - read the table from disk, andπ use each factorial 5 times }π T1 := tStart;π Assign(Facts,'Fact_tbl.TMP');π Reset(Facts);π Read(Facts,Table);π Close(Facts);π T2 := tGet;π FOR I := 0 TO 4 DOπ FOR J :=0 TO BigFact DOπ F := Table[J]; { f=j! }π T3 := tGet;π WriteLn('Reading the Table from disk took ',π tFormat(T1,T2),' seconds.');π WriteLn('Looking up each Factorial 5 times ',π 'to ok took ',tFormat(T2,T3),' seconds.');π WriteLn('Total: ',tFormat(T1,T3),' seconds.');π WriteLn;π WriteLn('Press Enter TO see the factorials');π ReadLN;π FOR I:=0 TO BigFact DOπ WriteLn('[',I,'] = ',Table[I]);πend.π 23 07-17-9307:28ALL GAYLE DAVIS Math Conversion Unit IMPORT 64 ₧ { MATH Unit for various conversions }π{$DEFINE Use8087} { define this for EXTENDED 8087 floating point math }ππUNIT MATH;ππ{$IFDEF Use8087}π{$N+}π{$ELSEπ{$N-}π{$ENDIF}ππINTERFACEππTYPEπ {$IFDEF Use8087}π FLOAT = EXTENDED;π {$ELSE}π FLOAT = REAL;π {$ENDIF}ππFUNCTION FahrToCent(FahrTemp: FLOAT): FLOAT;πFUNCTION CentToFahr(CentTemp: FLOAT): FLOAT;πFUNCTION KelvToCent(KelvTemp: FLOAT): FLOAT;πFUNCTION CentToKelv(CentTemp: FLOAT): FLOAT;πPROCEDURE InchToFtIn(Inches: FLOAT; VAR ft,ins: FLOAT);πFUNCTION FtInToInch(ft,ins: FLOAT): FLOAT;πFUNCTION InchToYard(Inches: FLOAT): FLOAT;πFUNCTION YardToInch(Yards: FLOAT): FLOAT;πFUNCTION InchToMile(Inches: FLOAT): FLOAT;πFUNCTION MileToInch(Miles: FLOAT): FLOAT;πFUNCTION InchToNautMile(Inches: FLOAT): FLOAT;πFUNCTION NautMileToInch(NautMiles: FLOAT): FLOAT;πFUNCTION InchToMeter(Inches: FLOAT): FLOAT;πFUNCTION MeterToInch(Meters: FLOAT): FLOAT;πFUNCTION SqInchToSqFeet(SqInches: FLOAT): FLOAT;πFUNCTION SqFeetToSqInch(SqFeet: FLOAT): FLOAT;πFUNCTION SqInchToSqYard(SqInches: FLOAT): FLOAT;πFUNCTION SqYardToSqInch(SqYards: FLOAT): FLOAT;πFUNCTION SqInchToSqMile(SqInches: FLOAT): FLOAT;πFUNCTION SqMileToSqInch(SqMiles: FLOAT): FLOAT;πFUNCTION SqInchToAcre(SqInches: FLOAT): FLOAT;πFUNCTION AcreToSqInch(Acres: FLOAT): FLOAT;πFUNCTION SqInchToSqMeter(SqInches: FLOAT): FLOAT;πFUNCTION SqMeterToSqInch(SqMeters: FLOAT): FLOAT;πFUNCTION CuInchToCuFeet(CuInches: FLOAT): FLOAT;πFUNCTION CuFeetToCuInch(CuFeet: FLOAT): FLOAT;πFUNCTION CuInchToCuYard(CuInches: FLOAT): FLOAT;πFUNCTION CuYardToCuInch(CuYards: FLOAT): FLOAT;πFUNCTION CuInchToCuMeter(CuInches: FLOAT): FLOAT;πFUNCTION CuMeterToCuInch(CuMeters: FLOAT): FLOAT;πFUNCTION FluidOzToPint(FluidOz: FLOAT): FLOAT;πFUNCTION PintToFluidOz(Pints: FLOAT): FLOAT;πFUNCTION FluidOzToImpPint(FluidOz: FLOAT): FLOAT;πFUNCTION ImpPintToFluidOz(ImpPints: FLOAT): FLOAT;πFUNCTION FluidOzToGals(FluidOz: FLOAT): FLOAT;πFUNCTION GalsToFluidOz(Gals: FLOAT): FLOAT;πFUNCTION FluidOzToImpGals(FluidOz: FLOAT): FLOAT;πFUNCTION ImpGalsToFluidOz(ImpGals: FLOAT): FLOAT;πFUNCTION FluidOzToCuMeter(FluidOz: FLOAT): FLOAT;πFUNCTION CuMeterToFluidOz(CuMeters: FLOAT): FLOAT;πPROCEDURE OunceToLbOz(Ounces: FLOAT; VAR lb,oz: FLOAT);πFUNCTION LbOzToOunce(lb,oz: FLOAT): FLOAT;πFUNCTION OunceToTon(Ounces: FLOAT): FLOAT;πFUNCTION TonToOunce(Tons: FLOAT): FLOAT;πFUNCTION OunceToLongTon(Ounces: FLOAT): FLOAT;πFUNCTION LongTonToOunce(LongTons: FLOAT): FLOAT;πFUNCTION OunceToGram(Ounces: FLOAT): FLOAT;πFUNCTION GramToOunce(Grams: FLOAT): FLOAT;ππππIMPLEMENTATIONππ{ Temperature conversion }ππFUNCTION FahrToCent(FahrTemp: FLOAT): FLOAT;ππ BEGINπ FahrToCent:=(FahrTemp+40.0)*(5.0/9.0)-40.0;π END;πππFUNCTION CentToFahr(CentTemp: FLOAT): FLOAT;ππ BEGINπ CentToFahr:=(CentTemp+40.0)*(9.0/5.0)-40.0;π END;πππFUNCTION KelvToCent(KelvTemp: FLOAT): FLOAT;ππ BEGINπ KelvToCent:=KelvTemp-273.16;π END;πππFUNCTION CentToKelv(CentTemp: FLOAT): FLOAT;ππ BEGINπ CentToKelv:=CentTemp+273.16;π END;ππππ{ Linear measurement conversion }ππPROCEDURE InchToFtIn(Inches: FLOAT; VAR ft,ins: FLOAT);ππ BEGINπ ft:=INT(Inches/12.0);π ins:=Inches-ft*12.0;π END;πππFUNCTION FtInToInch(ft,ins: FLOAT): FLOAT;ππ BEGINπ FtInToInch:=ft*12.0+ins;π END;πππFUNCTION InchToYard(Inches: FLOAT): FLOAT;ππ BEGINπ InchToYard:=Inches/36.0;π END;πππFUNCTION YardToInch(Yards: FLOAT): FLOAT;ππ BEGINπ YardToInch:=Yards*36.0;π END;πππFUNCTION InchToMile(Inches: FLOAT): FLOAT;ππ BEGINπ InchToMile:=Inches/63360.0;π END;πππFUNCTION MileToInch(Miles: FLOAT): FLOAT;ππ BEGINπ MileToInch:=Miles*63360.0;π END;πππFUNCTION InchToNautMile(Inches: FLOAT): FLOAT;ππ BEGINπ InchToNautMile:=Inches/72960.0;π END;πππFUNCTION NautMileToInch(NautMiles: FLOAT): FLOAT;ππ BEGINπ NautMileToInch:=NautMiles*72960.0;π END;πππFUNCTION InchToMeter(Inches: FLOAT): FLOAT;ππ BEGINπ InchToMeter:=Inches*0.0254;π END;πππFUNCTION MeterToInch(Meters: FLOAT): FLOAT;ππ BEGINπ MeterToInch:=Meters/0.0254;π END;ππππ{ Area conversion }ππFUNCTION SqInchToSqFeet(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqFeet:=SqInches/144.0;π END;πππFUNCTION SqFeetToSqInch(SqFeet: FLOAT): FLOAT;ππ BEGINπ SqFeetToSqInch:=SqFeet*144.0;π END;πππFUNCTION SqInchToSqYard(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqYard:=SqInches/1296.0;π END;πππFUNCTION SqYardToSqInch(SqYards: FLOAT): FLOAT;ππ BEGINπ SqYardToSqInch:=SqYards*1296.0;π END;πππFUNCTION SqInchToSqMile(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqMile:=SqInches/4.0144896E9;π END;πππFUNCTION SqMileToSqInch(SqMiles: FLOAT): FLOAT;ππ BEGINπ SqMileToSqInch:=SqMiles*4.0144896E9;π END;πππFUNCTION SqInchToAcre(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToAcre:=SqInches/6272640.0;π END;πππFUNCTION AcreToSqInch(Acres: FLOAT): FLOAT;ππ BEGINπ AcreToSqInch:=Acres*6272640.0;π END;πππFUNCTION SqInchToSqMeter(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqMeter:=SqInches/1550.016;π END;πππFUNCTION SqMeterToSqInch(SqMeters: FLOAT): FLOAT;ππ BEGINπ SqMeterToSqInch:=SqMeters*1550.016;π END;ππππ{ Volume conversion }ππFUNCTION CuInchToCuFeet(CuInches: FLOAT): FLOAT;ππ BEGINπ CuInchToCuFeet:=CuInches/1728.0;π END;πππFUNCTION CuFeetToCuInch(CuFeet: FLOAT): FLOAT;ππ BEGINπ CuFeetToCuInch:=CuFeet*1728.0;π END;πππFUNCTION CuInchToCuYard(CuInches: FLOAT): FLOAT;ππ BEGINπ CuInchToCuYard:=CuInches/46656.0;π END;πππFUNCTION CuYardToCuInch(CuYards: FLOAT): FLOAT;ππ BEGINπ CuYardToCuInch:=CuYards*46656.0;π END;πππFUNCTION CuInchToCuMeter(CuInches: FLOAT): FLOAT;ππ BEGINπ CuInchToCuMeter:=CuInches/61022.592;π END;πππFUNCTION CuMeterToCuInch(CuMeters: FLOAT): FLOAT;ππ BEGINπ CuMeterToCuInch:=CuMeters*61022.592;π END;πππ{ Liquid measurement conversion }ππFUNCTION FluidOzToPint(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToPint:=FluidOz/16.0;π END;πππFUNCTION PintToFluidOz(Pints: FLOAT): FLOAT;ππ BEGINπ PintToFluidOz:=Pints*16.0;π END;πππFUNCTION FluidOzToImpPint(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToImpPint:=FluidOz/20.0;π END;πππFUNCTION ImpPintToFluidOz(ImpPints: FLOAT): FLOAT;ππ BEGINπ ImpPintToFluidOz:=ImpPints*20.0;π END;πππFUNCTION FluidOzToGals(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToGals:=FluidOz/128.0;π END;πππFUNCTION GalsToFluidOz(Gals: FLOAT): FLOAT;ππ BEGINπ GalsToFluidOz:=Gals*128.0;π END;πππFUNCTION FluidOzToImpGals(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToImpGals:=FluidOz/160.0;π END;πππFUNCTION ImpGalsToFluidOz(ImpGals: FLOAT): FLOAT;ππ BEGINπ ImpGalsToFluidOz:=ImpGals*160.0;π END;πππFUNCTION FluidOzToCuMeter(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToCuMeter:=FluidOz/33820.0;π END;πππFUNCTION CuMeterToFluidOz(CuMeters: FLOAT): FLOAT;ππ BEGINπ CuMeterToFluidOz:=CuMeters*33820.0;π END;πππ{ Weight conversion }ππPROCEDURE OunceToLbOz(Ounces: FLOAT; VAR lb,oz: FLOAT);ππ BEGINπ lb:=INT(Ounces/16.0);π oz:=Ounces-lb*16.0;π END;πππFUNCTION LbOzToOunce(lb,oz: FLOAT): FLOAT;ππ BEGINπ LbOzToOunce:=lb*16.0+oz;π END;πππFUNCTION OunceToTon(Ounces: FLOAT): FLOAT;ππ BEGINπ OunceToTon:=Ounces/32000.0;π END;πππFUNCTION TonToOunce(Tons: FLOAT): FLOAT;ππ BEGINπ TonToOunce:=Tons*32000.0;π END;πππFUNCTION OunceToLongTon(Ounces: FLOAT): FLOAT;ππ BEGINπ OunceToLongTon:=Ounces/35840.0;π END;πππFUNCTION LongTonToOunce(LongTons: FLOAT): FLOAT;ππ BEGINπ LongTonToOunce:=LongTons*35840.0;π END;πππFUNCTION OunceToGram(Ounces: FLOAT): FLOAT;ππ BEGINπ OunceToGram:=Ounces*28.35;π END;πππFUNCTION GramToOunce(Grams: FLOAT): FLOAT;ππ BEGINπ GramToOunce:=Grams/28.35;π END;πππEND.ππ 24 08-27-9321:17ALL LOU DUCHEZ Factoring Program IMPORT 8 ₧ {LOU DUCHEZππ> Could anybody explain how to Write such a routine in Pascal?ππHere's a dorky little "Factoring" Program I wrote to display the factorsπof a number:π}ππProgram factors;πVarπ lin,π lcnt : LongInt;πbeginπ Write('Enter number to factor: ');π readln(lin);π lcnt := 2;π While lcnt * lcnt <= lin doπ beginπ if lin mod lcnt = 0 thenπ Writeln('Factors:', lcnt : 9, (lin div lcnt) : 9);π lcnt := lcnt + 1;π end;πend.ππ{πNotice that I only check For factors up to the square root of the numberπTyped in. Also, notice the "mod" operator: gives the remainder of Integerπdivision ("div" gives the Integer result of division).ππNot Really knowing exactly what you want to accomplish, I don't Really knowπif the above is of much help. But what the hey.π} 25 08-27-9321:29ALL SEAN PALMER Dividing Fixed Integers IMPORT 12 ₧ {πSEAN PALMERππI'm using TP. Here are the fixed division routines I'm currently usingπ(they are, as you can see, quite specialized)ππI had to abandon the original fixed division routines because I didn'tπknow how to translate the 386-specific instructions using DB. (MOVSX,πSHLD, etc)π}ππtypeπ fixed = recordπ f : word;π i : integer;π end;ππ shortFixed = recordπ f : byte;π i : shortint;π end;ππ{ this one divides a fixed by a fixed, result is fixed needs 386 }ππfunction fixedDiv(d1, d2 : longint) : longint; assembler;πasmπ db $66; xor dx, dxπ mov cx, word ptr D1 + 2π or cx, cxπ jns @Sπ db $66; dec dxπ @S:π mov dx, cxπ mov ax, word ptr D1π db $66; shl ax, 16π db $66; idiv word ptr d2π db $66; mov dx, axπ db $66; shr dx, 16πend;ππ{ this one divides a longint by a longint, result is fixed needs 386 }ππfunction div2Fixed(d1, d2 : longint) : longint; assembler;πasmπ db $66; xor dx, dxπ db $66; mov ax, word ptr d1π db $66; shl ax, 16π jns @S;π db $66; dec dxπ @S:π db $66; idiv word ptr d2π db $66; mov dx, axπ db $66; shr dx, 16πend;ππ{ this one divides an integer by and integer, result is shortFixed }ππfunction divfix(d1, d2 : integer) : integer; assembler;πasmπ mov al, byteπ ptr d1 + 1π cbwπ mov dx, axπ xor al, alπ mov ah, byte ptr d1π idiv d2πend;πππ 26 08-27-9321:34ALL DJ MURDOCH Matrix Math IMPORT 33 ₧ {πDJ MURDOCHππ>The solution I use For dynamic Objects (I don't have any Complex code) isπ>to keep a counter in each matrix Record; every Function decrements theπ>counter, and when it reaches 0, disposes of the Object. if you need toπ>use an Object twice, you increment the counter once before using it.ππ> if you allocate an Object twice, how do you get the first address back intoπ> the Pointer Variable so it can be disposed? I must not understand theπ> problem. if I do:ππ> new(p); new(p);ππ> Unless I save the value of the first p, how can I dispose it? And if Iπ> save it, why not use two Pointer Variables, p1 and p2, instead?ππYou're right, there's no way to dispose of the first p^. What I meant isπsomething like this: Suppose X and Y are Pointers to matrix Objects. if Iπwant to calculate Z as their product, and don't have any need For them anyπmore, then it's fine if MatMul disposes of them inππ Z := MatMul(X,Y);ππIn fact, it's Really handy, because it lets me calculate X Y Z asππ W := MatMul(X, MatMul(Y,Z));ππThe problem comes up when I try to calculate something like X^2, because MatMulπwould get in trouble trying to dispose of X twice inππ Y := MatMul(X, X);ππThe solution I use is to keep a counter in every Object, and to follow a rigidπdiscipline:ππ 1. Newly created Objects (Function results) always have the counter set toπ zero.ππ 2. Every Function which takes a Pointer to one of these Objects as anπ argument is sure to "touch" the Pointer, by passing it exactly once toπ another Function. (There's an exception below that lets you pass it moreπ than once if you need to.)ππ3. if a Function doesn't need to pass the Object to another Function, thenπ it passes it to the special Function "Touch()", to satisfy rule 2.π Touch checks the counter; if it's zero, it disposes of the Object,π otherwise, it decrements it by one.ππ4. The way to get around the "exactly once" rule 2 is to call the "Protect"π Function before you pass the Object. This just increments the counter.ππ5. Functions should never change Objects being passed to them as arguments;π there's a Function called "Local" which makes a local copy to work on ifπ you need it. What Local does is to check the counter; if it's zero,π Local just returns the original Object, otherwise it asks the Object toπ make a copy of itself.ππFor example, to do the line above safely, I'd code it asππ Y := MatMul(X, Protect(X));ππMatMul would look something like this:π}ππFunction MatMul(Y, Z : PMatrix) : PMatrix;πVarπ result : PMatrix;πbeginπ { Allocate result, fill in the values appropriately, then }π Touch(Y);π Touch(Z);π MatMul := result;πend;ππ{πThe first Touch would just decrement the counter in X, and the second wouldπdispose of it (assuming it wasn't already protected before the creation of Y).ππI've found that this system works Really well, and I can sleep at night,πknowing that I never leave dangling Pointers even though I'm doing lots ofπallocations and deallocations.ππHere, in Case you're interested, is the Real matrix multiplier:π}ππFunction MProd(x, y : PMatrix) : PMatrix;π{ Calculate the matrix product of x and y }πVarπ result : PMatrix;π i, j, k : Word;π mp : PFloat;πbeginπ if (x = nil) or (y = nil) or (x^.cols <> y^.rows) thenπ MProd := nilπ elseπ beginπ result := Matrix(x^.rows, y^.cols, nil, True);π if result <> nil thenπ With result^ doπ beginπ For i := 1 to rows doπ With x^.r^[i]^ doπ For j := 1 to cols doπ beginπ mp := pval(i,j);π mp^ := 0;π For k := 1 to x^.cols doπ mp^ := mp^ + c[k] * y^.r^[k]^.c[j];π end;π end;π MProd := result;π Touch(x);π Touch(y);π end;πend;ππ{πAs you can see, the memory allocation is a pretty minor part of it. Theπdynamic indexing is Really ugly (I'd like to use "y[k,j]", but I'm stuck usingπ"y^.r^[k]^.c[j]"), but I haven't found any way around that.π}ππ 27 08-27-9321:45ALL MICHAEL BYRNE Prime Numbers IMPORT 7 ₧ {πMICHAEL M. BYRNEππ> the way, it took about 20 mins. on my 386/40 to get prime numbersπ> through 20000. I tried to come up With code to do the same Withπ> Turbo but it continues to elude me. Could anybody explainπ> how to Write such a routine in Pascal?ππHere is a simple Boolean Function For you to work With.π}ππFunction Prime(N : Integer) : Boolean;π{Returns True if N is a prime; otherwise returns False. Precondition: N > 0.}πVarπ I : Integer;πbeginπ if N = 1 thenπ Prime := Falseπ elseπ if N = 2 thenπ Prime := Trueπ elseπ begin { N > 2 }π Prime := True; {tentatively}π For I := 2 to N - 1 doπ if (N mod I = 0) thenπ Prime := False;π end; { N > 2 }πend;π 28 08-27-9321:45ALL JONATHAN WRITE More Prime Numbers IMPORT 9 ₧ {πJONATHAN WRIGHTππHere is source For finding primes. I just pulled this off of an OLD backupπdisk, so I don't Really know how optimized it is, but it works:π}ππConstπ FirstPrime = 2;π MaxPrimes = 16000; (* Limit 64k For one Array, little more work For more *)ππVarπ Primes : Array [1..MaxPrimes] of LongInt;ππ PrimesFound : LongInt;π TestNumber : LongInt;π Count : LongInt;ππ IsPrime : Boolean;ππbeginπ PrimesFound := 1;π TestNumber := FirstPrime + 1;ππ For Count := 1 to MaxPrimes DOπ Primes[Count] := 0;ππ Primes[1] := FirstPrime;ππ Repeatπ Count := 1;π IsPrime := True;ππ Repeatπ if Odd (TestNumber) thenπ if TestNumber MOD Primes[Count] = 0 thenπ IsPrime := False;π INC (Count);π Until (IsPrime = False) or (Count > PrimesFound);ππ if IsPrime = True thenπ beginπ INC (PrimesFound);π Primes[PrimesFound] := TestNumber;π Write (TestNumber, ', ');π end;π INC (TestNumber);π Until PrimesFound = MaxPrimes;πend.π 29 08-27-9321:45ALL GUY MCLOUGHLIN Still More Primes IMPORT 20 ₧ {πGUY MCLOUGHLINππ>the way, it took about 20 mins. on my 386/40 to get prime numbersπ>through 20000. I tried to come up With code to do the same Withπ>Turbo but it continues to elude me. Could anybody explainπ>how to Write such a routine in Pascal?ππ ...The following PRIME routine should prove to be a bit faster:π}ππ{ Find the square-root of a LongInt. }πFunction FindSqrt(lo_IN : LongInt) : LongInt;ππ { SUB : Find square-root For numbers less than 65536. }π Function FS1(wo_IN : Word) : Word;π Varπ wo_Temp1,π wo_Temp2 : Word;π lo_Error : Integer;π beginπ if (wo_IN > 0) thenπ beginπ wo_Temp1 := 1;π wo_Temp2 := wo_IN;π While ((wo_Temp1 shl 1) < wo_Temp2) doπ beginπ wo_Temp1 := wo_Temp1 shl 1;π wo_Temp2 := wo_Temp2 shr 1;π end;π Repeatπ wo_Temp1 := (wo_Temp1 + wo_Temp2) div 2;π wo_Temp2 := wo_IN div wo_Temp1;π lo_Error := (LongInt(wo_Temp1) - wo_Temp2);π Until (lo_Error <= 0);π FS1 := wo_Temp1;π endπ elseπ FS1 := 0;π end;ππ { SUB : Find square-root For numbers greater than 65535. }π Function FS2(lo_IN : longInt) : longInt;π Varπ lo_Temp1,π lo_Temp2,π lo_Error : longInt;π beginπ if (lo_IN > 0) thenπ beginπ lo_Temp1 := 1;π lo_Temp2 := lo_IN;π While ((lo_Temp1 shl 1) < lo_Temp2) doπ beginπ lo_Temp1 := lo_Temp1 shl 1;π lo_Temp2 := lo_Temp2 shr 1;π end;ππ Repeatπ lo_Temp1 := (lo_Temp1 + lo_Temp2) div 2;π lo_Temp2 := lo_IN div lo_Temp1;π lo_Error := (lo_Temp1 - lo_Temp2);π Until (lo_Error <= 0);π FS2 := lo_Temp1;π endπ elseπ FS2 := 0;π end;ππbeginπ if (lo_IN < 65536) thenπ FindSqrt := FS1(lo_IN)π elseπ FindSqrt := FS2(lo_IN);πend;ππ{ Check if a number is prime. }πFunction Prime(lo_IN : LongInt) : Boolean;πVarπ lo_Sqrt,π lo_Loop : LongInt;πbeginπ if not odd(lo_IN) thenπ beginπ Prime := (lo_IN = 2);π Exit;π end;π if (lo_IN mod 3 = 0) thenπ beginπ Prime := (lo_IN = 3);π Exit;π end;π if (lo_IN mod 5 = 0) thenπ beginπ Prime := (lo_IN = 5);π Exit;π end;ππ lo_Sqrt := FindSqrt(lo_IN);π lo_Loop := 7;π While (lo_Loop < lo_Sqrt) doπ beginπ inc(lo_Loop, 2);π if (lo_IN mod lo_Loop = 0) thenπ beginπ Prime := False;π Exit;π end;π end;π Prime := True;πend;π 30 08-27-9321:46ALL JANOS SZAMOSFALVI More Primes Yet !! IMPORT 7 ₧ {πJANOS SZAMOSFALVIππthe following routine uses a brute force approach with someπoptimization; it took less than 3 minutes with a 286/12 to findπand print all primes up to 32768, about 50 seconds w/o printingπthem; it becomes a bit slow when you get into a 6 digit rangeπ}ππPROGRAM Primes;πVARπ number,π max_div,π divisor : INTEGER;π prime : BOOLEAN;πBEGINπ writeln('Primes:');π writeln('2');π FOR number := 2 TO MAXINT DOπ BEGINπ max_div := Round(sqrt(number) + 0.5);π prime := number MOD 2 <> 0;π divisor := 3;π WHILE prime AND (divisor < max_div) DOπ BEGINπ prime := number MOD divisor <> 0;π divisor := divisor + 2;π END;π IF prime THENπ writeln(number);π END;πEND.π 31 08-27-9321:47ALL MARK LEWIS Pythagorean Triples IMPORT 44 ₧ Program PYTHAGOREAN_TRIPLES;π{written by Mark Lewis, April 1, 1990}π{developed and written in Turbo Pascal v3.0}ππConstπ hicnt = 100;π ZERO = 0;ππTypeπ PythagPtr = ^PythagRec; {Pointer to find the Record}π PythagRec = Record {the Record we are storing}π A : Real;π B : Real;π C : Real;π total : Real;π next : PythagPtr {Pointer to next Record in line}π end;ππVarπ Root : PythagPtr; {the starting point}π QUIT : Boolean;π ch : Char;ππProcedure listdispose(Var root : pythagptr);ππVarπ holder : pythagptr;ππbeginπ if root <> nil then {if we have Records in the list}π Repeat {...}π holder := root^.next; {save location of next Record}π dispose(root); {remove this Record}π root := holder; {go to next Record}π Until root = nil; {Until they are all gone}πend;ππProcedure findpythag(Var root : pythagptr);πVarπ x,y,z,stored : Integer;π xy,zz,xx,yy : Real;π abandon : Boolean;π workrec : pythagrec;π last,current : pythagptr;ππbeginπ stored := zero; {init count at ZERO}π For z := 1 to hicnt do {start loop 3}π beginπ zz := sqr(z); {square loop counter}π if zz < zero thenπ zz := 65536.0 + zz; {twiddle For negatives}π For y := 1 to hicnt do {start loop 2}π beginπ yy := sqr(y); {square loop counter}π if yy < zero thenπ yy := 65536.0 + yy; {twiddle For negatives}π For x := 1 to hicnt do {start loop 1}π beginπ abandon := False; {keep this one}π xx := sqr(x); {square loop counter}π xy := xx + yy; {add sqr(loop2) and sqr(loop1)}π if not ((xy <> zz) or ((xy = zz) and (xy = 1.0))) thenπ beginπ With workrec doπ beginπ a := x; {put them into our storage Record}π b := y;π c := z;π total := zz;π end;π if root = nil then {is this the first Record?}π beginπ new(root); {allocate space}π workrec.next := nil; {anchor the Record}π root^ := workrec; {store it}π stored := succ(stored); {how many found?}π endπ else {this is not the first Record}π beginπ current := root; {save where we are now}π Repeat {walk Records looking For dups}π if (current^.total = workrec.total) thenπ abandon := True; {is this one a dup?}{abandon it}π last := current; {save where we are}π current := current^.next {go to next Record}π Until (current = nil) or abandon;π if not abandon then {save this one?}π beginπ {we're going to INSERT this Record into the}π {line between the ones greater than and less}π {than the A Var in the Record}π {ie: 5,12,13 goes between 3,4,5 and 6,8,10}π if root^.a > workrec.a thenπ beginπ new(root); {allocate mem For this one}π workrec.next := last; {point to next rec}π root^ := workrec; {save this one}π stored := succ(stored); {how many found?}π endπ else {insert between last^.next and current}π beginπ new(last^.next); {allocate memory}π workrec.next := current; {point to current}π last^.next^ := workrec; {save this one}π stored := succ(stored); {how many found?}π end;π end;π end;π end;π end;π end;π end;π Writeln('I have found and stored ',stored,' Pythagorean Triples.');πend;ππProcedure showRecord(workrec : pythagrec);ππbeginπ With workrec doπ beginπ Writeln('A = ',a:6:0,' ',sqr(a):6:0);π Writeln('B = ',b:6:0,' ',sqr(b):6:0,' ',sqr(a)+sqr(b):6:0);π Writeln('C = ',c:6:0,' ',sqr(c):6:0,' <-^');π endπend;ππProcedure viewlist(root : pythagptr);ππVarπ i : Integer;π current : pythagptr;ππbeginπ if root = nil thenπ beginπ Writeln('<< Your list is empty! >>');π Write('>> Press (CR) to continue: ');π readln;π endπ elseπ beginπ Writeln('Viewing Records');π current := root;π While current <> nil doπ beginπ showRecord(current^);π Write('Press (CR) to view next Record. . . ');π readln;π current := current^.nextπ end;π endπend;ππbeginπ Writeln('PYTHAGOREAN TRIPLES');π Writeln('-------------------');π Writeln;π Writeln('Remember the formula For a Right Triangle?');π Writeln('A squared + B squared = C squared');π Writeln;π Writeln('I call the set of numbers that fits this formula');π Writeln(' Pythagorean Triples');π Writeln;π Writeln('This Program Uses a "brute force" method of finding all');π Writeln('the Pythagorean Triples between 1 and 100');π Writeln;π root := nil;π quit := False;π Repeatπ Writeln('Command -> [F]ind, [V]iew, [D]ispose, [Q]uit ');π readln(ch);π Case ch ofπ 'q','Q' : quit := True;π 'f','F' : findpythag(root);π 'v','V' : viewlist(root);π 'd','D' : listdispose(root);π end;π Until quit;π if root <> nil thenπ listdispose(root);π Writeln('Normal Program Termination');πend.ππ
