NoDigits:=100 (* Number of Digits of d_beta(1) *)

slope[m0_]:=Module[{m=m0},
P=1+(Sqrt[(m/(m-1))]);T[x_]:=N[FractionalPart[P* x]];
digit[x_,i_]:=Floor[P *Nest[T,x,i-1]];
e=Table[digit[1,i],{i,2,NoDigits}];
If[Order[e,ConstantArray[0,Length[e]]]>-0.5, 1,
If[Order[e,Join[{0},ConstantArray[1,Length[e]-1]]]<0.5,0,(* Generic Case *)
PalDef[l_]:=Module[{PalPref={}},
For[i=1,i<Length[l]+1,i++,l0=Join[PalPref,{l[[i]] }];
For[n=1,n<Length[l0]+1,n++,longPal=Take[l0,-(Length[l0]+1-n)];If[longPal==Reverse[longPal],Pal=Join[l0,Reverse[Take[l0,Length[l0]-Length[longPal]]]];
Break[]]
];PalPref=Pal
]
]; (* End of PalDef *)
le={e[[2]]};Label[palcalc]; PalDef[le];le=Join[le,{e[[Length[Pal]+2]]}] ;
If[Pal==Take[e,{2,Length[Pal]+1}]&&Not[MemberQ[Pal,2]],Goto[palcalc]]; (* If[Pal *)                          PalDef[Drop[le,-2]];u=Pal; (* End of Defining u *)
If[Not[MemberQ[u,1]], 
If[Order[ Take[e,{Length[u]+2,2*Length[u]+2}],Join[{1},u]]>0.5, 
(Length[u]+1)/(Length[u]+2),Length[u]/(Length[u]+1)],(* If[Order[ Take *)
 If[Not[MemberQ[u,0]],If[Order[ Take[e,{Length[u]+2,2*Length[u]+2}],Join[{0},u]]>0.5, 
1/(Length[u]+1),1/(Length[u]+2)],(* If[Order[ Take *)
q=(Count[u,1]+1)/(Length[u]+2);
For[modi=1,modi<Denominator[q]+1,modi++,If[Mod[modi*(Denominator[q]-Numerator[q]),Denominator[q]]==1,Break[]]];(* End of modi *)pPal=Take[e,{2,modi-1}];qPal=Take[e,{2,Length[u]-modi+1}];
If[(Take[e,{Length[u]+2,Length[u]+3}]=={0,1}&&Order[Join[u,{0,1}],Take[e,{Length[u]+4,2*Length[u]+5}]]>0.5)||
(Take[e,{Length[u]+2,Length[u]+3}]=={1,0}&&Order[Take[e,{Length[u]+4,2*Length[u]+5}],Join[u,{1,0}]]>0.5),
(Length[u]-Count[u,1]+1)/(Length[u]+2), (* c-i *)
If [(Take[e,{Length[u]+2,Length[u]+3}]=={0,0})||(Take[e,{Length[u]+2,Length[u]+3}]=={0,1}&&Order[Take[e,{Length[u]+4,2*Length[u]+5}],Join[u,{0,1}]]>0.5),(Length[qPal]-Count[qPal,1]+1)/(Length[qPal]+2), (* c-ii *)
If [(Order[{1,1},Take[e,{Length[u]+2,Length[u]+3}]]>-0.5)||(Take[e,{Length[u]+2,Length[u]+3}]=={1,0}&&
Order[Join[u,{1,0}],Take[e,{Length[u]+4,2*Length[u]+5}]]>0.5),(Length[pPal]-Count[pPal,1]+1)/(Length[pPal]+2), (* c-iii *)  (Length[u]-Count[u,1]+1)/(Length[u]+2) (* c-iv *)
] (* If [(Order[{1,1} *)
]  (* If [(Take[e,{Length[u]+2, *)
]
](* If[Not[MemberQ[u,0]] *)
](* If[Not[MemberQ[u,1]] *)
(* Generic Case *)
](*2nd IF*)
](*1st IF*)
]

Mud[m0_]:=Module[{m=m0},
b=Denominator[slope[m]];a=Numerator[slope[m]];central=Table[Ceiling[a/b*(n+1)]-Ceiling[a/b* n],{n,1,b-2}];
centralInv=Table[Ceiling[(b-a)/b*(n+1)]-Ceiling[(b-a)/b* n],{n,1,b-2}];
beta0=FindRoot[x^b-2x^(b-1)-centralInv.Table[x^(b-2-k),{k,1,b-2}],{x,2.5}][[1,2]];
((beta0^b*(beta0-1)^2)/(beta0^(b+2)-2beta0^(b+1)+1))
]

p[m0_]:=Module[{m=m0}, b=Denominator[slope[m]];a=Numerator[slope[m]];
If[m<Mud[m], FindRoot[(m-1)*x^b-m*x^(b-1)-((m-1)central+1).Table[x^(b-1-k),{k,1,b-2}]-m,{x,2.5}][[1,2]],
FindRoot[x^b-((m-1)centralInv).Table[x^(b-k),{k,1,b-2}]-m,{x,2.5}][[1,2]]
]
]

p[6]

p[7]

p[2.5]

p[2.7]

p[5]

p[10]