Making customized InputForm and ShortInputForm

问题:

I often wish to see the internal representation of Mathematica's graphical objects not in the FullForm but in much more readable InputForm having the ability to select parts of the code by double-clicking on it and easily copy this code to a new input Cell. But the default InputForm does not allow this since InputForm is displayed by default as a String, not as Mathematica's code. Is there a way to have InputForm displayed as Mathematica's code?

I also often wish to see a shortened version of such InputForm where all long lists of coordinates are displayed as the first coordinate followed by number of skipped coordinate values wrapped with Skeleton, all empty Lists removed and all numbers are also shortened for displaying no more than 6 digits. It would be even better to use 6 digits only for coordinates but for color directives such as Hue display only 2 significant digits. For example,

Plot[{Sin[x], .5 Sin[2 x]}, {x, 0, 2 \[Pi]}, 
  Filling -> {1 -> {2}}] // ShortInputForm

should give:

Graphics[GraphicsComplex[{{1.28228`*^-7, 1.28228*^-7}, <<1133>>}, 
    {{{EdgeForm[], Directive[{Opacity[0.2], Hue[0.67, 0.6, 0.6]}], 
          GraphicsGroup[{Polygon[{{1133, <<578>>}}]}]}, 
        {EdgeForm[], Directive[{Opacity[0.2], Hue[0.67, 0.6, 0.6]}],              
     GraphicsGroup[{Polygon[{{432, <<556>>}}]}]}}, {{Hue[0.67, 0.6, 
      0.6], Line[{1, <<431>>}]}, {Hue[0.91, 0.6, 0.6], 
          Line[{432, <<701>>}]}}}], {AspectRatio -> GoldenRatio^(-1), 
  Axes -> True, AxesOrigin -> {0, 0}, 
    Method -> {"AxesInFront" -> True}, 
  PlotRange -> {{0, 2*Pi}, {-1., 1}}, 
    PlotRangeClipping -> True, 
  PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]

(note that -0.9999998592131705 is converted to -1., 1.2822827157509358*^-7 is converted to 1.28228*^-7 and Hue[0.9060679774997897, 0.6, 0.6] is converted to Hue[0.91, 0.6, 0.6]).

In this way, I wish to have the output of InputForm as Mathematica's code and also have a ShortInputForm function which will give the shortened version of this code. Can anybody help me?

---

As to the first part of the question, I have found one way to achieve what I want:

Plot[{Sin[x], .5 Sin[2 x]}, {x, 0, 2 \[Pi]}, Filling -> {1 -> {2}}] //
   InputForm // StandardForm

回答1:

UPDATE

The most recent version of the shortInputForm function can be found here.

---

Original post

Here is another, even better solution (compatible with Mathematica 5):

myInputForm[expr_] := 
 Block[{oldContexts, output, interpretation, skeleton},
  output = ToString[expr, InputForm];
  oldContexts = {$Context, $ContextPath};
  $Context = "myTemp`"; $ContextPath = {$Context};
  output = DisplayForm@ToBoxes[ToExpression[output] /.
      {myTemp`interpretation -> If[$VersionNumber >= 6,
         System`Interpretation, System`First@{#} &],
       myTemp`Row -> System`Row,
       myTemp`skeleton -> System`Skeleton,
       myTemp`sequence :> (System`Sequence @@ # &)}, StandardForm];
  {$Context, $ContextPath} = oldContexts; output]
shortInputForm[expr_] := myInputForm[expr /. {{} -> Sequence[],
    lst : {x_ /; VectorQ[x, NumberQ], y__} /;
      (MatrixQ[lst, NumberQ] && Length[lst] > 3) :>
     {x /. v : {a_, b__} /; Length[v] > 3 :>
        {a, interpretation[skeleton[Length[{b}]], sequence@{b}]},
      interpretation[skeleton[Length[{y}]], sequence@{y}]},
    lst : {x_, y__} /; VectorQ[lst, NumberQ] && Length[lst] > 3 :>
     {x, interpretation[skeleton[Length[{y}]], sequence@{y}]}}]

How it works

This solution is based on simple idea: we need to block conversion of such things as Graphics, Point and others to typeset expressions in order to get them displayed in the internal form (as expressions suitable for input). Happily, if we do this, the resulting StandardForm output is found to be just formatted (two-dimensional) InputForm of the original expression. This is just what is needed!

But how to do this? First of all, this conversion is made by FormatValues defined for Symbols like Graphics, Point etc. One can get full list of such Symbols by evaluating the following:

list = Symbol /@ 
  Select[DeleteCases[Names["*"], "I" | "Infinity"], 
   ToExpression[#, InputForm, 
     Function[symbol, Length[FormatValues@symbol] > 0, HoldAll]] &]

My first idea was just Block all these Symbols (and it works!):

myInputForm[expr_] := 
 With[{list = list}, Block[list, RawBoxes@MakeBoxes@expr]]

But this method leads to the evaluation of all these Symbols and also evaluates all FormatValues for all Symbols in the $ContextPath. I think it should be avoided.

Other way to block these FormatValues is just to remove context "System`" from the $ContextPath. But it works only if these Symbols are not resolved yet to the "System`" context. So we need first to convert our expression to String, then remove "System`" context from the $ContextPath and finally convert the string backward to the original expression. Then all new Symbols will be associated with the current $Context (and Graphics, Point etc. - too, since they are not in the $ContextPath). For preventing context shadowing conflicts and littering the "Global`" context I switch $Context to "myTemp`" which can be easily cleared if necessary.

This is how myInputForm works.

Now about shortInputForm. The idea is not just to display a shortened version of myInputForm but also preserve the ability to select and copy parts of the shortened code into new input cell and use this code as it would be the full code without abbreviations. In version 6 and higher it is possible to achieve the latter with Interpretation. For compatibility with pre-6 versions of Mathematica I have added a piece of code that removes this ability if $VersionNumber is less than 6.

The only problem that I faced when working with Interpretation is that it has no SequenceHold attribute and so we cannot simply specify Sequence as the second argument for Interpretation. But this problem can easily be avoided by wrapping sequence in List and then Applying Sequence to it:

System`Sequence @@ # &

Note that I need to specify the exact context for all built-in Symbols I use because at the moment of calling them the "System`" context is not in the $ContextPath.

This ends the non-standard decisions taken me in the development of these functions. Suggestions and comments are welcome!

回答2:

At this moment I have come to the following solution:

round[x_, n_] := (10^-n*Round[10^n*MantissaExponent[x]]) /.
   {m_, e_} :> N[m*10^e];
ShortInputForm[expr_] := ((expr /.
       {{} -> Sequence[],
        lst : {x_ /; VectorQ[x, NumberQ], y__} /;
          (MatrixQ[lst, NumberQ] && Length[lst] > 2) :>
         {x, Skeleton[Length[{y}]]},
        lst : {x_, y__} /; VectorQ[lst, NumberQ] && Length[lst] > 2 :>
         {x, Skeleton[Length[{y}]]}} /.
      {exp : Except[List | Point][x__] /; 
         VectorQ[{x}, MachineNumberQ] :>
        (round[#, 2] & /@ exp), 
       x_Real /; MachineNumberQ[x] :> round[x, 6]})
    // InputForm // StandardForm)

Now: