7
$\begingroup$

Background

I have a block of code, reproduced at the bottom of this post, consisting of combined \$PreRead and \$PrePrint statements, that automatically formats outputs as 'input = output', and also allows easy inline combination of math and text (allowing the text to be placed either before, after, or both), as follows. [Note that one merely needs to put the text in quotes, and separate it from the math with a semicolon (;).]

int=Integrate[x^2,x]
"Letting"; int=Integrate[x^2,x]
"We find that"; int/x; ", as expected."

$\text{int}=\int x^2 \, dx=\frac{x^3}{3}$

$\color{blue}{\textit {Letting}}\>\text{int}=\int x^2 \, dx=\frac{x^3}{3}$

$\color{blue}{\textit {We find that}}\>\frac{int}{x} = \frac{x^2}{3}\> \color{blue}{\textit {, as expected.}}$

[Attribution: The code is a synthesis and extension, done by MB1965 and myself (Combined inline printing of input, output, and text, w/ minimal added syntax), of code blocks written by Simon Rochester (Would like input and output printed on same line, w/o needing extra syntax) and Mr. Wizard (Notebook formatting - easier descriptions for equations and results? ).]

Issue

As far as I can tell, the code works perfectly. However, I've subsequently realized that the code's input=output functionality isn't appropriate for graphical output, since it puts the graphics inline with the input (making them too small, and thus necessitating manual resizing):

Plot[x^2, {x, -10, 10}]

enter image description here

Objective

To address the above issue, I'd like to modify the code to enable me to tell Mathematica to not implement its inline input=output functionality for specific inputs. I had in mind adding some distinguishing symbol, or combination of symbols, not used elsewhere in Mathematica, at the end of my input (e.g., a triple semicolon or colon):

Plot[x^2, {x, -10, 10}];;;

