Is it possible in Mathematica to get a step-by-step evaluation of some functions; that's to say, outputting not only the result but all the stages that have led to it? If so, how does one do it?
----------------------------------------------------------------------------------
Here's an attempt to (somewhat) modernize WalkD[]:
Format[d[f_, x_], TraditionalForm] := DisplayForm[RowBox[{FractionBox["\[DifferentialD]",RowBox[{"\[DifferentialD]", x}]], f}]]; SpecificRules = {d[x_, x_] :> 1, d[(f_)[x_], x_] :> D[f[x], x], d[(a_)^(x_), x_] :> D[a^x, x] /; FreeQ[a, x]}; ConstantRule = d[c_, x_] :> 0 /; FreeQ[c, x]; LinearityRule = {d[f_ + g_, x_] :> d[f, x] + d[g, x], d[c_ f_, x_] :> c d[f, x] /; FreeQ[c, x]}; PowerRule = {d[x_, x_] :> 1, d[(x_)^(a_), x_] :> a*x^(a - 1) /; FreeQ[a, x]}; ProductRule = d[f_ g_, x_] :> d[f, x] g + f d[g, x]; QuotientRule = d[(f_)/(g_), x_] :> (d[f, x]*g - f*d[g, x])/g^2; InverseFunctionRule = d[InverseFunction[f_][x_], x_] :>1/Derivative[1][f][InverseFunction[f][x]]; ChainRule = {d[(f_)^(a_), x_] :> a*f^(a - 1)*d[f, x] /; FreeQ[a, x], d[(a_)^(f_), x_] :> Log[a]*a^f*d[f, x] /; FreeQ[a, x], d[(f_)[g_], x_] :> (D[f[x], x] /. x -> g)*d[g, x], d[(f_)^(g_), x_] :> f^g*d[g*Log[f], x]}; $RuleNames = {"Specific Rules", "Constant Rule", "Linearity Rule", "Power Rule","Product Rule", "Quotient Rule", "Inverse Function Rule", "Chain Rule"}; displayStart[expr_] := CellPrint[Cell[BoxData[MakeBoxes[HoldForm[expr], TraditionalForm]], "Output",Evaluatable -> False, CellMargins -> {{Inherited, Inherited}, {10, 10}},CellFrame -> False, CellEditDuplicate -> False]] displayDerivative[expr_, k_Integer] := CellPrint[Cell[BoxData[TooltipBox[RowBox[{InterpretationBox["=", Sequence[]], " ",MakeBoxes[HoldForm[expr], TraditionalForm]}], $RuleNames[[k]],LabelStyle -> "TextStyling"]], "Output", Evaluatable -> False,CellMargins -> {{Inherited, Inherited}, {10, 10}},CellFrame -> False, CellEditDuplicate -> False]] WalkD[f_, x_] := Module[{derivative, oldderivative, k}, derivative = d[f, x]; displayStart[derivative];While[! FreeQ[derivative, d], oldderivative = derivative; k = 0;While[oldderivative == derivative, k++; derivative = derivative /.ToExpression[StringReplace[$RuleNames[[k]], " " -> ""]]]; displayDerivative[derivative, k]];D[f, x]]I've tried to make the formatting of the derivative look a bit more traditional, as well as having the differentiation rule used be a tooltip instead of an explicitly generated cell (thus combining the best features of WalkD[] and RunD[]); you'll only see the name of the differentiation rule used if you mouseover the corresponding expression.
I have improved J. M.'s version of walkD by adding error handling. I have also added walkInt that works like walkD except for integration. Code:
Format[d[f_, x_], TraditionalForm] := Module[{paren, boxes}, paren = MatchQ[f,Plus[_,__]]; boxes = RowBox[{f}];If[paren, boxes = RowBox[{"(", boxes, ")"}]]; boxes = RowBox[{FractionBox["\[DifferentialD]", RowBox[{"\[DifferentialD]", x}]], boxes}];DisplayForm[boxes]]; dSpecificRules = {d[x_, x_] :> 1, d[(f_)[x_], x_] :> D[f[x], x], d[(a_)^(x_), x_] :> D[a^x, x] /; FreeQ[a, x]}; dConstantRule = d[c_, x_] :> 0 /; FreeQ[c, x]; dLinearityRule = {d[f_ + g_, x_] :> d[f, x] + d[g, x], d[c_ f_, x_] :> c d[f, x] /; FreeQ[c, x]}; dPowerRule = {d[x_, x_] :> 1, d[(x_)^(a_), x_] :> a*x^(a - 1) /; FreeQ[a, x]}; dProductRule = d[f_ g_, x_] :> d[f, x] g + f d[g, x]; dQuotientRule = d[(f_)/(g_), x_] :> (d[f, x]*g - f*d[g, x])/g^2; dInverseFunctionRule := d[InverseFunction[f_][x_], x_] :>1/Derivative[1][f][InverseFunction[f][x]]; dChainRule = {d[(f_)^(a_), x_] :> a*f^(a - 1)*d[f, x] /; FreeQ[a, x], d[(a_)^(f_), x_] :> Log[a]*a^f*d[f, x] /; FreeQ[a, x], d[(f_)[g_], x_] :> (D[f[x], x] /. x -> g)*d[g, x], d[(f_)^(g_), x_] :> f^g*d[g*Log[f], x]}; $dRuleNames = {"Specific Rules", "Constant Rule", "Linearity Rule", "Power Rule","Quotient Rule", "Product Rule", "Inverse Function Rule", "Chain Rule"}; displayStart[expr_] := CellPrint[Cell[BoxData[MakeBoxes[HoldForm[expr], TraditionalForm]], "Output",Evaluatable -> False, CellMargins -> {{Inherited, Inherited}, {10, 10}},CellFrame -> False, CellEditDuplicate -> False]]; displayDerivative[expr_, k_Integer] := CellPrint[Cell[BoxData[TooltipBox[RowBox[{InterpretationBox["=", Sequence[]], " ",MakeBoxes[HoldForm[expr], TraditionalForm]}], "Differentation: " <> $dRuleNames[[k]],LabelStyle -> "TextStyling"]], "Output", Evaluatable -> False,CellMargins -> {{Inherited, Inherited}, {10, 10}},CellFrame -> False, CellEditDuplicate -> False]];walkD::differentationError = "Failed to differentiate expression!"; walkD[f_, x_] := Module[{derivative, oldderivative, k}, derivative = d[f, x]; displayStart[derivative];While[! FreeQ[derivative, d], oldderivative = derivative; k = 0;While[oldderivative == derivative, k++;If[k > Length@$dRuleNames,Message[walkD::differentationError];Return[D[f, x]];]; derivative = derivative /. ToExpression["d" <> StringReplace[$dRuleNames[[k]], " " -> ""]]]; displayDerivative[derivative, k]];D[f, x]];Format[int[f_,x_],TraditionalForm]:= ( paren = MatchQ[f,Plus[_,__]]; boxes = RowBox[{f}];If[paren, boxes = RowBox[{"(", boxes, ")"}]]; boxes = RowBox[{boxes, "\[DifferentialD]", x}]; boxes = RowBox[{"\[Integral]", boxes}];DisplayForm[boxes]); intSpecificRules = {int[(f_)[x_], x_] :> Integrate[f[x], x], int[(a_)^(x_), x_] :> Integrate[a^x, x] /; FreeQ[a, x]}; intConstantRule = int[c_, x_] :> c*x /; FreeQ[c, x]; intLinearityRule = {int[f_ + g_, x_] :> int[f, x] + int[g, x], int[c_ f_, x_] :> c int[f, x] /; FreeQ[c, x]}; intPowerRule = {int[x_, x_] :> x^2 / 2, int[1/x_, x_] :> Log[x], int[(x_)^(a_), x_] :> x^(a + 1)/(a + 1) /; FreeQ[a, x]}; intSubstitutionRule = { int[(f_)^(a_), x_] :> ((Integrate[u^a, u] / d[f, x]) /. u -> f) /; FreeQ[a, x] && FreeQ[D[f, x], x], int[(f_)^(a_) g_, x_] :> ((Integrate[u^a, u] / d[f, x]) * g /. u -> f) /; FreeQ[a, x] && FreeQ[FullSimplify[D[f, x] / g], x], int[(a_)^(f_), x_] :> (a ^ f)/(d[f, x] * Log[a]) /; FreeQ[a, x] && FreeQ[D[f, x], x], int[(a_)^(f_) g_, x_] :> (a ^ f)/(d[f, x] * Log[a]) * g /; FreeQ[a, x] && FreeQ[FullSimplify[D[f, x] / g], x], int[(f_)[g_], x_] :> (Integrate[f[u], u] /. u -> g) / d[g, x] /; FreeQ[D[g, x], x], int[(f_)[g_] h_, x_] :> (Integrate[f[u], u] /. u -> g) / d[g, x] * h /; FreeQ[FullSimplify[D[g, x] / h], x]}; intProductRule = int[f_ g_, x_] :> int[f, x] g - int[int[f, x] * d[g, x], x]; $intRuleNames = {"Specific Rules", "Constant Rule", "Linearity Rule", "Power Rule", "Substitution Rule", "Product Rule"}; displayIntegral[expr_, k_Integer] := CellPrint[Cell[BoxData[TooltipBox[RowBox[{InterpretationBox["=", Sequence[]], " ",MakeBoxes[HoldForm[expr], TraditionalForm]}], "Integration: " <> $intRuleNames[[k]],LabelStyle -> "TextStyling"]], "Output", Evaluatable -> False,CellMargins -> {{Inherited, Inherited}, {10, 10}},CellFrame -> False, CellEditDuplicate -> False]];walkInt::integrationError = "Failed to integrate expression!";walkInt::differentationError = "Failed to differentiate expression!"; walkInt[f_, x_] := Module[{integral, oldintegral, k, leafcounts, ruleused}, integral = int[f, x]; displayStart[integral]; leafcounts = {}; ruleused = "";While[! FreeQ[integral, int],If[ruleused == "Product Rule",AppendTo[leafcounts, LeafCount @ integral];If[Length @ leafcounts >= 5 && OrderedQ @ Take[leafcounts, -5],Message[walkInt::integrationError];Return[Integrate[f, x]];];]; oldintegral = integral; k = 0;While[oldintegral == integral, k++;If[k > Length@$intRuleNames,Message[walkInt::integrationError];Return[Integrate[f, x]];]; integral = integral /. ToExpression["int" <> StringReplace[$intRuleNames[[k]], " " -> ""]]]; ruleused = $intRuleNames[[k]]; displayIntegral[integral, k];While[! FreeQ[integral, d], oldintegral = integral; k = 0;While[oldintegral == integral, k++;If[k > Length@$dRuleNames,Message[walkInt::differentationError];Return[Integrate[f, x]];]; integral = integral /. ToExpression["d" <> StringReplace[$dRuleNames[[k]], " " -> ""]]]; displayDerivative[integral, k]];];Integrate[f, x]];Sample output:
