bfloat.red 104 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817
  1. COMMENT Module for Arbitrary Precision Real Arithmetic;
  2. SYMBOLIC;
  3. COMMENT *** Tables for Bigfloats ***;
  4. GLOBAL '(DOMAINLIST!*);
  5. DOMAINLIST!* := UNION('(!:BF!:),DOMAINLIST!*);
  6. PUT('BIGFLOAT,'TAG,'!:BF!:);
  7. PUT('!:BF!:,'DNAME,'BIGFLOAT);
  8. FLAG('(!:BF!:),'FIELD);
  9. PUT('!:BF!:,'I2D,'I2BF!:);
  10. PUT('!:FT!:,'!:BF!:,'!*FT2BF);
  11. PUT('!:RN!:,'!:BF!:,'!*RN2BF);
  12. PUT('!:BF!:,'MINUSP,'MINUSP!:);
  13. PUT('!:BF!:,'PLUS,'BFPLUS!:);
  14. PUT('!:BF!:,'TIMES,'TTIMES!:);
  15. PUT('!:BF!:,'DIFFERENCE,'TDIFFERENCE!:);
  16. PUT('!:BF!:,'QUOTIENT,'BFQUOTIENT!:);
  17. PUT('!:BF!:,'ZEROP,'ZEROP!:);
  18. PUT('!:BF!:,'PREPFN,'BFPREP!:);
  19. PUT('!:BF!:,'SPECPRN,'BFPRIN);
  20. COMMENT SMACROS needed;
  21. SYMBOLIC SMACRO PROCEDURE MT!: U; CADR U;
  22. SYMBOLIC SMACRO PROCEDURE EP!: U; CDDR U;
  23. SYMBOLIC PROCEDURE I2BF!: U; '!:BF!: . U . 0;
  24. SYMBOLIC PROCEDURE !*RN2BF U;
  25. BEGIN SCALAR X;
  26. X := GET('!:BF!:,'I2D);
  27. RETURN APPLY(GET('!:BF!:,'QUOTIENT),
  28. LIST(APPLY(X,LIST CADR U),APPLY(X,LIST CDDR U)))
  29. END;
  30. SYMBOLIC PROCEDURE !*FT2BF U; CONV!:A2BF CDR U;
  31. GLOBAL '(!:PREC!:);
  32. SYMBOLIC PROCEDURE BFPLUS!:(U,V);
  33. %value is sum of U and V, or zero (NIL) if outside precision;
  34. BEGIN SCALAR X,Y;
  35. X := TPLUS!:(U,V);
  36. Y := '!:BF!: . ABS MT!: X . (EP!: X+!:PREC!:-1);
  37. RETURN IF LESSP!:(Y,ABS!: U) AND LESSP!:(Y,ABS!: V) THEN NIL
  38. ELSE X
  39. END;
  40. SYMBOLIC PROCEDURE BFQUOTIENT!:(U,V);
  41. DIVIDE!:(U,V,!:PREC!:);
  42. SYMBOLIC PROCEDURE BFPREP!: U; U;
  43. SYMBOLIC PROCEDURE BFPRIN NMBR;
  44. %prints a big-float in a variety of formats. Still needs work
  45. %for fortran output;
  46. BEGIN INTEGER J,K; SCALAR U,V,W;
  47. NMBR := ROUND!:MT('!:BF!: . NMBR,!:PREC!:-2);
  48. IF ZEROP!:(NMBR) THEN RETURN PRIN2!* '!0;
  49. U := EXPLODE ABS(J := MT!: NMBR);
  50. K := EP!: NMBR;
  51. IF K>=0 THEN IF K>5 THEN GO TO ETYPE
  52. ELSE <<V := LIST('!.,'!0);
  53. WHILE (K := K-1)>=0 DO V := '!0 . V;
  54. U := NCONC(U,V)>>
  55. ELSE IF (K := ORDER!:(NMBR)+1)>0
  56. THEN <<V := U;
  57. WHILE (K := K-1)>0 DO V := CDR V;
  58. RPLACD(V,'!. . CDR V)>>
  59. ELSE IF K<-10 THEN GO TO ETYPE
  60. ELSE <<WHILE (K := K+1)<=0 DO U := '!0 . U;
  61. U := '!0 . '!. . U>>;
  62. BFPRIN1(U,J);
  63. RETURN NMBR;
  64. ETYPE:
  65. IF NULL( CDR(U)) THEN RPLACD(U , LIST('!0));
  66. U:= CAR U . '!. . CDR U;
  67. J := BFPRIN1(U,J);
  68. IF J=0 THEN <<PRIN2!*("E " ); J:=2>> ELSE
  69. IF J=1 THEN <<PRIN2!*(" E " ); J:=4>> ELSE
  70. IF J=2 THEN <<PRIN2!*(" E "); J:=0>> ELSE
  71. IF J=3 THEN <<PRIN2!*(" E " ); J:=0>> ELSE
  72. IF J=4 THEN <<PRIN2!*(" E "); J:=2>>;
  73. U:=EXPLODE( K:=ORDER!:(NMBR));
  74. IF K>=0 THEN U:=CONS('!+,U);
  75. WHILE U DO <<PRIN2!*( CAR(U)); U:=CDR(U); J:=J+1;
  76. IF J=5 THEN <<PRIN2!*(" "); J:=0>> >>;
  77. RETURN NMBR
  78. END;
  79. SYMBOLIC PROCEDURE BFPRIN1(U,J);
  80. BEGIN SCALAR V,W;
  81. IF J<0 THEN U := '!- . U;
  82. %suppress trailing zeros;
  83. V := U;
  84. WHILE NOT(CAR V EQ '!.) DO V := CDR V;
  85. V := CDR V;
  86. L: WHILE CDR V AND NOT(CADR V EQ '!0) DO V := CDR V;
  87. W := CDR V;
  88. WHILE W AND CAR W EQ '!0 DO W := CDR W;
  89. IF NULL W THEN RPLACD(V,NIL) ELSE <<V := W; GO TO L>>;
  90. %now print the number;
  91. J := 0;
  92. FOR EACH CHAR IN U DO <<PRIN2!* CHAR; J := J+1;
  93. IF J=5 THEN <<IF !*NAT THEN PRIN2!* '! ;
  94. J := 0>>>>;
  95. RETURN J
  96. END;
  97. SYMBOLIC PROCEDURE BFLERRMSG U;
  98. %Standard error message for BFLOAT module;
  99. REDERR LIST("Invalid argument to",U);
  100. COMMENT Simp property for !:BF!: since PREP is identity;
  101. SYMBOLIC PROCEDURE !:BF!:SIMP U; ('!:BF!: . U) ./ 1;
  102. PUT('!:BF!:,'SIMPFN,'!:BF!:SIMP);
  103. !:PREC!: := 12; %default value;
  104. INITDMODE 'BIGFLOAT;
  105. SYMBOLIC PROCEDURE PRECISION N;
  106. IF N=0 THEN !:PREC!:-2 ELSE <<!:PREC!: := N+2; N>>;
  107. SYMBOLIC OPERATOR PRECISION;
  108. COMMENT *** Tables for Elementary Function Numerical Values ***;
  109. DEFLIST('((EXP BIGFLOAT) (LOG BIGFLOAT) (SIN BIGFLOAT) (COS BIGFLOAT)
  110. (TAN BIGFLOAT) (ASIN BIGFLOAT) (ACOS BIGFLOAT)
  111. (ATAN BIGFLOAT) (SQRT BIGFLOAT)),
  112. 'TARGETMODE);
  113. PUT('EXP,'DOMAINFN,'EXP!*);
  114. SYMBOLIC PROCEDURE EXP!* U; EXP!:(U,!:PREC!:);
  115. PUT('LOG,'DOMAINFN,'LOG!*);
  116. SYMBOLIC PROCEDURE LOG!* U; LOG!:(U,!:PREC!:);
  117. PUT('SIN,'DOMAINFN,'SIN!*);
  118. SYMBOLIC PROCEDURE SIN!* U; SIN!:(U,!:PREC!:);
  119. PUT('COS,'DOMAINFN,'COS!*);
  120. SYMBOLIC PROCEDURE COS!* U; COS!:(U,!:PREC!:);
  121. PUT('TAN,'DOMAINFN,'TAN!*);
  122. SYMBOLIC PROCEDURE TAN!* U; TAN!:(U,!:PREC!:);
  123. PUT('ASIN,'DOMAINFN,'ASIN!*);
  124. SYMBOLIC PROCEDURE ASIN!* U; ASIN!:(U,!:PREC!:);
  125. PUT('ACOS,'DOMAINFN,'ACOS!*);
  126. SYMBOLIC PROCEDURE ACOS!* U; ACOS!:(U,!:PREC!:);
  127. PUT('ATAN,'DOMAINFN,'ATAN!*);
  128. SYMBOLIC PROCEDURE ATAN!* U; ATAN!:(U,!:PREC!:);
  129. PUT('SQRT,'DOMAINFN,'SQRT!*);
  130. SYMBOLIC PROCEDURE SQRT!* U; SQRT!:(U,!:PREC!:);
  131. COMMENT *** Tables for constants with numerical values ***;
  132. DEFLIST('((E BIGFLOAT) (PI BIGFLOAT)),'TARGETMODE);
  133. PUT('E,'DOMAINFN,'E!*);
  134. PUT('PI,'DOMAINFN,'PI!*);
  135. SYMBOLIC PROCEDURE PI!*;
  136. IF !:PREC!:>1000 THEN !:BIGPI !:PREC!: ELSE !:PI !:PREC!:;
  137. SYMBOLIC PROCEDURE E!*; !:E !:PREC!:;
  138. %*************************************************************$
  139. %*************************************************************$
  140. %** **$
  141. %** ARBITRARY PRECISION REAL ARITHMETIC SYSTEM **$
  142. %** machine-independent version **$
  143. %** **$
  144. %** made by **$
  145. %** **$
  146. %** Tateaki Sasaki **$
  147. %** **$
  148. %** The University of Utah, March 1979 **$
  149. %** **$
  150. %**=========================================================**$
  151. %** **$
  152. %** For design philosophy and characteristics of this **$
  153. %** system, see T. Sasaki, "An Arbitrary Precision **$
  154. %** Real Arithmetic Package in REDUCE," Proceedings **$
  155. %** of EUROSAM '79, Marseille (France), June 1979. **$
  156. %** **$
  157. %** For implementing and using this system, see T. Sasaki, **$
  158. %** "Manual for Arbitrary Precision Real Arithmetic **$
  159. %** System in REDUCE," Operating Report of Utah Sym- **$
  160. %** bolic Computation Group. **$
  161. %** **$
  162. %**=========================================================**$
  163. %** **$
  164. %** In order to speed up this system, you have only to **$
  165. %** rewrite four routines (DECPREC!:, INCPREC!:, **$
  166. %** PRECI!:, and ROUND!:LAST) machine-dependently. **$
  167. %** **$
  168. %**=========================================================**$
  169. %** **$
  170. %** Table of Contents **$
  171. %** **$
  172. %** 1-1. Initialization. **$
  173. %** 1-2. Constructor, selectors and basic predicate. **$
  174. %** 1-3. Temporary routines for rational number arithmetic. **$
  175. %** 1-4. Counters. **$
  176. %** 1-5. Routines for converting the numeric type. **$
  177. %** 1-6. Routines for converting a big-float number. **$
  178. %** 1-7. Routines for reading/printing numbers. **$
  179. %** 2-1. Arithmetic manipulation routines. **$
  180. %** 2-2. Arithmetic predicates. **$
  181. %** 3-1. Elementary constants. **$
  182. %** 3-2. Routines for saving constants. **$
  183. %** 4-1. Elementary functions. **$
  184. %** 5-1. Appendix: routines for defining infix operators. **$
  185. %** **$
  186. %*************************************************************$
  187. %*************************************************************$
  188. %*************************************************************$
  189. %*************************************************************$
  190. %** **$
  191. %** 1-1. Initialization. **$
  192. %** **$
  193. %*************************************************************$
  194. %*************************************************************$
  195. SYMBOLIC$ % Mode ====> SYMBOLIC mode $
  196. GLOBAL '(!:PREC!:)$ % For the global precision $
  197. %!:PREC!: := NIL$ % Default value of !:PREC!:$
  198. %*************************************************************$
  199. %*************************************************************$
  200. %** **$
  201. %** 1-2. CONSTRUCTOR, SELECTORS and basic PREDICATE. **$
  202. %** **$
  203. %*************************************************************$
  204. %*************************************************************$
  205. %*************************************************************$
  206. SYMBOLIC SMACRO PROCEDURE MAKE!:BF(MT,EP); %****************$
  207. %========================================================$
  208. % This function constructs an internal representation of $
  209. % a number "n" composed of the mantissa MT and the $
  210. % exponent EP with the base 10. The magnitude of $
  211. % the number thus constructed is hence MT*10**EP. $
  212. % **** CAUTION! MT and EP are integers. So, EP denotes $
  213. % **** the order of the last figure in "n", where $
  214. % **** ORDER(n)=k if 10**k <= ABS(n) < 10**(k+1), $
  215. % **** with the exception ORDER(0)=0. $
  216. % The number "n" is said to be of precision "k" if its $
  217. % mantissa is a k-figure number. $
  218. % MT and EP are any integers (positive or negative). So,$
  219. % you can handle any big or small numbers. In this $
  220. % sense, "BF" denotes a BIG-FLOATING-POINT number. $
  221. % Hereafter, an internal representation of a number $
  222. % constructed by MAKE!:BF is referred to as a $
  223. % BIG-FLOAT representation. $
  224. %========================================================$
  225. CONS('!:BF!: , CONS(MT,EP))$
  226. %*************************************************************$
  227. SYMBOLIC PROCEDURE BFP!:(X); %******************************$
  228. %==============================================$
  229. % This function returns T if X is a BIG-FLOAT $
  230. % representation, else it returns NIL. $
  231. % X is any LISP entity. $
  232. %==============================================$
  233. IF ATOM(X) THEN NIL ELSE
  234. IF CAR(X) EQ '!:BF!: THEN T ELSE NIL$
  235. %*************************************************************$
  236. SYMBOLIC SMACRO PROCEDURE MT!:(NMBR); %*********************$
  237. %====================================================$
  238. % This function selects the mantissa of a number "n".$
  239. % NMBR is a BIG-FLOAT representation of "n". $
  240. %====================================================$
  241. CADR(NMBR)$
  242. %*************************************************************$
  243. SYMBOLIC SMACRO PROCEDURE EP!:(NMBR); %*********************$
  244. %====================================================$
  245. % This function selects the exponent of a number "n".$
  246. % NMBR is a BIG-FLOAT representation of "n". $
  247. %====================================================$
  248. CDDR(NMBR)$
  249. %*************************************************************$
  250. %*************************************************************$
  251. %** **$
  252. %** 1-3. Temporary routines for rational number arithmetic. **$
  253. %** **$
  254. %*************************************************************$
  255. %*************************************************************$
  256. %*************************************************************$
  257. SYMBOLIC PROCEDURE MAKE!:RATNUM(NM,DN); %*******************$
  258. %=====================================================$
  259. % This function constructs an internal representation $
  260. % of a rational number composed of the numerator $
  261. % NM and the denominator DN. $
  262. % NM and DN are any integers (positive or negative). $
  263. % **** Four routines in this section are temporary. $
  264. % **** That is, if your system has own routines $
  265. % **** for rational number arithmetic, you can $
  266. % **** accommodate our system to yours only by $
  267. % **** redefining these four routines. $
  268. %=====================================================$
  269. IF DN=0 THEN REDERR
  270. ("ZERO DENOMINATOR IN MAKE!:RATNUM") ELSE
  271. IF DN>0 THEN CONS('!:RATNUM!: , CONS( NM, DN))
  272. ELSE CONS('!:RATNUM!: , CONS(-NM,-DN))$
  273. %*************************************************************$
  274. SYMBOLIC PROCEDURE RATNUMP!:(X); %**************************$
  275. %===================================================$
  276. % This function returns T if X is a rational number $
  277. % representation, else it returns NIL. $
  278. % X is any LISP entity. $
  279. %===================================================$
  280. IF ATOM(X) THEN NIL ELSE
  281. IF CAR(X) EQ '!:RATNUM!: THEN T ELSE NIL$
  282. %*************************************************************$
  283. SYMBOLIC SMACRO PROCEDURE NUMR!:(RNMBR); %******************$
  284. %===================================================$
  285. % This function selects the numerator of a rational $
  286. % number "n". $
  287. % RNMBR is a rational number representation of "n". $
  288. %===================================================$
  289. CADR(RNMBR)$
  290. %*************************************************************$
  291. SYMBOLIC SMACRO PROCEDURE DENM!:(RNMBR); %******************$
  292. %=====================================================$
  293. % This function selects the denominator of a rational $
  294. % number "n". $
  295. % RNMBR is a rational number representation of "n". $
  296. %=====================================================$
  297. CDDR(RNMBR)$
  298. %*************************************************************$
  299. %*************************************************************$
  300. %** **$
  301. %** 1-4. COUNTERS. **$
  302. %** **$
  303. %*************************************************************$
  304. %*************************************************************$
  305. %*************************************************************$
  306. SYMBOLIC SMACRO PROCEDURE PRECI!:(NMBR); %******************$
  307. %====================================================$
  308. % This function counts the precision of a number "n".$
  309. % NMBR is a BIG-FLOAT representation of "n". $
  310. %====================================================$
  311. LENGTH( EXPLODE( ABS( MT!:(NMBR))))$
  312. %*************************************************************$
  313. SYMBOLIC PROCEDURE ORDER!:(NMBR); %*************************$
  314. %================================================$
  315. % This function counts the order of a number "n".$
  316. % NMBR is a BIG-FLOAT representation of "n". $
  317. % **** ORDER(n)=k if 10**k <= ABS(n) < 10**(k+1) $
  318. % **** when n is not 0, and ORDER(0)=0. $
  319. %================================================$
  320. IF MT!:(NMBR)=0 THEN 0
  321. ELSE PRECI!:(NMBR) + EP!:(NMBR) - 1$
  322. %*************************************************************$
  323. %*************************************************************$
  324. %** **$
  325. %** 1-5. Routines for converting the numeric type. **$
  326. %** **$
  327. %*************************************************************$
  328. %*************************************************************$
  329. %*************************************************************$
  330. SYMBOLIC PROCEDURE CONV!:A2BF(N); %*************************$
  331. %======================================================$
  332. % This function converts a number N or a number-like $
  333. % entity N to a <BIG-FLOAT>, i.e., a BIG-FLOAT $
  334. % representation of N. $
  335. % N is either an integer, a floating-point number, $
  336. % a string representing a number, a rational $
  337. % number, or a <BIG-FLOAT>. $
  338. % **** This function is the most general conversion $
  339. % **** function to get a BIG-FLOAT representation.$
  340. % **** In this sense, A means an Arbitrary number.$
  341. % **** A rational number is converted to a <BIG-FLOAT> $
  342. % **** of precision !:PREC!: if !:PREC!: is not $
  343. % **** NIL, else the precision is set 50. $
  344. %======================================================$
  345. IF BFP!:(N) THEN N ELSE
  346. IF FIXP(N) THEN MAKE!:BF(N,0) ELSE
  347. IF FLOATP(N) THEN READ!:NUM(N) ELSE
  348. IF STRINGP(N) THEN READ!:NUM(N) ELSE
  349. IF RATNUMP!:(N) THEN CONV!:R2BF(N ,
  350. (IF !:PREC!: THEN !:PREC!: ELSE 50) )
  351. ELSE BFLERRMSG 'CONV!:A2BF$
  352. %*************************************************************$
  353. SYMBOLIC PROCEDURE CONV!:F2BF(FNMBR); %*********************$
  354. %================================================$
  355. % This function converts a floating-point number $
  356. % FNMBR to a <BIG-FLOAT>, i.e., a BIG-FLOAT $
  357. % representation. $
  358. % FNMBR is a floating-point number. $
  359. % **** CAUSION!. If you input a number, say, 0.1,$
  360. % **** some systems do not accept it as 0.1 $
  361. % **** but may accept it as 0.09999999. $
  362. % **** In such a case, you had better use $
  363. % **** CONV!:S2BF than to use CONV!:F2BF. $
  364. %================================================$
  365. IF FLOATP(FNMBR) THEN READ!:NUM(FNMBR)
  366. ELSE BFLERRMSG 'CONV!:F2BF$
  367. %*************************************************************$
  368. SYMBOLIC PROCEDURE CONV!:I2BF(INTGR); %*********************$
  369. %====================================================$
  370. % This function converts an integer INTGR to a <BIG- $
  371. % FLOAT>, i.e., a BIG-FLOAT representation. $
  372. % INTGR is an integer. $
  373. %====================================================$
  374. IF FIXP(INTGR) THEN MAKE!:BF(INTGR,0)
  375. ELSE BFLERRMSG 'CONV!:I2BF$
  376. %*************************************************************$
  377. SYMBOLIC PROCEDURE CONV!:R2BF(RNMBR,K); %*******************$
  378. %=====================================================$
  379. % This function converts a rational number RNMBR to a $
  380. % <BIG-FLOAT> of precision K, i.e., a BIG-FLOAT $
  381. % representation with a given precision. $
  382. % RNMBR is a rational number representation. $
  383. % K is a positive integer. $
  384. %=====================================================$
  385. IF RATNUMP!:(RNMBR) AND FIXP(K) AND K>0 THEN
  386. DIVIDE!:( MAKE!:BF( NUMR!:(RNMBR),0) ,
  387. MAKE!:BF( DENM!:(RNMBR),0) , K)
  388. ELSE BFLERRMSG 'CONV!:R2BF$
  389. %*************************************************************$
  390. SYMBOLIC PROCEDURE CONV!:S2BF(STRNG); %*********************$
  391. %==============================================$
  392. % This function converts a string representing $
  393. % a number "n" to a <BIG-FLOAT>, i.e., $
  394. % a BIG-FLOAT representation. $
  395. % STRNG is a string representing "n". "n" may $
  396. % be an integer, a floating-point number $
  397. % of any precision, or a rational number. $
  398. % **** CAUTION! Some systems may set the $
  399. % **** maximum size of string. $
  400. %==============================================$
  401. IF STRINGP(STRNG) THEN READ!:NUM(STRNG)
  402. ELSE BFLERRMSG 'CONV!:S2BF$
  403. %*************************************************************$
  404. SYMBOLIC PROCEDURE CONV!:BF2F(NMBR); %**********************$
  405. %=========================================================$
  406. % This function converts a <BIG-FLOAT>, i.e., a BIG-FLOAT $
  407. % representation of "n", to a floating-point number. $
  408. % NMBR is a BIG-FLOAT representation of the number "n". $
  409. %=========================================================$
  410. IF BFP!:(NMBR) THEN
  411. TIMES( FLOAT( MT!:(NMBR)) ,
  412. FLOAT( EXPT(10 , EP!:(NMBR))) )
  413. ELSE BFLERRMSG 'CONV!:BF2F$
  414. %*************************************************************$
  415. SYMBOLIC PROCEDURE CONV!:BF2I(NMBR); %**********************$
  416. %=========================================================$
  417. % This function converts a <BIG-FLOAT>, i.e., a BIG-FLOAT $
  418. % representation of "n", to an integer. The result $
  419. % is the integer part of "n". $
  420. % **** For getting the nearest integer to "n", please use $
  421. % **** the combination MT!:( CONV!:EP(NMBR,0)). $
  422. % NMBR is a BIG-FLOAT representation of the number "n". $
  423. %=========================================================$
  424. IF BFP!:(NMBR) THEN
  425. IF EP!:(NMBR:=CUT!:EP(NMBR,0)) = 0 THEN MT!:(NMBR)
  426. ELSE MT!:(NMBR)*EXPT(10 , EP!:(NMBR))
  427. ELSE BFLERRMSG 'CONV!:BF2I$
  428. %*************************************************************$
  429. SYMBOLIC PROCEDURE CONV!:BF2R(NMBR); %**********************$
  430. %=========================================================$
  431. % This function converts a <BIG-FLOAT>, i.e., a BIG-FLOAT $
  432. % representation of "n", to a rational number. $
  433. % NMBR is a BIG-FLOAT representation of "n". $
  434. % **** The numerator and the denominator of the result $
  435. % **** have no common divisor. $
  436. %=========================================================$
  437. IF BFP!:(NMBR) THEN
  438. BEGIN INTEGER NN,ND,M,N,Q;
  439. IF (Q:=EP!:(NMBR)) >= 0 THEN
  440. <<NN:=MT!:(NMBR)*EXPT(10,Q); ND:=1; M:=1>>
  441. ELSE <<NN:=MT!:(NMBR); ND:=EXPT(10,-Q);
  442. IF ABS(NN) > ABS(ND) THEN <<M:=NN; N:=ND>>
  443. ELSE <<M:=ND; N:=NN>>;
  444. WHILE NOT(N=0) DO
  445. <<Q:=REMAINDER(M,N); M:=N; N:=Q>> >>;
  446. RETURN MAKE!:RATNUM( NN/M , ND/M);
  447. END
  448. ELSE BFLERRMSG 'CONV!:BF2R$
  449. %*************************************************************$
  450. %*************************************************************$
  451. %** **$
  452. %** 1-6. Routines for converting a BIG-FLOAT number. **$
  453. %** **$
  454. %*************************************************************$
  455. %*************************************************************$
  456. %*************************************************************$
  457. SYMBOLIC PROCEDURE DECPREC!:(NMBR,K); %*********************$
  458. %======================================================$
  459. % This function converts a number "n" to an equivalent $
  460. % number the precision of which is decreased by K.$
  461. % **** CAUTION! No rounding is made. $
  462. % NMBR is a BIG-FLOAT representation of "n". $
  463. % K is a positive integer. $
  464. %======================================================$
  465. MAKE!:BF( MT!:(NMBR)/EXPT(10,K) , EP!:(NMBR)+K)$
  466. %*************************************************************$
  467. SYMBOLIC PROCEDURE INCPREC!:(NMBR,K); %*********************$
  468. %======================================================$
  469. % This function converts a number "n" to an equivalent $
  470. % number the precision of which is increased by K.$
  471. % **** CAUTION! No rounding is made. $
  472. % NMBR is a BIG-FLOAT representation of "n". $
  473. % K is a positive integer. $
  474. %======================================================$
  475. MAKE!:BF( MT!:(NMBR)*EXPT(10,K) , EP!:(NMBR)-K)$
  476. %*************************************************************$
  477. SYMBOLIC PROCEDURE CONV!:MT(NMBR,K); %**********************$
  478. %===========================================$
  479. % This function converts a number "n" to an $
  480. % equivalent number of precision K by $
  481. % rounding "n" or adding "0"s to "n". $
  482. % NMBR is a BIG-FLOAT representation of "n".$
  483. % K is a positive integer. $
  484. %===========================================$
  485. IF BFP!:(NMBR) AND FIXP(K) AND K>0 THEN
  486. IF (K:=PRECI!:(NMBR)-K) = 0 THEN NMBR
  487. ELSE IF K<0 THEN INCPREC!:(NMBR,-K)
  488. ELSE ROUND!:LAST( DECPREC!:(NMBR,K-1))
  489. ELSE BFLERRMSG 'CONV!:MT$
  490. %*************************************************************$
  491. SYMBOLIC PROCEDURE CONV!:EP(NMBR,K); %**********************$
  492. %==============================================$
  493. % This function converts a number "n" to an $
  494. % equivalent number having the exponent K $
  495. % by rounding "n" or adding "0"s to "n". $
  496. % NMBR is a BIG-FLOAT representation of "n". $
  497. % K is an integer (positive or negative). $
  498. %==============================================$
  499. IF BFP!:(NMBR) AND FIXP(K) THEN
  500. IF (K:=K-EP!:(NMBR)) = 0 THEN NMBR
  501. ELSE IF K<0 THEN INCPREC!:(NMBR,-K)
  502. ELSE ROUND!:LAST( DECPREC!:(NMBR,K-1))
  503. ELSE BFLERRMSG 'CONV!:EP$
  504. %*************************************************************$
  505. SYMBOLIC PROCEDURE CUT!:MT(NMBR,K); %***********************$
  506. %======================================================$
  507. % This function returns a given number "n" unchanged $
  508. % if its precision is not greater than K, else it $
  509. % cuts off its mantissa at the (K+1)th place and $
  510. % returns an equivalent number of precision K. $
  511. % **** CAUTION! No rounding is made. $
  512. % NMBR is a BIG-FLOAT representation of "n". $
  513. % K is a positive integer. $
  514. %======================================================$
  515. IF BFP!:(NMBR) AND FIXP(K) AND K>0 THEN
  516. IF (K:=PRECI!:(NMBR)-K) <= 0 THEN NMBR
  517. ELSE DECPREC!:(NMBR,K)
  518. ELSE BFLERRMSG 'CUT!:MT$
  519. %*************************************************************$
  520. SYMBOLIC PROCEDURE CUT!:EP(NMBR,K); %***********************$
  521. %======================================================$
  522. % This function returns a given number "n" unchanged $
  523. % if its exponent is not less than K, else it $
  524. % cuts off its mantissa and returns an equivalent $
  525. % number of exponent K. $
  526. % **** CAUTION! No rounding is made. $
  527. % NMBR is a BIG-FLOAT representation of "n". $
  528. % K is an integer (positive or negative). $
  529. %======================================================$
  530. IF BFP!:(NMBR) AND FIXP(K) THEN
  531. IF (K:=K-EP!:(NMBR)) <= 0 THEN NMBR
  532. ELSE DECPREC!:(NMBR,K)
  533. ELSE BFLERRMSG 'CUT!:EP$
  534. %*************************************************************$
  535. SYMBOLIC PROCEDURE MATCH!:(N1,N2); %************************$
  536. %==========================================================$
  537. % This function converts either "n1" or "n2" so that they $
  538. % have the same exponent, which is the smaller of $
  539. % the exponents of "n1" and "n2". $
  540. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  541. % **** CAUTION! Using this function, one of the previous $
  542. % **** expressions of "n1" and "n2" is lost. $
  543. %==========================================================$
  544. IF BFP!:(N1) AND BFP!:(N2) THEN
  545. BEGIN INTEGER E1,E2; SCALAR N;
  546. IF (E1:=EP!:(N1)) = (E2:=EP!:(N2)) THEN RETURN T;
  547. IF E1>E2 THEN <<RPLACA(N1 , CAR(N:=CONV!:EP(N1,E2)));
  548. RPLACD(N1 , CDR(N)) >>
  549. ELSE <<RPLACA(N2 , CAR(N:=CONV!:EP(N2,E1)));
  550. RPLACD(N2 , CDR(N)) >>; RETURN T;
  551. END
  552. ELSE BFLERRMSG 'MATCH!:$
  553. %*************************************************************$
  554. SYMBOLIC PROCEDURE ROUND!:MT(NMBR,K); %*********************$
  555. %========================================================$
  556. % This function rounds a number "n" at the (K+1)th place $
  557. % and returns an equivalent number of precision K $
  558. % if the precision of "n" is greater than K, else $
  559. % it returns the given number unchanged. $
  560. % NMBR is a BIG-FLOAT representation of "n". $
  561. % K is a positive integer. $
  562. %========================================================$
  563. IF BFP!:(NMBR) AND FIXP(K) AND K>0 THEN
  564. IF (K:=PRECI!:(NMBR)-K-1) < 0 THEN NMBR
  565. ELSE IF K=0 THEN ROUND!:LAST(NMBR)
  566. ELSE ROUND!:LAST( DECPREC!:(NMBR,K))
  567. ELSE BFLERRMSG 'ROUND!:MT$
  568. %*************************************************************$
  569. SYMBOLIC PROCEDURE ROUND!:EP(NMBR,K); %*********************$
  570. %==================================================$
  571. % This function rounds a number "n" and returns an $
  572. % equivalent number having the exponent K if $
  573. % the exponent of "n" is less than K, else $
  574. % it returns the given number unchanged. $
  575. % NMBR is a BIG-FLOAT representation of "n". $
  576. % K is an integer (positive or negative). $
  577. %==================================================$
  578. IF BFP!:(NMBR) AND FIXP(K) THEN
  579. IF (K:=K-1-EP!:(NMBR)) < 0 THEN NMBR
  580. ELSE IF K=0 THEN ROUND!:LAST(NMBR)
  581. ELSE ROUND!:LAST( DECPREC!:(NMBR,K))
  582. ELSE BFLERRMSG 'ROUND!:EP$
  583. %*************************************************************$
  584. SYMBOLIC PROCEDURE ROUND!:LAST(NMBR); %*********************$
  585. %=====================================================$
  586. % This function rounds a number "n" at its last place.$
  587. % NMBR is a BIG-FLOAT representation of "n". $
  588. %=====================================================$
  589. BEGIN SCALAR N;
  590. N := DIVIDE(ABS(MT!:(NMBR)),10);
  591. IF CDR N<5 THEN N := CAR N ELSE N := CAR N+1;
  592. IF MT!:(NMBR) < 0 THEN N := -N;
  593. RETURN MAKE!:BF(N , EP!:(NMBR)+1);
  594. END$
  595. %*************************************************************$
  596. %*************************************************************$
  597. %** **$
  598. %** 1-7. Routines for reading/printing numbers. **$
  599. %** **$
  600. %*************************************************************$
  601. %*************************************************************$
  602. %*************************************************************$
  603. SYMBOLIC PROCEDURE READ!:LNUM(L); %*************************$
  604. %=======================================================$
  605. % This function reads a long number "n" represented by $
  606. % a list in a way described below, and constructs $
  607. % a BIG-FLOAT representation of "n". $
  608. % **** Using this function, you can input any long $
  609. % **** floating-point numbers without difficulty. $
  610. % L is a list of integers, the first element of which $
  611. % gives the order of "n" and all the next elements $
  612. % when concatenated give the mantissa of "n". $
  613. % **** ORDER(n)=k if 10**k <= ABS(n) < 10**(k+1). $
  614. % **** Except for the first element, all integers in L $
  615. % **** should not begin with "0" because some $
  616. % **** systems suppress leading zeros. $
  617. %=======================================================$
  618. IF MEMBER(NIL , MAPCAR(L,'FIXP)) THEN BFLERRMSG
  619. 'READ!:LNUM ELSE
  620. BEGIN INTEGER MT,EP,K,SIGN; SCALAR U,V;
  621. MT:=0;
  622. EP:=CAR( U:=L)+1;
  623. IF CADR(L)>0 THEN SIGN:=1 ELSE SIGN:=-1;
  624. WHILE U:=CDR(U) DO
  625. <<V:=EXPLODE( ABS( CAR(U))); K:=0;
  626. WHILE V DO <<K:=K+1; V:=CDR(V) >>;
  627. MT:=MT*EXPT(10,K)+ABS( CAR(U)); EP:=EP-K>>;
  628. RETURN MAKE!:BF(SIGN*MT,EP);
  629. END$
  630. %*************************************************************$
  631. SYMBOLIC PROCEDURE READ!:NUM(N); %**************************$
  632. %========================================================$
  633. % This function reads a number or a number-like entity N $
  634. % and constructs a BIG-FLOAT representation of it. $
  635. % N is an integer, a floating-point number, or a string $
  636. % representing a number. $
  637. % **** If the system does not accept or may incorrectly $
  638. % **** accept the floating-point numbers, you can $
  639. % **** input them as strings such as "1.234E-56", $
  640. % **** "-78.90 D+12" , "+3456 B -78", or "901/234". $
  641. % **** A rational number in a string form is converted $
  642. % **** to a <BIG-FLOAT> of precision !:PREC!: if $
  643. % **** !:PREC!: is not NIL, else the precision of $
  644. % **** the result is set 50. $
  645. % **** Some systems set the maximum size of strings. If $
  646. % **** you want to input long numbers exceeding $
  647. % **** such a maximum size, please use READ!:LNUM. $
  648. %========================================================$
  649. IF FIXP(N) THEN MAKE!:BF(N,0) ELSE
  650. IF NOT( NUMBERP(N) OR STRINGP(N)) THEN BFLERRMSG
  651. 'READ!:NUM ELSE
  652. BEGIN INTEGER J,M,SIGN; SCALAR CH,U,V,L,APPEAR!.,APPEAR!/;
  653. J:=M:=0;
  654. SIGN:=1;
  655. U:=V:=APPEAR!.:=APPEAR!/:=NIL;
  656. L:=EXPLODE(N);
  657. LOOP: CH:=CAR(L);
  658. IF DIGIT(CH) THEN <<U:=CONS(CH,U); J:=J+1>> ELSE
  659. IF CH EQ '!. THEN <<APPEAR!.:=T ; J:=0 >> ELSE
  660. IF CH EQ '!/ THEN <<APPEAR!/:=T; V:=U; U:=NIL>> ELSE
  661. IF CH EQ '!- THEN SIGN:=-1 ELSE
  662. IF CH EQ 'E OR CH EQ 'D OR CH EQ 'B
  663. OR CH EQ '!e OR CH EQ '!d OR CH EQ '!b THEN GO TO JUMP;
  664. ENDL: IF L:=CDR(L) THEN GOTO LOOP ELSE GOTO MAKE;
  665. JUMP: WHILE L:=CDR(L) DO
  666. <<IF DIGIT( CH:=CAR(L)) OR CH EQ '!-
  667. THEN V:=CONS(CH,V) >>;
  668. L:=REVERSE(V);
  669. IF CAR(L) EQ '!- THEN M:=-COMPRESS( CDR(L))
  670. ELSE M:= COMPRESS(L);
  671. MAKE: U:=REVERSE(U);
  672. V:=REVERSE(V);
  673. IF APPEAR!/ THEN RETURN CONV!:R2BF
  674. ( MAKE!:RATNUM( SIGN*COMPRESS(V) , COMPRESS(U)) ,
  675. (IF !:PREC!: THEN !:PREC!: ELSE 50) );
  676. IF APPEAR!. THEN J:=-J ELSE J:=0;
  677. IF SIGN=1 THEN U:=COMPRESS(U) ELSE U:=-COMPRESS(U);
  678. RETURN MAKE!:BF(U,J+M);
  679. END$
  680. %*************************************************************$
  681. SYMBOLIC PROCEDURE PRINT!:BF(NMBR,TYPE); %******************$
  682. %==========================================================$
  683. % This function prints a number "n" in the print-type TYPE.$
  684. % NMBR is a BIG-FLOAT representation of "n". $
  685. % TYPE is either 'N, 'I, 'E, 'F, 'L, 'R, meaning as: $
  686. % TYPE='N ... the internal representation is printed. $
  687. % TYPE='I ... the integer part is printed. $
  688. % TYPE='E ... <mantissa in form *.***>E<exponent>. $
  689. % TYPE='F ... <integer part>.<decimal part>. $
  690. % TYPE='L ... in a list form readable by READ!:LNUM. $
  691. % TYPE='R ... printed as a rational number. $
  692. % **** The number is printed by being inserted a blank $
  693. % **** after each five characters. Therefore, you $
  694. % **** can not use the printed numbers as input data, $
  695. % **** except when they are printed in type 'L. $
  696. %==========================================================$
  697. IF NOT( TYPE EQ 'N OR TYPE EQ 'I OR TYPE EQ 'E OR
  698. TYPE EQ 'F OR TYPE EQ 'L OR TYPE EQ 'R)
  699. OR NOT( BFP!:(NMBR)) THEN BFLERRMSG 'PRINT!:BF ELSE
  700. BEGIN INTEGER J,K; SCALAR U,V;
  701. IF ZEROP!:(NMBR) THEN NMBR:=MAKE!:BF(0,0);
  702. IF TYPE EQ 'I THEN GOTO ITYPE ELSE
  703. IF TYPE EQ 'E THEN GOTO ETYPE ELSE
  704. IF TYPE EQ 'F THEN GOTO FTYPE ELSE
  705. IF TYPE EQ 'L THEN GOTO LTYPE ELSE
  706. IF TYPE EQ 'R THEN GOTO RTYPE;
  707. NTYPE: PRINT(NMBR);
  708. RETURN T;
  709. ITYPE: U:=EXPLODE( CONV!:BF2I(NMBR));
  710. J:=0;
  711. WHILE U DO <<PRIN2( CAR(U)); U:=CDR(U); J:=J+1;
  712. IF J=5 THEN <<PRIN2(" "); J:=0>> >>;
  713. TERPRI(); RETURN T;
  714. ETYPE: U:=EXPLODE( ABS( J:=MT!:(NMBR)));
  715. IF NULL( CDR(U)) THEN RPLACD(U , LIST(0));
  716. IF J>=0 THEN U:=CONS( CAR(U) , CONS('!. , CDR(U)))
  717. ELSE U:=CONS('!- , CONS( CAR(U) , CONS('!.,CDR(U))));
  718. J:=0;
  719. WHILE U DO <<PRIN2( CAR(U)); U:=CDR(U); J:=J+1;
  720. IF J=5 THEN <<PRIN2(" "); J:=0>> >>;
  721. IF J=0 THEN <<PRIN2("E " ); J:=2>> ELSE
  722. IF J=1 THEN <<PRIN2(" E " ); J:=4>> ELSE
  723. IF J=2 THEN <<PRIN2(" E "); J:=0>> ELSE
  724. IF J=3 THEN <<PRIN2(" E " ); J:=0>> ELSE
  725. IF J=4 THEN <<PRIN2(" E "); J:=2>>;
  726. U:=EXPLODE( K:=ORDER!:(NMBR));
  727. IF K>=0 THEN U:=CONS('!+,U);
  728. WHILE U DO <<PRIN2( CAR(U)); U:=CDR(U); J:=J+1;
  729. IF J=5 THEN <<PRIN2(" "); J:=0>> >>;
  730. TERPRI(); RETURN T;
  731. FTYPE: U:=EXPLODE( ABS( MT!:(NMBR)));
  732. IF (J:=EP!:(NMBR)) >= 0 THEN
  733. <<V:=NIL; WHILE (J:=J-1)>=0 DO V:=CONS(0,V);
  734. U:=NCONC(U,V) >> ELSE
  735. IF (J:=ORDER!:(NMBR)+1) > 0 THEN
  736. <<V:=U; WHILE (J:=J-1)>0 DO V:=CDR(V);
  737. RPLACD(V , CONS('!.,CDR(V))) >>
  738. ELSE <<WHILE (J:=J+1)<=0 DO U:=CONS(0,U);
  739. U:=CONS(0 , CONS('!.,U)) >>;
  740. IF MT!:(NMBR) < 0 THEN U:=CONS('!-,U);
  741. J:=0;
  742. WHILE U DO <<PRIN2( CAR(U)); U:=CDR(U); J:=J+1;
  743. IF J=5 THEN <<PRIN2(" "); J:=0>> >>;
  744. TERPRI(); RETURN T;
  745. LTYPE: PRIN2(" '(");
  746. PRIN2( ORDER!:(NMBR));
  747. PRIN2(" ");
  748. U:=EXPLODE( MT!:(NMBR));
  749. J:=0;
  750. WHILE U DO <<PRIN2( CAR(U)); U:=CDR(U); J:=J+1;
  751. IF J>=5 AND U AND NOT( CAR(U) EQ '!0)
  752. THEN <<PRIN2(" "); J:=J-5>> >>;
  753. PRIN2(")"); TERPRI(); RETURN T;
  754. RTYPE: PRINT!:RATNUM( CONV!:BF2R(NMBR));
  755. RETURN T;
  756. END$
  757. %*************************************************************$
  758. SYMBOLIC PROCEDURE PRINT!:RATNUM(RNMBR); %******************$
  759. %======================================================$
  760. % This function prints a rational number "n". $
  761. % RNMBR is a rational number representation of "n". $
  762. % **** The number is printed by being inserted a blank $
  763. % **** after each five characters. So, you can $
  764. % **** not use the printed numbers as input data. $
  765. %======================================================$
  766. IF NOT( RATNUMP!:(RNMBR)) THEN BFLERRMSG 'PRINT!:RATNUM ELSE
  767. BEGIN INTEGER J; SCALAR U,V;
  768. U:=NUMR!:(RNMBR);
  769. V:=DENM!:(RNMBR);
  770. IF V<0 THEN <<U:=-U; V:=-V>>;
  771. J:=0;
  772. U:=EXPLODE(U);
  773. WHILE U DO <<PRIN2( CAR(U)); U:=CDR(U); J:=J+1;
  774. IF J=5 THEN <<PRIN2(" "); J:=0>> >>;
  775. IF J=0 THEN <<PRIN2("/ " ); J:=2>> ELSE
  776. IF J=1 THEN <<PRIN2(" / " ); J:=4>> ELSE
  777. IF J=2 THEN <<PRIN2(" / "); J:=0>> ELSE
  778. IF J=3 THEN <<PRIN2(" / " ); J:=0>> ELSE
  779. IF J=4 THEN <<PRIN2(" / "); J:=2>>;
  780. V:=EXPLODE(V);
  781. WHILE V DO <<PRIN2( CAR(V)); V:=CDR(V); J:=J+1;
  782. IF J=5 THEN <<PRIN2(" "); J:=0>> >>;
  783. TERPRI(); RETURN T;
  784. END$
  785. %*************************************************************$
  786. %*************************************************************$
  787. %** **$
  788. %** 2-1. Arithmetic manipulation routines. **$
  789. %** **$
  790. %*************************************************************$
  791. %*************************************************************$
  792. %*************************************************************$
  793. SYMBOLIC PROCEDURE ABS!:(NMBR); %***************************$
  794. %===============================================$
  795. % This function makes the absolute value of "n".$
  796. % N is a BIG-FLOAT representation of "n". $
  797. %===============================================$
  798. IF MT!:(NMBR) > 0 THEN NMBR
  799. ELSE MAKE!:BF( -MT!:(NMBR) , EP!:(NMBR))$
  800. %*************************************************************$
  801. SYMBOLIC PROCEDURE MINUS!:(NMBR); %*************************$
  802. %=============================================$
  803. % This function makes the minus number of "n".$
  804. % N is a BIG-FLOAT representation of "n". $
  805. %=============================================$
  806. MAKE!:BF( -MT!:(NMBR) , EP!:(NMBR))$
  807. %*************************************************************$
  808. SYMBOLIC PROCEDURE PLUS!:(N1,N2); %*************************$
  809. %==========================================================$
  810. % This function calculates the sum of "n1" and "n2". $
  811. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  812. %==========================================================$
  813. BEGIN INTEGER E1,E2;
  814. IF (E1:=EP!:(N1)) = (E2:=EP!:(N2)) THEN RETURN
  815. MAKE!:BF( MT!:(N1)+MT!:(N2) , E1)
  816. ELSE IF E1>E2 THEN RETURN MAKE!:BF
  817. ( MT!:( INCPREC!:(N1,E1-E2))+MT!:(N2) , E2)
  818. ELSE RETURN MAKE!:BF
  819. ( MT!:(N1)+MT!:( INCPREC!:(N2,E2-E1)) , E1);
  820. END$
  821. %*************************************************************$
  822. SYMBOLIC PROCEDURE DIFFERENCE!:(N1,N2); %*******************$
  823. %==========================================================$
  824. % This function calculates the difference of "n1" and "n2".$
  825. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  826. %==========================================================$
  827. BEGIN INTEGER E1,E2;
  828. IF (E1:=EP!:(N1)) = (E2:=EP!:(N2)) THEN RETURN
  829. MAKE!:BF( MT!:(N1)-MT!:(N2) , E1)
  830. ELSE IF E1>E2 THEN RETURN MAKE!:BF
  831. ( MT!:( INCPREC!:(N1,E1-E2))-MT!:(N2) , E2)
  832. ELSE RETURN MAKE!:BF
  833. ( MT!:(N1)-MT!:( INCPREC!:(N2,E2-E1)) , E1);
  834. END$
  835. %*************************************************************$
  836. SYMBOLIC PROCEDURE TIMES!:(N1,N2); %************************$
  837. %==========================================================$
  838. % This function calculates the product of "n1" and "n2". $
  839. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  840. %==========================================================$
  841. MAKE!:BF( MT!:(N1)*MT!:(N2) , EP!:(N1)+EP!:(N2))$
  842. %*************************************************************$
  843. SYMBOLIC PROCEDURE DIVIDE!:(N1,N2,K); %*********************$
  844. %==========================================================$
  845. % This function calculates the quotient of "n1" and "n2", $
  846. % with the precision K, by rounding the ratio of "n1" $
  847. % and "n2" at the (K+1)th place. $
  848. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  849. % K is any positive integer. $
  850. %==========================================================$
  851. BEGIN
  852. N1:=CONV!:MT(N1 , K+PRECI!:(N2)+1);
  853. N1:=MAKE!:BF( MT!:(N1)/MT!:(N2) , EP!:(N1)-EP!:(N2));
  854. RETURN ROUND!:MT(N1,K);
  855. END$
  856. %*************************************************************$
  857. SYMBOLIC PROCEDURE EXPT!:(NMBR,K); %************************$
  858. %===============================================$
  859. % This function calculates the Kth power of "n".$
  860. % The result will become a long number if $
  861. % ABS(K) >> 1. $
  862. % NMBR is a BIG-FLOAT representation of "n". $
  863. % K is an integer (positive or negative). $
  864. % **** For calculating a power X**K, with non- $
  865. % **** integer K, please use TEXPT!:ANY. $
  866. %===============================================$
  867. IF K>=0 THEN
  868. MAKE!:BF( EXPT( MT!:(NMBR) , K) , EP!:(NMBR)*K)
  869. ELSE DIVIDE!:( MAKE!:BF(1,0) , EXPT!:(NMBR,-K) ,
  870. -PRECI!:(NMBR)*K)$
  871. %*************************************************************$
  872. SYMBOLIC PROCEDURE TPLUS!:(N1,N2); %************************$
  873. %==========================================================$
  874. % This function calculates the sum of "n1" and "n2" $
  875. % up to a precision specified by !:PREC!: or N1 or N2.$
  876. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2",$
  877. % otherwise they are converted to <BIG-FLOAT>'s. $
  878. %==========================================================$
  879. IF BFP!:( N1:=CONV!:A2BF(N1)) AND
  880. BFP!:( N2:=CONV!:A2BF(N2)) THEN ROUND!:MT
  881. ( PLUS!:(N1,N2) , (IF !:PREC!: THEN !:PREC!:
  882. ELSE MAX( PRECI!:(N1) , PRECI!:(N2))) )
  883. ELSE BFLERRMSG 'TPLUS!:$
  884. %*************************************************************$
  885. SYMBOLIC PROCEDURE TDIFFERENCE!:(N1,N2); %******************$
  886. %==========================================================$
  887. % This function calculates the difference of "n1" and "n2" $
  888. % up to a precision specified by !:PREC!: or N1 or N2.$
  889. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2",$
  890. % otherwise they are converted to <BIG-FLOAT>'s. $
  891. %==========================================================$
  892. IF BFP!:( N1:=CONV!:A2BF(N1)) AND
  893. BFP!:( N2:=CONV!:A2BF(N2)) THEN ROUND!:MT
  894. ( DIFFERENCE!:(N1,N2) , (IF !:PREC!: THEN !:PREC!:
  895. ELSE MAX( PRECI!:(N1) , PRECI!:(N2))) )
  896. ELSE BFLERRMSG 'TDIFFERENCE!:$
  897. %*************************************************************$
  898. SYMBOLIC PROCEDURE TTIMES!:(N1,N2); %***********************$
  899. %==========================================================$
  900. % This function calculates the product of "n1" and "n2" $
  901. % up to a precision specified by !:PREC!: or N1 or N2.$
  902. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2",$
  903. % otherwise they are converted to <BIG-FLOAT>'s. $
  904. %==========================================================$
  905. IF BFP!:( N1:=CONV!:A2BF(N1)) AND
  906. BFP!:( N2:=CONV!:A2BF(N2)) THEN ROUND!:MT
  907. ( TIMES!:(N1,N2) , (IF !:PREC!: THEN !:PREC!:
  908. ELSE MAX( PRECI!:(N1) , PRECI!:(N2))) )
  909. ELSE BFLERRMSG 'TTIMES!:$
  910. %*************************************************************$
  911. SYMBOLIC PROCEDURE TDIVIDE!:(N1,N2); %**********************$
  912. %==========================================================$
  913. % This function calculates the quotient of "n1" and "n2" $
  914. % up to a precision specified by !:PREC!: or N1 or N2.$
  915. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2",$
  916. % otherwise they are converted to <BIG-FLOAT>'s. $
  917. %==========================================================$
  918. IF BFP!:( N1:=CONV!:A2BF(N1)) AND
  919. BFP!:( N2:=CONV!:A2BF(N2)) THEN
  920. DIVIDE!:(N1 , N2 , (IF !:PREC!: THEN !:PREC!:
  921. ELSE MAX( PRECI!:(N1) , PRECI!:(N2))) )
  922. ELSE BFLERRMSG 'TDIVIDE!:$
  923. %*************************************************************$
  924. SYMBOLIC PROCEDURE TEXPT!:(NMBR,K); %***********************$
  925. %=====================================================$
  926. % This function calculates the Kth power of "n" up to $
  927. % the precision specified by !:PREC!: or NMBR. $
  928. % NMBR is a BIG-FLOAT representation of "n", $
  929. % otherwise it is converted to a <BIG-FLOAT>. $
  930. % K is an integer (positive or negative). $
  931. % **** For calculating a power X**K, where K is not $
  932. % **** an integer, please use TEXPT!:ANY. $
  933. %=====================================================$
  934. IF BFP!:( NMBR:=CONV!:A2BF(NMBR)) AND FIXP(K) THEN
  935. IF K=0 THEN MAKE!:BF(1,0) ELSE
  936. IF K=1 THEN NMBR ELSE
  937. IF K<0 THEN TDIVIDE!:( MAKE!:BF(1,0) ,
  938. TEXPT!:(NMBR,-K) )
  939. ELSE TEXPT!:CAL(NMBR , K , (IF !:PREC!: THEN
  940. !:PREC!: ELSE PRECI!:(NMBR)) )
  941. ELSE BFLERRMSG 'TEXPT!:$
  942. SYMBOLIC PROCEDURE TEXPT!:CAL(NMBR,K,PREC);
  943. IF K=1 THEN NMBR ELSE
  944. BEGIN INTEGER K2; SCALAR U;
  945. U:=ROUND!:MT( TIMES!:(NMBR,NMBR) , PREC);
  946. IF K=2 THEN RETURN U ELSE
  947. IF (K-2*(K2:=K/2)) = 0 THEN RETURN
  948. TEXPT!:CAL(U,K2,PREC)
  949. ELSE RETURN ROUND!:MT
  950. ( TIMES!:(NMBR , TEXPT!:CAL(U,K2,PREC)) , PREC);
  951. END$
  952. %*************************************************************$
  953. SYMBOLIC PROCEDURE QUOTIENT!:(N1,N2); %*********************$
  954. %==========================================================$
  955. % This function calculates the integer quotient of "n1" $
  956. % and "n2", just as the "QUOTIENT" for integers does. $
  957. % **** For calculating the quotient up to a necessary $
  958. % **** precision, please use DIVIDE!:. $
  959. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  960. %==========================================================$
  961. BEGIN INTEGER E1,E2;
  962. IF (E1:=EP!:(N1)) = (E2:=EP!:(N2)) THEN RETURN
  963. MAKE!:BF( MT!:(N1)/MT!:(N2) , 0)
  964. ELSE IF E1>E2 THEN RETURN
  965. QUOTIENT!:( INCPREC!:(N1,E1-E2) , N2)
  966. ELSE RETURN
  967. QUOTIENT!:( N1 , INCPREC!:(N2,E2-E1));
  968. END$
  969. %*************************************************************$
  970. SYMBOLIC PROCEDURE REMAINDER!:(N1,N2); %********************$
  971. %==========================================================$
  972. % This function calculates the remainder of "n1" and "n2", $
  973. % just as the "REMAINDER" for integers does. $
  974. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  975. %==========================================================$
  976. BEGIN INTEGER E1,E2;
  977. IF (E1:=EP!:(N1)) = (E2:=EP!:(N2)) THEN RETURN
  978. MAKE!:BF( REMAINDER( MT!:(N1) , MT!:(N2)) , E2)
  979. ELSE IF E1>E2 THEN RETURN
  980. REMAINDER!:( INCPREC!:(N1,E1-E2) , N2)
  981. ELSE RETURN
  982. REMAINDER!:( N1 , INCPREC!:(N2,E2-E1));
  983. END$
  984. %*************************************************************$
  985. SYMBOLIC PROCEDURE TEXPT!:ANY(X,Y); %***********************$
  986. %====================================================$
  987. % This function calculates the power x**y, where "x" $
  988. % and "y" are any numbers. The precision of $
  989. % the result is specified by !:PREC!: or X or Y.$
  990. % **** For a negative "x", this function returns $
  991. % **** -(-x)**y unless "y" is an integer. $
  992. % X is a BIG-FLOAT representation of "x", otherwise $
  993. % it is converted to a <BIG-FLOAT>. $
  994. % Y is either an integer, a floating-point number, $
  995. % or a BIG-FLOAT number, i.e., a BIG-FLOAT $
  996. % representation of "y". $
  997. %====================================================$
  998. IF FIXP(Y) THEN TEXPT!:(X,Y) ELSE
  999. IF INTEGERP!:(Y) THEN TEXPT!:(X , CONV!:BF2I(Y)) ELSE
  1000. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1001. NOT( BFP!:( Y:=CONV!:A2BF(Y))) THEN BFLERRMSG
  1002. 'TEXPT!:ANY ELSE
  1003. IF MINUSP!:(Y) THEN TDIVIDE!:( MAKE!:BF(1,0) ,
  1004. TEXPT!:ANY(X , MINUS!:(Y)) ) ELSE
  1005. BEGIN INTEGER N; SCALAR XP,YP;
  1006. N:=(IF !:PREC!: THEN !:PREC!:
  1007. ELSE MAX( PRECI!:(X) , PRECI!:(Y)) );
  1008. IF MINUSP!:(X) THEN XP:=MINUS!:(X) ELSE XP:=X;
  1009. IF INTEGERP!:( TIMES!:(Y , CONV!:I2BF(2))) THEN
  1010. <<XP:=INCPREC!:(XP,1);
  1011. YP:=TEXPT!:(XP , CONV!:BF2I(Y));
  1012. YP:=TIMES!:(YP , SQRT!:(XP,N+1));
  1013. YP:=ROUND!:MT(YP,N) >>
  1014. ELSE
  1015. <<YP:=TTIMES!:(Y , LOG!:(XP,N+1));
  1016. YP:=EXP!:(YP,N) >>;
  1017. RETURN (IF MINUSP!:(X) THEN MINUS!:(YP) ELSE YP);
  1018. END$
  1019. %*************************************************************$
  1020. SYMBOLIC PROCEDURE MAX!:(N1,N2); %**************************$
  1021. %==========================================================$
  1022. % This function returns the larger of "n1" and "n2". $
  1023. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1024. %==========================================================$
  1025. IF GREATERP!:(N2,N1) THEN N2 ELSE N1$
  1026. %*************************************************************$
  1027. SYMBOLIC PROCEDURE MIN!:(N1,N2); %**************************$
  1028. %==========================================================$
  1029. % This function returns the smaller of "n1" and "n2". $
  1030. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1031. %==========================================================$
  1032. IF LESSP!:(N2,N1) THEN N2 ELSE N1$
  1033. %*************************************************************$
  1034. %*************************************************************$
  1035. %** **$
  1036. %** 2-2. Arithmetic predicates. **$
  1037. %** **$
  1038. %*************************************************************$
  1039. %*************************************************************$
  1040. %*************************************************************$
  1041. SYMBOLIC PROCEDURE GREATERP!:(N1,N2); %*********************$
  1042. %==========================================================$
  1043. % This function returns T if "n1" > "n2" else returns NIL. $
  1044. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1045. %==========================================================$
  1046. BEGIN INTEGER E1,E2;
  1047. IF (E1:=EP!:(N1)) = (E2:=EP!:(N2)) THEN
  1048. RETURN (IF MT!:(N1) > MT!:(N2) THEN T ELSE NIL)
  1049. ELSE IF E1>E2 THEN
  1050. IF MT!:( INCPREC!:(N1,E1-E2)) > MT!:(N2)
  1051. THEN RETURN T ELSE RETURN NIL
  1052. ELSE IF MT!:(N1) > MT!:( INCPREC!:(N2,E2-E1))
  1053. THEN RETURN T ELSE RETURN NIL;
  1054. END$
  1055. %*************************************************************$
  1056. SYMBOLIC PROCEDURE GEQ!:(N1,N2); %**************************$
  1057. %==========================================================$
  1058. % This function returns T if "n1" >= "n2" else returns NIL.$
  1059. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1060. %==========================================================$
  1061. NOT( LESSP!:(N1,N2))$
  1062. %*************************************************************$
  1063. SYMBOLIC PROCEDURE EQUAL!:(N1,N2); %************************$
  1064. %==========================================================$
  1065. % This function returns T if "n1" = "n2" else returns NIL. $
  1066. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1067. %==========================================================$
  1068. IF ZEROP!:( DIFFERENCE!:(N1,N2)) THEN T ELSE NIL$
  1069. %*************************************************************$
  1070. SYMBOLIC PROCEDURE LESSP!:(N1,N2); %************************$
  1071. %==========================================================$
  1072. % This function returns T if "n1" < "n2" else returns NIL. $
  1073. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1074. %==========================================================$
  1075. GREATERP!:(N2,N1)$
  1076. %*************************************************************$
  1077. SYMBOLIC PROCEDURE LEQ!:(N1,N2); %**************************$
  1078. %==========================================================$
  1079. % This function returns T if "n1" <= "n2" else returns NIL.$
  1080. % N1 and N2 are BIG-FLOAT representations of "n1" and "n2".$
  1081. %==========================================================$
  1082. NOT( GREATERP!:(N1,N2))$
  1083. %*************************************************************$
  1084. SYMBOLIC PROCEDURE INTEGERP!:(X); %*************************$
  1085. %===================================================$
  1086. % This function returns T if X is a BIG-FLOAT $
  1087. % representing an integer, else it returns NIL.$
  1088. % X is any LISP entity. $
  1089. %===================================================$
  1090. IF BFP!:(X) THEN IF EP!:(X)>=0 OR
  1091. EQUAL!:(X , CONV!:I2BF( CONV!:BF2I(X))) THEN T
  1092. ELSE NIL
  1093. ELSE NIL$
  1094. %*************************************************************$
  1095. SYMBOLIC PROCEDURE MINUSP!:(X); %***************************$
  1096. %===================================================$
  1097. % This function returns T if "x"<0 else returns NIL.$
  1098. % X is any LISP entity. $
  1099. %===================================================$
  1100. IF BFP!:(X) AND MT!:(X) < 0 THEN T ELSE NIL$
  1101. %*************************************************************$
  1102. SYMBOLIC PROCEDURE ZEROP!:(X); %****************************$
  1103. %===================================================$
  1104. % This function returns T if "x"=0 else returns NIL.$
  1105. % X is any LISP entity. $
  1106. %===================================================$
  1107. IF BFP!:(X) AND MT!:(X) = 0 THEN T ELSE NIL$
  1108. %*************************************************************$
  1109. %*************************************************************$
  1110. %** **$
  1111. %** 3-1. Elementary CONSTANTS. **$
  1112. %** **$
  1113. %*************************************************************$
  1114. %*************************************************************$
  1115. %*************************************************************$
  1116. SYMBOLIC PROCEDURE !:PI(K); %*******************************$
  1117. %====================================================$
  1118. % This function calculates the value of the circular $
  1119. % constant "PI", with the precision K, by $
  1120. % using Machin's well known identity: $
  1121. % PI = 16*atan(1/5) - 4*atan(1/239). $
  1122. % Calculation is performed mainly on integers. $
  1123. % K is a positive integer. $
  1124. %====================================================$
  1125. IF NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG '!:PI ELSE
  1126. IF K<=20 THEN ROUND!:MT
  1127. ( MAKE!:BF( 314159265358979323846 , -20) , K) ELSE
  1128. BEGIN INTEGER K3,S,SS,M,N,X; SCALAR U;
  1129. U:=GET!:CONST( '!:PI , K);
  1130. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1131. SS:=N:=EXPT(10 , K3:=K+3)/5;
  1132. X :=-5**2;
  1133. M:=1;
  1134. WHILE NOT(N=0) DO <<N:=N/X; SS:=SS+N/( M:=M+2) >>;
  1135. S:=N:=EXPT(10,K3)/239;
  1136. X:=-239**2;
  1137. M:=1;
  1138. WHILE NOT(N=0) DO <<N:=N/X; S:=S+N/( M:=M+2) >>;
  1139. ANS: U:=ROUND!:MT( MAKE!:BF( 16*SS-4*S , -K3) , K);
  1140. SAVE!:CONST( '!:PI , U); RETURN U;
  1141. END$
  1142. %*************************************************************$
  1143. SYMBOLIC PROCEDURE !:BIGPI(K); %****************************$
  1144. %====================================================$
  1145. % This function calculates the value of the circular $
  1146. % constant "PI", with the precision K, by the $
  1147. % arithmetic-geometric mean method. (See, $
  1148. % R. Brent, JACM Vol.23, #2, pp.242-251(1976).) $
  1149. % K is a positive integer. $
  1150. % **** This function should be used only when you $
  1151. % **** need "PI" of precision higher than 1000. $
  1152. %====================================================$
  1153. IF NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG '!:BIGPI ELSE
  1154. BEGIN INTEGER K2,N; SCALAR DCUT,HALF,X,Y,U,V;
  1155. U:=GET!:CONST( '!:PI , K);
  1156. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1157. K2 :=K+2;
  1158. HALF:=CONV!:S2BF("0.5");
  1159. DCUT:=MAKE!:BF(10,-K2);
  1160. X:=CONV!:I2BF( N:=1);
  1161. Y:=DIVIDE!:(X , !:SQRT2(K2) , K2);
  1162. U:=CONV!:S2BF("0.25");
  1163. WHILE GREATERP!:( ABS!:(DIFFERENCE!:(X,Y)) , DCUT) DO
  1164. <<V:=X;
  1165. X:=TIMES!:( PLUS!:(X,Y) , HALF);
  1166. Y:=SQRT!:( CUT!:EP( TIMES!:(Y,V) , -K2) , K2);
  1167. V:=DIFFERENCE!:(X,V);
  1168. V:=TIMES!:( TIMES!:(V,V) , CONV!:I2BF(N));
  1169. U:=DIFFERENCE!:(U , CUT!:EP(V,-K2));
  1170. N:=2*N>>;
  1171. V:=CUT!:MT( EXPT!:( PLUS!:(X,Y) , 2) , K2);
  1172. U:=DIVIDE!:(V , TIMES!:( CONV!:I2BF(4) , U) , K);
  1173. SAVE!:CONST( '!:PI , U); RETURN U;
  1174. END$
  1175. %*************************************************************$
  1176. SYMBOLIC PROCEDURE !:E(K); %********************************$
  1177. %=====================================================$
  1178. % This function calculates the value of "e", the base $
  1179. % of the natural logarithm, with the precision K,$
  1180. % by summing the Taylor series for exp(x=1). $
  1181. % Calculation is performed mainly on integers. $
  1182. % K is a positive integer. $
  1183. %=====================================================$
  1184. IF NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG '!:E ELSE
  1185. IF K<=20 THEN ROUND!:MT
  1186. ( MAKE!:BF( 271828182845904523536 , -20) , K) ELSE
  1187. BEGIN INTEGER K2,ANS,M,N; SCALAR U;
  1188. U:=GET!:CONST( '!:E , K);
  1189. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1190. K2:=K+2;
  1191. M :=1;
  1192. N :=EXPT(10,K2);
  1193. ANS:=0;
  1194. WHILE NOT(N=0) DO ANS:=ANS+( N:=N/( M:=M+1));
  1195. ANS:=ANS+2*EXPT(10,K2);
  1196. U:=ROUND!:MT( MAKE!:BF(ANS,-K2) , K);
  1197. SAVE!:CONST( '!:E , U); RETURN U;
  1198. END$
  1199. %*************************************************************$
  1200. SYMBOLIC PROCEDURE !:E01(K); %******************************$
  1201. %=====================================================$
  1202. % This function calculates exp(0.1), the value of the $
  1203. % exponential function at the point 0.1, with $
  1204. % the precision K. $
  1205. % K is a positive integer. $
  1206. %=====================================================$
  1207. BEGIN SCALAR U;
  1208. U:=GET!:CONST( '!:E01 , K);
  1209. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1210. U:=EXP!:( CONV!:S2BF("0.1") , K);
  1211. SAVE!:CONST( '!:E01 , U); RETURN U;
  1212. END$
  1213. %*************************************************************$
  1214. SYMBOLIC PROCEDURE !:LOG2(K); %*****************************$
  1215. %==============================================$
  1216. % This function calculates log(2), the natural $
  1217. % logarithm of 2, with the precision K. $
  1218. % K is a positive integer. $
  1219. %==============================================$
  1220. BEGIN SCALAR U;
  1221. U:=GET!:CONST( '!:LOG2 , K);
  1222. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1223. U:=LOG!:( CONV!:I2BF(2) , K);
  1224. SAVE!:CONST( '!:LOG2 , U); RETURN U;
  1225. END$
  1226. %*************************************************************$
  1227. SYMBOLIC PROCEDURE !:LOG3(K); %*****************************$
  1228. %==============================================$
  1229. % This function calculates log(3), the natural $
  1230. % logarithm of 3, with the precision K. $
  1231. % K is a positive integer. $
  1232. %==============================================$
  1233. BEGIN SCALAR U;
  1234. U:=GET!:CONST( '!:LOG3 , K);
  1235. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1236. U:=LOG!:( CONV!:I2BF(3) , K);
  1237. SAVE!:CONST( '!:LOG3 , U); RETURN U;
  1238. END$
  1239. %*************************************************************$
  1240. SYMBOLIC PROCEDURE !:LOG5(K); %*****************************$
  1241. %==============================================$
  1242. % This function calculates log(5), the natural $
  1243. % logarithm of 5, with the precision K. $
  1244. % K is a positive integer. $
  1245. %==============================================$
  1246. BEGIN SCALAR U;
  1247. U:=GET!:CONST( '!:LOG5 , K);
  1248. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1249. U:=LOG!:( CONV!:I2BF(5) , K);
  1250. SAVE!:CONST( '!:LOG5 , U); RETURN U;
  1251. END$
  1252. %*************************************************************$
  1253. SYMBOLIC PROCEDURE !:LOG10(K); %****************************$
  1254. %===============================================$
  1255. % This function calculates log(10), the natural $
  1256. % logarithm of 10, with the precision K. $
  1257. % K is a positive integer. $
  1258. %===============================================$
  1259. BEGIN SCALAR U;
  1260. U:=GET!:CONST( '!:LOG10 , K);
  1261. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1262. U:=LOG!:( CONV!:I2BF(10) , K);
  1263. SAVE!:CONST( '!:LOG10 , U); RETURN U;
  1264. END$
  1265. %*************************************************************$
  1266. SYMBOLIC PROCEDURE !:LOGPI(K); %****************************$
  1267. %===============================================$
  1268. % This function calculates log(PI), the natural $
  1269. % logarithm of "PI", with the precision K. $
  1270. % K is a positive integer. $
  1271. %===============================================$
  1272. BEGIN SCALAR U;
  1273. U:=GET!:CONST( '!:LOGPI , K);
  1274. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1275. U:=LOG!:( !:PI(K+2) , K);
  1276. SAVE!:CONST( '!:LOGPI , U); RETURN U;
  1277. END$
  1278. %*************************************************************$
  1279. SYMBOLIC PROCEDURE !:SQRT2(K); %****************************$
  1280. %===================================================$
  1281. % This function calculates SQRT(2), the square root $
  1282. % of 2, with the precision K. $
  1283. % K is a positive integer. $
  1284. %===================================================$
  1285. BEGIN SCALAR U;
  1286. U:=GET!:CONST( '!:SQRT2 , K);
  1287. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1288. U:=SQRT!:( CONV!:I2BF(2) , K);
  1289. SAVE!:CONST( '!:SQRT2 , U); RETURN U;
  1290. END$
  1291. %*************************************************************$
  1292. SYMBOLIC PROCEDURE !:SQRT3(K); %****************************$
  1293. %===================================================$
  1294. % This function calculates SQRT(3), the square root $
  1295. % of 3, with the precision K. $
  1296. % K is a positive integer. $
  1297. %===================================================$
  1298. BEGIN SCALAR U;
  1299. U:=GET!:CONST( '!:SQRT3 , K);
  1300. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1301. U:=SQRT!:( CONV!:I2BF(3) , K);
  1302. SAVE!:CONST( '!:SQRT3 , U); RETURN U;
  1303. END$
  1304. %*************************************************************$
  1305. SYMBOLIC PROCEDURE !:SQRT5(K); %****************************$
  1306. %===================================================$
  1307. % This function calculates SQRT(5), the square root $
  1308. % of 5, with the precision K. $
  1309. % K is a positive integer. $
  1310. %===================================================$
  1311. BEGIN SCALAR U;
  1312. U:=GET!:CONST( '!:SQRT5 , K);
  1313. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1314. U:=SQRT!:( CONV!:I2BF(5) , K);
  1315. SAVE!:CONST( '!:SQRT5 , U); RETURN U;
  1316. END$
  1317. %*************************************************************$
  1318. SYMBOLIC PROCEDURE !:SQRT10(K); %***************************$
  1319. %====================================================$
  1320. % This function calculates SQRT(10), the square root $
  1321. % of 10, with the precision K. $
  1322. % K is a positive integer. $
  1323. %====================================================$
  1324. BEGIN SCALAR U;
  1325. U:=GET!:CONST( '!:SQRT10 , K);
  1326. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1327. U:=SQRT!:( CONV!:I2BF(10) , K);
  1328. SAVE!:CONST( '!:SQRT10 , U); RETURN U;
  1329. END$
  1330. %*************************************************************$
  1331. SYMBOLIC PROCEDURE !:SQRTPI(K); %***************************$
  1332. %====================================================$
  1333. % This function calculates SQRT(PI), the square root $
  1334. % of "PI", with the precision K. $
  1335. % K is a positive integer. $
  1336. %====================================================$
  1337. BEGIN SCALAR U;
  1338. U:=GET!:CONST( '!:SQRTPI , K);
  1339. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1340. U:=SQRT!:( !:PI(K+2) , K);
  1341. SAVE!:CONST( '!:SQRTPI , U); RETURN U;
  1342. END$
  1343. %*************************************************************$
  1344. SYMBOLIC PROCEDURE !:SQRTE(K); %****************************$
  1345. %===================================================$
  1346. % This function calculates SQRT(e), the square root $
  1347. % of "e", with the precision K. $
  1348. % K is a positive integer. $
  1349. %===================================================$
  1350. BEGIN SCALAR U;
  1351. U:=GET!:CONST( '!:SQRTE , K);
  1352. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1353. U:=SQRT!:( !:E(K+2) , K);
  1354. SAVE!:CONST( '!:SQRTE , U); RETURN U;
  1355. END$
  1356. %*************************************************************$
  1357. SYMBOLIC PROCEDURE !:CBRT2(K); %****************************$
  1358. %=================================================$
  1359. % This function calculates CBRT(2), the cube root $
  1360. % of 2, with the precision K. $
  1361. % K is a positive integer. $
  1362. %=================================================$
  1363. BEGIN SCALAR U;
  1364. U:=GET!:CONST( '!:CBRT2 , K);
  1365. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1366. U:=CBRT!:( CONV!:I2BF(2) , K);
  1367. SAVE!:CONST( '!:CBRT2 , U); RETURN U;
  1368. END$
  1369. %*************************************************************$
  1370. SYMBOLIC PROCEDURE !:CBRT3(K); %****************************$
  1371. %=================================================$
  1372. % This function calculates CBRT(3), the cube root $
  1373. % of 3, with the precision K. $
  1374. % K is a positive integer. $
  1375. %=================================================$
  1376. BEGIN SCALAR U;
  1377. U:=GET!:CONST( '!:CBRT3 , K);
  1378. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1379. U:=CBRT!:( CONV!:I2BF(3) , K);
  1380. SAVE!:CONST( '!:CBRT3 , U); RETURN U;
  1381. END$
  1382. %*************************************************************$
  1383. SYMBOLIC PROCEDURE !:CBRT5(K); %****************************$
  1384. %=================================================$
  1385. % This function calculates CBRT(5), the cube root $
  1386. % of 5, with the precision K. $
  1387. % K is a positive integer. $
  1388. %=================================================$
  1389. BEGIN SCALAR U;
  1390. U:=GET!:CONST( '!:CBRT5 , K);
  1391. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1392. U:=CBRT!:( CONV!:I2BF(5) , K);
  1393. SAVE!:CONST( '!:CBRT5 , U); RETURN U;
  1394. END$
  1395. %*************************************************************$
  1396. SYMBOLIC PROCEDURE !:CBRT10(K); %***************************$
  1397. %==================================================$
  1398. % This function calculates CBRT(10), the cube root $
  1399. % of 10, with the precision K. $
  1400. % K is a positive integer. $
  1401. %==================================================$
  1402. BEGIN SCALAR U;
  1403. U:=GET!:CONST( '!:CBRT10 , K);
  1404. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1405. U:=CBRT!:( CONV!:I2BF(10) , K);
  1406. SAVE!:CONST( '!:CBRT10 , U); RETURN U;
  1407. END$
  1408. %*************************************************************$
  1409. SYMBOLIC PROCEDURE !:CBRTPI(K); %***************************$
  1410. %==================================================$
  1411. % This function calculates CBRT(PI), the cube root $
  1412. % of "PI", with the precision K. $
  1413. % K is a positive integer. $
  1414. %==================================================$
  1415. BEGIN SCALAR U;
  1416. U:=GET!:CONST( '!:CBRTPI , K);
  1417. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1418. U:=CBRT!:( !:PI(K+2) , K);
  1419. SAVE!:CONST( '!:CBRTPI , U); RETURN U;
  1420. END$
  1421. %*************************************************************$
  1422. SYMBOLIC PROCEDURE !:CBRTE(K); %****************************$
  1423. %=================================================$
  1424. % This function calculates CBRT(e), the cube root $
  1425. % of "e", with the precision K. $
  1426. % K is a positive integer. $
  1427. %=================================================$
  1428. BEGIN SCALAR U;
  1429. U:=GET!:CONST( '!:CBRTE , K);
  1430. IF U = "NOT FOUND" THEN NIL ELSE RETURN U;
  1431. U:=CBRT!:( !:E(K+2) , K);
  1432. SAVE!:CONST( '!:CBRTE , U); RETURN U;
  1433. END$
  1434. %*************************************************************$
  1435. %*************************************************************$
  1436. %** **$
  1437. %** 3-2. Routines for saving CONSTANTS. **$
  1438. %** **$
  1439. %*************************************************************$
  1440. %*************************************************************$
  1441. %*************************************************************$
  1442. SYMBOLIC PROCEDURE GET!:CONST(CNST,K); %********************$
  1443. %==================================================$
  1444. % This function returns the value of constant CNST $
  1445. % of the precision K, if it was calculated $
  1446. % previously with, at least, the precision K, $
  1447. % else it returns "NOT FOUND". $
  1448. % CNST is the name of the constant (to be quoted). $
  1449. % K is a positive integer. $
  1450. %==================================================$
  1451. IF ATOM(CNST) AND FIXP(K) AND K>0 THEN
  1452. BEGIN SCALAR U;
  1453. U:=GET(CNST , 'SAVE!:C);
  1454. IF NULL(U) OR CAR(U)<K THEN RETURN "NOT FOUND"
  1455. ELSE IF CAR(U)=K THEN RETURN CDR(U)
  1456. ELSE RETURN ROUND!:MT(CDR(U),K);
  1457. END
  1458. ELSE BFLERRMSG 'GET!:CONST$
  1459. %*************************************************************$
  1460. SYMBOLIC PROCEDURE SAVE!:CONST(CNST,NMBR); %****************$
  1461. %=================================================$
  1462. % This function saves the value of constant CNST $
  1463. % for the later use. $
  1464. % CNST is the name of the constant (to be quoted).$
  1465. % NMBR is a BIG-FLOAT representation of the value.$
  1466. %=================================================$
  1467. IF ATOM(CNST) AND BFP!:(NMBR) THEN
  1468. PUT(CNST , 'SAVE!:C , CONS( PRECI!:(NMBR) , NMBR))
  1469. ELSE BFLERRMSG 'SAVE!:CONST$
  1470. %*************************************************************$
  1471. SYMBOLIC PROCEDURE SET!:CONST(CNST,L); %********************$
  1472. %=================================================$
  1473. % This function sets the value of constant CNST. $
  1474. % CNST is the name of the constant (to be quoted).$
  1475. % L is a list of integers, which represents the $
  1476. % value of the constant in the way described $
  1477. % in the function READ!:LNUM. $
  1478. %=================================================$
  1479. SAVE!:CONST(CNST , READ!:LNUM(L))$
  1480. %*************************************************************$
  1481. SYMBOLIC$ %SETTING THE CONSTANTS ***************************$
  1482. SET!:CONST( '!:PI , '( 0 3141 59265 35897 93238 46264
  1483. 33832 79502 88419 71693 99375 105820 9749 44592 30781
  1484. 64062 86208 99862 80348 25342 11706 79821 48086 51328
  1485. 23066 47093 84460 95505 82231 72535 94081 28481 1174
  1486. 5028410 2701 93852 11055 59644 62294 89549 30381 96442
  1487. 88109 8) )$
  1488. SET!:CONST( '!:E , '( 0 2718 28182 84590 45235 36028
  1489. 74713 52662 49775 72470 93699 95957 49669 67627 72407
  1490. 66303 53547 59457 13821 78525 16642 74274 66391 93200
  1491. 30599 21817 41359 66290 43572 90033 42952 60595 63073
  1492. 81323 28627 943490 7632 33829 88075 31952 510190 1157
  1493. 38341 9) )$
  1494. SET!:CONST( '!:E01 , '( 0 1105 17091 80756 47624 81170
  1495. 78264 90246 66822 45471 94737 51871 87928 63289 44096
  1496. 79667 47654 30298 91433 18970 74865 36329 2) )$
  1497. SET!:CONST( '!:LOG2 , '(-1 6931 47180 55994 53094 17232
  1498. 12145 81765 68075 50013 43602 55254 1206 800094 93393
  1499. 62196 96947 15605 86332 69964 18687 54200 2) )$
  1500. SET!:CONST( '!:LOG3 , '( 0 1098 61228 866810 9691 39524
  1501. 52369 22525 70464 74905 57822 74945 17346 94333 63749
  1502. 42932 18608 96687 36157 54813 73208 87879 7) )$
  1503. SET!:CONST( '!:LOG5 , '( 0 1609 43791 2434100 374 60075
  1504. 93332 26187 63952 56013 54268 51772 19126 47891 47417
  1505. 898770 7657 764630 1338 78093 179610 7999 7) )$
  1506. SET!:CONST( '!:LOG10 , '( 0 2302 58509 29940 456840 1799
  1507. 14546 84364 20760 11014 88628 77297 60333 27900 96757
  1508. 26096 77352 48023 599720 5089 59829 83419 7) )$
  1509. SET!:CONST( '!:LOGPI , '( 0 1144 72988 5849400 174 14342
  1510. 73513 53058 71164 72948 12915 31157 15136 23071 47213
  1511. 77698 848260 7978 36232 70275 48970 77020 1) )$
  1512. SET!:CONST( '!:SQRT2 , '( 0 1414 21356 23730 95048 80168
  1513. 872420 96980 7856 96718 75376 94807 31766 79737 99073
  1514. 24784 621070 38850 3875 34327 64157 27350 1) )$
  1515. SET!:CONST( '!:SQRT3 , '( 0 17320 5080 75688 77293 52744
  1516. 634150 5872 36694 28052 53810 38062 805580 6979 45193
  1517. 301690 88000 3708 11461 86757 24857 56756 3) )$
  1518. SET!:CONST( '!:SQRT5 , '( 0 22360 6797 74997 89696 40917
  1519. 36687 31276 235440 6183 59611 52572 42708 97245 4105
  1520. 209256 37804 89941 441440 8378 78227 49695 1) )$
  1521. SET!:CONST( '!:SQRT10, '( 0 3162 277660 1683 79331 99889
  1522. 35444 32718 53371 95551 39325 21682 685750 4852 79259
  1523. 44386 39238 22134 424810 8379 30029 51873 47))$
  1524. SET!:CONST( '!:SQRTPI, '( 0 1772 453850 9055 16027 29816
  1525. 74833 41145 18279 75494 56122 38712 821380 7789 85291
  1526. 12845 91032 18137 49506 56738 54466 54162 3) )$
  1527. SET!:CONST( '!:SQRTE , '( 0 1648 721270 7001 28146 8486
  1528. 507878 14163 57165 3776100 710 14801 15750 79311 64066
  1529. 10211 94215 60863 27765 20056 36664 30028 7) )$
  1530. SET!:CONST( '!:CBRT2 , '( 0 1259 92104 98948 73164 7672
  1531. 106072 78228 350570 2514 64701 5079800 819 75112 15529
  1532. 96765 13959 48372 93965 62436 25509 41543 1) )$
  1533. SET!:CONST( '!:CBRT3 , '( 0 1442 249570 30740 8382 32163
  1534. 83107 80109 58839 18692 53499 35057 75464 16194 54168
  1535. 75968 29997 33985 47554 79705 64525 66868 4) )$
  1536. SET!:CONST( '!:CBRT5 , '( 0 1709 97594 66766 96989 35310
  1537. 88725 43860 10986 80551 105430 5492 43828 61707 44429
  1538. 592050 4173 21625 71870 10020 18900 220450 ) )$
  1539. SET!:CONST( '!:CBRT10, '( 0 2154 4346900 318 83721 75929
  1540. 35665 19350 49525 93449 42192 10858 24892 35506 34641
  1541. 11066 48340 80018 544150 3543 24327 61012 6) )$
  1542. SET!:CONST( '!:CBRTPI, '( 0 1464 59188 75615 232630 2014
  1543. 25272 63790 39173 85968 55627 93717 43572 55937 13839
  1544. 36497 98286 26614 56820 67820 353820 89750 ) )$
  1545. SET!:CONST( '!:CBRTE , '( 0 1395 61242 50860 89528 62812
  1546. 531960 2586 83759 79065 15199 40698 26175 167060 3173
  1547. 90156 45951 84696 97888 17295 83022 41352 1) )$
  1548. %*************************************************************$
  1549. %*************************************************************$
  1550. %** **$
  1551. %** 4-1. Elementary FUNCTIONS. **$
  1552. %** **$
  1553. %*************************************************************$
  1554. %*************************************************************$
  1555. %*************************************************************$
  1556. SYMBOLIC PROCEDURE SQRT!:(X,K); %***************************$
  1557. %===================================================$
  1558. % This function calculates SQRT(x), the square root $
  1559. % of "x", with the precision K, by Newton's $
  1560. % iteration method. $
  1561. % X is a BIG-FLOAT representation of "x", x >= 0, $
  1562. % otherwise it is converted to a <BIG-FLOAT>. $
  1563. % K is a positive integer. $
  1564. %===================================================$
  1565. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR MINUSP!:(X) OR
  1566. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'SQRT!: ELSE
  1567. IF ZEROP!:(X) THEN CONV!:I2BF(0) ELSE
  1568. BEGIN INTEGER K2,NCUT,NFIG; SCALAR DCUT,HALF,DY,Y,Y0,U;
  1569. K2 :=K+2;
  1570. NCUT:=K2-(ORDER!:(X)+1)/2;
  1571. HALF:=CONV!:S2BF("0.5");
  1572. DCUT:=MAKE!:BF(10,-NCUT);
  1573. DY :=MAKE!:BF(20,-NCUT);
  1574. Y0:=CONV!:MT(X,2);
  1575. IF REMAINDER( EP!:(Y0) , 2) = 0 THEN
  1576. Y0:=MAKE!:BF( 3+2*MT!:(Y0)/25 , EP!:(Y0)/2)
  1577. ELSE Y0:=MAKE!:BF( 10+2*MT!:(Y0)/9 , (EP!:(Y0)-1)/2);
  1578. NFIG:=1;
  1579. WHILE NFIG<K2 OR GREATERP!:( ABS!:(DY) , DCUT) DO
  1580. <<IF (NFIG:=2*NFIG) > K2 THEN NFIG:=K2;
  1581. U :=DIVIDE!:(X,Y0,NFIG);
  1582. Y :=TIMES!:( PLUS!:(Y0,U) , HALF);
  1583. DY:=DIFFERENCE!:(Y,Y0);
  1584. Y0:=Y>>;
  1585. RETURN ROUND!:MT(Y,K);
  1586. END$
  1587. %*************************************************************$
  1588. SYMBOLIC PROCEDURE CBRT!:(X,K); %***************************$
  1589. %===================================================$
  1590. % This function calculates CBRT(x), the cube root $
  1591. % of "x", with the precision K, by Newton's $
  1592. % iteration method. $
  1593. % X is a BIG-FLOAT representation of any real "x", $
  1594. % otherwise it is converted to a <BIG-FLOAT>. $
  1595. % K is a positive integer. $
  1596. %===================================================$
  1597. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1598. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'CBRT!: ELSE
  1599. IF ZEROP!:(X) THEN CONV!:I2BF(0) ELSE
  1600. IF MINUSP!:(X) THEN
  1601. MINUS!:( CBRT!:( MINUS!:(X) , K)) ELSE
  1602. BEGIN INTEGER K2,NCUT,NFIG,J; SCALAR DCUT,THRE,DY,Y,U;
  1603. K2 :=K+2;
  1604. NCUT:=K2-(ORDER!:(X)+2)/3;
  1605. THRE:=CONV!:I2BF(3);
  1606. DCUT:=MAKE!:BF(10,-NCUT);
  1607. DY :=MAKE!:BF(20,-NCUT);
  1608. Y:=CONV!:MT(X,3);
  1609. IF (J:=REMAINDER( EP!:(Y) , 3)) = 0 THEN
  1610. Y:=MAKE!:BF( 5 + MT!:(Y)/167 , EP!:(Y)/3) ELSE
  1611. IF J=1 OR J=-2 THEN
  1612. Y:=MAKE!:BF( 10+ MT!:(Y)/75 , (EP!:(Y)-1)/3)
  1613. ELSE Y:=MAKE!:BF( 22+2*MT!:(Y)/75 , (EP!:(Y)-2)/3);
  1614. NFIG:=1;
  1615. WHILE NFIG<K2 OR GREATERP!:( ABS!:(DY) , DCUT) DO
  1616. <<IF (NFIG:=2*NFIG) > K2 THEN NFIG:=K2;
  1617. U :=CUT!:MT( TIMES!:(Y,Y) , NFIG);
  1618. U :=DIVIDE!:(X , U , NFIG);
  1619. J :=ORDER!:( U:=DIFFERENCE!:(U,Y))+NCUT-K2;
  1620. DY:=DIVIDE!:(U , THRE , MAX(1,NFIG+J));
  1621. Y :=PLUS!:(Y,DY) >>;
  1622. RETURN ROUND!:MT(Y,K);
  1623. END$
  1624. %*************************************************************$
  1625. SYMBOLIC PROCEDURE EXP!:(X,K); %****************************$
  1626. %=================================================$
  1627. % This function calculates exp(x), the value of $
  1628. % the exponential function at the point "x", $
  1629. % with the precision K, by summing terms of $
  1630. % the Taylor series for exp(z), 0 < z < 1. $
  1631. % X is a BIG-FLOAT representation of any real "x",$
  1632. % otherwise it is converted to a <BIG-FLOAT>.$
  1633. % K is a positive integer. $
  1634. %=================================================$
  1635. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1636. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'EXP!: ELSE
  1637. IF ZEROP!:(X) THEN CONV!:I2BF(1) ELSE
  1638. BEGIN INTEGER K2,M; SCALAR ONE,Q,R,Y,YQ,YR,SAVE!:P;
  1639. K2 :=K+2;
  1640. ONE:=CONV!:I2BF(1);
  1641. Q:=CONV!:I2BF( M:=CONV!:BF2I( Y:=ABS!:(X)));
  1642. R:=DIFFERENCE!:(Y,Q);
  1643. IF ZEROP!:(Q) THEN YQ:=ONE
  1644. ELSE << SAVE!:P:=!:PREC!:; !:PREC!::=K2;
  1645. YQ:=TEXPT!:( !:E(K2) , M);
  1646. !:PREC!::=SAVE!:P>>;
  1647. IF ZEROP!:(R) THEN YR:=ONE ELSE
  1648. BEGIN INTEGER J,N; SCALAR DCUT,FCTRIAL,RI,TM;
  1649. DCUT:=MAKE!:BF(10,-K2);
  1650. YR:=RI:=TM:=ONE;
  1651. M:=1;
  1652. J:=0;
  1653. WHILE GREATERP!:(TM,DCUT) DO
  1654. <<FCTRIAL:=CONV!:I2BF( M:=M*( J:=J+1));
  1655. RI:=CUT!:EP( TIMES!:(RI,R) , -K2);
  1656. N :=MAX(1 , K2-ORDER!:(FCTRIAL)+ORDER!:(RI));
  1657. TM:=DIVIDE!:(RI,FCTRIAL,N);
  1658. YR:=PLUS!:(YR,TM); IF REMAINDER(J,10)=0 THEN
  1659. YR:=CUT!:EP(YR,-K2) >>;
  1660. END;
  1661. Y:=CUT!:MT( TIMES!:(YQ,YR) , K+1);
  1662. RETURN (IF MINUSP!:(X) THEN DIVIDE!:(ONE,Y,K)
  1663. ELSE ROUND!:LAST(Y) );
  1664. END$
  1665. %*************************************************************$
  1666. SYMBOLIC PROCEDURE LOG!:(X,K); %****************************$
  1667. %===================================================$
  1668. % This function calculates log(x), the value of the $
  1669. % logarithmic function at the point "x", with $
  1670. % the precision K, by summing terms of the $
  1671. % Taylor series for log(1+z), 0 < z < 0.10518. $
  1672. % X is a BIG-FLOAT representation of "x", x > 0, $
  1673. % otherwise it is converted to a <BIG-FLOAT>. $
  1674. % K is a positive integer. $
  1675. %===================================================$
  1676. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1677. MINUSP!:(X) OR ZEROP!:(X) OR
  1678. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'LOG!: ELSE
  1679. IF EQUAL!:(X , CONV!:I2BF(1)) THEN CONV!:I2BF(0) ELSE
  1680. BEGIN INTEGER K2,M; SCALAR EE,ES,ONE,SIGN,L,Y,Z,SAVE!:P;
  1681. K2 :=K+2;
  1682. ONE:=CONV!:I2BF(1);
  1683. EE :=!:E(K2);
  1684. ES :=!:E01(K2);
  1685. IF GREATERP!:(X,ONE) THEN <<SIGN:=ONE; Y:=X>>
  1686. ELSE <<SIGN:=MINUS!:(ONE); Y:=DIVIDE!:(ONE,X,K2) >>;
  1687. IF LESSP!:(Y,EE) THEN <<M:=0; Z:=Y>>
  1688. ELSE <<IF (M:=(ORDER!:(Y)*23)/10) = 0 THEN Z:=Y
  1689. ELSE << SAVE!:P:=!:PREC!:; !:PREC!::=K2;
  1690. Z:=DIVIDE!:(Y , TEXPT!:(EE,M) , K2);
  1691. !:PREC!::=SAVE!:P>>;
  1692. WHILE GREATERP!:(Z,EE) DO
  1693. <<M:=M+1; Z:=DIVIDE!:(Z,EE,K2) >> >>;
  1694. L:=CONV!:I2BF(M);
  1695. Y:=CONV!:S2BF("0.1");
  1696. WHILE GREATERP!:(Z,ES) DO
  1697. <<L:=PLUS!:(L,Y); Z:=DIVIDE!:(Z,ES,K2) >>;
  1698. Z:=DIFFERENCE!:(Z,ONE);
  1699. BEGIN INTEGER N; SCALAR DCUT,TM,ZI;
  1700. Y:=TM:=ZI:=Z;
  1701. Z:=MINUS!:(Z);
  1702. DCUT:=MAKE!:BF(10,-K2);
  1703. M:=1;
  1704. WHILE GREATERP!:( ABS!:(TM) , DCUT) DO
  1705. <<ZI:=CUT!:EP( TIMES!:(ZI,Z) , -K2);
  1706. N :=MAX(1 , K2+ORDER!:(ZI));
  1707. TM:=DIVIDE!:(ZI , CONV!:I2BF( M:=M+1) , N);
  1708. Y :=PLUS!:(Y,TM); IF REMAINDER(M,10)=0 THEN
  1709. Y:=CUT!:EP(Y,-K2) >>;
  1710. END;
  1711. Y:=PLUS!:(Y,L);
  1712. RETURN ROUND!:MT( TIMES!:(SIGN,Y) , K);
  1713. END$
  1714. %*************************************************************$
  1715. SYMBOLIC PROCEDURE LN!:(X,K); %*****************************$
  1716. %=================================================$
  1717. % This function calculates log(x), the value of $
  1718. % the logarithmic function at the point "x", $
  1719. % with the precision K, by solving $
  1720. % x = exp(y) by Newton's method. $
  1721. % X is a BIG-FLOAT representation of "x", x > 0, $
  1722. % otherwise it is converted to a <BIG-FLOAT>.$
  1723. % K is a positive integer. $
  1724. %=================================================$
  1725. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1726. MINUSP!:(X) OR ZEROP!:(X) OR
  1727. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'LN!: ELSE
  1728. IF EQUAL!:(X , CONV!:I2BF(1)) THEN CONV!:I2BF(0) ELSE
  1729. BEGIN INTEGER K2,M; SCALAR EE,ONE,SIGN,Y,Z,SAVE!:P;
  1730. K2 :=K+2;
  1731. ONE:=CONV!:I2BF(1);
  1732. EE :=!:E(K2+2);
  1733. IF GREATERP!:(X,ONE) THEN <<SIGN:=ONE; Y:=X>>
  1734. ELSE <<SIGN:=MINUS!:(ONE); Y:=DIVIDE!:(ONE,X,K2) >>;
  1735. IF LESSP!:(Y,EE) THEN <<M:=0; Z:=Y>>
  1736. ELSE <<IF (M:=(ORDER!:(Y)*23)/10) = 0 THEN Z:=Y
  1737. ELSE << SAVE!:P:=!:PREC!:; !:PREC!::=K2;
  1738. Z:=DIVIDE!:(Y , TEXPT!:(EE,M) , K2);
  1739. !:PREC!::=SAVE!:P>>;
  1740. WHILE GREATERP!:(Z,EE) DO
  1741. <<M:=M+1; Z:=DIVIDE!:(Z,EE,K2) >> >>;
  1742. BEGIN INTEGER NFIG,N; SCALAR DCUT,DX,DY,X0;
  1743. DCUT:=MAKE!:BF(10,-K2);
  1744. DY :=MAKE!:BF(20,-K2);
  1745. Y:=DIVIDE!:( DIFFERENCE!:(Z,ONE) ,
  1746. CONV!:S2BF("1.72") , 2);
  1747. NFIG:=1;
  1748. WHILE NFIG<K2 OR GREATERP!:( ABS!:(DY) , DCUT) DO
  1749. <<IF (NFIG:=2*NFIG) > K2 THEN NFIG:=K2;
  1750. X0:=EXP!:(Y,NFIG);
  1751. DX:=DIFFERENCE!:(Z,X0);
  1752. N :=MAX(1 , NFIG+ORDER!:(DX));
  1753. DY:=DIVIDE!:(DX,X0,N);
  1754. Y :=PLUS!:(Y,DY) >>;
  1755. END;
  1756. Y:=PLUS!:( CONV!:I2BF(M) , Y);
  1757. RETURN ROUND!:MT( TIMES!:(SIGN,Y) , K);
  1758. END$
  1759. %*************************************************************$
  1760. SYMBOLIC PROCEDURE SIN!:(X,K); %****************************$
  1761. %=================================================$
  1762. % This function calculates sin(x), the value of $
  1763. % the sine function at the point "x", with $
  1764. % the precision K, by summing terms of the $
  1765. % Taylor series for sin(z), 0 < z < PI/4. $
  1766. % X is a BIG-FLOAT representation of any rael "x",$
  1767. % otherwise it is converted to a <BIG-FLOAT>.$
  1768. % K is a positive integer. $
  1769. %=================================================$
  1770. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1771. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'SIN!: ELSE
  1772. IF ZEROP!:(X) THEN CONV!:I2BF(0) ELSE
  1773. IF MINUSP!:(X) THEN
  1774. MINUS!:( SIN!:( MINUS!:(X) , K)) ELSE
  1775. BEGIN INTEGER K2,M; SCALAR PI4,SIGN,Q,R,Y;
  1776. K2 :=K+2;
  1777. M :=PRECI!:(X);
  1778. PI4:=TIMES!:( !:PI(K2+M) , CONV!:S2BF("0.25"));
  1779. IF LESSP!:(X,PI4) THEN <<M:=0; R:=X>>
  1780. ELSE <<M:=CONV!:BF2I( Q:=QUOTIENT!:(X,PI4));
  1781. R:=DIFFERENCE!:(X , TIMES!:(Q,PI4)) >>;
  1782. SIGN:=CONV!:I2BF(1);
  1783. IF M>=8 THEN M:=REMAINDER(M,8);
  1784. IF M>=4 THEN <<SIGN:=MINUS!:(SIGN); M:=M-4>>;
  1785. IF M=0 THEN GOTO SN ELSE IF M=1 THEN GOTO M1 ELSE
  1786. IF M=2 THEN GOTO M2 ELSE GOTO M3;
  1787. M1: R:=CUT!:MT( DIFFERENCE!:(PI4,R) , K2);
  1788. RETURN TIMES!:(SIGN , COS!:(R,K));
  1789. M2: R:=CUT!:MT(R,K2);
  1790. RETURN TIMES!:(SIGN , COS!:(R,K));
  1791. M3: R:=CUT!:MT( DIFFERENCE!:(PI4,R) , K2);
  1792. SN: BEGIN INTEGER J,N,NCUT; SCALAR DCUT,FCTRIAL,RI,TM;
  1793. NCUT:=K2-MIN(0 , ORDER!:(R)+1);
  1794. DCUT:=MAKE!:BF(10,-NCUT);
  1795. Y:=RI:=TM:=R;
  1796. R:=MINUS!:( CUT!:EP( TIMES!:(R,R) , -NCUT));
  1797. M:=J:=1;
  1798. WHILE GREATERP!:( ABS!:(TM) , DCUT) DO
  1799. <<J:=J+2;
  1800. FCTRIAL:=CONV!:I2BF( M:=M*J*(J-1));
  1801. RI:=CUT!:EP( TIMES!:(RI,R) , -NCUT);
  1802. N :=MAX(1 , K2-ORDER!:(FCTRIAL)+ORDER!:(RI));
  1803. TM:=DIVIDE!:(RI,FCTRIAL,N);
  1804. Y :=PLUS!:(Y,TM); IF REMAINDER(J,20)=0 THEN
  1805. Y:=CUT!:EP(Y,-NCUT) >>;
  1806. END;
  1807. RETURN ROUND!:MT( TIMES!:(SIGN,Y) , K);
  1808. END$
  1809. %*************************************************************$
  1810. SYMBOLIC PROCEDURE COS!:(X,K); %****************************$
  1811. %=================================================$
  1812. % This function calculates cos(x), the value of $
  1813. % the cosine function at the point "x", with $
  1814. % the precision K, by summing terms of the $
  1815. % Taylor series for cos(z), 0 < z < PI/4. $
  1816. % X is a BIG-FLOAT representation of any real "x",$
  1817. % otherwise it is converted to a <BIG-FLOAT>.$
  1818. % K is a positive integer. $
  1819. %=================================================$
  1820. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1821. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'COS!: ELSE
  1822. IF ZEROP!:(X) THEN CONV!:I2BF(1) ELSE
  1823. IF MINUSP!:(X) THEN COS!:( MINUS!:(X) , K) ELSE
  1824. BEGIN INTEGER K2,M; SCALAR PI4,SIGN,Q,R,Y;
  1825. K2 :=K+2;
  1826. M :=PRECI!:(X);
  1827. PI4:=TIMES!:( !:PI(K2+M) , CONV!:S2BF("0.25"));
  1828. IF LESSP!:(X,PI4) THEN <<M:=0; R:=X>>
  1829. ELSE <<M:=CONV!:BF2I( Q:=QUOTIENT!:(X,PI4));
  1830. R:=DIFFERENCE!:(X , TIMES!:(Q,PI4)) >>;
  1831. SIGN:=CONV!:I2BF(1);
  1832. IF M>=8 THEN M:=REMAINDER(M,8);
  1833. IF M>=4 THEN <<SIGN:=MINUS!:(SIGN); M:=M-4>>;
  1834. IF M>=2 THEN SIGN:=MINUS!:(SIGN);
  1835. IF M=0 THEN GOTO CS ELSE IF M=1 THEN GOTO M1 ELSE
  1836. IF M=2 THEN GOTO M2 ELSE GOTO M3;
  1837. M1: R:=CUT!:MT( DIFFERENCE!:(PI4,R) , K2);
  1838. RETURN TIMES!:(SIGN , SIN!:(R,K));
  1839. M2: R:=CUT!:MT(R,K2);
  1840. RETURN TIMES!:(SIGN , SIN!:(R,K));
  1841. M3: R:=CUT!:MT( DIFFERENCE!:(PI4,R) , K2);
  1842. CS: BEGIN INTEGER J,N; SCALAR DCUT,FCTRIAL,RI,TM;
  1843. DCUT:=MAKE!:BF(10,-K2);
  1844. Y:=RI:=TM:=CONV!:I2BF(1);
  1845. R:=MINUS!:( CUT!:EP( TIMES!:(R,R) , -K2));
  1846. M:=1;
  1847. J:=0;
  1848. WHILE GREATERP!:( ABS!:(TM) , DCUT) DO
  1849. <<J:=J+2;
  1850. FCTRIAL:=CONV!:I2BF( M:=M*J*(J-1));
  1851. RI:=CUT!:EP( TIMES!:(RI,R) , -K2);
  1852. N :=MAX(1 , K2-ORDER!:(FCTRIAL)+ORDER!:(RI));
  1853. TM:=DIVIDE!:(RI,FCTRIAL,N);
  1854. Y :=PLUS!:(Y,TM); IF REMAINDER(J,20)=0 THEN
  1855. Y:=CUT!:EP(Y,-K2) >>;
  1856. END;
  1857. RETURN ROUND!:MT( TIMES!:(SIGN,Y) , K);
  1858. END$
  1859. %*************************************************************$
  1860. SYMBOLIC PROCEDURE TAN!:(X,K); %****************************$
  1861. %=================================================$
  1862. % This function calculates tan(x), the value of $
  1863. % the tangent function at the point "x", $
  1864. % with the precision K, by calculating $
  1865. % sin(x) or cos(x) = sin(PI/2-x). $
  1866. % X is a BIG-FLOAT representation of any real "x",$
  1867. % otherwise it is converted to a <BIG-FLOAT>.$
  1868. % K is a positive integer. $
  1869. %=================================================$
  1870. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1871. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'TAN!: ELSE
  1872. IF ZEROP!:(X) THEN CONV!:I2BF(0) ELSE
  1873. IF MINUSP!:(X) THEN
  1874. MINUS!:( TAN!:( MINUS!:(X) , K)) ELSE
  1875. BEGIN INTEGER K2,M; SCALAR ONE,PI4,SIGN,Q,R;
  1876. K2 :=K+2;
  1877. ONE:=CONV!:I2BF(1);
  1878. M :=PRECI!:(X);
  1879. PI4:=TIMES!:( !:PI(K2+M) , CONV!:S2BF("0.25"));
  1880. IF LESSP!:(X,PI4) THEN <<M:=0; R:=X>>
  1881. ELSE <<M:=CONV!:BF2I( Q:=QUOTIENT!:(X,PI4));
  1882. R:=DIFFERENCE!:(X , TIMES!:(Q,PI4)) >>;
  1883. IF M>=4 THEN M:=REMAINDER(M,4);
  1884. IF M>=2 THEN SIGN:=MINUS!:(ONE) ELSE SIGN:=ONE;
  1885. IF M=1 OR M=3 THEN R:=DIFFERENCE!:(PI4,R);
  1886. R:=CUT!:MT(R,K2);
  1887. IF M=0 OR M=3 THEN GOTO M03 ELSE GOTO M12;
  1888. M03: R:=SIN!:(R,K2);
  1889. Q:=DIFFERENCE!:(ONE , TIMES!:(R,R));
  1890. Q:=SQRT!:( CUT!:MT(Q,K2) , K2);
  1891. RETURN TIMES!:(SIGN , DIVIDE!:(R,Q,K));
  1892. M12: R:=SIN!:(R,K2);
  1893. Q:=DIFFERENCE!:(ONE , TIMES!:(R,R));
  1894. Q:=SQRT!:( CUT!:MT(Q,K2) , K2);
  1895. RETURN TIMES!:(SIGN , DIVIDE!:(Q,R,K));
  1896. END$
  1897. %*************************************************************$
  1898. SYMBOLIC PROCEDURE ASIN!:(X,K); %***************************$
  1899. %==================================================$
  1900. % This function calculates asin(x), the value of $
  1901. % the arcsine function at the point "x", $
  1902. % with the precision K, by calculating $
  1903. % atan(x/SQRT(1-x**2)) by ATAN!:. $
  1904. % The answer is in the range [-PI/2 , PI/2]. $
  1905. % X is a BIG-FLOAT representation of "x", IxI <= 1,$
  1906. % otherwise it is converted to a <BIG-FLOAT>. $
  1907. % K is a positive integer. $
  1908. %==================================================$
  1909. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1910. GREATERP!:( ABS!:(X) , CONV!:I2BF(1)) OR
  1911. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'ASIN!: ELSE
  1912. IF MINUSP!:(X) THEN
  1913. MINUS!:( ASIN!:( MINUS!:(X) , K)) ELSE
  1914. BEGIN INTEGER K2; SCALAR ONE,Y;
  1915. K2 :=K+2;
  1916. ONE:=CONV!:I2BF(1);
  1917. IF LESSP!:( DIFFERENCE!:(ONE,X) , MAKE!:BF(10,-K2))
  1918. THEN RETURN ROUND!:MT
  1919. ( TIMES!:( !:PI(K+1) , CONV!:S2BF("0.5")) , K);
  1920. Y:=CUT!:MT( DIFFERENCE!:(ONE , TIMES!:(X,X)) , K2);
  1921. Y:=DIVIDE!:(X , SQRT!:(Y,K2) , K2);
  1922. RETURN ATAN!:(Y,K);
  1923. END$
  1924. %*************************************************************$
  1925. SYMBOLIC PROCEDURE ACOS!:(X,K); %***************************$
  1926. %==================================================$
  1927. % This function calculates acos(x), the value of $
  1928. % the arccosine function at the point "x", $
  1929. % with the precision K, by calculating $
  1930. % atan(SQRT(1-x**2)/x) if x > 0 or $
  1931. % atan(SQRT(1-x**2)/x) + PI if x < 0. $
  1932. % The answer is in the range [0 , PI]. $
  1933. % X is a BIG-FLOAT representation of "x", IxI <= 1,$
  1934. % otherwise it is converted to a <BIG-FLOAT>. $
  1935. % K is a positive integer. $
  1936. %==================================================$
  1937. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1938. GREATERP!:( ABS!:(X) , CONV!:I2BF(1)) OR
  1939. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'ACOS!: ELSE
  1940. BEGIN INTEGER K2; SCALAR Y;
  1941. K2:=K+2;
  1942. IF LESSP!:( ABS!:(X) , MAKE!:BF(50,-K2))
  1943. THEN RETURN ROUND!:MT
  1944. ( TIMES!:( !:PI(K+1) , CONV!:S2BF("0.5")) , K);
  1945. Y:=DIFFERENCE!:( CONV!:I2BF(1) , TIMES!:(X,X));
  1946. Y:=CUT!:MT(Y,K2);
  1947. Y:=DIVIDE!:( SQRT!:(Y,K2) , ABS!:(X) , K2);
  1948. RETURN (IF MINUSP!:(X) THEN ROUND!:MT
  1949. ( DIFFERENCE!:( !:PI(K+1) , ATAN!:(Y,K)) , K)
  1950. ELSE ATAN!:(Y,K) );
  1951. END$
  1952. %*************************************************************$
  1953. SYMBOLIC PROCEDURE ATAN!:(X,K); %***************************$
  1954. %====================================================$
  1955. % This function calculates atan(x), the value of the $
  1956. % arctangent function at the point "x", with $
  1957. % the precision K, by summing terms of the $
  1958. % Taylor series for atan(z) if 0 < z < 0.42. $
  1959. % Otherwise the following identities are used: $
  1960. % atan(x) = PI/2 - atan(1/x) if 1 < x and $
  1961. % atan(x) = 2*atan(x/(1+SQRT(1+x**2))) $
  1962. % if 0.42 <= x <= 1. $
  1963. % The answer is in the range [-PI/2 , PI/2]. $
  1964. % X is a BIG-FLOAT representation of any real "x", $
  1965. % otherwise it is converted to a <BIG-FLOAT>. $
  1966. % K is a positive integer. $
  1967. %====================================================$
  1968. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  1969. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'ATAN!: ELSE
  1970. IF ZEROP!:(X) THEN CONV!:I2BF(0) ELSE
  1971. IF MINUSP!:(X) THEN
  1972. MINUS!:( ATAN!:( MINUS!:(X) , K)) ELSE
  1973. BEGIN INTEGER K2; SCALAR ONE,PI4,Y,Z;
  1974. K2 :=K+2;
  1975. ONE:=CONV!:I2BF(1);
  1976. PI4:=TIMES!:( !:PI(K2) , CONV!:S2BF("0.25"));
  1977. IF EQUAL!:(X,ONE) THEN RETURN ROUND!:MT(PI4,K);
  1978. IF GREATERP!:(X,ONE) THEN RETURN ROUND!:MT
  1979. ( DIFFERENCE!:( PLUS!:(PI4,PI4) ,
  1980. ATAN!:( DIVIDE!:(ONE,X,K2) , K+1)) , K);
  1981. IF LESSP!:(X , CONV!:S2BF("0.42")) THEN GOTO AT;
  1982. Y:=PLUS!:(ONE , CUT!:MT( TIMES!:(X,X) , K2));
  1983. Y:=PLUS!:(ONE , SQRT!:(Y,K2));
  1984. Y:=ATAN!:( DIVIDE!:(X,Y,K2) , K+1);
  1985. RETURN ROUND!:MT( TIMES!:(Y , CONV!:I2BF(2)) , K);
  1986. AT: BEGIN INTEGER M,N,NCUT; SCALAR DCUT,TM,ZI;
  1987. NCUT:=K2-MIN(0 , ORDER!:(X)+1);
  1988. Y:=TM:=ZI:=X;
  1989. Z:=MINUS!:( CUT!:EP( TIMES!:(X,X) , -NCUT));
  1990. DCUT:=MAKE!:BF(10,-NCUT);
  1991. M:=1;
  1992. WHILE GREATERP!:( ABS!:(TM) , DCUT) DO
  1993. <<ZI:=CUT!:EP( TIMES!:(ZI,Z) , -NCUT);
  1994. N :=MAX(1 , K2+ORDER!:(ZI));
  1995. TM:=DIVIDE!:(ZI , CONV!:I2BF( M:=M+2) , N);
  1996. Y :=PLUS!:(Y,TM); IF REMAINDER(M,20)=0 THEN
  1997. Y:=CUT!:EP(Y,-NCUT) >>;
  1998. END;
  1999. RETURN ROUND!:MT(Y,K)
  2000. END$
  2001. %*************************************************************$
  2002. SYMBOLIC PROCEDURE ARCSIN!:(X,K); %*************************$
  2003. %==================================================$
  2004. % This function calculates arcsin(x), the value of $
  2005. % the arcsine function at the point "x", with $
  2006. % the precision K, by solving $
  2007. % x = sin(y) if 0 < x <= 0.72, or $
  2008. % SQRT(1-x**2) = sin(y) if 0.72 < x, $
  2009. % by Newton's iteration method. $
  2010. % The answer is in the range [-PI/2 , PI/2]. $
  2011. % X is a BIG-FLOAT representation of "x", IxI <= 1,$
  2012. % otherwise it is converted to a <BIG-FLOAT>. $
  2013. % K is a positive integer. $
  2014. %==================================================$
  2015. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  2016. GREATERP!:( ABS!:(X) , CONV!:I2BF(1)) OR
  2017. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'ARCSIN!: ELSE
  2018. IF ZEROP!:(X) THEN CONV!:I2BF(0) ELSE
  2019. IF MINUSP!:(X) THEN
  2020. MINUS!:( ARCSIN!:( MINUS!:(X) , K)) ELSE
  2021. BEGIN INTEGER K2; SCALAR DCUT,ONE,PI2,Y;
  2022. K2 :=K+2;
  2023. DCUT:=MAKE!:BF(10 , -K2+ORDER!:(X)+1);
  2024. ONE :=CONV!:I2BF(1);
  2025. PI2 :=TIMES!:( !:PI(K2+2) , CONV!:S2BF("0.5"));
  2026. IF LESSP!:( DIFFERENCE!:(ONE,X) , DCUT) THEN
  2027. RETURN ROUND!:MT(PI2,K);
  2028. IF GREATERP!:(X , CONV!:S2BF("0.72")) THEN GOTO AC
  2029. ELSE GOTO AS;
  2030. AC: Y:=CUT!:MT( DIFFERENCE!:(ONE , TIMES!:(X,X)) , K2);
  2031. Y:=ARCSIN!:( SQRT!:(Y,K2) , K);
  2032. RETURN ROUND!:MT( DIFFERENCE!:(PI2,Y) , K);
  2033. AS: BEGIN INTEGER NFIG,N; SCALAR CX,DX,DY,X0;
  2034. DY:=ONE;
  2035. Y :=X;
  2036. NFIG:=1;
  2037. WHILE NFIG<K2 OR GREATERP!:( ABS!:(DY) , DCUT) DO
  2038. <<IF (NFIG:=2*NFIG) > K2 THEN NFIG:=K2;
  2039. X0:=SIN!:(Y,NFIG);
  2040. CX:=DIFFERENCE!:(ONE , TIMES!:(X0,X0));
  2041. CX:=CUT!:MT(CX,NFIG);
  2042. CX:=SQRT!:(CX,NFIG);
  2043. DX:=DIFFERENCE!:(X,X0);
  2044. N :=MAX(1 , NFIG+ORDER!:(DX));
  2045. DY:=DIVIDE!:(DX,CX,N);
  2046. Y :=PLUS!:(Y,DY) >>;
  2047. END;
  2048. RETURN ROUND!:MT(Y,K);
  2049. END$
  2050. %*************************************************************$
  2051. SYMBOLIC PROCEDURE ARCCOS!:(X,K); %*************************$
  2052. %====================================================$
  2053. % This function calculates arccos(x), the value of $
  2054. % the arccosine function at the point "x", with $
  2055. % the precision K, by calculating $
  2056. % arcsin(SQRT(1-x**2)) if x > 0.72 and $
  2057. % PI/2 - arcsin(x) otherwise by ARCSIN!:. $
  2058. % The answer is in the range [0 , PI]. $
  2059. % X is a BIG-FLOAT representation of "x", IxI <= 1, $
  2060. % otherwise it is converted to a <BIG-FLOAT>. $
  2061. % K is a positive integer. $
  2062. %====================================================$
  2063. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  2064. GREATERP!:( ABS!:(X) , CONV!:I2BF(1)) OR
  2065. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'ARCCOS!: ELSE
  2066. IF LEQ!:(X , CONV!:S2BF("0.72")) THEN
  2067. ROUND!:MT( DIFFERENCE!:
  2068. ( TIMES!:( !:PI(K+1) , CONV!:S2BF("0.5")) ,
  2069. ARCSIN!:(X,K) ) , K)
  2070. ELSE ARCSIN!:( SQRT!:( CUT!:MT
  2071. ( DIFFERENCE!:( CONV!:I2BF(1) , TIMES!:(X,X)) ,
  2072. K+2) , K+2) , K)$
  2073. %*************************************************************$
  2074. SYMBOLIC PROCEDURE ARCTAN!:(X,K); %*************************$
  2075. %==================================================$
  2076. % This function calculates arctan(x), the value of $
  2077. % the arctangent function at the point "x", $
  2078. % with the precision K, by calculating $
  2079. % arcsin(x/SQRT(1+x**2)) by ARCSIN!: $
  2080. % The answer is in the range [-PI/2 , PI/2]. $
  2081. % X is a BIG-FLOAT representation of any real "x", $
  2082. % otherwise it is converted to a <BIG-FLOAT>. $
  2083. % K is a positive integer. $
  2084. %==================================================$
  2085. IF NOT( BFP!:( X:=CONV!:A2BF(X))) OR
  2086. NOT( FIXP(K)) OR K<=0 THEN BFLERRMSG 'ARCTAN!: ELSE
  2087. IF MINUSP!:(X) THEN
  2088. MINUS!:( ARCTAN!:( MINUS!:(X) , K))
  2089. ELSE ARCSIN!:( DIVIDE!:(X , SQRT!:( CUT!:MT
  2090. ( PLUS!:( CONV!:I2BF(1) , TIMES!:(X,X)) ,
  2091. K+2) , K+2) , K+2) , K)$
  2092. END;