# 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

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

• Maybe see Label and ColumnForm. – LouisB Feb 15 '18 at 2:02
• 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. – Alexei Boulbitch Feb 15 '18 at 9:05

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


For a function version:

display[x_Quantity, y_Quantity] := Block[{m, a, F},
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]]


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

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


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


Example 2:

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


without too many nonsense digits:

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


# 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


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


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:

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]


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]


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.

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


$$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 =.
`