# Only significands on y-axis

I would like to create plot similiar to this:

where significands are on y-axis, while $\times 10^{4}$ is above the plot (or could be placed at any place in graph). So far I managed to get only exponent right, using this code:

f[x_] := 100 Exp[x] Sin[20  x];
ymax = 1.5*^4;
ymin = -1.5*^4;
xticks = {#, #} & /@ Range[0, 5, 0.5];
yticks =
Map[
{#, NumberForm[#, {3, 1}, ExponentFunction -> (4 &)]} &,
N[FindDivisions[{ymin, ymax}, 6]]];

Plot[f[x], {x, 0, 5},
PlotRange -> {{0, 5}, {ymin, ymax}},
Frame -> True,
FrameTicks -> {{yticks, None}, {xticks, None}},
Axes -> False]


I will be grateful for any help.

You can use the internal function ChartingScaledTicks to get the needed ticks:

plot = Plot[
f[x],
{x, 0, 5},
PlotRange->{{0,5}, {-15000,15000}},
Frame->True,
FrameTicks->{{ChartingScaledTicks[{10^4#&, 10^-4#&}],None}, {Automatic,None}}
]


If you want to add $\times 10^{4}$ above the plot, you need to expand the padding. A good way to do this is to use my GraphicsInformation function to obtain this information. Install with:

PacletInstall[
"GraphicsInformation",
"Site" -> "http://raw.githubusercontent.com/carlwoll/GraphicsInformation/master"
]


<<GraphicsInformation


pad = "ImagePadding" /. GraphicsInformation[plot]


{{23., 4.}, {17., 6.5}}

So, the final plot looks like:

Show[
plot,
Epilog -> Text[Row@{"\[Times] ", Superscript[10, 4]}, Offset[{0, 10}, Scaled[{0, 1}]], {-1, 0}],
PlotRangeClipping->False,
]


• I am having no luck trying to look at the web site raw.githubusercontent.com/carlwoll/GraphicsInformation/master. I would like to download your package. What steps do I need to take to do that? Commented Jan 9, 2018 at 2:13
• @JackLaVigne Did running the PacletInstall command I gave not work? I just tried it and it worked. Commented Jan 9, 2018 at 2:38
• Using PacletInstall worked fine but is mysterious to me. I was hoping to get a file to use permanently. Perhaps my ignorance of PacletInstall is the source of confusion. When I did that did a package "GraphicsInformation" get put on my path? Commented Jan 9, 2018 at 2:41
• @JackLaVigne Yes, GraphicsInformation should be on your path if PacletInstall succeeded. On OSX it lives in Library/Mathematica/Paclets/Repository/GraphicsInformation. Commented Jan 9, 2018 at 2:48
• OK, found it at C:\Users\JLaVigne\AppData\Roaming\Mathematica\Paclets\Repository\GraphicsInformation-0.0.1. I am on Windows 7. Commented Jan 9, 2018 at 2:59

There are lots of ways to do it as the various answers to this question will prove. One way is by scaling the plot range.

f[x_] := 100 Exp[x] Sin[20 x]
ymax = 1.5*^4;
ymin = -1.5*^4;
xticks = Range[0, 5, 0.5];

With[{k = 10^4},
yticks = N @ FindDivisions[{ymin, ymax}/k, 6];
Column[{
Row[{"    \[Times]", Superscript[10, Log10[k]]}],
Plot[f[x]/k, {x, 0, 5},
PlotRange -> {{0, 5}, {ymin, ymax}/k},
Frame -> True,
FrameTicks -> {{yticks, None}, {xticks, None}},
Axes -> False,
ImageSize -> 450]},
Spacings -> 0]]


A start could be

f[x_] := 100 Exp[x] Sin[20 x];
ymax = 1.5*^4;
ymin = -1.5*^4;
xticks = {#, #} & /@ Range[0, 5, 0.5];

yticks = Map[{#, # 10^-4} &, N[FindDivisions[{ymin, ymax}, 6]]];

Plot[f[x], {x, 0, 5}, PlotRange -> {{0, 5}, {ymin, ymax}},
Frame -> True, FrameTicks -> {{yticks, None}, {xticks, None}},
Axes -> False,
PlotLabel ->
Pane["\[Times]\!$$\*SuperscriptBox[\(10$$, $$4$$]\)",
Alignment -> Left, ImageSize -> 320]]


or maybe

Labeled[Plot[f[x], {x, 0, 5}, PlotRange -> {{0, 5}, {ymin, ymax}},
Frame -> True, FrameTicks -> {{yticks, None}, {xticks, None}},
Axes -> False],
Style["    \[Times]\!$$\*SuperscriptBox[\(10$$, $$4$$]\)",
12], {{Top, Left}}]


Or to be able to set the distance from the text to the frame:

Plot[f[x], {x, 0, 5}, PlotRange -> {{0, 5}, {ymin, ymax}},
Frame -> True, FrameTicks -> {{yticks, None}, {xticks, None}},
Axes -> False, PlotRangeClipping -> False,
ImagePadding -> {{Automatic, Automatic}, {Automatic, 25}},
Epilog ->
Style[Text["\[Times]\!$$\*SuperscriptBox[\(10$$, $$4$$]\)",
Scaled[{0.05, 1.08}]], 10, Darker@Gray]]
`