math.pp 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {
  13. This unit is an equivalent to the Delphi math unit
  14. (with some improvements)
  15. What's to do:
  16. o a lot of function :), search for !!!!
  17. o some statistical functions
  18. o all financial functions
  19. o optimizations
  20. }
  21. unit math;
  22. interface
  23. {$MODE objfpc}
  24. {$ifdef VER1_0}
  25. { we don't assume cross compiling from 1.0.x-m68k ... }
  26. {$define FPC_HAS_TYPE_EXTENDED}
  27. {$endif VER1_0}
  28. uses
  29. sysutils;
  30. { Ranges of the IEEE floating point types, including denormals }
  31. {$ifdef FPC_HAS_TYPE_SINGLE}
  32. const
  33. MinSingle = 1.5e-45;
  34. MaxSingle = 3.4e+38;
  35. {$endif FPC_HAS_TYPE_SINGLE}
  36. {$ifdef FPC_HAS_TYPE_DOUBLE}
  37. const
  38. MinDouble = 5.0e-324;
  39. MaxDouble = 1.7e+308;
  40. {$endif FPC_HAS_TYPE_DOUBLE}
  41. {$ifdef FPC_HAS_TYPE_EXTENDED}
  42. const
  43. MinExtended = 3.4e-4932;
  44. MaxExtended = 1.1e+4932;
  45. {$endif FPC_HAS_TYPE_EXTENDED}
  46. {$ifdef FPC_HAS_TYPE_COMP}
  47. const
  48. MinComp = -9.223372036854775807e+18;
  49. MaxComp = 9.223372036854775807e+18;
  50. {$endif FPC_HAS_TYPE_COMP}
  51. { the original delphi functions use extended as argument, }
  52. { but I would prefer double, because 8 bytes is a very }
  53. { natural size for the processor }
  54. { WARNING : changing float type will }
  55. { break all assembler code PM }
  56. {$ifdef FPC_HAS_TYPE_FLOAT128}
  57. type
  58. float = float128;
  59. const
  60. MinFloat = MinFloat128;
  61. MaxFloat = MaxFloat128;
  62. {$else FPC_HAS_TYPE_FLOAT128}
  63. {$ifdef FPC_HAS_TYPE_EXTENDED}
  64. type
  65. float = extended;
  66. const
  67. MinFloat = MinExtended;
  68. MaxFloat = MaxExtended;
  69. {$else FPC_HAS_TYPE_EXTENDED}
  70. {$ifdef FPC_HAS_TYPE_DOUBLE}
  71. type
  72. float = double;
  73. const
  74. MinFloat = MinDouble;
  75. MaxFloat = MaxDouble;
  76. {$else FPC_HAS_TYPE_DOUBLE}
  77. {$ifdef FPC_HAS_TYPE_SINGLE}
  78. type
  79. float = single;
  80. const
  81. MinFloat = MinSingle;
  82. MaxFloat = MaxSingle;
  83. {$else FPC_HAS_TYPE_SINGLE}
  84. {$fatal At least one floating point type must be supported}
  85. {$endif FPC_HAS_TYPE_SINGLE}
  86. {$endif FPC_HAS_TYPE_DOUBLE}
  87. {$endif FPC_HAS_TYPE_EXTENDED}
  88. {$endif FPC_HAS_TYPE_FLOAT128}
  89. type
  90. PFloat = ^Float;
  91. PInteger = ^Integer;
  92. tpaymenttime = (ptendofperiod,ptstartofperiod);
  93. einvalidargument = class(ematherror);
  94. TValueRelationship = -1..1;
  95. const
  96. EqualsValue = 0;
  97. LessThanValue = Low(TValueRelationship);
  98. GreaterThanValue = High(TValueRelationship);
  99. { Min/max determination }
  100. function MinIntValue(const Data: array of Integer): Integer;
  101. function MaxIntValue(const Data: array of Integer): Integer;
  102. { Extra, not present in Delphi, but used frequently }
  103. function Min(a, b: Integer): Integer;
  104. function Max(a, b: Integer): Integer;
  105. function Min(a, b: Cardinal): Cardinal;
  106. function Max(a, b: Cardinal): Cardinal;
  107. function Min(a, b: Int64): Int64;
  108. function Max(a, b: Int64): Int64;
  109. {$ifdef FPC_HAS_TYPE_SINGLE}
  110. function Min(a, b: Single): Single;
  111. function Max(a, b: Single): Single;
  112. {$endif FPC_HAS_TYPE_SINGLE}
  113. {$ifdef FPC_HAS_TYPE_DOUBLE}
  114. function Min(a, b: Double): Double;
  115. function Max(a, b: Double): Double;
  116. {$endif FPC_HAS_TYPE_DOUBLE}
  117. {$ifdef FPC_HAS_TYPE_EXTENDED}
  118. function Min(a, b: Extended): Extended;
  119. function Max(a, b: Extended): Extended;
  120. {$endif FPC_HAS_TYPE_EXTENDED}
  121. // Sign functions
  122. Type
  123. TValueSign = -1..1;
  124. const
  125. NegativeValue = Low(TValueSign);
  126. ZeroValue = 0;
  127. PositiveValue = High(TValueSign);
  128. function Sign(const AValue: Integer): TValueSign; overload;
  129. function Sign(const AValue: Int64): TValueSign; overload;
  130. function Sign(const AValue: Double): TValueSign; overload;
  131. { angle conversion }
  132. function degtorad(deg : float) : float;
  133. function radtodeg(rad : float) : float;
  134. function gradtorad(grad : float) : float;
  135. function radtograd(rad : float) : float;
  136. function degtograd(deg : float) : float;
  137. function gradtodeg(grad : float) : float;
  138. { one cycle are 2*Pi rad }
  139. function cycletorad(cycle : float) : float;
  140. function radtocycle(rad : float) : float;
  141. { trigoniometric functions }
  142. function tan(x : float) : float;
  143. function cotan(x : float) : float;
  144. procedure sincos(theta : float;var sinus,cosinus : float);
  145. { inverse functions }
  146. function arccos(x : float) : float;
  147. function arcsin(x : float) : float;
  148. { calculates arctan(y/x) and returns an angle in the correct quadrant }
  149. function arctan2(y,x : float) : float;
  150. { hyperbolic functions }
  151. function cosh(x : float) : float;
  152. function sinh(x : float) : float;
  153. function tanh(x : float) : float;
  154. { area functions }
  155. { delphi names: }
  156. function arccosh(x : float) : float;
  157. function arcsinh(x : float) : float;
  158. function arctanh(x : float) : float;
  159. { IMHO the function should be called as follows (FK) }
  160. function arcosh(x : float) : float;
  161. function arsinh(x : float) : float;
  162. function artanh(x : float) : float;
  163. { triangle functions }
  164. { returns the length of the hypotenuse of a right triangle }
  165. { if x and y are the other sides }
  166. function hypot(x,y : float) : float;
  167. { logarithm functions }
  168. function log10(x : float) : float;
  169. function log2(x : float) : float;
  170. function logn(n,x : float) : float;
  171. { returns natural logarithm of x+1 }
  172. function lnxp1(x : float) : float;
  173. { exponential functions }
  174. function power(base,exponent : float) : float;
  175. { base^exponent }
  176. function intpower(base : float;const exponent : Integer) : float;
  177. { number converting }
  178. { rounds x towards positive infinity }
  179. function ceil(x : float) : Integer;
  180. { rounds x towards negative infinity }
  181. function floor(x : float) : Integer;
  182. { misc. functions }
  183. { splits x into mantissa and exponent (to base 2) }
  184. procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
  185. { returns x*(2^p) }
  186. function ldexp(x : float; const p : Integer) : float;
  187. { statistical functions }
  188. function mean(const data : array of float) : float;
  189. function sum(const data : array of float) : float;
  190. function mean(const data : PFloat; Const N : longint) : float;
  191. function sum(const data : PFloat; Const N : Longint) : float;
  192. function sumofsquares(const data : array of float) : float;
  193. function sumofsquares(const data : PFloat; Const N : Integer) : float;
  194. { calculates the sum and the sum of squares of data }
  195. procedure sumsandsquares(const data : array of float;
  196. var sum,sumofsquares : float);
  197. procedure sumsandsquares(const data : PFloat; Const N : Integer;
  198. var sum,sumofsquares : float);
  199. function minvalue(const data : array of float) : float;
  200. function minvalue(const data : array of integer) : Integer;
  201. function minvalue(const data : PFloat; Const N : Integer) : float;
  202. function MinValue(const Data : PInteger; Const N : Integer): Integer;
  203. function maxvalue(const data : array of float) : float;
  204. function maxvalue(const data : array of integer) : Integer;
  205. function maxvalue(const data : PFloat; Const N : Integer) : float;
  206. function maxvalue(const data : PInteger; Const N : Integer) : Integer;
  207. { calculates the standard deviation }
  208. function stddev(const data : array of float) : float;
  209. function stddev(const data : PFloat; Const N : Integer) : float;
  210. { calculates the mean and stddev }
  211. procedure meanandstddev(const data : array of float;
  212. var mean,stddev : float);
  213. procedure meanandstddev(const data : PFloat;
  214. Const N : Longint;var mean,stddev : float);
  215. function variance(const data : array of float) : float;
  216. function totalvariance(const data : array of float) : float;
  217. function variance(const data : PFloat; Const N : Integer) : float;
  218. function totalvariance(const data : PFloat; Const N : Integer) : float;
  219. { returns random values with gaussian distribution }
  220. function randg(mean,stddev : float) : float;
  221. { I don't know what the following functions do: }
  222. function popnstddev(const data : array of float) : float;
  223. function popnstddev(const data : PFloat; Const N : Integer) : float;
  224. function popnvariance(const data : PFloat; Const N : Integer) : float;
  225. function popnvariance(const data : array of float) : float;
  226. procedure momentskewkurtosis(const data : array of float;
  227. var m1,m2,m3,m4,skew,kurtosis : float);
  228. procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
  229. var m1,m2,m3,m4,skew,kurtosis : float);
  230. { geometrical function }
  231. { returns the euclidean L2 norm }
  232. function norm(const data : array of float) : float;
  233. function norm(const data : PFloat; Const N : Integer) : float;
  234. { include cpu specific stuff }
  235. {$i mathuh.inc}
  236. implementation
  237. { include cpu specific stuff }
  238. {$i mathu.inc}
  239. ResourceString
  240. SMathError = 'Math Error : %s';
  241. SInvalidArgument = 'Invalid argument';
  242. Procedure DoMathError(Const S : String);
  243. begin
  244. Raise EMathError.CreateFmt(SMathError,[S]);
  245. end;
  246. Procedure InvalidArgument;
  247. begin
  248. Raise EInvalidArgument.Create(SInvalidArgument);
  249. end;
  250. function Sign(const AValue: Integer): TValueSign;
  251. begin
  252. If Avalue<0 then
  253. Result:=NegativeValue
  254. else If Avalue>0 then
  255. Result:=PositiveValue
  256. else
  257. Result:=ZeroValue;
  258. end;
  259. function Sign(const AValue: Int64): TValueSign;
  260. begin
  261. If Avalue<0 then
  262. Result:=NegativeValue
  263. else If Avalue>0 then
  264. Result:=PositiveValue
  265. else
  266. Result:=ZeroValue;
  267. end;
  268. function Sign(const AValue: Double): TValueSign;
  269. begin
  270. If Avalue<0.0 then
  271. Result:=NegativeValue
  272. else If Avalue>0.0 then
  273. Result:=PositiveValue
  274. else
  275. Result:=ZeroValue;
  276. end;
  277. function degtorad(deg : float) : float;
  278. begin
  279. degtorad:=deg*(pi/180.0);
  280. end;
  281. function radtodeg(rad : float) : float;
  282. begin
  283. radtodeg:=rad*(180.0/pi);
  284. end;
  285. function gradtorad(grad : float) : float;
  286. begin
  287. gradtorad:=grad*(pi/200.0);
  288. end;
  289. function radtograd(rad : float) : float;
  290. begin
  291. radtograd:=rad*(200.0/pi);
  292. end;
  293. function degtograd(deg : float) : float;
  294. begin
  295. degtograd:=deg*(200.0/180.0);
  296. end;
  297. function gradtodeg(grad : float) : float;
  298. begin
  299. gradtodeg:=grad*(180.0/200.0);
  300. end;
  301. function cycletorad(cycle : float) : float;
  302. begin
  303. cycletorad:=(2*pi)*cycle;
  304. end;
  305. function radtocycle(rad : float) : float;
  306. begin
  307. { avoid division }
  308. radtocycle:=rad*(1/(2*pi));
  309. end;
  310. function tan(x : float) : float;
  311. begin
  312. Tan:=Sin(x)/Cos(x)
  313. end;
  314. function cotan(x : float) : float;
  315. begin
  316. cotan:=Cos(X)/Sin(X);
  317. end;
  318. procedure sincos(theta : float;var sinus,cosinus : float);
  319. begin
  320. sinus:=sin(theta);
  321. cosinus:=cos(theta);
  322. end;
  323. { ArcSin and ArcCos from Arjan van Dijk ([email protected]) }
  324. function arcsin(x : float) : float;
  325. begin
  326. if abs(x) > 1 then InvalidArgument
  327. else if abs(x) < 0.5 then
  328. arcsin := arctan(x/sqrt(1-sqr(x)))
  329. else
  330. arcsin := sign(x) * (pi*0.5 - arctan(sqrt(1 / sqr(x) - 1)));
  331. end;
  332. function Arccos(x : Float) : Float;
  333. begin
  334. arccos := pi*0.5 - arcsin(x);
  335. end;
  336. {$ifndef FPC_MATH_HAS_ARCTAN2}
  337. function arctan2(y,x : float) : float;
  338. begin
  339. if (x=0) then
  340. begin
  341. if y=0 then
  342. arctan2:=0.0
  343. else if y>0 then
  344. arctan2:=pi/2
  345. else if y<0 then
  346. arctan2:=-pi/2;
  347. end
  348. else
  349. ArcTan2:=ArcTan(y/x);
  350. end;
  351. {$endif FPC_MATH_HAS_ARCTAN2}
  352. function cosh(x : float) : float;
  353. var
  354. temp : float;
  355. begin
  356. temp:=exp(x);
  357. cosh:=0.5*(temp+1.0/temp);
  358. end;
  359. function sinh(x : float) : float;
  360. var
  361. temp : float;
  362. begin
  363. temp:=exp(x);
  364. sinh:=0.5*(temp-1.0/temp);
  365. end;
  366. Const MaxTanh = 5678.22249441322; // Ln(MaxExtended)/2
  367. function tanh(x : float) : float;
  368. var Temp : float;
  369. begin
  370. if x>MaxTanh then exit(1.0)
  371. else if x<-MaxTanh then exit (-1.0);
  372. temp:=exp(-2*x);
  373. tanh:=(1-temp)/(1+temp)
  374. end;
  375. function arccosh(x : float) : float;
  376. begin
  377. arccosh:=arcosh(x);
  378. end;
  379. function arcsinh(x : float) : float;
  380. begin
  381. arcsinh:=arsinh(x);
  382. end;
  383. function arctanh(x : float) : float;
  384. begin
  385. if x>1 then InvalidArgument;
  386. arctanh:=artanh(x);
  387. end;
  388. function arcosh(x : float) : float;
  389. begin
  390. if x<1 then InvalidArgument;
  391. arcosh:=Ln(x+Sqrt(x*x-1));
  392. end;
  393. function arsinh(x : float) : float;
  394. begin
  395. arsinh:=Ln(x+Sqrt(1+x*x));
  396. end;
  397. function artanh(x : float) : float;
  398. begin
  399. If abs(x)>1 then InvalidArgument;
  400. artanh:=(Ln((1+x)/(1-x)))*0.5;
  401. end;
  402. function hypot(x,y : float) : float;
  403. begin
  404. hypot:=Sqrt(x*x+y*y)
  405. end;
  406. function log10(x : float) : float;
  407. begin
  408. log10:=ln(x)/ln(10);
  409. end;
  410. function log2(x : float) : float;
  411. begin
  412. log2:=ln(x)/ln(2)
  413. end;
  414. function logn(n,x : float) : float;
  415. begin
  416. if n<0 then InvalidArgument;
  417. logn:=ln(x)/ln(n);
  418. end;
  419. function lnxp1(x : float) : float;
  420. begin
  421. if x<-1 then
  422. InvalidArgument;
  423. lnxp1:=ln(1+x);
  424. end;
  425. function power(base,exponent : float) : float;
  426. begin
  427. If Exponent=0.0 then
  428. Result:=1.0
  429. else
  430. If base>0.0 then
  431. Power:=exp(exponent * ln (base))
  432. else if base=0.0 then
  433. Result:=0.0
  434. else
  435. InvalidArgument
  436. end;
  437. function intpower(base : float;const exponent : Integer) : float;
  438. var
  439. i : longint;
  440. begin
  441. i:=abs(exponent);
  442. intpower:=1.0;
  443. while i>0 do
  444. begin
  445. while (i and 1)=0 do
  446. begin
  447. i:=i shr 1;
  448. base:=sqr(base);
  449. end;
  450. i:=i-1;
  451. intpower:=intpower*base;
  452. end;
  453. if exponent<0 then
  454. intpower:=1.0/intpower;
  455. end;
  456. function ceil(x : float) : integer;
  457. begin
  458. Ceil:=Trunc(x);
  459. If Frac(x)>0 then
  460. Ceil:=Ceil+1;
  461. end;
  462. function floor(x : float) : integer;
  463. begin
  464. Floor:=Trunc(x);
  465. If Frac(x)<0 then
  466. Floor := Floor-1;
  467. end;
  468. procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
  469. begin
  470. Exponent :=0;
  471. if (abs(x)<0.5) then
  472. While (abs(x)<0.5) do
  473. begin
  474. x := x*2;
  475. Dec(Exponent);
  476. end
  477. else
  478. While (abs(x)>1) do
  479. begin
  480. x := x/2;
  481. Inc(Exponent);
  482. end;
  483. mantissa := x;
  484. end;
  485. function ldexp(x : float;const p : Integer) : float;
  486. begin
  487. ldexp:=x*intpower(2.0,p);
  488. end;
  489. function mean(const data : array of float) : float;
  490. begin
  491. Result:=Mean(@data[0],High(Data)+1);
  492. end;
  493. function mean(const data : PFloat; Const N : longint) : float;
  494. begin
  495. mean:=sum(Data,N);
  496. mean:=mean/N;
  497. end;
  498. function sum(const data : array of float) : float;
  499. begin
  500. Result:=Sum(@Data[0],High(Data)+1);
  501. end;
  502. function sum(const data : PFloat;Const N : longint) : float;
  503. var
  504. i : longint;
  505. begin
  506. sum:=0.0;
  507. for i:=0 to N-1 do
  508. sum:=sum+data[i];
  509. end;
  510. function sumofsquares(const data : array of float) : float;
  511. begin
  512. Result:=sumofsquares(@data[0],High(Data)+1);
  513. end;
  514. function sumofsquares(const data : PFloat; Const N : Integer) : float;
  515. var
  516. i : longint;
  517. begin
  518. sumofsquares:=0.0;
  519. for i:=0 to N-1 do
  520. sumofsquares:=sumofsquares+sqr(data[i]);
  521. end;
  522. procedure sumsandsquares(const data : array of float;
  523. var sum,sumofsquares : float);
  524. begin
  525. sumsandsquares (@Data[0],High(Data)+1,Sum,sumofsquares);
  526. end;
  527. procedure sumsandsquares(const data : PFloat; Const N : Integer;
  528. var sum,sumofsquares : float);
  529. var
  530. i : Integer;
  531. temp : float;
  532. begin
  533. sumofsquares:=0.0;
  534. sum:=0.0;
  535. for i:=0 to N-1 do
  536. begin
  537. temp:=data[i];
  538. sumofsquares:=sumofsquares+sqr(temp);
  539. sum:=sum+temp;
  540. end;
  541. end;
  542. function stddev(const data : array of float) : float;
  543. begin
  544. Result:=Stddev(@Data[0],High(Data)+1)
  545. end;
  546. function stddev(const data : PFloat; Const N : Integer) : float;
  547. begin
  548. StdDev:=Sqrt(Variance(Data,N));
  549. end;
  550. procedure meanandstddev(const data : array of float;
  551. var mean,stddev : float);
  552. begin
  553. Meanandstddev(@Data[0],High(Data)+1,Mean,stddev);
  554. end;
  555. procedure meanandstddev(const data : PFloat;
  556. Const N : Longint;var mean,stddev : float);
  557. Var I : longint;
  558. begin
  559. Mean:=0;
  560. StdDev:=0;
  561. For I:=0 to N-1 do
  562. begin
  563. Mean:=Mean+Data[i];
  564. StdDev:=StdDev+Sqr(Data[i]);
  565. end;
  566. Mean:=Mean/N;
  567. StdDev:=(StdDev-N*Sqr(Mean));
  568. If N>1 then
  569. StdDev:=Sqrt(Stddev/(N-1))
  570. else
  571. StdDev:=0;
  572. end;
  573. function variance(const data : array of float) : float;
  574. begin
  575. Variance:=Variance(@Data[0],High(Data)+1);
  576. end;
  577. function variance(const data : PFloat; Const N : Integer) : float;
  578. begin
  579. If N=1 then
  580. Result:=0
  581. else
  582. Result:=TotalVariance(Data,N)/(N-1);
  583. end;
  584. function totalvariance(const data : array of float) : float;
  585. begin
  586. Result:=TotalVariance(@Data[0],High(Data)+1);
  587. end;
  588. function totalvariance(const data : Pfloat;Const N : Integer) : float;
  589. var S,SS : Float;
  590. begin
  591. If N=1 then
  592. Result:=0
  593. else
  594. begin
  595. SumsAndSquares(Data,N,S,SS);
  596. Result := SS-Sqr(S)/N;
  597. end;
  598. end;
  599. function randg(mean,stddev : float) : float;
  600. Var U1,S2 : Float;
  601. begin
  602. repeat
  603. u1:= 2*random-1;
  604. S2:=Sqr(U1)+sqr(2*random-1);
  605. until s2<1;
  606. randg:=Sqrt(-2*ln(S2)/S2)*u1*stddev+Mean;
  607. end;
  608. function popnstddev(const data : array of float) : float;
  609. begin
  610. PopnStdDev:=Sqrt(PopnVariance(@Data[0],High(Data)+1));
  611. end;
  612. function popnstddev(const data : PFloat; Const N : Integer) : float;
  613. begin
  614. PopnStdDev:=Sqrt(PopnVariance(Data,N));
  615. end;
  616. function popnvariance(const data : array of float) : float;
  617. begin
  618. popnvariance:=popnvariance(@data[0],high(Data)+1);
  619. end;
  620. function popnvariance(const data : PFloat; Const N : Integer) : float;
  621. begin
  622. PopnVariance:=TotalVariance(Data,N)/N;
  623. end;
  624. procedure momentskewkurtosis(const data : array of float;
  625. var m1,m2,m3,m4,skew,kurtosis : float);
  626. begin
  627. momentskewkurtosis(@Data[0],High(Data)+1,m1,m2,m3,m4,skew,kurtosis);
  628. end;
  629. procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
  630. var m1,m2,m3,m4,skew,kurtosis : float);
  631. Var S,SS,SC,SQ,invN,Acc,M1S,S2N,S3N,temp : Float;
  632. I : Longint;
  633. begin
  634. invN:=1.0/N;
  635. s:=0;
  636. ss:=0;
  637. sq:=0;
  638. sc:=0;
  639. for i:=0 to N-1 do
  640. begin
  641. temp:=Data[i]; { faster }
  642. S:=S+temp;
  643. acc:=temp*temp;
  644. ss:=ss+acc;
  645. Acc:=acc*temp;
  646. Sc:=sc+acc;
  647. acc:=acc*temp;
  648. sq:=sq+acc;
  649. end;
  650. M1:=s*invN;
  651. M1S:=M1*M1;
  652. S2N:=SS*invN;
  653. S3N:=SC*invN;
  654. M2:=S2N-M1S;
  655. M3:=S3N-(M1*3*S2N) + 2*M1S*M1;
  656. M4:=SQ*invN - (M1 * 4 * S3N) + (M1S*6*S2N-3*Sqr(M1S));
  657. Skew:=M3*power(M2,-3/2);
  658. Kurtosis:=M4 / Sqr(M2);
  659. end;
  660. function norm(const data : array of float) : float;
  661. begin
  662. norm:=Norm(@data[0],High(Data)+1);
  663. end;
  664. function norm(const data : PFloat; Const N : Integer) : float;
  665. begin
  666. norm:=sqrt(sumofsquares(data,N));
  667. end;
  668. function MinIntValue(const Data: array of Integer): Integer;
  669. var
  670. I: Integer;
  671. begin
  672. Result := Data[Low(Data)];
  673. For I := Succ(Low(Data)) To High(Data) Do
  674. If Data[I] < Result Then Result := Data[I];
  675. end;
  676. function MinValue(const Data: array of Integer): Integer;
  677. begin
  678. Result:=MinValue(Pinteger(@Data[0]),High(Data)+1)
  679. end;
  680. function MinValue(const Data: PInteger; Const N : Integer): Integer;
  681. var
  682. I: Integer;
  683. begin
  684. Result := Data[0];
  685. For I := 1 To N-1 do
  686. If Data[I] < Result Then Result := Data[I];
  687. end;
  688. function minvalue(const data : array of float) : float;
  689. begin
  690. Result:=minvalue(PFloat(@data[0]),High(Data)+1);
  691. end;
  692. function minvalue(const data : PFloat; Const N : Integer) : float;
  693. var
  694. i : longint;
  695. begin
  696. { get an initial value }
  697. minvalue:=data[0];
  698. for i:=1 to N-1 do
  699. if data[i]<minvalue then
  700. minvalue:=data[i];
  701. end;
  702. function MaxIntValue(const Data: array of Integer): Integer;
  703. var
  704. I: Integer;
  705. begin
  706. Result := Data[Low(Data)];
  707. For I := Succ(Low(Data)) To High(Data) Do
  708. If Data[I] > Result Then Result := Data[I];
  709. end;
  710. function maxvalue(const data : array of float) : float;
  711. begin
  712. Result:=maxvalue(PFloat(@data[0]),High(Data)+1);
  713. end;
  714. function maxvalue(const data : PFloat; Const N : Integer) : float;
  715. var
  716. i : longint;
  717. begin
  718. { get an initial value }
  719. maxvalue:=data[0];
  720. for i:=1 to N-1 do
  721. if data[i]>maxvalue then
  722. maxvalue:=data[i];
  723. end;
  724. function MaxValue(const Data: array of Integer): Integer;
  725. begin
  726. Result:=MaxValue(PInteger(@Data[0]),High(Data)+1)
  727. end;
  728. function maxvalue(const data : PInteger; Const N : Integer) : Integer;
  729. var
  730. i : longint;
  731. begin
  732. { get an initial value }
  733. maxvalue:=data[0];
  734. for i:=1 to N-1 do
  735. if data[i]>maxvalue then
  736. maxvalue:=data[i];
  737. end;
  738. function Min(a, b: Integer): Integer;
  739. begin
  740. if a < b then
  741. Result := a
  742. else
  743. Result := b;
  744. end;
  745. function Max(a, b: Integer): Integer;
  746. begin
  747. if a > b then
  748. Result := a
  749. else
  750. Result := b;
  751. end;
  752. function Min(a, b: Cardinal): Cardinal;
  753. begin
  754. if a < b then
  755. Result := a
  756. else
  757. Result := b;
  758. end;
  759. function Max(a, b: Cardinal): Cardinal;
  760. begin
  761. if a > b then
  762. Result := a
  763. else
  764. Result := b;
  765. end;
  766. function Min(a, b: Int64): Int64;
  767. begin
  768. if a < b then
  769. Result := a
  770. else
  771. Result := b;
  772. end;
  773. function Max(a, b: Int64): Int64;
  774. begin
  775. if a > b then
  776. Result := a
  777. else
  778. Result := b;
  779. end;
  780. {$ifdef FPC_HAS_TYPE_SINGLE}
  781. function Min(a, b: Single): Single;
  782. begin
  783. if a < b then
  784. Result := a
  785. else
  786. Result := b;
  787. end;
  788. function Max(a, b: Single): Single;
  789. begin
  790. if a > b then
  791. Result := a
  792. else
  793. Result := b;
  794. end;
  795. {$endif FPC_HAS_TYPE_SINGLE}
  796. {$ifdef FPC_HAS_TYPE_DOUBLE}
  797. function Min(a, b: Double): Double;
  798. begin
  799. if a < b then
  800. Result := a
  801. else
  802. Result := b;
  803. end;
  804. function Max(a, b: Double): Double;
  805. begin
  806. if a > b then
  807. Result := a
  808. else
  809. Result := b;
  810. end;
  811. {$endif FPC_HAS_TYPE_DOUBLE}
  812. {$ifdef FPC_HAS_TYPE_EXTENDED}
  813. function Min(a, b: Extended): Extended;
  814. begin
  815. if a < b then
  816. Result := a
  817. else
  818. Result := b;
  819. end;
  820. function Max(a, b: Extended): Extended;
  821. begin
  822. if a > b then
  823. Result := a
  824. else
  825. Result := b;
  826. end;
  827. {$endif FPC_HAS_TYPE_EXTENDED}
  828. end.
  829. {
  830. $Log$
  831. Revision 1.15 2003-11-09 21:52:54 michael
  832. + Added missing sign functions
  833. Revision 1.14 2003/10/29 19:10:07 jonas
  834. * fixed arctan2
  835. Revision 1.13 2003/10/26 15:58:05 florian
  836. * fixed arctan2 to handle x=0 correctly as well
  837. Revision 1.12 2003/09/01 20:46:59 peter
  838. * small fixes for sparc
  839. Revision 1.11 2003/04/24 09:38:12 florian
  840. * min/max must check the compiler capabilities
  841. Revision 1.10 2003/04/24 09:21:59 florian
  842. + moved cpu dependend code to mathuh.inc and mathu.inc
  843. Revision 1.9 2003/01/03 20:34:02 peter
  844. * i386 fpu controlword functions added
  845. Revision 1.8 2002/09/07 21:06:12 carl
  846. * cleanup of parameters
  847. - remove assembler code
  848. Revision 1.7 2002/09/07 16:01:22 peter
  849. * old logs removed and tabs fixed
  850. }