KDP_book

Mathematica: Functional and procedural programming

In[3388]:= NamesInNBfiles[x_ /; FileExistsQ[x]] := Module[{c = FileConvert[x –> "#.m"], b, h, g = {}, s = {}, k},

a = ReadString[c]; DeleteFile[c]; b = "`" <> StringReplace[a, {"RowBox[{" –> "", "\n" –> "", "\r" –> ""}] <> "`"; c = Map[#[[1]] &, StringPosition[b, "`"]];

For[k = 1, k <= Length[c] – 1, k++, h = StringTake[b, {c[[k]], c[[k + 1]]}]; h = StringReplace[h, "`" –> ""];

If[SymbolQ[h], AppendTo[g, h], 7]]; g = DeleteDuplicates[g]; Map[If[NameQ[#] && ! SystemQ[#] && StringLength[#] > 1, AppendTo[s, #], 7] &, g]; Sort[s]]

In[3389]:= NamesInNBfiles["C:\\math\\mathtoolbox.nb"]

Out[3389]= {"AcNb", "ActBFM", "ActBFMuserQ",…,"$Version2"}

In[3390]:= Length[%]

Out[3390]= 1418

The above mentioned procedure for solving a task uses the

FileConvert function, whose call FileConvert[F1 –> "File2.ext"] converts the contents of source file F1 to the format defined by the extension ext and saves the result to the file "File2.ext". In addition, files can be converted from formats supported by the function Import to formats supported by Export. Given that the internal content of a certain file plays a rather significant role in solving programming problems related to the structure of the file, the question of converting the file into a more acceptable format seems to be quite important. In particular, the above procedure uses the FileConvert function for converting of the nb–files to m–files, facilitating the task solution. This approach has been used in a number of applications [8-15].

271

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

3.9. Certain additional tools of expressions processing in the Mathematica software

Analogously to the most software systems the Mathematica understands everything with what it manipulates as expression

(graphics, lists, formulas, strings, modules, functions, numbers, etc.). And although all these expressions, at first sight, significantly differ, Mathematica presents them in so–called full format. And only the postponed assignment ":=" has no full format. For the purpose of definition of the heading of an e expression (the type defining it) the built-in Head function is used whose call Head[e] returns the heading of an e expression:

In[3331]:= G := S; Z[x_] := Block[{}, x]; F[x_] := x; M[x_] := x; M[x_, y_] := x + y; Map[Head, {ProcQ, Sin, 77, a + b, # &, G, Z,

Function[{x}, x], x*y, x^y, F, M}]

Out[3332]= {Symbol, Symbol, Integer, Plus, Function, Symbol, Symbol, Function, Times, Power, Symbol, Symbol}

For more exact definition of headings we created an useful modification of built-in Head function in the form of the Head1 procedure expanding its opportunities, for example, it concerns testing of blocks, system functions, the user functions, modules, etc. Thus, the call Head1[x] returns the heading of an expression x in the context {Block, Function, Module, System, Symbol, Head[x],

PureFunction}. In addition, on the objects of the same name that have one name with several definitions the procedure call will return $Failed. The fragment below represents source code of the Head1 procedure with examples of its use comparatively with the Head function as it is illustrated by certain examples of the following fragment on which the functional distinctions of both tools are rather evident.

In[3333]:= Head1[x_] := Module[{a = PureDefinition[x]},

If[ListQ[a], $Failed, If[a === "System", System, If[BlockQ[x], Block, If[ModuleQ2[x], Module, f[PureFuncQ[x], PureFunction, If[Quiet[Check[FunctionQ[x], False]], Function, Head[x]]]]]]]]

In[3334]:= G := S; Z[x_] := Block[{}, x]; F[x_] := x; M[x_] := x; M[x_, y_] := x + y; Map[Head, {ProcQ, Sin, 6, a + b, # &, G, Z,

272

Mathematica: Functional and procedural programming

Function[{x}, x], x*y, x^y, F, M}]

Out[3334]= {Symbol, Symbol, Integer, Plus, Function, Symbol, Symbol, Function, Times, Power, Symbol, Symbol}

In[3335]:= Map[Head1, {ProcQ, Sin, 6, a + b, # &, G, Z, Function[{x}, x], x*y, x^y, F, M}]

Out[3335]= {Module, System, Integer, Plus, PureFunction, Symbol, Block, PureFunction, Times, Power, Function, $Failed}

The Head1 procedure has a quite certain meaning for more exact (relatively to system standard) classification of expressions according to their headings. On many expressions the calls of Head1 procedure and Head function are identical, whereas on certain their calls significantly differ. In [2,4-6,8-16], two useful modifications of the Head1: Head2 and Head3 are represented. The expression concept is the important unifying principle in the system having identical internal structure which allows to confine a rather small amount of the basic operations. Meantime, despite identical basic structure of expressions, Mathematica provides a set of various functions for work as with expression, and its separate components.

Tools of testing of correctness of expressions. The system

Mathematica has a number of the means providing the testing of correctness of syntax of expressions among which only two functions are available to the user, namely:

SyntaxQ["x"] – returns True, if x – a syntactic correct expression; otherwise False is returned;

SyntaxLength["x"] – returns the quantity w of symbols, since the beginning of a "x" string that determines syntactic correct expression

StringTake["x", {1, w}]; in a case w>StringLength["x"] the system declares that whole "x" string is correct, demanding continuation.

In our opinion, it isn't very conveniently in case of software processing of the expressions. Therefore extension in the form of SyntaxLength1 procedure is of certain interest.

In[4447]:= SyntaxLength1[x_ /; StringQ[x], y___] :=

Module[{a = "", b = 1, d, h = {}, c = StringLength[x]}, While[b <= c, d = SyntaxQ[a = a <> StringTake[x, {b}]]; If[d, AppendTo[h, StringTrim2[a, {"+", "–", " "}, 3]]]; b++];

273

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

h = DeleteDuplicates[h]; If[{y} != {} && ! HowAct[{y}[[1]]], {y} = {h}]; If[h == {}, 0, StringLength[h[[–1]]]]]

In[4448]:= {SyntaxLength1["d[a[1]] + b[2]", g], g} Out[4448]= {14, {"d", "d[a[1]]", "d[a[1]] + b", "d[a[1]] + b[2]"}}

The call SyntaxLength1[x] returns the maximum number w of position in a string x such that the next condition is carried out ToExpression[StringTake[x, {1, w}]] – a syntactically correct expression, otherwise 0 (zero) is will be returned; whereas the call SyntaxLength1[x, y] through the 2nd optional y argument – an indefinite variable – additionally returns the list of substrings of the string x representing correct expressions.

Unlike the SyntaxLength1 procedure, the procedure call SyntaxLength2[j] gathers correct sub-expressions extracted from a string j into lists of expressions identical on the length. The function call ExtrVarsOfStr1[j] returns the sorted list of possible symbols in string format successfully extracted from a string j; if symbols are absent, the empty list – {} is returned. Unlike the ExtrVarsOfStr procedure the ExtrVarsOfStr1 function provides the more exhaustive extraction of all possible symbols from the strings. Whereas, the procedure call FactualVarsStr1[j] returns the list of all factual variables extracted from a string j; source code of the last tool with an example are represented below.

In[6]:= FactualVarsStr1[x_ /; StringQ[x]] := Module[{b = "",

c = {}, h, t, k, a = StringLength[x] + 1, d = x <> "[", j = 1},

While[j <= a, For[k = j, k <= a, k++, If[SymbolQ[t = StringTake[d, {k, k}]] || t == "`", b = b <> t, If[! MemberQ[{"", "`"}, b], AppendTo[c, {b, If[MemberQ[CNames["AladjevProcedures`"],

b], "AladjevProcedures`", h = If[ContextQ[b], "contexts", Quiet[ToExpression["Context[" <> b <> "]"]]]; If[h == "AladjevProcedures`", $Context, h]]}], 7]; b = ""]; j = k + 1]]; c = Map[DeleteDuplicates, Map[Flatten, Gather[c, #1[[2]] == #2[[2]] &]]];

c = Map[Sort[#, ContextQ[#1] &] &, c]; c = Map[If[MemberQ[#, "contexts"] && ! MemberQ[#, "Global`"], Flatten[{"contexts",

274

Mathematica: Functional and procedural programming

ReplaceAll[#, "contexts" –> Nothing]}], #] &, c]; c = Map[Flatten[{#[[1]], Sort[#[[2 ;; –1]]]}] &, c];

Map[If[#[[1]] != "Global`" && MemberQ[#, "contexts"], Flatten[{"contexts", ReplaceAll[#, "contexts" –> Nothing]}], #] &, c]]

In[7]:= FactualVarsStr1[PureDefinition[StrStr]]

Out[7]= {{"AladjevProcedures`", "StrStr"}, {"Global`", "x"}, {"System`", "If", "StringJoin", "StringQ", "ToString"}}

The procedure call FactualVarsStr1[x] on the whole returns the nested list whose sub-lists have contexts as the first element whereas the others define the symbols extracted from a string x which have these contexts. If the string x contains contexts then "contexts" element precedes their sorted tuple in sub-list. The above means is useful enough in practical programming in the Mathematica and their codes contain a number of rather useful programming receptions [16].

Call SyntaxQ[x] of standard Mathematica function returns True if a string x corresponds to syntactically correct input for a single expression, and returns False otherwise. In addition, the function tests only syntax of expression, ignoring its semantics at its evaluation. Whereas the tools ExpressionQ, ExprQ, Expr1Q along with the syntax provide testing of expressions regarding their semantic correctness. The calls of all these tools on a string x returns True if string x contains a syntactically and semantically correct single expression, and False otherwise. Fragment below represents source code of the ExprQ1 function and examples of its use in comparison with the built–in SyntaxQ function.

In[2214]:= Expr1Q[x_ /; StringQ[x]] :=

Quiet[Check[SameQ[ToExpression[x], ToExpression[x]], False]] In[2215]:= {z, a, c, d} = {500, 90, 77, 42}; SyntaxQ["z=(c+d)*a/0"]

Out[2215]= True

In[2216]:= Expr1Q["z=(c+d)*a/0"]

Out[2216]= False

In[2217]:= {SyntaxQ["77 = 72"], Expr1Q["77 = 72"]} Out[2217]= {True, False}

Thus, the function call Expr1Q[x] returns False only if the call ToExpression[x] causes an erroneous situation for a string x that contains some expression.

275

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

It is possible to apply the Cases function for definition of the expressions coinciding with a given pattern, however not all problems of expressions comparison with patterns are solved by the standard means. For solution of the problem in broader aspect the EquExprPatt procedure can be rather useful whose call EquExprPatt[x, p] returns True if expression x corresponds to the given p pattern, and False otherwise. The fragment below presents source code of the procedure and an example of its use.

In[1395]:= EquExprPatt[x_, y_ /; ExprPatternQ[y]] := Module[{c, d = {}, j, t, v = {}, k = 1, p, g = {}, s = {},

a = Map[FullForm, Map[Expand, {x, y}]], b = Mapp[MinusList, Map[OP, Map[Expand, {x, y}]], {FullForm}], z = SetAttributes[ToString, Listable], w}, {b, c} = ToString[{b, a}]; p = StringPosition[c[[2]], {"Pattern[", "Blank[]]"}];

While[k = 2*k–1; k <= Length[p], AppendTo[d, StringTake[c[[2]], {p[[k]][[1]], p[[k + 1]][[2]]}]]; k++]; {t, k} = {ToExpression[d], 1};

While[k <= Length[t], AppendTo[v, StringJoin[ToString[Op[t[[k]]]]]]; k++]; v = ToString[v]; v = Map13[Rule, {d, v}]; v = StringReplace[c[[2]], v]; b=Quiet[Mapp[Select, b, ! SystemQ[#]||

BlockFuncModQ[ToString[#]] &]]; {b, k, j} = {ToString[b], 1, 1};

While[k <= Length[b[[1]]], z = b[[1]][[k]]; AppendTo[g, {"[" <> z <> "," –> "[w", " " <> z <> "," –> " w", "[" <> z <> "]" –> "[w]", " " <> z <> "]" –> " w]"}]; k++];

While[j <= Length[b[[2]]], z = b[[2]][[j]]; AppendTo[s, {"[" <> z <> "," –> "[w", " " <> z <> "," –> " w", "[" <> z <> "]" –> "[w]", " " <> z <> "]" –> " w]"}]; j++];

ClearAttributes[ToString, Listable]; z = Map9[StringReplace, {c[[1]], v}, Map[Flatten, {g, s}]];

SameQ[z[[1]], StringReplace[z[[2]], Join[GenRules[Flatten[Map[# <>

"," &, Map[ToString, t]]], "w"], GenRules[Flatten[Map[# <> "]" &, Map[ToString, t]]], "w]"], GenRules[Flatten[Map[# <> ")" &, Map[ToString, t]]], "w)"]]]]]

In[1396]:= Mapp[EquExprPatt, {a + b*c^5, 5 + 6*y^7, a + b*p^m, a + b*m^p}, a + b*x_^n_]

Out[1396]= {True, True, True, True}

276

Mathematica: Functional and procedural programming

Expressions processing at level of their components. Means of this group provide a quite effective differentiated processing of expressions. Because of combined symbolical architecture the Mathematica gives a possibility of direct generalization of the element–oriented list operations to arbitrary expressions, that allows to support operations as on separate terms, and on sets of terms at the given levels in trees of the expressions. Without going into details to all tools supporting work with components of expressions, we will give only the main from them that have been complemented by our means. Whereas with more detailed description of built–in tools of this group, including admissible formats of coding, it is possible to get acquainted in the Help, or in the corresponding literature on the Mathematica system.

The call Variables[p] of built–in function returns the list of all independent variables of a polynomial p, at the same time, its application to an arbitrary expression has some limitations. Meantime for receiving all independent variables of a certain expression x it is quite possible to use a simple function whose call UnDefVars[x] returns the list of all independent variables of an expression x. Unlike the UnDefVars the call UnDefVars1[x] returns the list of all independent variables in string format of an expression x. In certain cases the mentioned functions have certain preferences relative to the built–in Variables function.

The call Replace[x, r {, j}] of built–in function returns result of application of a rule r of the form a → b or list of such rules for transformation of x expression as a whole; application of the 3rd optional j argument defines application of r rules to parts of j level of a x expression. Meantime, the built-in Replace function has a number of restrictions some of which a simple procedure considerably obviates, whose call Replace1[x, r] returns result of application of r rules to all or selective independent variables of x expression. In a case of detection by the procedure Replace1 of empty rules the appropriate message will be printed with the indication of the list of those r rules that were empty, i.e. whose left parts aren't entered into the list of independent variables of x expression. Fragment below presents source code of Replace1

277

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

with examples of its use; in addition, comparison with result of use of the Replace function on the same expression is done.

In[33]:= Replace1[x_, y_ /; ListQ[y] && DeleteDuplicates[Map[Head, y]] == {Rule}||Head[y] == Rule] := Module[{a = x // FullForm // ToString, b = UnDefVars[x], c, p, l, h = {}, r, k = 1, d = ToStringRule[DeleteDuplicates[Flatten[{y}]]]},

p = Map14[RhsLhs, d, "Lhs"]; c = Select[p, ! MemberQ[Map[ToString, b], #] &]; If[c != {}, Print["Rules " <> ToString[Flatten[Select[d, MemberQ[c,

RhsLhs[#, "Lhs"]] &]]] <> " are vacuous"]]; While[k <= Length[d], l = RhsLhs[d[[k]], "Lhs"]; r = RhsLhs[d[[k]], "Rhs"];

h = Append[h, {"[" <> l –> "[" <> r, " " <> l –> " " <> r, l <> "]" –> r <> "]"}]; k++];

Simplify[ToExpression[StringReplace[a, Flatten[h]]]]]

In[34]:= X = (x^2 – y^2)/(Sin[x] + Cos[y]) + a*Log[x + y]; Replace[X, {x –> a + b, a –> 90, y –> Cos[a], z –> Log[t]}]

Out[34]= a*Log[x + y] + (x^2 – y^2)/(Cos[y] + Sin[x])

In[35]:= Replace1[X, {x –> a + b, a –> 90, y –> Cos[a], z –> Log[t], t –> c + d}]

Rules {ComplexInfinity –> (Log[t]), t –> (c + d)} are vacuous Out[35]= 90*Log[a + b + Cos[a]] + ((a + b)^2 – Cos[a]^2)/

(Cos[Cos[a]] + Sin[a + b])

Due to quite admissible impossibility of performance of the replacements of sub-expressions of an expression at the required its levels, there are questions as of belonging of sub-expressions of expression to its levels, and of belonging of sub-expression to the given expression level. The following two procedures in a certain extent solve these problems. A call SubExprOnLevels[x] returns the nested list whose 2–element sub-lists contain levels numbers as the first elements, and lists of sub-expressions on these levels as the second elements of an expression x. Whereas the call ExprOnLevelQ[x, y, z] returns True if a y sub-expression belongs to the z–th level of x expression, and False otherwise. In addition, in a case of False return, the call ExprOnLevelQ[x,y,z,t] through the optional t argument – an indefinite symbol – returns additionally the list of levels numbers of the x expression which

278

Mathematica: Functional and procedural programming

contain the y as a sub-expression. The fragment below represents the source codes of both procedures with examples of their use.

In[1137]:= SubExprOnLevels[x_] := Module[{a, b, c = {}}, Do[If[Set[a, DeleteDuplicates[Level[x, {j}]]] ===

Set[b, DeleteDuplicates[Level[x, {j + 1}]]], Return[c], AppendTo[c, {j, a}]], {j, Infinity}]]

In[1138]:= SubExprOnLevels[(x^2 + y^2)/(x + y)]

Out[1138]= {{1, {1/(x + y), x^2 + y^2}}, {2, {x + y, –1, x^2, y^2}}, {3, {x, y, 2}}}

In[1140]:= ExprOnLevelQ[x_, y_, z_Integer, t___] :=

Module[{a = SubExprOnLevels[x], b = {}, c = {}},

If[! MemberQ[Map[#[[1]] &, a], z], False, If[MemberQ[a[[z]][[2]], y], True, If[{t} != {} && NullQ[t],

Do[If[MemberQ[a[[j]][[2]], y], AppendTo[b, a[[j]][[1]]], 7], {j, Length[a]}]; t = b; False, 7]]]]

In[1141]:= ExprOnLevelQ[(x + y)/(x + a*x^2/b^2), x^2, 1, agn]

Out[1141]= False In[1142]:= agn Out[1142]= {4}

At structural analysis of expressions, a quite certain interest is the CompOfExpr procedure, which allows to determine the component composition of an algebraical expression.

In[7]:= CompOfExpr[x_] :=

Module[{a = ToString[FullForm[x]], b = Map[ToString, FullFormF[]], Num = {}, Str = {}, Sys = {}, Vars = {}, User = {}, av},

ClearAll[av]; a = StringReplace4[a, GenRules[b, ""], av];

a= "{" <> StringReplace[a, {"[" –> ",", "]" –> ","}] <> "}";

a= Select[ToExpression[a], ! SameQ[#, Null] &];

a= Sort[DeleteDuplicates[a]];

Map[If[StringQ[#], AppendTo[Str, #], If[NumericQ[#], AppendTo[Num, #],

If[SystemQ[#], AppendTo[Sys, #], If[BlockFuncModQ[#], AppendTo[User, #],

AppendTo[Vars, #]]]]] &, a]; {{"Sys", Sys}, {"User", User}, {"Vars", Vars}, {"Str", Str}, {"Num", Num}, {"Op", ToExpression[Complement[b, av[[2]]]]}}]

279

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

In[8]:= X = {(x^2 – y^2)/(Sin[x]+Cos[y])/a^Log[x+y], {"a", "b", "c"}, ToExpression["ToString1"], ToExpression["CompOfExpr"]};

In[9]:= CompOfExpr[X]

Out[9]= {{"Sys", {Cos, List, Log, Sin}}, {"User", {CompOfExpr, ToString1}}, {"Vars", {a, x, y}}, {"Str", {"a", "b", "c"}}, {"Num", {–1, 2}}, {"Op", {Plus, Power, Times}}}

In[10]:= CompOfExpr[{(Sin[x] + b)/(Cos[y] + c), ToString1, ProcQ, {73, 78}, "agn"}]

Out[10]= {{"Sys", {Cos, List, Sin}}, {"User", {ProcQ, ToString1}}, {"Vars", {b, c, x, y}}, {"Str", {"agn"}},

{"Num", {–1, 73, 78}}, {"Op", {Plus, Power, Times}}}

Calling CompOfExpr[x] procedure returns the nested list of two–element sub–lists; each sub–list contains one of the words

"Sys" (system tools), "User" (the user tools), "Vars" (variables), "Str" (strings), "Num" (numbers), "Op" (operations) as the first element, while the second element represents the list of components (type of which is defined by the corresponding first word) of an algebraical x expression.

In the certain cases exists necessity to execute the exchange of values of variables with the corresponding exchange of all their attributes. So, variables x and y having values 77 and 72 should receive the values 42 and 47 accordingly along with the appropriate exchange of all their attributes. The procedure call VarExch[x, y] solves this problem, returning Null, i.e. nothing. The list of two names of variables in string format for exchange by values and attributes or the nested list of ListList type acts as the actual argument; anyway all elements of pairs of the list have to be definite, otherwise the call returns Null with printing of the appropriate diagnostic message, for example:

In[7]:= x = a + b; y = m – n; SetAttributes[x, {Protected, Listable}]

In[8]:= {x, y} Out[8]= {a + b, m – n}

In[9]:= VarExch[{"x", "y"}] In[10]:= Definition[x]

Out[10]= x = m – n In[11]:= Definition[y]

Out[11]= Attributes[y] = {Listable, Protected} y = a + b

280