sexp and slog at a microcalculator Kouznetsov Fellow Posts: 151 Threads: 9 Joined: Apr 2008 01/08/2009, 08:51 AM (This post was last modified: 01/11/2009, 11:50 PM by Kouznetsov.) Henryk, I upload the Mahtematica version of the fast sexp and fast slog. (* It is posted also at *) (* http://en.citizendium.org/wiki/Tetration...l.jpg/code *) (* Copyleft 2008-2009 by Dmitrii Kouznetosv*) (* Please indicate the souce if redistribute *) << GraphicsImplicitPlot c[x_, y_, z_] = RGBColor[x, y, z]; Zc = 0.31813150520476413531 - 1.33723570143068940890 I Zo = Conjugate[Zc] a2 = N[1/2/(Zo - 1), 20] a3 = (a2 + 1/6)/(Zo*Zo - 1) a4 = (a2/2 + a2*a2/2 + a3 + 1/24)/(Zo*Zo*Zo - 1) a5 = (a2*a2/2 + a2/6 + a2*a3 + a3/2 + a4 + 1/120)/(Zo*Zo*Zo*Zo - 1) R = 1.0779614375278 - .9465409639479I b0 = 0.1223 - 0.02370I e = Exp[Zo*z + R] Li = 2*Pi*I fima[z_] = Zo + e*(1 + e*(a2 + e*(a3 + e*(a4 + e*a5))) + b0*Exp[Li*z]); FIMA[z_] := If[Im[z] < 4 + .2379Re[z], Exp[FIMA[z - 1]], fima[z]] matai = { 0.37090658903228507226 + (1.33682167078891400713*I) , 0.03660096537598455518 + (0.13922215389950498565*I) , -0.16888431840641535131 + (0.09718533619629270148*I) , -0.12681315048680869007 + (-0.11831628767028627702*I) , 0.04235809310323926380 + (-0.10520930088320722129*I) , 0.05848306393563178218 + (-0.00810224524496080435*I) , 0.02340031665294847393 + (0.01807777011820375229*I) , 0.00344260984701375092 + (0.01815103755635914459*I) , -0.00803695814441672193 + (0.00917428467034995393*I) , -0.00704695528168774229 + (-0.00093958506727472686*I) , -0.00184617963095305509 + (-0.00322342583181676459*I) , 0.00054064885443097391 + (-0.00189672061015605498*I) , 0.00102243648088806748 + (-0.00055968657179243165*I) , 0.00064714396398048754 + (0.00025980661935827123*I) , 0.00010444455593372213 + (0.00037199472598828116*I) , -0.00011178535404343476 + (0.00016786687552190863*I) , -0.00010630158710808594 + (0.00002072200033125881*I) , -0.00005078098819110608 + (-0.00003575913005741248*I) , -0.00000314742998690270 + (-0.00003523185937587781*I) , 0.00001347661344130504 + (-0.00001333034137448205*I) , 0.00000980239082395275 + (0.00000047607184151673*I) , 0.00000355493475454698 + (0.00000389816212201278*I) , -0.00000021552652645735 + (0.00000296273413237997*I) , -0.00000131673903627820 + (0.00000097381354534333*I) , -0.00000083401960806066 + (-0.00000018663858711081*I) , -0.00000022869610981361 + (-0.00000037497716770031*I) , 0.00000005372584613379 + (-0.00000023060136585176*I) , 0.00000011406656653786 + (-0.00000006569510293486*I) , 0.00000006663595460757 + (0.00000002326630571343*I) , 0.00000001396786846375 + (0.00000003315118300198*I) , -0.00000000684890556421 + (0.00000001713041981611*I) , -0.00000000916619598268 + (0.00000000403886083652*I) , -0.00000000502933384276 + (-0.00000000222121299478*I) , -0.00000000084484352792 + (-0.00000000273668661113*I) , 0.00000000070086729861 + (-0.00000000124687683156*I) , 0.00000000070558101710 + (-0.00000000021962577544*I) , 0.00000000035900951951 + (0.00000000018774741308*I) , 0.00000000005248658571 + (0.00000000021201177126*I) , -0.00000000006264758835 + (0.00000000009059171879*I) , -0.00000000005333473585 + (0.00000000001006078866*I) , -0.00000000002432138144 + (-0.00000000001506937008*I) , -0.00000000000331880379 + (-0.00000000001544700067*I) , 0.00000000000501652570 + (-0.00000000000658967459*I) , 0.00000000000401214135 + (-0.00000000000036708383*I) , 0.00000000000158629111 + (0.00000000000119885992*I) , 0.00000000000019668766 + (0.00000000000106532662*I) , -0.00000000000036355730 + (0.00000000000047229527*I) , -0.00000000000029920206 + (0.00000000000001251827*I) , -0.00000000000010305550 + (-0.00000000000009571381*I) , -0.00000000000000910369 + (-0.00000000000007087680*I) , 0.00000000000002418310 + (-0.00000000000003240337*I) }; z3 = z - 3I; z32 = z3/2; tai[z_] = Sum[Extract[matai, n + 1]*z32^n, {n, 0, 50}]; TAI[z_] := If[Re[z] < -.5, Log[TAI[z + 1]], If[Re[z] > .5, Exp[TAI[z - 1]], tai[z]]] matao = { 0.30685281944005469058, 1.18353470251664338875 , 1.58593285160678321155, 1.36629265207672068172 , 1.36264601823980036066, 1.21734246689515424045 , 1.10981816083559525765, 0.96674692974769849130 , 0.84089872598668435888, 0.71353210966804747617 , 0.60168548504001373445, 0.49928574281440518678 , 0.41140086629121763728, 0.33506195665178500898 , 0.27104779243942234146, 0.21728554054610033086 , 0.17311050207880035456, 0.13690016038526570119 , 0.10765949732729711286, 0.08413804539743192923 , 0.06542450487497340761, 0.05060001212013485322 , 0.03895655493977817629, 0.02985084640296329153 , 0.02277908979501017117, 0.01730960309240666892 , 0.01310389615589767874, 0.00988251130733762764 , 0.00742735935367278347, 0.00556296426263720549 , 0.00415334478103463346, 0.00309116153137843543 , 0.00229387529664008653, 0.00169729976398295653 , 0.00125245885041635465, 0.00092172809095368547 , 0.00067661152429638357, 0.00049544127485341987 , 0.00036192128589181518, 0.00026376927786672476 , 0.00019180840045267570, 0.00013917553105723647 , 0.00010077412023867018, 0.00007281884753121133 , 0.00005251474516228446, 0.00003779882770351268 , 0.00002715594536867241, 0.00001947408515177282 , 0.00001394059355016322, 0.00000996213949015693 , 0.00000710713872292710, 0.00000506199803708578 , 0.00000359960968975399, 0.00000255569149787694 , 0.00000181175810338313, 0.00000128245831538430 , 0.00000090647322737496, 0.00000063980422418981 , 0.00000045095738191441, 0.00000031741772125007 , 0.00000022312521183625, 0.00000015663840476155 , 0.00000010982301013230, 0.00000007690305934973 , 0.00000005378502675604, 0.00000003757126131521 , 0.00000002621429405247, 0.00000001826909956818 , 0.00000001271754463425, 0.00000000884310192977 , 0.00000000614230041407, 0.00000000426177146865 , 0.00000000295386817285, 0.00000000204522503591 , 0.00000000141464900426, 0.00000000097750884878 , 0.00000000067478454029, 0.00000000046535930671 , 0.00000000032062550784, 0.00000000022069891976 , 0.00000000015177557961, 0.00000000010428189463 , 0.00000000007158597119, 0.00000000004909806710 , 0.00000000003364531769, 0.00000000002303635851 , 0.00000000001575933679, 0.00000000001077213757 , 0.00000000000735717912, 0.00000000000502077719 , 0.00000000000342362421, 0.00000000000233271256 , 0.00000000000158818623, 0.00000000000108046566 , 0.00000000000073450488, 0.00000000000049894945 , 0.00000000000033868911, 0.00000000000022973789 , 0.00000000000015572383, 0.00000000000010548054 , 0.00000000000007139840, 0.00000000000004829557 , 0.00000000000003264619, 0.00000000000002205299 , 0.00000000000001488731, 0.00000000000001004347 , 0.00000000000000677124, 0.00000000000000456225 }; maclo[z_] = Sum[Extract[matao, n + 1]*(z/2.)^n, {n, 0, 100}] + Log[z + 2] MACLO[z_] := If[Re[z] < -.5, Log[MACLO[z + 1]], If[Re[z] > .5, Exp[MACLO[z - 1]], maclo[z] ]] SEXP[z_] := If[Im[z] > 4.5 , FIMA[z], If[Im[z] > 1.5, TAI[z], If[Im[z] > -1.5, MACLO[z], If[Im[z] > -4.5, Conjugate[TAI[Conjugate[z]]], Conjugate[FIMA[Conjugate[z]]] ]]]] (* Polt of Figure 0 *) r = Re[SEXP[x + I*y]]; f = Im[SEXP[x + I*y]]; plo0 = ImplicitPlot[{r == Re[Zo], f == Im[Zo], r == -1.8, r == -1.6, r == -1.4, r == -1.2, r == -.8, r == -.6, r == -.4, r == -.2, r == 1.8, r == 1.6, r == 1.4, r == 1.2, r == .8, r == .6, r == .4, r == .2, f == -1.8, f == -1.6, f == -1.4, f == -1.2, f == -.8, f == -.6, f == -.4, f == -.2, f == 1.8, f == 1.6, f == 1.4, f == 1.2, f == .8, f == .6, f == .4, f == .2, r == -3, r == -2, r == -1, r == 0, r == 1, r == 2, r == 3, f == -3, f == -2, f == -1, f == 0, f == 1, f == 2, f == 3 }, {x, -2.1, 2.1}, {y, -.3, 5.5}, PlotStyle -> { c[1, 0, 1], c[0, 1, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 1, 0], c[0, 0, 0], c[0, 0, 0], c[0, 0, 0], c[0, 0, 0], c[0, 0, 0], c[0, 0, 0], c[0, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 0], c[1, 0, 1], c[0, 0, 1], c[0, 0, 1], c[0, 0, 1], }, PlotPoints -> 100, PlotRange -> {{-2.1, 2.1}, {-.3, 5.5}} {SEXP[-1], SEXP[0], SEXP[1]} plo1 = Plot[{SEXP[x], SEXP'[x], SEXP''[x]}, {x, -1.9, 1.2}, GridLines -> {{-2, -1, 1}, {-2, -1, 1, 2, 3}}, AspectRatio -> Automatic, PlotRange -> {{-2, 1.2}, {-2.1, 3.1}}, PlotStyle -> {c[0, 0, 0], c[1, 0, 0], c[0, .7, 0], c[0, 0, 1], c[.5, 0, .7]}]; plo2 = Plot[{SEXP'[x], SEXP''[x], SEXP'''[x], SEXP''''[x]}, {x, -1.9, 1.2}, GridLines -> {{-2, -1.5, -1, -.5, .5, 1}, {-2, -1, 1, 2, 3}}, AspectRatio -> Automatic, PlotRange -> {{-2, 1.2}, {-2.1, 3.1}}, PlotStyle -> {c[1, 0, 0], c[0, .7, 0], c[0, 0, 1], c[.5, 0, .7]}]; {SEXP[0], SEXP'[0], SEXP''[0], SEXP'''[0], SEXP''''[0], SEXP'''''[0]} Export["plo0.jpg", plo0] Export["plo0.eps", plo0] Export["plo0.pdf", plo0] Export["plo0.svg", plo0] Export["plo1.jpg", plo1] Export["plo1.eps", plo1] Export["plo1.pdf", plo1] Export["plo1.svg", plo1] Export["plo2.jpg", plo2] Export["plo2.eps", plo2] Export["plo2.pdf", plo2] Export["plo2.svg", plo2] (* end of code. Copyleft 2008-2009 by Dmitrii Kouznetsov *)         I include the two pics generated with this code. I would not say that in Mathematica, the algorithm runs so fast as in the C++. In C++, it takes few seconds, to generate an equivalent of plo0 above; the Mathematica takes few minutes. Anyway, the algorithm is simple and can run even at microcalculators. It would be interesting to compare the results to other algorithms. The superexponential seems to be more precise than slog; I made sexp of 3 pieces, while the slog is "one piece". If there are any way to see, wether any other algorithm is more precise? « Next Oldest | Next Newest »

 Possibly Related Threads… Thread Author Replies Views Last Post fast accurate Kneser sexp algorithm sheldonison 40 133,922 07/03/2022, 06:38 AM Last Post: JmsNxn Revisting my accelerated slog solution using Abel matrix inversion jaydfox 22 41,129 05/16/2021, 11:51 AM Last Post: Gottfried A note on computation of the slog Gottfried 6 17,844 07/12/2010, 10:24 AM Last Post: Gottfried Improving convergence of Andrew's slog jaydfox 19 47,894 07/02/2010, 06:59 AM Last Post: bo198214 regular sexp: curve near h=-2 (h=-2 + eps*I) Gottfried 2 10,461 03/10/2010, 07:52 AM Last Post: Gottfried intuitive slog base sqrt(2) developed between 2 and 4 bo198214 1 6,749 09/10/2009, 06:47 PM Last Post: bo198214 regular sexp:different fixpoints Gottfried 6 21,163 08/11/2009, 06:47 PM Last Post: jaydfox sexp(strip) is winding around the fixed points Kouznetsov 8 23,887 06/29/2009, 10:05 AM Last Post: bo198214 SAGE code implementing slog with acceleration jaydfox 4 12,577 10/22/2007, 12:59 AM Last Post: jaydfox Dissecting Andrew's slog solution jaydfox 15 33,390 09/20/2007, 05:53 AM Last Post: jaydfox

Users browsing this thread: 1 Guest(s)