KDP_book

Mathematica: Functional and procedural programming

On the other hand, the procedure call Rename[x, y] in the regular mode returns Null, providing replacement of x name of some defined object on y name with saving of all attributes of this object. In addition, the x name is removed from the current session by the Remove function. But if y argument defines the name of a defined object or an undefined name with attributes, the call is returned unevaluated. If the first x argument is illegal for renaming, the procedure call returns Null; in addition, the Rename procedure successfully processes also objects of the same name of type "Block", "Function", "Module". The Rename1 procedure is an useful version of the above procedure, being based on our procedure Definition2. The call Rename1[x, y] is similar to the call Rename[x,y] whereas the call Rename1[x,y,z] with the third optional z argument – an arbitrary expression – performs the same functions as the call Rename1[x, y] without change of an initial x object.

The VarExch1 procedure is a version of the above VarExch procedure and is based on use of the Rename procedure with global variables; it admits the same type of actual argument, but unlike the second procedure the call VarExch1[w] in a case of detection of indefinite elements of a list w or its sublists will be returned unevaluated without print of any diagnostic message. In the fragment below, source code of the Rename1 procedure along with typical examples of its application is represented.

In[7]:= Rename1[x_String /; HowAct[x], y_ /; ! HowAct[y], z___] := Module[{a = Attributes[x], b = Definition2[x][[1 ;; –2]], c = ToString[y]},

b = Map[StringReplacePart[#, c, {1, StringLength[x]}] &, b];

ToExpression[b]; ToExpression["SetAttributes[" <> c <> ", " <> ToString[a] <> "]"]; If[{z} == {}, ToExpression["ClearAttributes[" <> x <> ", " <>

ToString[a] <> "]; Remove[" <> x <> "]"], Null]]

In[8]:= x := 500; y = 500; SetAttributes[x, {Listable, Protected}] In[9]:= Rename1["x", Trg42]

In[10]:= {x, Trg42, Attributes["Trg42"]} Out[10]= {x, 500, {Listable, Protected}}

281

V.Z. Aladjev, M.L. Shishakov, V.A. Vaganov

In[11]:= Rename1["y", Trg47, 90]

In[12]:= {y, Trg47, Attributes["Trg47"]}

Out[12]= {500, 500, {}}

Use in procedures of global variables, in a lot of cases will allow to simplify programming, sometimes significantly. This mechanism sufficient in detail is considered in [15]. Meanwhile, mechanism of global variables in Mathematica isn't universal, quite correctly working in a case of evaluation of definitions of procedures containing global variables in the current session in the Input–paragraph; whereas in general case it isn't supported when the loading in the current session of the procedures that contain global variables, in particular, from nb–files with the subsequent activation of their contents.

For the purpose of exclusion of similar situation a tool has been offered, whose call NbCallProc[x] reactivates a block, a function or a module x in the current session, whose definition was in a nb–file loaded into the current session with returning of Null, i.e. nothing. The call NbCallProc[x] reactivates in the current session all definitions of blocks, functions and modules with the same name x and with different headings. All these definitions have to be loaded previously from some nb–file into the current session and activated by means of function "Evaluate Notebook" of the GUI. The following fragment represents source code of the NbCallProc procedure with example of its use for the above VarExch1 procedure that uses the global variables.

In[2442]:= NbCallProc[x_ /; BlockFuncModQ[x]] :=

Module[{a = SubsDel[StringReplace[ToString1[DefFunc[x]], "\n \n" –> ";"], "`" <> ToString[x] <> "`", {"[", ","}, –1]}, Clear[x];

ToExpression[a]]

In[2443]:= NbCallProc[VarExch1]

The performed verification convincingly demonstrates, that the VarExch1 that contains the global variables and uploaded from the nb–file with subsequent its activation (by the "Evaluate Notebook"), is carried out absolutely correctly and with correct functioning of mechanism of global variables restoring values after an exit from the VarExch1 procedure. The NbCallProc has

282

Mathematica: Functional and procedural programming

a number of rather interesting appendices above all if necessity of application of procedures activated in the Input–paragraph of the current session arises.

Maple has 2 useful tools of manipulation with expressions of the type {range, equation, inequality, relation}, whose calls lhs(Exp) and rhs(Exp) return the left and the right parts of an expression Exp respectively. More precisely, the call lhs(Exp), rhs(Exp) returns a value op(1, Exp) and op(2, Exp) respectively. Whereas Mathematica has no similar useful means. The given deficiency is compensated by the RhsLhs procedure, whose the source code with examples of application are given below. The call RhsLhs[w, y] depending on a value {"Rhs", "Lhs"} of the second y argument returns right or left part of w expressions respectively relatively to operator Head[w], whereas the call RhsLhs[x,y,t] in addition through a undefined t variable returns operator Head[x] concerning whom splitting of the x expression onto left and right parts was made. RhsLhs procedure can be rather easily modified in the light of expansion of the analyzed operators Head[x]. RhsLhs1 procedure is a certain functional equivalent to the previous procedure [8-16].

In[7]:= RhsLhs[x__] := Module[{a = Head[{x}[[1]]],

b = ToString[InputForm[{x}[[1]]]], d, h = {x},

c= {{Greater, ">"}, {Or, "||"}, {GreaterEqual, ">="}, {Span, ";;"}, {And, "&&"}, {LessEqual, "<="}, {Unequal, "!="}, {Rule, "–>"}, {Less, "<"}, {Plus, {"+", "–"}}, {Power, "^"}, {Equal, "=="}, {NonCommutativeMultiply, "**"}, {Times, {"*", "/"}}}},

If[Length[h] < 2 || ! MemberQ[{"Lhs", "Rhs"}, h[[2]]],

Return[Defer[RhsLhs[x]]], Null]; If[! MemberQ[Select[Flatten[c], ! StringQ[#] &], a] || a == Symbol, Return[Defer[RhsLhs[x]]], Null];

d = StringPosition[b, Flatten[Select[c, #[[1]] == a &], 1][[2]]]; a = Flatten[Select[c, #[[1]] == a &]]; If[Length[h] >= 3 && ! HowAct[h[[3]]],

ToExpression[ToString[h[[3]]] <> "=" <> ToString1[a]], Null]; ToExpression[If[h[[2]] == "Lhs", StringTrim[StringTake[b, {1, d[[1]][[1]] – 1}]], StringTrim[StringTake[b, {d[[1]][[2]] + 1, –1}]]]]]

283

V.Z. Aladjev, M.L. Shishakov, V.A. Vaganov

In[8]:= Mapp[RhsLhs, {a^b, a*b, a –> b, a <= b, a||b, a && b}, "Rhs"]

Out[8]= {b, b, b, b, b, b}

In[9]:= {{RhsLhs[7 ;; 42, "Rhs", s], s}, {RhsLhs[a && b, "Lhs", v], v}} Out[9]= {{42, {Span, ";;"}}, {a, {And, "&&"}}}

In a number of appendices the undoubted interest presents an analog of the Maple-procedure whattype(x) that returns the type of an expression x which is one of basic Maple–types. The procedure of the same name acts as a similar analog in system Mathematica whose call WhatType[x] returns type of an object x of one of basic types {"Module", "DynamicModule", "Complex", "Block", "Real", "Integer", "Rational", "Times", "Rule", "Power", "And", "Alternatives", "List", "Plus", "Condition", "StringJoin", "UndirectedEdge", …}. The fragment represents source code of the procedure and examples of its application for identification of the types of various objects.

In[7]:= WhatType[x_ /; StringQ[x]] := Module[{b = t, d,

c= $Packages, a = Quiet[Head[ToExpression[x]]]},

If[a === Symbol, Clear[t]; d = Context[x];

If[d == "Global`", d = Quiet[ProcFuncBlQ[x, t]]; If[d === True, Return[{t, t = b}[[1]]],

Return[{"Undefined", t = b}[[1]]]], If[d == "System`", Return[{d, t = b}[[1]]], Null]], Return[{ToString[a], t = b}[[1]]]];

If[Quiet[ProcFuncBlQ[x, t]], If[MemberQ[{"Module", "DynamicModule", "Block"}, t],

Return[{t, t = b}[[1]]], t = b;

ToString[Quiet[Head[ToExpression[x]]]]], t = b; "Undefined"]] In[8]:= Map[WhatType, {"a^b", "a**b", "3+7*I", "{42, 47}", "a&&b"}]

Out[8]= {"Power", "NonCommutativeMultiply", "Complex", "List", "And"}

In[9]:= Map[WhatType, {"a_/; b", "a <> b", "a <–> b", "a|b"}]

Out[9]= {"Condition", "StringJoin", "TwoWayRule", "Alternatives"}

However, it should be noted that the WhatType procedure don`t support exhaustive testing of types, meantime on its basis it is simple to expand the class of the tested types.

The functions Replace and ReplaceAll of Mathematica have essential restrictions in relation to replacement of sub-expressions relatively of very simple expressions as it will illustrated below.

284

Mathematica: Functional and procedural programming

The reason of it can be explained by the following circumstance, using the procedure useful enough also as independent means. The call ExpOnLevels[x, y, z] returns the list of an expression x levels on which a sub-expression y is located. While procedure call with the third optional z argument – an indefinite symbol – through it additionally returns the nested list of ListList type of all sub-expressions of expression x on all its levels. In addition, the first element of each sub-list of such ListList list determines a level of the x expression while the second element defines the list of sub-expressions located on this level. If sub-expression y is absent on the levels identified by Level function, calling the procedure call returns the appropriate diagnostic message. The fragment below represents the source code of the ExpOnLevels procedure with some typical examples of its application.

In[7]:= ExpOnLevels[x_, y_, z___] := Module[{a = {}, b}, Do[AppendTo[a, {j, Set[b, Level[x, {j}]]}];

If[b == {}, Break[], Continue[]], {j, 1, Infinity}]; a = a[[1 ;; –2]]; If[{z} != {} && NullQ[z], z = a, 77]; b = Map[If[MemberQ[#[[2]], y], #[[1]], Nothing] &, a]; If[b == {}, "Sub-expression " <> ToString1[y] <>

" can't be identified", b]] In[8]:= ExpOnLevels[a + b^3 + 1/x^(3/(a + 2)) + b[t] + 1/x^2, x^2]

Out[8]= "Sub-expression x^2 can't be identified"

In[9]:= ExpOnLevels[a + b^3 + 1/x^(3/(a + 2)) + b[t] + a/x^2, x^2, g]

Out[9]= "Sub-expression x^2 can't be identified" In[10]:= g

Out[10]= {{1, {a, b^3, a/x^2, x^(–(3/(2 + a))), b[t]}}, {2, {b, 3, a, 1/x^2, x, –(3/(2 + a)), t}},

{3, {x, –2, –3, 1/2 + a)}}, {4, {2 + a, –1}}, {5, {2, a}}}

Replacement sub-expressions in expressions. The procedure

ExpOnLevels can determine admissible replacements carrying out by means of the standard functions Replace and ReplaceAll as they are based on the Level function that evaluates the list of all sub-expressions of an expression on the set levels. The call of the built–in Replace function on unused rules don't return any diagnostical information, at the same time, if all rules were not used, then the function call is returned as unevaluated. In turn,

285

V.Z. Aladjev, M.L. Shishakov, V.A. Vaganov

the procedure below that is based on the previous ExpOnLevels procedure gives full diagnostics concerning the unused rules. The procedure call ReplaceInExpr[x,y,z] is analogous to the call Replace[x, y, All] where y is a rule or their list whereas thru the 3rd optional z argument – an undefined symbol – additionally is returned the message identifying the list of the unused rules.

The procedure call ReplaceInExpr1[x, y, z] is analogous to the call ReplaceInExpr[x, y, z] but not its result where y is a rule or their list whereas through the third optional z argument – an undefined symbol – additionally the message is returned which identifies a list of the unused rules. If unused rules are absent, then the z symbol remains undefined. The following fragment represents source code of the ReplaceInExpr1 procedure with typical examples of its application. Of the presented examples one can clearly see the difference between both procedures.

In[7]:= ReplaceInExpr1[x_, r_/; RuleQ[r]||ListRulesQ[r], y___] := Module[{a = ToString1 @@ {ToBoxes @@ {x}}, b, c = If[RuleQ[r], {r}, r], d, h = {}}, Do[b = ToString1 @@ {ToBoxes @@ {c[[j]][[1]]}};

d = ToString1 @@ {ToBoxes @@ {c[[j]][[2]]}};

If[StringFreeQ[a, b], AppendTo[h, j], a = StringReplace[a, b –> d]], {j, 1, Length[c]}]; a = ToExpression[a]; If[{y} != {} && NullQ[y], y = h, 77];

ReleaseHold[MakeExpression[a, StandardForm]]] In[8]:= ReplaceInExpr1[x^2 + 1/x^2 + c[t], {x^2 –> m^3, t –> j[x]}]

Out[8]= 1/m^3 + m^3 + c[2[x]]

In[9]:= ReplaceInExpr1[(a + b[t]) + 1/x^(3/(b[t] + 2)) + b[t] + a/x^2, {x^2 –> mp, b[t] –> gsv, x^3 –> tag, a –> 77}, gs]

Out[9]= 77 + 2*gsv + 77/mp + x^(–(3/(2 + gsv))) In[10]:= gs

Out[10]= {3}

In[11]:= ReplaceInExpr[(a + b[t]) + 1/x^(3/(b[t] + 2)) + b[t] + a/x^2, {x^2 –> mp, b[t] –> gsv, x^3 –> tag, a –> 77}, gs1]

Out[11]= 77 + 2*gsv + 77/x^2 + x^(–(3/(2 + gsv))) In[12]:= gs1

Out[12]= "Rules {1, 3} were not used"

Using the built-in ToBoxes function that creates the boxes corresponding to the printed form of expressions in the form

286

Mathematica: Functional and procedural programming

StandardForm, we can allocate the sub-expressions composing an expression. The procedure call SubExpressions[x] returns the list of sub-expressions composing an expression x, in a case of impossibility the empty list is returned, i.e. {}. The fragment below represents source code of the SubExpressions procedure with a typical example of its application.

In[12]:= SubExpressions[x_] := Module[{b, c = {}, d, h, t,

a = ToString1[ToBoxes[x]]}, b = Select[ExtrVarsOfStr[a, 2], SystemQ[#] || UserQ[#] &]; Do[h = b[[j]]; d = StringPosition[a, h]; Do[t = "["; Do[If[StringCount[t, "["] == StringCount[t, "]"], AppendTo[c, h <> t]; Break[],

t = t <> StringTake[a, {d[[p]][[2]] + k + 1}]], {k, 1, Infinity}], {p, 1, Length[d]}], {j, 1, Length[b]}]; c = Map[Quiet[Check[ToExpression[#], Nothing]] &, c];

Map[ReleaseHold[MakeExpression[#, StandardForm]] &, c]]

In[13]:= SubExpressions[a*b + 1/x^(3/(b[t] + 2)) + J[t] + d/x^2]

Out[13]= {d/x^2, 3/(2 + b[t]), a*b + d/x^2 + x^(–(3/(2 + b[t]))) + J[t], a*b, –(3/(2 + b[t])), 2 + b[t], b[t], Sin[t], x^2, x^(–(3/(2 + b[t])))}

Unlike the above SubExpressions procedure, the procedure SubExpressions1 is based on the standard FullForm function. The call SubExpressions1[x] returns the list of sub–expressions that compose an expression x, while in a case of impossibility the empty list is returned, i.e. {}. The system Level function and our SubExpressions ÷ SubExpressions2 means allow to outline possibilities of the Mathematica concerning the replacements of the sub–expressions in expressions [8,12-16].

As an alternative to the above tools can be offered the Subs procedure that is functionally equivalent to the above standard ReplaceAll function, however which is relieved of a number of its shortcomings. Procedure call Subs[x, y, z] returns the result of substitutions to an expression x of all occurrences of y sub– expressions onto z expressions. In addition, if x – an arbitrary correct expression, then as the 2nd and 3rd arguments defining substitutions of format y –> z, an unary substitution or their list coded in form y ≡ {y1,y2,…,yn} and z ≡ {z1,z2,…,zn} act, defining

287

V.Z. Aladjev, M.L. Shishakov, V.A. Vaganov

the list of substitutions {y1 –> z1, y2 –> z2, …, yn –> zn} which are carried out consistently in the order defined at the Subs call. A number of bright examples of its use on those expressions and with those types of substitutions where the Subs surpasses the standard ReplaceAll function is represented, in particular, in [8-15]. These examples rather clearly illustrate advantages of the Subs procedure before the similar system software.

At last, Substitution is an integrated procedure of the tools

Subs ÷ Subs4. The procedure call Substitution[x, y, z] returns the result of substitutions into an arbitrary x expression of an expression z instead of occurrences in it of all y sub-expressions. In addition, if as x expression any correct expression admitted in Math–language is used, whereas as a single substitution or their set are coded y ≡ {y1,y2,...,yn} and z ≡ {z1,z2,...,zn} as the 2nd and 3rd arguments defining substitutions of the format y –> z by defining the set of substitutions {y1 –> z1, y2 –> z2, ..., yn –> zn} carried out consistently. The Substitution allows essentially to extend possibilities of expressions processing. The following fragment represents source code of the Substitution procedure and examples of its application, well illustrating its advantages over the standard means.

In[7]:= Substitution[x_, y_, z_] := Module[{d, k = 2, subs, subs1}, subs[m_, n_, p_] := Module[{a, b, c, h, t}, If[! HowAct[n], m /. n –> p, {a, b, c, h} =

First[{Map[ToString, Map[InputForm, {m, n, p, 1/n}]]}];

Simplify[ToExpression[StringReplace[StringReplace[a, b –> "(" <> c <> ")"], h –> "1/" <> "(" <> c <> ")"]]]; If[t === m, m /. n –> p, t]]];

subs1[m_, n_, p_] := ToExpression[StringReplace[ToString[ FullForm[m]], ToString[FullForm[n]] –> ToString[FullForm[p]]]];

If[! ListQ[y] && ! ListQ[z], If[Numerator[y] == 1 && ! SameQ[Denominator[y], 1], subs1[x, y, z], subs[x, y, z]], If[ListQ[y] && ListQ[z] && Length[y] == Length[z], If[Numerator[y[[1]]] == 1 && ! SameQ[Denominator[y[[1]]], 1],

d = subs1[x, y[[1]], z[[1]]], d = subs[x, y[[1]], z[[1]]]];

288

Mathematica: Functional and procedural programming

For[k, k <= Length[y], k++, If[Numerator[y[[k]]] == 1 &&

!SameQ[Denominator[y[[k]]], 1], d = subs1[d, y[[k]], z[[k]]], d = subs[d, y[[k]], z[[k]]]]]; d, Defer[Substitution[x, y, z]]]]]

In[8]:= Replace[1/x^2 + 1/y^3, {{x^2 –> a + b}, {y^3 –> c + d}}]

Out[8]= {1/x^2 + 1/y^3, 1/x^2 + 1/y^3}

In[9]:= Substitution[1/x^2 + 1/y^3, {x^2, y^3}, {a + b, c + d}]

Out[9]= 1/(a + b) + 1/(c + d)

In[10]:= Replace[1/x^2*1/y^3, {{1/x^2 –> a + b}, {1/y^3 –> c + d}}]

Out[10]= {1/(x^2*y^3), 1/(x^2*y^3)}

In[11]:= Substitution[1/x^2*1/y^3, {x^2, y^3}, {a + b, c + d}]

Out[11]= 1/((a + b)*(c + d))

It should be noted that the Substitution procedure rather significantly extends the standard tools intended for ensuring replacements of sub-expressions in expressions as the following examples rather visually illustrate. The Substitution1 procedure can be considered as an analogue of the Substitution procedure. Syntax of the procedure call Substitution1[x,y, z] is identical to the procedure call Substitution[x, y, z], returning the result of substitutions into arbitrary x expression of z sub-expression(s) instead of all occurrences of y sub-expression(s). A quite simple Substitution2 function is the simplified version of the previous

Substitution procedure, its call Substitution2[x,y,z] returns the result of substitutions into an expression x of a sub-expression z instead of all occurrences of sub-expression y. The Substitution2 function significantly uses expressions in the FullForm form and supports a rather wide range of substitutions.

In[2211]:= Substitution2[x_, y_, z_] :=

ToExpression[StringReplace[ToString[FullForm[x]], ToString[FullForm[y]] –> ToString[FullForm[z]]]]

In[2212]:= Substitution2[Sin[x^2]*Cos[1/b^3], 1/b^3, x^2]

Out[2212]= Cos[x^2]*Sin[x^2]

In[2213]:= Substitution2[1 + 1/x^2, x^2, a + b]

Out[2213]= 1 + 1/x^2

Meantime, already the second example of application of the function reveals its shortcomings, forcing on the same basis to complicate its algorithm. The following version in the procedure form somewhat enhances the function's possibilities.

289

V.Z. Aladjev, M.L. Shishakov, V.A. Vaganov

In[2242]:= Substitution3[x_, y_, z_] := Module[{c,

a = ToString[FullForm[Simplify[x]]], b = ToString[FullForm[z]]}, c = Map[ToString[FullForm[#]] &, {y, 1/y}]; c = GenRules[c, b]; ToExpression[StringReplace[a, c]]]

In[2243]:= Substitution3[1 + 1/x^2, x^2, a + b]

Out[2243]= 1 + a + b

In[2244]:= Substitution3[x^2 + 1/(a + 1/x^2), x^2, a + b]

Out[2244]= a + b + 1/(2*a + b)

In[2245]:= Substitution3[x^2 + 1/(1/x^2 + x^2), x^2, a + b]

Out[2245]= a + b + 1/(2*a + 2*b)

In[2246]:= Substitution[x^2 + 1/(1/x^2 + x^2), x^2, a + b]

Out[2246]= a + b + 1/(a + b + 1/(a + b))

Meantime, and the above version of the Substitution2 don`t fully solve the problem, as illustrated by the 3rd example of the previous fragment, making it impractical to further complicate such FullForm–based means. And only the above Substitution procedure solves the set problem.

The following procedure allows to eliminate restrictions inherent in means of the above so–called Subs–group. The call SubsInExpr[x,r] returns the result of substitution in an arbitrary expression x set in the form Hold[x] of the right parts of a rule or their list r instead of occurrences of the left parts corresponding them. In addition, all the left and the right parts of r rules should be coded in the Hold-form, otherwise the procedure call returns $Failed with printing of the appropriate message. The fragment below represents source code of the SubsInExpr procedure with some typical examples of its application.

In[2261]:= SubsInExpr[x_ /; Head[x] == Hold, r_ /; RuleQ[r] || ListRulesQ[r]] := Module[{a, b, c, f},

c = Map[Head[(#)[[1]]] === Hold && Head[(#)[[2]]] === Hold &, Set[b, Flatten[{r}]]]; If[! And @@ c,

Print["Incorrect tuple of factual arguments"]; $Failed, f[t_] := StringTake[ToString1[t], {6, –2}]; a = f[x]; c = Map[Rule[f[#[[1]]], "(" <> f[#[[2]]] <> ")"] &, b]; ToExpression[StringReplaceVars[a, c]]]]

In[2262]:= SubsInExpr[Hold[(a + b^3)/(c + d^(–2))],

Hold[d^–2] –> Hold[Sin[t]]]

290