Skip to main content

formatting - Combined inline printing of input, output, and text, w/ minimal added syntax



NOTE: The finished code for this project can be found here, under "UPDATE": How do I alter this \$PreRead + \$PrePrint statement so it can be selectively deactivated?



I have two blocks of code, reproduced at the bottom of this post, each of which provides significant utility. The first, which automatically formats outputs as 'input = output', consists of a \$PrePrint and a \$Post statement. The second, which allows easy inline combination of math and text, consists of a \$PreRead and a \$PrePrint. I’d like to implement both simultaneously, but can’t because only one \$PrePrint statement can be active in given session.  I’d thus like to merge these into a single block of code, which contains just one \$PrePrint statement, enabling me to obtain their combined functionality, and thus easily produce outputs that combine input, output and text.



The first piece of code (code block 1, below), written by Simon Rochester (Would like input and output printed on same line, w/o needing extra syntax), directs MMA to print input and output on a single line, in TraditionalForm, without the need for any added syntax. For example:


int = Integrate[x^2, x]
int/x
%/x



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


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


$\frac{\%}{x}=\frac{x}{3}$



g[x_] := Sin[x]
g[Pi]


$g(x\_):=\sin(x)$


$g(\pi)=0$




a = 2


$a=2$



The second piece of code (code block 2, below), originally written by Mr. Wizard (Notebook formatting - easier descriptions for equations and results?), and which I extended with significant assistance from MB1965 (How to generalize this combined PreRead + PrePrint code?), enables me to output math and text on a single line, with minimal added syntax — I can put text before, after, or both before and after the math; I can also output text alone:


"Text before."; Integrate[x^2, x]
Integrate[x^2, x]; "Text after"
"Text before."; Integrate[x^2, x]; "Text after."

"Text only.";


$\color{blue}{\textit {Text before.}}\>\frac{x^3}{3}$


$\frac{x^3}{3} \>\>\color{blue}{\textit {Text after.}}$


$\color{blue}{\textit {Text before.}}\>\frac{x^3}{3}\>\>\color{blue}{\textit {Text after.}}$


$\color{blue}{\textit {Text only.}}$



Note that the semicolon is only needed as a separator (not a terminator), except in the "text only" case.




I’d like to implement both code blocks simultaneously, enabling me to obtain their combined functionality, e.g.:


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


$\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.}}$




The rationale for this is to enable me to create, with minimal extra work, notebooks that are easily readable by non-MMA users. Thus, once the above objective is met, I can then use R. M.’s code-hiding palette (Is there a way to hide or toggle the visibility of code?) to remove all the input, leaving me with just the output alone.




The one issue I’ve noticed is that, while code block 1 will output both input and output even if there is normally no printed output, e.g.:


g[x_]:=Sin[x]


$g(\text{x$\_$}):=\sin (x)$



….code block 2 doesn’t output anything when there is no printed math output:


"Text before."; g[x_]:=Sin[x]



[No ouput]



MB1965 suggested this is because “whenever it [\$PreRead] encounters a Null return it doesn't bother to even check $PrePrint and simply returns nothing”. MB1965 further noted that, if an extra ""; "" is added after the math (where the second pair of quotes can contain text, if text after the math is desired), MMA will then print all the quoted text:


"Text before."; g[x_] := Sin[x]; ""; ""
g[x_] := Sin[x]; ""; "Text after"
"Text before"; g[x_] := Sin[x]; ""; "Text after"


$\color{blue}{\textit {Text before.}}$



$\color{blue}{\textit {Text after.}}$


$\color{blue}{\textit {Text before.}}\>\>\>\color{blue}{\textit {Text after.}}$



It would be great if I could get a fix for this corner case in the merged code.



