• 0 Vote(s) - 0 Average
• 1
• 2
• 3
• 4
• 5
 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 *) << 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? « Next Oldest | Next Newest »

 Messages In This Thread sexp and slog at a microcalculator - by Kouznetsov - 01/08/2009, 08:51 AM

 Possibly Related Threads... Thread Author Replies Views Last Post Revisting my accelerated slog solution using Abel matrix inversion jaydfox 21 17,646 02/09/2019, 02:25 PM Last Post: sheldonison fast accurate Kneser sexp algorithm sheldonison 38 90,940 01/14/2016, 05:05 AM Last Post: sheldonison A note on computation of the slog Gottfried 6 11,966 07/12/2010, 10:24 AM Last Post: Gottfried Improving convergence of Andrew's slog jaydfox 19 32,358 07/02/2010, 06:59 AM Last Post: bo198214 regular sexp: curve near h=-2 (h=-2 + eps*I) Gottfried 2 7,179 03/10/2010, 07:52 AM Last Post: Gottfried intuitive slog base sqrt(2) developed between 2 and 4 bo198214 1 4,462 09/10/2009, 06:47 PM Last Post: bo198214 regular sexp:different fixpoints Gottfried 6 14,321 08/11/2009, 06:47 PM Last Post: jaydfox sexp(strip) is winding around the fixed points Kouznetsov 8 15,967 06/29/2009, 10:05 AM Last Post: bo198214 SAGE code implementing slog with acceleration jaydfox 4 8,655 10/22/2007, 12:59 AM Last Post: jaydfox Dissecting Andrew's slog solution jaydfox 15 22,628 09/20/2007, 05:53 AM Last Post: jaydfox

Users browsing this thread: 1 Guest(s)