home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / morepscl.zip / MOREMATH.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-22  |  7KB  |  336 lines

  1. CONST e = 2.7182818;
  2.  
  3. Function Exponent(Base: Real; Power: Integer): Real;
  4. {Base can be real, power must be an integer}
  5.   VAR
  6.       X: INTEGER;
  7.       E: REAL;
  8.  
  9. BEGIN;
  10.   E:=1;
  11.   If Power = 0 then E:=1
  12.   Else If Power = 1 then E:=Base
  13.        Else For X:=1 to ABS(Power) do E:=E*Base;
  14.   If Power < 0 then E:=1/E;
  15.   Exponent:=E;
  16. END;
  17.  
  18. Function Log(Base, Expnt: Real): Real;
  19. {returns common (base 10) logarithm}
  20. Begin;
  21.   Log:=ln(Expnt)/ln(Base);
  22. End;
  23.  
  24. Function Prime(N: LongInt): Boolean;
  25. {Determines if argument is prime}
  26.   Var C: LongInt;
  27.       S: Real;
  28.       X: Boolean;
  29. Begin;
  30.   N:=ABS(N);
  31.   S:=SQRT(N);
  32.   X:=( (N<=2) OR (ODD(N)) AND (S <> INT(S) ) );
  33.   If X then Begin
  34.     C:=3;
  35.     While (X AND (C < Int(S))) do Begin
  36.       X:=((N Mod C) > 0);
  37.       C:=C+2;
  38.     End; {While}
  39.   End; {If X}
  40.   Prime:=X;
  41. End; {Prime}
  42.  
  43. Function Whole(X: Real): Boolean;
  44. Begin;
  45.   Whole:=INT(X) = X;
  46. End;
  47.  
  48. Function Seconds_to_Words(Sec: LongInt): String;
  49.   CONST
  50.        SecDay=86400;
  51.         SecHr=3600;
  52.        SecMin=60;
  53.   VAR
  54.        Days, Hours, Minutes, Seconds: LONGINT;
  55.                                    L: BYTE;
  56.                                 T, X: STRING;
  57.  
  58. BEGIN;
  59.  
  60.   Days:=Sec DIV SecDay;
  61.   Sec:=Sec-(SecDay*Days);
  62.   Hours:=Sec DIV SecHr;
  63.   Sec:=Sec-(SecHr*Hours);
  64.   Minutes:=Sec DIV SecMin;
  65.   Sec:=Sec-(SecMin*Minutes);
  66.   Seconds:=Sec;
  67.  
  68.   T:='';
  69.  
  70.   If Days > 0 then Begin
  71.     Str(Days,T);
  72.     T := T + ' Day';
  73.     If Days > 1 then T := T + 's';
  74.     T := T + ', ';
  75.   End; {If Days}
  76.  
  77.   If Hours > 0 then Begin
  78.     Str(Hours,X);
  79.     T := T + X + ' Hour';
  80.     If Hours > 1 then T := T + 's';
  81.     T := T + ', ';
  82.   End; {If Hours}
  83.  
  84.   If Minutes > 0 then Begin
  85.     Str(Minutes,X);
  86.     T := T + X + ' Minute';
  87.     If Minutes > 1 then T := T + 's';
  88.     T := T + ', ';
  89.   End; {If Minutes}
  90.  
  91.   If Seconds > 0 then Begin
  92.     Str(Seconds,X);
  93.     T := T + X + ' Second';
  94.     If Seconds > 1 then T := T + 's';
  95.   End; {If Seconds}
  96.  
  97.   L:=Length(T)-1;
  98.  
  99.   If T[L] = ',' then T:=Copy(T,1,(L-1));
  100.  
  101.   Seconds_To_Words:=T;
  102.  
  103. END; {Seconds to Words}
  104.  
  105. Function DegToRad(D: Real): Real;
  106. Begin;
  107.   DegToRad:=D*Pi/180;
  108. End; {DegToRad}
  109.  
  110. Function GradToRad(G: Real): Real;
  111. Begin;
  112.   GradToRad:=G*Pi/200;
  113. End; {GradToRad}
  114.  
  115. Function DegToGrad(D: Real): Real;
  116. Begin;
  117.   DegToGrad:=D/0.9;
  118. End; {DegToGrad}
  119.  
  120. Function RadToDeg(R: Real): Real;
  121. Begin;
  122.   RadToDeg:=R*180/Pi;
  123. End; {RadToDeg}
  124.  
  125. Function RadToGrad(R: Real): Real;
  126. Begin;
  127.   RadToGrad:=R*200/Pi;
  128. End;
  129.  
  130. Function GradToDeg(G: Real): Real;
  131. Begin;
  132.   GradToDeg:=G*0.9;
  133. End; {GradToDeg}
  134.  
  135. Function Tan(R: Real): Real;
  136. Begin;
  137.   Tan:=Sin(R) / Cos(R);
  138. End; {Tan}
  139.  
  140. Function Csc(R: Real): Real;
  141. Begin;
  142.   Csc:=1 / Sin(R);
  143. End; {Csc}
  144.  
  145. Function Sec(R: Real): Real;
  146. Begin;
  147.   Sec:=1 / Cos(R);
  148. End; {Sec}
  149.  
  150. Function Cot(R: Real): Real;
  151. Begin;
  152.   Cot:=Cos(R) / Sin(R);
  153. End; {Cot}
  154.  
  155. Function Hypotenuse_Equilateral_Triangle(S: Real): Real;
  156. Begin;
  157.   Hypotenuse_Equilateral_Triangle:=( SQRT(3) * S ) / 2;
  158. End;
  159.  
  160. Function Pythagoras(A, B: Real): Real;
  161. Begin;
  162.   Pythagoras:=Sqrt((A*A)+(B*B));
  163. End; {Pythagoras}
  164.  
  165. Function Triangle_Area(B, H: Real): Real;
  166. Begin;
  167.   Triangle_Area:=0.5 * B * H;
  168. End; {Triangle Area}
  169.  
  170. Function Equilateral_Triangle_Area(S: Real): Real;
  171. Begin;
  172.   Equilateral_Triangle_Area:=( SQRT(3) * (S*S) ) / 4;
  173. End;
  174.  
  175. Function Circle_Area(R: Real): Real;
  176. Begin;
  177.   Circle_Area:=Pi*(R*R);
  178. End;
  179.  
  180. Function Ellipse_Area(A, B: Real): Real;
  181. Begin;
  182.   Ellipse_Area:=Pi*A*B;
  183. End;
  184.  
  185. Function Square_Area(S: Real): Real;
  186. Begin;
  187.   Square_Area:=(S*S);
  188. End;
  189.  
  190. Function Rectangle_Area(X, Y: Real): Real;
  191. Begin;
  192.   Rectangle_Area:=X*Y;
  193. End;
  194.  
  195. Function Cube_Surface_Area(S: Real): Real;
  196. Begin;
  197.   Cube_Surface_Area:=6*(S*S);
  198. End;
  199.  
  200. Function Rectangular_Prism_Surface_Area(H, W, L: Real): Real;
  201. Begin;
  202.   Rectangular_Prism_Surface_Area:=(2*H*W) + (2*H*L) + (2*L*W);
  203. End;
  204.  
  205. Function Sphere_Surface_Area(R: Real): Real;
  206. Begin;
  207.   Sphere_Surface_Area:=4*Pi*(R*R);
  208. End;
  209.  
  210. Function Cylinder_Surface_Area(R, H: Real): Real;
  211. Begin;
  212.   Cylinder_Surface_Area:=(2*Pi*R*H) + (2*Pi*(R*R));
  213. End;
  214.  
  215. Function Cone_Surface_Area_Without_Base(R, H: Real): Real;
  216. Begin;
  217.   Cone_Surface_Area_Without_Base:=Pi*R*SQRT((R*R) + (H*H) );
  218. End;
  219.  
  220. Function Cone_Surface_Area_With_Base(R, H: Real): Real;
  221. Begin;
  222.   Cone_Surface_Area_With_Base:=(Pi*R*SQRT((R*R) + (H*H)) ) + (Pi*(R*R));
  223. End;
  224.  
  225. Function Sector_Area(R, A: Real): Real;
  226. Begin;
  227.   Sector_Area:=0.5*(R*R)*A;
  228. End;
  229.  
  230. Function Trapezoid_Area(A, B, H: Real): Real;
  231. Begin;
  232.   Trapezoid_Area:=(H / 2) * (A + B);
  233. End;
  234.  
  235. Function Circle_Circumference(R: Real): Real;
  236. Begin;
  237.   Circle_Circumference:=2*Pi*R;
  238. End;
  239.  
  240. Function Ellipse_Circumference(A, B: Real): Real;
  241. Begin;
  242.   Ellipse_Circumference := (2*Pi) * ( SQRT( ( (A*A) + (B*B) ) / 2 ) );
  243. End;
  244.  
  245. Function Cube_Volume(S: Real): Real;
  246. Begin;
  247.   Cube_Volume:=S*S*S;
  248. End;
  249.  
  250. Function Rectangle_Volume(X, Y, Z: Real): Real;
  251. Begin;
  252.   Rectangle_Volume:=X*Y*Z;
  253. End;
  254.  
  255. Function Sphere_Volume(R: Real): Real;
  256. Begin;
  257.   Sphere_Volume:=(4/3)*Pi*(R*R*R);
  258. End;
  259.  
  260. Function Cylinder_Volume(R, H: Real): Real;
  261. Begin;
  262.   Cylinder_Volume:=Pi*(R*R)*H;
  263. End; {Cylinder Volume}
  264.  
  265. Function Cone_Volume(R, H: Real): Real;
  266. Begin;
  267.   Cone_Volume:=(Pi*(R*R)*H)/3;
  268. End;
  269.  
  270. Function Prism_Volume(B, H: Real): Real;
  271. Begin;
  272.   Prism_Volume:=B*H;
  273. End; {Prism Volume}
  274.  
  275. Function Distance(X1, X2, Y1, Y2: Real): Real;
  276. Begin;
  277.   Distance:=Sqrt(Sqr(Y2-Y1)+Sqr(X2-X1));
  278. End; {Distance}
  279.  
  280. Function Factorial(N: LongInt): LongInt;
  281.   Var X, Y: LongInt;
  282. Begin;
  283.   If N <> 0 then Begin
  284.     X:=N;
  285.     For Y:=(N-1) downto 2 do X:=X*Y;
  286.     Factorial:=X;
  287.   End {If}
  288.   Else Factorial:=1;
  289. End; {Factorial}
  290.  
  291. Function GCF(A, B: LongInt): LongInt;
  292.   {finds the Greatest Common Factor between 2 arguments}
  293.   Var X, High: LongInt;
  294. Begin;
  295.   High:=1;
  296.   For X:=2 to A do If (A MOD X = 0)  AND  (B MOD X = 0) then High:=X;
  297.   GCF:=High;
  298. End; {GCF}
  299.  
  300. Function LCM(A, B: LongInt): LongInt;
  301.   {finds the Least Common Multiple between 2 arguments}
  302.   Var Inc, Low, High: LongInt;
  303. Begin;
  304.   If A > B then Begin
  305.     High:=A;
  306.     Low:=B;
  307.   End {If}
  308.   Else Begin
  309.     High:=B;
  310.     Low:=A;
  311.   End; {Else}
  312.   Inc:=High;
  313.   While High MOD Low <> 0 do High:=High+Inc;
  314.   LCM:=High;
  315. End; {LCM}
  316.  
  317. Procedure ISwap(Var X, Y: LongInt);
  318.  {swaps 2 Integer or LongInteger variables}
  319.  Var Z: LongInt;
  320. Begin;
  321.  Z:=X;
  322.  X:=Y;
  323.  Y:=Z;
  324. End;
  325.  
  326. Procedure RSwap(Var X, Y: Real);
  327.  {swaps 2 REAL variables}
  328.  Var Z: Real;
  329. Begin;
  330.  Z:=X;
  331.  X:=Y;
  332.  Y:=Z;
  333. End;
  334.  
  335.  
  336.