How to get rid of 0.000 and change 5.*10^n to 3*10^n on Log Plots?

Question

Using Version 13.1.0.0 (Edit: MacOS BigSur Version 11.6, Hardware M1 chip)

In order to show some Log (or LogLog) plot features that I find annoying, here is some code:

A=3/2;B=1/1000;G=1;
{Slider[Dynamic[G],{1/10,8}],"G"->Dynamic[G],"\n",Slider[Dynamic[A],{1/2,2}],"A"->Dynamic[A],"\n",Slider[Dynamic[B],{1/10000,1/100}],"B"->Dynamic[B],"\n",Dynamic[LogLogPlot[
Evaluate[ B/(G Gamma[G+1] Zeta[1+G](2-2^-G)) {Log[1+A/(-1+E^(B t))]^G,A^G E^(-B G t)}],{t,0,3000},PlotRange->{{0.01,Full},{0,Full}},WorkingPrecision->20,ImageSize->Medium]]} 

Please notice that the code this generates shows 0.000 rather than 0.001 on the y-axis and show numerical values at 5.x 10$^n$ rather than 3 x 10$^n$, where both the decimal points are unneeded and the divisions at 5 times ten to a power results in collisions a lot sooner than at 3 times ten to a power because N[Log10[3]] is 0.477121 or very close to 0.5 on a Log10 plot, whereas N[Log10[5]] is 0.69897, and not close to 0.5.

Are there any fixes for these annoying features that do not involve yards of Tick coding?

Notice the positions of the numbers NumberLinePlot[{Log10[1], Log10[3], Log10[5], Log10[10]}]

Re: Yards of tick code. For example,

FrameTicks -> {{{3, 3, {0, .01}}, {4, "", {0, .01}}, {5, 
    "", {0, .01}}, {6, "", {0, .01}}, {7, "", {0, .01}}, {8, 
    "", {0, .01}}, {9, "", {0, .01}}, {10, 10, {0, .015}}, {20, 
    "", {0, .01}}, {30, 30, {0, .01}}, {40, "", {0, .01}}, {50, 
    "", {0, .01}}, {60, "", {0, .01}}, {70, "", {0, .01}}, {80, 
    "", {0, .01}}, {90, "", {0, .01}}, {100, 100, {0, .015}}, {200, 
    "", {0, .01}}, {300, 300, {0, .01}}, {400, "", {0, .01}}, {500, 
    "", {0, .01}}, {600, "", {0, .01}}, {700, "", {0, .01}}, {800, 
    "", {0, .01}}, {900, "", {0, .01}}, {1000, 
    1000, {0, .015}}, {2000, "", {0, .01}}, {3000, 
    3000, {0, .01}}, {4000, "", {0, .01}}, {5000, "", {0, .01}}}, 
  Automatic}

To format an x-axis like the following:

PS, I put this in as bugs even though this has not been vetted because I do not need to have someone verify that $0.000\neq0.001$, i.e., seeing is believing.

Edit On 2023-08-02 I received notification from Wolfram that Mathematica 13.3.1.0 has fixed the M1 chip code bug. Indeed, the same code as above now displays 0.001 rather than 0.000 on the $y$-axis.

Answer 1

Based on the update, and applying some simplification so we can focus on the ticks, here is an approach that computes the option for the ticks.

TickSpec = 
  {Join[
     Table[{3*10^i, StringForm["3e``", i], .01}, {i, 0, Floor[Log10[3000]]}], 
     Table[{1*10^(i + 1), StringForm["1e``", i + 1], .02}, {i, 0, Floor[Log10[3000]]}]], {}};
LogLogPlot[Log10[x], {x, 0, 3000}, Ticks -> TickSpec]

You could parameterize this to get rid of the hard-coded 3000.

I should add that I didn't see in your examples why using FrameTicks was necessary, so I just used Ticks. But a similar treatment could be used for FrameTicks, although the format is slightly different.