sexp and slog at a microcalculator - Printable Version +- Tetration Forum (https://math.eretrandre.org/tetrationforum) +-- Forum: Tetration and Related Topics (https://math.eretrandre.org/tetrationforum/forumdisplay.php?fid=1) +--- Forum: Computation (https://math.eretrandre.org/tetrationforum/forumdisplay.php?fid=8) +--- Thread: sexp and slog at a microcalculator (/showthread.php?tid=221) sexp and slog at a microcalculator - Kouznetsov - 01/08/2009 Henryk, I upload the Mahtematica version of the fast sexp and fast slog. (* It is posted also at *) (* http://en.citizendium.org/wiki/TetrationDerivativesReal.jpg/code *) (* Copyleft 2008-2009 by Dmitrii Kouznetosv*) (* Please indicate the souce if redistribute *) << Graphics`ImplicitPlot` 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?