制作自定义输入表单和短输入表单

Question

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

我还经常希望看到此类InputForm的缩短版本，其中所有长坐标列表都显示为第一个坐标，后跟用Skeleton包裹的跳过坐标值的数量，全部为空{{} 1}}已删除，所有数字也缩短，显示不超过6位数。最好只使用6位数作为坐标，但对于颜色指令，例如Lists，只显示2位有效数字。例如，

Hue

应该给：

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]。< / p>

通过这种方式，我希望将Hue[0.91, 0.6, 0.6]的输出作为 Mathematica 的代码，并且还有一个InputForm函数，它将提供此代码的缩短版本。有人能帮助我吗？

---

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

ShortInputForm

Answer 1

更新

可以找到shortInputForm函数的最新版本here。

---

原帖

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

如何运作

此解决方案基于简单的想法：我们需要阻止Graphics，Point和其他to typeset expressions等内容的转换，以便以内部形式显示（如适合输入的表达式）。令人高兴的是，如果我们这样做，会发现生成的StandardForm输出只是原始表达式的格式化（二维）InputForm。这正是需要的！

但是怎么做？ 首先，this conversion is made by FormatValues为Symbol定义了Graphics，例如Point，Symbol等。通过评估以下内容，可以获得此类list = Symbol /@ Select[DeleteCases[Names["*"], "I" | "Infinity"], ToExpression[#, InputForm, Function[symbol, Length[FormatValues@symbol] > 0, HoldAll]] &] 的完整列表：< / p>

Block

我的第一个想法只是Symbol所有这些myInputForm[expr_] := With[{list = list}, Block[list, RawBoxes@MakeBoxes@expr]] （并且它有效！）：

Symbol

但是，此方法可以评估所有这些FormatValues，并评估Symbol中所有$ContextPath的所有FormatValues。我认为应该避免。

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

这就是shortInputForm的工作方式。

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

使用SequenceHold时遇到的唯一问题是它没有Sequence属性，因此我们不能简单地将Interpretation指定为List的第二个参数。但是，通过将序列包含在Apply中，然后Sequence System`Sequence @@ # & Symbol包含在其中，可以轻松避免此问题：

"System`"

请注意，我需要为我使用的所有内置$ContextPath指定确切的上下文，因为在调用它们时，{{1}}上下文不在{{1}}。< / p>

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

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)

现在：