In such cases, it would be nice to retain the code's ability to add text to output; here I'd like the text to be placed either above or below the graphics (depending on whether it's entered before or after the math in the input), rather than inline.

Secondarily, I'd also like to modify the code to be able to specify specific commands for which its inline input=output functionality is to be disabled (Plot, ListPlot, etc.).

I've made several attempts to achieve these modifications, but they were all unsuccessful.

Finally, note that I could globally deactivate the code prior to a given evaluation using:

$PreRead = .
$PrePrint = .

...and then reactivate it.

But that's somewhat inconvenient and impractical, since I would then need to go back up to wherever I'd posted the code block to reactivate it. In addition, this would preclude me from being able to globally evaluate the entire notebook (because of the code's length, it's not practical to re-paste it following every statement for which I'd deactivated it).


Code

$note1 = Null;
$note2 = Null;
$note3 = Null;

$outputStyles =
  <|
   "Default" -> {
     Blue,
     15,
     Italic,
     FontFamily -> "Times"
     },
   "Before" -> {
     Blue,
     15,
     Italic,
     FontFamily -> "Times"
     },
   "After" -> {
     Blue,
     15,
     Italic,
     FontFamily -> "Times"
     }
   |>;

boxExpr[body_] :=

  RowBox@{"Replace", "[", "\"thisIsJustATag\"", ";", body, ",", 
    "Null", "->", "\"\"", "]"};
styleNote[note_, style_] :=

  Style[ToExpression@note, 
   Sequence @@ Lookup[$outputStyles, style, $outputStyles["Default"]]];

extractNotes[boxes_] := 
  Replace[boxes, {RowBox[{note1_String?(StringMatchQ[#, "\"*\""] &), 
       ";", body__, ";", 
       note2_String?(StringMatchQ[#, "\"*\""] &)}] :> ($note1 = 
       styleNote[note1, "Before"]; $note2 = 
       styleNote[note2, "After"];
      boxExpr@body), 
    RowBox[{body__, ";", 
       note_String?(StringMatchQ[#, "\"*\""] &)}] :> ($note2 = 
       styleNote[note, "After"];
      $note1 = Null;
      boxExpr@body), 
    RowBox[{note_String?(StringMatchQ[#, "\"*\""] &), ";", 
       body__}] :> ($note1 = styleNote[note, "After"];
      $note2 = Null;
      boxExpr@body),
    RowBox[{note_String?(StringMatchQ[#, "\"*\""] &), 
       ";"}] :> ($note3 = styleNote[note, "Neither"];
      $note2 = Null; $note1 = Null;
      note), 
    e_ :> ($note1 = Null; $note2 = Null; boxExpr@e)}];

applyFormatting[out_] :=
  With[{line = $Line},
   HoldForm[In[line] = $placeHolder] /.

      DownValues[In] /. {
      $placeHolder -> out,
      HoldPattern[
        Replace[CompoundExpression["thisIsJustATag", expr_], 
         Null -> ""]] :> expr
      }
    /. {
     HoldPattern[a_ = ""] :> a,
     HoldPattern[a_ = a_] :> a,
     HoldPattern[a_ = HoldForm[a_]] :> a,
     HoldPattern[(c : (a_ = b_)) = b_] :> c,
     HoldPattern[(a_ = b_) = c_] :> HoldForm[a = b = c]
     }
   ];
addNotes[formatted_] :=
  TraditionalForm@Switch[{$note1, $note2, $note3},
   {Null, Null, Except@Null},
   With[{r = $note3}, $note3 = Null; r],
   {Except@Null, Except@Null, _},
   With[{r1 = $note1, r2 = $note2}, $note1 = $note2 = Null; 
    Row[{r1, formatted, r2}, Spacer[5]]
    ],
   {Except@Null, _, _},
   With[{r = $note1}, $note1 = Null;
    Row[{r, formatted}, Spacer[5]]
    ],
   {_, Except@Null, _},
   With[{r = $note2}, $note2 = Null;
    Row[{formatted, r}, Spacer[5]]
    ],
   _,
   formatted
   ];

$PreRead = extractNotes;
$PrePrint = addNotes@*applyFormatting;

Update

For the convenience of the reader, here is the current code, incorporating Mr. Wizard's additions:

$note1 = Null;
$note2 = Null;
$note3 = Null;

$outputStyles = <|
   "Default" -> {Blue, 15, Italic, FontFamily -> "Times"}, 
   "Before" -> {Blue, 15, Italic, FontFamily -> "Times"}, 
   "After" -> {Blue, 15, Italic, FontFamily -> "Times"}|>;

boxExpr[body_] := 
  RowBox@{"Replace", "[", "\"thisIsJustATag\"", ";", body, ",", 
    "Null", "->", "\"\"", "]"};
styleNote[note_, style_] := 
  Style[ToExpression@note, 
   Sequence @@ Lookup[$outputStyles, style, $outputStyles["Default"]]];

extractNotes[boxes_] := 
  Replace[boxes, {RowBox[{note1_String?(StringMatchQ[#, "\"*\""] &), 
       ";", body__, ";", 
       note2_String?(StringMatchQ[#, "\"*\""] &)}] :> ($note1 = 
       styleNote[note1, "Before"]; $note2 = 
       styleNote[note2, "After"];
      boxExpr@body), 
    RowBox[{body__, ";", 
       note_String?(StringMatchQ[#, "\"*\""] &)}] :> ($note2 = 
       styleNote[note, "After"];
      $note1 = Null;
      boxExpr@body), 
    RowBox[{note_String?(StringMatchQ[#, "\"*\""] &), ";", 
       body__}] :> ($note1 = styleNote[note, "After"];
      $note2 = Null;
      boxExpr@body), 
    RowBox[{note_String?(StringMatchQ[#, "\"*\""] &), 
       ";"}] :> ($note3 = styleNote[note, "Neither"];
      $note2 = Null; $note1 = Null;
      note), e_ :> ($note1 = Null; $note2 = Null; boxExpr@e)}];

applyFormatting[out_] := 
  With[{line = $Line}, 
   HoldForm[In[line] = $placeHolder] /. 
      DownValues[In] /. {$placeHolder -> out, 
      HoldPattern[
        Replace[CompoundExpression["thisIsJustATag", expr_], 
         Null -> ""]] :> expr} /. {HoldPattern[a_ = ""] :> a, 
     HoldPattern[a_ = a_] :> a, HoldPattern[a_ = HoldForm[a_]] :> a, 
     HoldPattern[(c : (a_ = b_)) = b_] :> c, 
     HoldPattern[(a_ = b_) = c_] :> HoldForm[a = b = c]}];
addNotes[formatted_] := 
  TraditionalForm@
   Switch[{$note1, $note2, $note3}, {Null, Null, Except@Null}, 
    With[{r = $note3}, $note3 = Null; r], {Except@Null, 
     Except@Null, _}, 
    With[{r1 = $note1, r2 = $note2}, $note1 = $note2 = Null;
     Row[{r1, formatted, r2}, Spacer[5]]], {Except@Null, _, _}, 
    With[{r = $note1}, $note1 = Null;
     Row[{r, formatted}, Spacer[5]]], {_, Except@Null, _}, 
    With[{r = $note2}, $note2 = Null;
     Row[{formatted, r}, Spacer[5]]], _, formatted];

bypass = Replace[
   RowBox[{b1___, RowBox[{b2___, ";;"}], ";"}] :> ($bypass = True; 
     RowBox[{b1, b2}])];

applyFormatting[out_] /; $bypass := Pane[out];

self : addNotes[formatted_] /; $bypass := ($bypass =.;
  Unevaluated[self] /. (DownValues[addNotes] /. Row -> Column))

SetAttributes[graphicsQ, HoldFirst]

graphicsQ[_Graphics | _Graphics3D | _Graph | _Image | _Image3D] = True;
graphicsQ[Legended[_?graphicsQ, ___]] = True;
graphicsQ[{___, _?graphicsQ, ___}] = True;

applyFormatting[out_?graphicsQ] := 
 Column[{# /. DownValues[In], Pane@out}] &[
   HoldForm@InputForm@In@# &@$Line] /. 
  HoldPattern[Replace["thisIsJustATag"; expr_, Null -> ""]] :> expr

$PreRead = extractNotes@*bypass;
$PrePrint = addNotes@*applyFormatting;

Mr. Wizard's very nice code blocks succeed in accomplishing both my primary and secondary goals, so I have accepted his answer. But, for completeness, I should note that three corner issues remain. The first two involve the new code; the third, involving the use of the semicolon to suppress output (including that the system sometimes prints it in red), is a carry-over from the code I originally posted (interestingly, when I quit the kernel, the red semicolons revert to black):

enter image description here

TEST CODE:

ParametricPlot[{{2 Cos[t], 2 Sin[t]}, {2 Cos[t], Sin[t]}, {Cos[t], 
2 Sin[t]}, {Cos[t], Sin[t]}}, {t, 0, 2 Pi}, 
PlotLegends -> "Expressions"];
ParametricPlot[{{2 Cos[t], 2 Sin[t]}, {2 Cos[t], Sin[t]}, {Cos[t], 
2 Sin[t]}, {Cos[t], Sin[t]}}, {t, 0, 2 Pi}, 
PlotLegends -> "Expressions"]
\[Alpha] = Integrate[x^2, x] ;;;
Sin[x] // N ;;;
"Some text"; Integrate[x^2, x];
Graphics[{Thick, Green,Rectangle[{0, -1}, {2, 1}], Red, Disk[], Blue,
Circle[{2, 0}], Yellow, Polygon[{{2, 0}, {4, 1}, {4, -1}}], 
Purple, Arrowheads[Large], Arrow[{{4, 3/2}, {0, 3/2}, {0, 0}}], 
Black, Dashed, Line[{{-1, 0}, {4, 0}}]}];
Graphics3D[Cylinder[]];
a = Plot[x^2, {x, -10, 10}];

enter image description here

$\endgroup$
  • $\begingroup$ Comments are not for extended discussion; this conversation has been moved to chat. $\endgroup$ – Mr.Wizard Mar 9 '17 at 5:38
10
$\begingroup$

Pane

It appears that someone along the way took out my carefully placed Pane which prevented downsizing of graphics. If you just want the graphics full size add it back in, either in your $PrePrint code or manually:

Pane @ Plot[x^2, {x, -10, 10}]

enter image description here

Intermediate Goal

To realize your intermediate goal of bypassing the auto-input-inlining, and to change the style of comments from row to column on bypassed output, I would add these lines:

bypass =
  Replace[
    RowBox[{b1___, RowBox[{b2___, ";;"}], ";"}] :>
      ($bypass = True; RowBox[{b1, b2}])
  ];

applyFormatting[out_] /; $bypass := Pane[out];

self : addNotes[formatted_] /; $bypass := ($bypass =.; 
  Unevaluated[self] /. (DownValues[addNotes] /. Row -> Column))

$PreRead = extractNotes@*bypass;
$PrePrint = addNotes@*applyFormatting;

Now:

enter image description here

And also:

"label above"; Plot[x^2, {x, -10, 10}]; "label below" ;;;

enter image description here

Final Goal

I believe this additional code will achieve the final goal as discussed in the comments.

Now hopefully working in the three additional cases I forgot to handle.

SetAttributes[graphicsQ, HoldFirst]

graphicsQ[_Graphics | _Graphics3D | _Graph | _Image | _Image3D] = True;
graphicsQ[Legended[_?graphicsQ, ___]] = True;
graphicsQ[{___, _?graphicsQ, ___}] = True;

applyFormatting[out_?graphicsQ] :=
  Column[{# /. DownValues[In], Pane @ out}] &[
    HoldForm @ InputForm @ In @ # & @ $Line
  ] /. HoldPattern[Replace["thisIsJustATag"; expr_, Null -> ""]] :> expr

Now:

Plot[Sinc[x], {x, 0, 12}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.