Formatting a number with fixed number of significant digits
You probably need to read tutorial Output Formats for Numbers, but long story short, you are looking for NumberForm
NumberForm[N[Pi], 10]
3.141592654
Main thing is controlling number of precise digits and the number of digits to the right of the decimal:
NumberForm[1.23456, {3, 4}]
1.2300
Cool things you can also do:
NumberForm[30!, DigitBlock -> 5, NumberSeparator -> " "]
265 25285 98121 91058 63630 84800 00000
NumberForm[1234567890., 10, ExponentStep -> 6, NumberMultiplier -> "*"]
Here I present the scientific formatting function I have developed. It allows to restrict the displayed digits to only precise digits (negative and zero precision are also supported) and to specify the maximum number of zeros after the decimal point before converting the number to exponential form (negative values of this option are interpreted as the minimum number of digits before decimal point which will be showed). The option PadSign controls sign padding for positive numbers. The option Align allows to specify where the \[AlignmentMarker] should be placed inside of the number: before decimal point ("."), before first significant digit of the number ("FirstDigit") or it should not be included in the output (any other value). The output is always wrapped in Item and the option Alignment->"\[AlignmentMarker]" is set when the Align is not switched off. It is also possible to pass any options of Item through SciForm.
Here is a demonstration of what is possible with SciForm (the code for generating this table see at bottom of this post):
The code of SciForm:
ClearAll[SciForm];
Options[SciForm]=Join[Options[Item],{Align->"FirstDigit",PadSign->False}];
SyntaxInformation[SciForm]={"ArgumentsPattern"->{_,_.,OptionsPattern[]}};
SciForm::"sigz"= "In addition to `1` precise digit`3` requested, `2` zero`4` will appear as placeholder`4`.";
SciForm[x_?NumericQ,prec_Integer,thr_Integer:4,opts:OptionsPattern[]]:=
Module[{rd,e=MantissaExponent[x][[2]],m1,m2,sign,mess,exp,i,al,alF},
rd=If[prec>0,ToString/@RealDigits[Round[x,10^(-prec+e)],10,prec][[1]],{}];
sign=If[Negative[x],"-",If[TrueQ@OptionValue[PadSign],ToString[Invisible["+"],StandardForm],""]];
If[Head[alF=al=OptionValue[Align]]===List,al=First@alF;alF={"\[AlignmentMarker]",alF[[2]]},alF={"\[AlignmentMarker]",Center}];
m1=If[TrueQ[al==="FirstDigit"],"\[AlignmentMarker]",""];
m2=If[TrueQ[al==="."],"\[AlignmentMarker]",""];
i=If[TrueQ[MatchQ[al,"."|"FirstDigit"]],
Item[#,Alignment->alF,FilterRules[{opts},Options[Item]]]&,Item[#,FilterRules[{opts},Options[Item]]]&];
exp[n_]:=ToString[Superscript["10",n],StandardForm];
mess:=Message[SciForm::"sigz",prec,-thr-prec,If[prec>1,"s",""],If[-thr-prec>1,"s",""]];
i@Which[
e!=prec<=0,StringJoin[sign,m1,"0",m2,".?*",exp[e-prec]],
e==prec<=0,StringJoin[sign,m1,"0",m2,".?"],
0==e>=-thr,StringJoin[sign,"0",m2,".",m1,rd],
0>e>=-thr,StringJoin[sign,"0",m2,".",Array["0"&,-e],m1,rd],
0>=-thr>e,StringJoin[sign,"0",m2,".",m1,rd,"*",exp[e]],
1<=-thr>e&&-thr<prec>=1,StringJoin[sign,m1,Insert[rd,{m2,"."},1-thr],"*",exp[e+thr]],
1<=-thr==prec>e,StringJoin[sign,m1,rd,m2,"*",exp[e+thr]],
1<=-thr>prec>e,mess;StringJoin[sign,m1,rd,Array["0"&,-thr-prec],m2,"*",exp[e+thr]],
prec>e>0,StringJoin[sign,m1,Insert[rd,{m2,"."},e+1]],
prec==e>0&&-thr<=prec,StringJoin[sign,m1,rd,m2],
e==-thr>prec>0,mess;StringJoin[sign,m1,rd,Array["0"&,-thr-prec],m2],
e>prec>0&&-thr<=prec,StringJoin[sign,m1,rd,m2,"*",exp[e-prec]],
e>=prec>0&&-thr>prec,mess;StringJoin[sign,m1,rd,Array["0"&,-thr-prec],m2,"*",exp[e+thr]]
]];
The code for the above table:
data = {.0000000123456789, .000000123456789, -.00000123456789, \
-.0000123456789, .000123456789, .00123456789, .0123456789, .123456789,
1.23456789, 12.3456789, 123.456789, 1234.56789, 12345.6789,
123456.789};
(*Note that NumberForm does not print Message although when called as \
NumberForm[123456.789,5] it does. Is it a bug? *)
Grid[Prepend[
{SciForm[#, 4
, Align -> "."
, BaseStyle ->
FontFamily -> "Times"],
SciForm[#, 4, 5
, BaseStyle ->
FontFamily -> "Times"],
SciForm[#, 4, -4
, BaseStyle ->
FontFamily -> "Times"],
SciForm[#, 4, -1
, BaseStyle ->
FontFamily -> "Times"]} & /@ data,
Item[#, Alignment -> "\[AlignmentMarker]",
BaseStyle -> {10, Bold}] & /@ {
"SciForm[\[AlignmentMarker]#,4\[IndentingNewLine],Align\[Rule]\".\
\"\[IndentingNewLine],BaseStyle\[Rule]\[IndentingNewLine]FontFamily\
\[Rule]\"Times\"]&",
"SciForm[#\[AlignmentMarker],4,5\[IndentingNewLine],Align\[Rule]\"\
FirstDigit\"\[IndentingNewLine],BaseStyle\[Rule]\[IndentingNewLine]\
FontFamily\[Rule]\"Times\"]&",
"SciFor\[AlignmentMarker]m[#,4,-4\[IndentingNewLine],Align\[Rule]\
\"FirstDigit\"\[IndentingNewLine],BaseStyle\[Rule]\[IndentingNewLine]\
FontFamily\[Rule]\"Times\"]&",
"SciFor\[AlignmentMarker]m[#,4,-1\[IndentingNewLine],Align\[Rule]\
\"FirstDigit\"\[IndentingNewLine],BaseStyle\[Rule]\[IndentingNewLine]\
FontFamily\[Rule]\"Times\"]&"}
], Frame -> All, Alignment -> {Automatic, Center}]
Any ideas and suggestions are welcome!
It's not so easy to achieve your goal, because NumberForm always wants a number n of digits to precision or a pair {totaldigits, digits-after-decimal-point}. So we must use PaddingForm or Row to do it. The solution isn't very short then. But the following code seems to work:
Clear[format]
Options[format] = Options[NumberForm];
format[x_, sd_] :=
Module[{m, e, man, exp, num, n, f}, {m, e} = MantissaExponent[x];
If[Abs[x] <= 10^-sd,
Row[{PaddedForm[10 m, {sd, sd - 1}], Superscript["\[Times]10", e - sd + 2]}],
If[e < sd,
n = sd - e - 1; f = sd - e;
If[n == 0, PaddedForm[x, {sd, f}], PaddedForm[x, {n, f}]],
If[sd == e, PaddedForm[x, sd],(*else sd<e*)
Row[{Round[10^sd m, 10^-sd],
Superscript["\[Times]10", e - sd]}]]]]]
For your examples you will get
Update
Replacing the Numberform, in If[n==0,...] with PaddedForm[x,{sd,f}] seems to work for the cases, which the old routine failed, as Alexey Popkov mentioned in his comment.
Update 2
Seems to work now for numbers smaller than 10^-sd.