From 49799190a6d089ba58758c76b7a2194934af2de5 Mon Sep 17 00:00:00 2001 From: Jaron Kent-Dobias Date: Mon, 6 Feb 2023 17:05:47 +0100 Subject: Added an inverse coordinate function. --- IsingScalingFunction.wl | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/IsingScalingFunction.wl b/IsingScalingFunction.wl index 29370eb..b119b9f 100644 --- a/IsingScalingFunction.wl +++ b/IsingScalingFunction.wl @@ -99,7 +99,7 @@ Ghs := { Around[-1.04 10^7, 0.01 10^7] } -Data[2] = <| +Data[2] = Rationalize[#, 10^-20] & /@ <| "θ0" -> 1.148407773492004`, "θYL" -> 0.9896669889911205`, "CYL" -> -0.172823989504767`, @@ -107,7 +107,7 @@ Data[2] = <| "gs" -> {0.37369093055254343`, -0.021636313152585823`} |> -Data[3] = <| +Data[3] = Rationalize[#, 10^-20] & /@ <| "θ0" -> 1.2542120477507488`, "θYL" -> 0.6020557328641167`, "CYL" -> -0.38566364361428684`, @@ -115,7 +115,7 @@ Data[3] = <| "gs" -> {0.4483788209731592`, -0.022032295172535358`, 0.00022200608228654115`} |> -Data[4] = <| +Data[4] = Rationalize[#, 10^-20] & /@ <| "θ0" -> 1.3164928721109121`, "θYL" -> 0.6400189996493497`, "CYL" -> -0.3563974694580203`, @@ -123,7 +123,7 @@ Data[4] = <| "gs" -> {0.4410742751152714`, -0.034817777358116885`, 0.000678172648789985`, -0.00004305140578834467`} |> -Data[5] = <| +Data[5] = Rationalize[#, 10^-20] & /@ <| "θ0" -> 1.3403205742656135`, "θYL" -> 0.6238113973493433`, "CYL" -> -0.38002950945224295`, @@ -131,7 +131,7 @@ Data[5] = <| "gs" -> {0.44371885415894785`, -0.04609943321005163`, -0.0007458341071947777`, 0.00005966875622885447`, -4.403083529955303`*^-6} |> -Data[6] = <| +Data[6] = Rationalize[#, 10^-20] & /@ <| "θ0" -> 1.3626103817690176`, "θYL" -> 0.6462147447024515`, "CYL" -> -0.35576386594103865`, @@ -163,6 +163,14 @@ ut[R_, θ_] := R t[θ] uh[θ0_, gs_][R_, θ_] := R^Δ g[θ0, gs][θ] +InverseCoordinates[\[Theta]0_, gs_, wp_:20][tn_, hn_] := + ({Exp[logR], \[Theta]0 Tanh[x]} /. + FindRoot[{ + Rationalize[tn, 10^-30] == ut[Exp[logR], \[Theta]0 Tanh[x]], + Rationalize[hn, 10^-30] == uh[\[Theta]0, gs][Exp[logR], \[Theta]0 Tanh[x]] + }, {{logR, 2}, {x, Sign[hn]/2}}, WorkingPrecision -> wp]) /; + NumericQ[tn] && NumericQ[hn] + η[θ0_, gs_][θ_] := t[θ] / RealAbs[g[θ0, gs][θ]]^(1 / Δ) ξ[θ0_, gs_][θ_] := g[θ0, gs][θ] / RealAbs[t[θ]]^Δ @@ -198,7 +206,7 @@ InverseDerivativeList[n_][f_][x_] := Module[ fp'[xp] D[Pm, xp] - (2 m - 1) fp''[xp] Pm], 1, Range[n - 1]] /. Derivative[m_][fp][xp] :> dfs[[m]]; MapIndexed[{Pn, i} \[Function] Pn/dfs[[1]]^(2 i[[1]] - 1), Pns] - ] +] CompositeFunctionDerivativeList[G_, F_, X_, FSupp_:(0&)][m_, θ_] := Module[ { ds, dF, df, fp }, -- cgit v1.2.3-54-g00ecf