制作定制的InputForm和ShortInputForm

Question

我经常希望看到 Mathematica 图形对象的内部表示，而不是在 FullForm 中，而是在更具可读性的 InputForm 中，并且能够选择双击部分代码，然后轻松将此代码复制到新的输入 Cell 中。但默认的 InputForm 不允许这样做，因为 InputForm 默认显示为 String，而不是 Mathematica'的代码。有没有办法让 InputForm 显示为 Mathematica 的代码？

我还经常希望看到这种 InputForm 的缩短版本，其中所有长坐标列表都显示为第一个坐标，后跟用 Skeleton 包裹的跳过坐标值的数量，所有空的列表被删除，所有数字也被缩短以显示不超过6位数字。最好仅使用 6 位坐标来表示，但对于诸如 Hue 之类的颜色指令，仅显示 2 位有效数字。例如，

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

应该给出：（

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]}}]

注意 -0.9999998592131705 转换为 -1.，1.2822827157509358*^-7 转换为 1.28228*^-7 和 Hue[0.9060679774997897, 0.6, 0.6] 转换为 Hue[0.91, 0.6, 0.6]）。

通过这种方式，我希望将 InputForm 的输出作为 Mathematica 的代码，并且还有一个 ShortInputForm 函数，该函数将给出缩短的版本这段代码。有人可以帮助我吗？

---

关于问题的第一部分，我找到了一种方法来实现我想要的：

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

Answer 1

更新

shortInputForm 函数的最新版本可以在此处找到。

---

原始帖子

这是另一个更好的解决方案（与 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}]}}]

它是如何工作的

这个解决方案基于简单的想法：我们需要阻止图形等内容的转换>、Point 以及其他 排版表达式，以便将它们显示在内部表单中（作为适合输入的表达式）。令人高兴的是，如果我们这样做，结果会发现 StandardForm 输出只是原始表达式的格式化（二维）InputForm。这正是所需要的！

但如何做到这一点呢？
首先，此转换是由FormatValues为 Symbol 定义，例如 Graphics、Point 等。可以获取此类的完整列表Symbol 通过评估以下内容：

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

我的第一个想法是阻止所有这些Symbol（并且它有效！）：

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

但是这种方法会导致对所有这些 Symbol 进行评估，并评估 $ContextPath 中所有 Symbol 的所有 FormatValues。我认为应该避免。

阻止这些 FormatValues 的其他方法只是从 $ContextPath 中删除上下文 "System`"。但只有当这些 Symbol 尚未解析为 "System`" 上下文时，它才有效。因此，我们首先需要将表达式转换为 String，然后从 $ContextPath 中删除 "System`" 上下文，最后将字符串向后转换为原来的表达。然后所有新的 Symbol 都将与当前的 $Context （以及 Graphics、Point 等）相关联，因为它们不在 $ContextPath 中）。为了防止上下文阴影冲突和乱七八糟的 "Global`" 上下文，我将 $Context 切换到 "myTemp`" ，如有必要，可以轻松清除它。

这就是myInputForm 的工作原理。

现在介绍一下shortInputForm。这个想法不仅是显示 myInputForm 的缩短版本，而且还保留选择部分缩短代码并将其复制到新输入单元格并使用此代码的能力，因为它将是没有缩写的完整代码。在版本 6 及更高版本中，可以通过 Interpretation 实现后者。为了与 Mathematica 6 之前的版本兼容，我添加了一段代码，如果 $VersionNumber 小于 6，则删除此功能。

这是我工作时遇到的唯一问题与 Interpretation 的区别在于它没有 SequenceHold 属性，因此我们不能简单地将 Sequence 指定为 Interpretation 的第二个参数。但是这个问题可以通过将序列包装在 List 中，然后对其进行 Applying Sequence 来轻松避免：

System`Sequence @@ # &

请注意，我需要指定确切的上下文对于我使用的所有内置 Symbol ，因为在调用它们时 "System`" 上下文不在 $ContextPath 中。

这结束了我在开发这些功能时做出的非标准决定。欢迎提出建议和意见！

Answer 2

此时我得出以下解决方案：

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)

现在：