$PrePrint = (TraditionalForm@HoldForm[In[line] = #] /. line -> $Line /. DownValues[In] /.
     {HoldPattern[a_ = a_] :> a,
      HoldPattern[a_ = HoldForm[a_]] :> a,
      HoldPattern[(c : (a_ = b_)) = b_] :> c,
      HoldPattern[(a_ = b_) = c_] :> HoldForm[a = b = c]

      }
    ) &;

$Post = (Replace[#, Null -> HoldForm[In[line]] /. line -> $Line /. DownValues[In]]) &;


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

Replace[#, {RowBox[{note1_String?(StringMatchQ[#, "\"*\""] &), ";", 
    body__, ";", 
    note2_String?(StringMatchQ[#, "\"*\""] &)}] :> ($note1 = 
    Style[ToExpression@note1, FontFamily -> "Times", Italic, FontSize -> 15, Blue]; $note2 = 
    Style[ToExpression@note2, FontFamily -> "Times", Italic, FontSize -> 15, Blue];
   RowBox[{body}]),
 RowBox[{body__, ";", 
    note_String?(StringMatchQ[#, "\"*\""] &)}] :> ($note2 = 
    Style[ToExpression@note, FontFamily -> "Times", Italic, FontSize -> 15, Blue];
   $note1 = Null;

   RowBox[{body}]),
 RowBox[{note_String?(StringMatchQ[#, "\"*\""] &), ";", 
    body__}] :> ($note1 = Style[ToExpression@note, FontFamily -> "Times", Italic, FontSize -> 15, Blue];
   $note2 = Null;
   RowBox[{body}]),
 RowBox[{note_String?(StringMatchQ[#, "\"*\""] &), 
    ";"}] :> ($note3 = Style[ToExpression@note, FontFamily -> "Times", Italic, FontSize -> 15, Blue];
   $note2 = Null; $note1 = Null;
   RowBox[{note}]),
 e_ :> ($note1 = Null; $note2 = Null; e)}] &;

$PrePrint = Which[($note1 == Null && $note2 == Null && $note3 =!= 
   Null), # &[$note3, $note3 = Null],
($note1 =!= Null && $note2 =!= Null && $note3 == Null), # &[
 Row[{$note1, Spacer[5], Pane@#, Spacer[5], $note2}], $note1 = 
  Null, $note2 = Null],
($note1 =!= Null && $note2 =!= Null && $note3 == Null), # &[
 Row[{$note1, Spacer[5], Pane@#, Spacer[5], $note2}], $note1 = 
  Null, $note2 = Null],
($note1 =!= Null && $note2 === Null && $note3 == Null), # &[
 Row[{$note1, Spacer[5], Pane@#}], $note1 = Null],

($note1 === Null && $note2 =!= Null && $note3 == Null), # &[
 Row[{Pane@#, Spacer[5], $note2}], $note2 = Null], True, #] &;

Answer



I took the liberty of partitioning your code into functions for each formatting step.


For part 2, you simply need to edit the $PreRead so that it never actually sees Null. Here's a function that does that:


boxExpr[body_] :=
  RowBox@{"Replace", "[", "\"thisIsJustATag\"", ";", body, ",", 
    "Null", "->", "\"\"", "]"};

The "thisIsJustATag" there will make more sense in a moment.



Then I pulled out the note extraction task and used boxExpr everywhere there was RowBox[{body}]. Note that I'm using the styleNote function I defined in my suggestion at the bottom. To deal with issue (2) mentioned in the comments we also apply boxExpr in the no-note case.


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

Next I tackled joining the two parts. Easiest to do via a two step process. First we apply the Part 1 code you supplied plus a tweak to remove the Replace expression we added in boxExpr (this is where the tag is important):


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]

     }
   ];

And then I pulled out the note formatting function and cleaned that up a little (using Switch is easier than Which here I think):


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

And then all we need is this:


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

to get the desired result.


Suggestion



To make your life easier I'd suggest adding a store of text styles like:


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

     Blue,
     15,
     Italic,
     FontFamily -> "Times"
     },
   "After" -> {
     Blue,
     15,
     Italic,
     FontFamily -> "Times"

     }
   |>;

and a styling function like:


styleNote[note_, style_] :=
  Style[ToExpression@note, 
   Sequence @@ Lookup[$outputStyles, style, $outputStyles["Default"]]];

And then you can replace all of your note styling calls with a simple styleNote calls which will allow you to change how you do the styling without changing your $PreRead at all.


For example you can change the color for your after note text like this:



$outputStyles["After"] = $outputStyles["After"] /. Blue -> Red

No need to edit the $PreRead function at all this way.


All together


For those who don't want to copy all the pieces in, this is all the formatting code as I have it:


$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;

Comments

Post a Comment

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...
Post a Comment
Read more

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?
Post a Comment
Read more

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...
Post a Comment
Read more