8
$\begingroup$

One small step toward automating homework :)

My lecturer doesn't accept calculations done in Mathematica code as homework. I have 30 pages of small calculations such as the one below. I don't want to write them out by hand. Surely there is a way to automate the process using TraditionalForm[] and macro coding?

Below is a minimalist example.


Input

The function should take as an input a simple physics calculation.

e.g.

(m = Quantity[1, "Kilograms"];
 a = Quantity[9.81, "Meters" ("Seconds")^-2];
 F == m a;
 F = m a;)

like so:

someFunction[
             (m = Quantity[1, "Kilograms"];
              a = Quantity[9.81, "Meters" ("Seconds")^-2];
              F == m a;
              F = m a;)
]

Output

It should calculate the calculation and format the output in TraditionalForm[] like so

enter image description here


tips or suggestions for good ways to approach this challenge would be greatly appreciated

$\endgroup$
2
  • 1
    $\begingroup$ Maybe see Label and ColumnForm. $\endgroup$
    – LouisB
    Commented Feb 15, 2018 at 2:02
  • 1
    $\begingroup$ There is a number of nice solutions below. However, I find that the efforts (purely in typing) of producing this "automated" result is not smaller than the one of opening a DisplayFormula (or a DisplayFormulaNumbered) cell and directly typing it in. Than the Input and Output cells can be grouped and collapsed around the cell containing results. This enables one to reopen the input cell and change if needed. That is how I do such things over years. $\endgroup$ Commented Feb 15, 2018 at 9:05

5 Answers 5

9
$\begingroup$
TraditionalForm[
 Column[{
   Defer[m = Quantity[1, "Kilograms"]],
   Defer[a = Quantity[9.81, "Meters" ("Seconds")^-2]],
   Defer[F == m a],
   m = Quantity[1, "Kilograms"]; 
   a = Quantity[9.81, "Meters" ("Seconds")^-2];
   HoldForm[F] == m a}]
 ]

enter image description here

For a function version:

display[x_Quantity, y_Quantity] := Block[{m, a, F},
  TraditionalForm[
   Column[{
     Defer[m = x],
     Defer[a = y],
     Defer[F == m a],
     HoldForm[F] == x*y}]
   ]
  ]

display[Quantity[1, "Kilograms"], 
 Quantity[9.81, "Meters" ("Seconds")^-2]]

enter image description here

Note that making a more general function is a little bit difficult given limited information in the OP.

$\endgroup$
6
$\begingroup$

Here is a function that given an equation and a list of replacement rules for the variables, inserts the values and formats the output:

insertEq[eqn_, var_] := TraditionalForm[Column[Flatten[{  
  var /. Rule -> Equal,  
  eqn,  
  eqn /. var  
 }]]]  

For your minimalist example you get:

insertEq[F == a m, {
  m -> Quantity[3, "Kilograms"],
  a -> Quantity[9.81, "Meters" ("Seconds")^-2]
 }]

enter image description here

Edit

To extend a bit: Here is a function that does unit simplification if needed. In addition, there is an optional third argument to specify the number of significant digits of the result.

Clear[insertEq]
insertEq[lhs_ == rhs_, var_, prec_: MachinePrecision] := Module[{rhsIn, rhsSim},
  rhsIn = SetPrecision[rhs /. var, prec];
  rhsSim = UnitSimplify[rhsIn];
  TraditionalForm[Column[Flatten[{
      var /. Rule -> Equal,
      Equal @@ {lhs, rhs, rhsIn, If[rhsIn === rhsSim, Nothing, rhsSim]}
     }]]]]

Example 1:

insertEq[F == a m, {
  m -> Quantity[3, "Kilograms"],
  a -> Quantity[9.81, "Meters" ("Seconds")^-2]
 }]

enter image description here

Example 2:

insertEq[A == Pi r^2, {r -> Quantity[0.5, "Meters"]}]

enter image description here

without too many nonsense digits:

insertEq[A == Pi r^2, {r -> Quantity[0.5, "Meters"]},3]

enter image description here

$\endgroup$
4
$\begingroup$

Via proper original record

I think it is much easier not via a "function" but via a "program" or basically the format you formulate it originally. There is almost no difference in amount of original information, but because of different format no function is necessary:

{mm=Quantity[1,"Kilograms"];
    Inactivate[m=mm,Set],
aa=Quantity[9.81,"Meters" ("Seconds")^-2];
    Inactivate[a=aa,Set],
    Inactivate[F == m a,Set|Times],
F == Activate[mm aa]}//Column//TraditionalForm

enter image description here

Via a function

Or if you insist on having a function then you probably should formulate original record a bit differently:

x=Inactivate[
{m=Quantity[1,"Kilograms"],
a=Quantity[9.81,"Meters" ("Seconds")^-2],
F==m a,
F=m a},Set]

Then defining a function as

someFunction[x_]:=Module[{aa,mm},
{Inactivate[m=x[[1,2]],Set],
Inactivate[a=x[[2,2]],Set],
x[[3]],
F==x[[1,2]]x[[2,2]]}//
Column//TraditionalForm]

you can get now same result:

someFunction[x]

but again, this seems redundant as formulating original record properly can give you what you need, no function needed.

Further thoughts on automation

For automation you might want to look into templating:

$\endgroup$
4
$\begingroup$

Although this does not exactly answer your question, since the units of products are not derived automatically, so one has to type the units by hand for each equation, but this is what I use to format equations with units in Latex.

It uses siunitx from Latex via Matrex package to make it work inside Mathematica. The nice thing about this, is that siunitx has many options for formatting, and the output can not be beat. It is Latex after all. all of these can be used from inside Matex.

<<MaTeX`
SetOptions[MaTeX,"Preamble"->{"\\usepackage{amsmath,siunitx}"}];

MaTeX["
\\begin{aligned}
m &= 3 \\, \\si{kg}\\\\
a &= 9.81 \\,\\si{m/s^2} \\\\
F &= m a\\\\
F&=9.81 \, \\si{kg.m/s^2}
\\end{aligned}
",Magnification->2]

Mathematica graphics

Or you can use its macros like this

MaTeX["
 \\begin{aligned}
 m &= 3 \\, \\si{\\kilogram}\\\\
 a &= 9.81 \\,\\si{\\meter\\per\\square\\second} \\\\
 F &= m a\\\\
 F&=9.81 \, \\si{\\kilogram\\meter\\per\\square\\second}
 \\end{aligned}
 ", Magnification -> 2]

Mathematica graphics

on a side note, I think Mathematica should be used for calculations, modeling, making animations and plots and such. Latex is then used to typeset the final report. This might seem like extra work, but at the end, the final product will look much better. Using Latex, one can also generate both PDF and HTML from same source.

$\endgroup$
2
$\begingroup$

The code that appears in this answer (How do I alter this \$PreRead + \$PrePrint statement so it can be selectively deactivated?) seems well-suited to your needs. If you enter and evaluate it (pasted below for your convenience), you can get the following with no extra typing:

m = Quantity[1, "Kilograms"]
a = Quantity[9.81, "Meters" ("Seconds")^-2]
F = m a

enter image description here

$PreRead =.
$PrePrint =.

$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@TraditionalForm@In@# &@$Line] /. 
  HoldPattern[Replace["thisIsJustATag"; expr_, Null -> ""]] :> expr

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

To deactivate the above code, use:

$PreRead =.
$PrePrint =.
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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