KDP_book

Mathematica: Functional and procedural programming

including procedures and functions. The mechanism of dynamic generation is quite simple and enough in detail is considered in [8-15], whereas examples of its use can be found in source codes of tools of the present book. Below we will present a number of useful enough means for strings processing in Mathematica.

The procedure call SuffPref[S, s, n] provides testing of a S string regarding to begin (n=1), to end (n=2) or both ends (n=3) be limited by a substring or substrings from a s list. In a case of establishment of such fact the SuffPref returns True, otherwise False is returned. Whereas the function call StrStr[x] provides return an expression x different from a string, in string format, and a double string otherwise. In a number of cases the StrStr function is a rather useful at working with strings, in particular, with the standard StringReplace function. The following below represents source codes of the above tools along with examples of their application.

In[7]:= SuffPref[S_ /; StringQ[S], s_ /; StringQ[s]||ListQ[s] && AllTrue[Map[StringQ, s], TrueQ], n_ /; MemberQ[{1, 2, 3}, n]] := Module[{a, b, c, k = 1}, If[StringFreeQ[S, s], False, b = StringLength[S]; c = Flatten[StringPosition[S, s]]; If[n == 3 && c[[1]] == 1 && c[[–1]] == b, True,

If[n == 1 && c[[1]] == 1, True,

If[n == 2 && c[[–1]] == b, True, False]]]]]

In[8]:= StrStr[x_] := If[StringQ[x], "\"" <> x <> "\"", ToString[x]] In[9]:= Map[StrStr, {"RANS", a + b, IAN, {72, 77, 67}, F[x, y]}]

Out[9]= {"\"RANS\"", "a + b", "IAN", "{72, 77, 67}", "F[x, y]"} In[10]:= SuffPref["IAN_RANS_RAC_REA_90_500", "90_500", 2]

Out[10]= True

If the StrStr function is intended, first of all, for creation of double strings, then the following simple procedure converts double strings and strings of higher nesting level to the classical strings. The procedure call ReduceString[x] returns the result of converting of a string x to the usual classical string.

In[15]:= ReduceString[x_ /; StringQ[x]] := Module[{a = x}, Do[If[SuffPref[a, "\"", 3], a = StringTake[a, {2, –2}],

Return[a]], {j, 1, Infinity}]]

131

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

In[16]:= ReduceString["\"\"\"\"\"{a + b, \"g\", s}\"\"\"\"\""]

Out[16]= "{a + b, \"g\", s}"

The SuffPrefList procedure [8,16] is a rather useful version of the above SuffPref procedure concerning the lists. At n=1, the procedure call SuffPrefList[x, y, n] returns the maximal subset common for the lists x and y with their beginning, whereas at n=2, the procedure call SuffPrefList[x, y, n] returns the maximal subset common for the lists x and y since their end, otherwise the call returns two–element sub-list whose elements define the above limiting sub-lists of the lists x and y with the both ends; moreover, if the call SuffPrefList[x, y, n, z] has fourth optional z argument – an arbitrary function from one argument, then each element of lists x and y is previously processed by a z function. The fragment below represents source code of the SuffPrefList procedure along with typical example of its application.

In[7]:= SuffPrefList[x_ /; ListQ[x], y_ /; ListQ[y],

t_ /; MemberQ[{1, 2, 3}, t], z___] := Module[{a = Sort[Map[Length, {x, y}]], b = x, c = y, d = {{}, {}}, j}, If[{z} != {} && FunctionQ[z] || SystemQ[z], {b, c} = {Map[z, b], Map[z, c]}, 6]; Goto[t]; Label[3]; Label[1];

Do[If[b[[j]] === c[[j]], AppendTo[d[[1]], b[[j]]], Break[]], {j, 1, a[[1]]}];

If[t == 1, Goto[Exit], 6]; Label[2]; Do[If[b[[j]] === c[[j]], AppendTo[d[[2]], b[[j]]], Break[]], {j, –1, –a[[1]], –1}]; d[[2]] = Reverse[d[[2]]]; Label[Exit]; If[t == 1, d[[1]], If[t == 2, d[[2]], {d[[1]], d[[2]]}]]]

In[8]:= SuffPrefList[{x, y, x, y, a, b, c, x, y, x, y}, {x, y, x, y}, 3]

Out[8]= {{x, y, x, y}, {x, y, x, y}}

StringTrim1÷ StringTrim3 procedures are useful extensions to the built-in StringTrim function. In particular, the procedure call StringTrim3[S, s, s1, s2, n, m] returns the result of truncation of a S string by s symbols on the left (n=1), on the right (n=2) or both ends (n=3) for case of s1 = "" and s2 = "", at condition that truncating is done onto m depth. Whereas in a case of the s1 and s2 arguments different from empty string instead of truncating the corresponding inserting of strings s1 (at the left) and s2 (on the right) are done. Thus, the arguments s1 and s2 – two string

132

Mathematica: Functional and procedural programming

arguments for processing of the ends of the initial S string at the left and on the right accordingly are defined. In addition, in a case of S = "" or s = "" the procedure call returns the S string; at that, a single character or their string can act as the s argument. The fragment below represents source code of the StringTrim3 procedure along with typical example of its application.

In[7]:= StringTrim3[S_String, s_String, s1_String, s2_String, n_Integer, m_ /; MemberQ[{1, 2, 3}, m]] :=

Module[{a = S, b, c = "", p = 1, t = 1, h},

If[S == "" || s == "", S, Do[b = StringPosition[a, s]; If[b == {}, Break[], a = StringReplacePart[a, "", If[m == 1, {If[b[[1]][[1]] == 1, p++; b[[1]], Nothing]},

If[m == 2, {If[b[[–1]][[2]] == StringLength[a], t++; b[[–1]], Nothing]}, {If[b[[1]][[1]] == 1, p++; b[[1]], Nothing], If[b[[–1]][[2]] == StringLength[a], t++; b[[–1]], Nothing]}]]]];

If[a == c, Break[], 6]; c = a, {j, 1, n}]; h = {p, t} – {1, 1};

If[m == 1, StringRepeat[s1, h[[1]]] <> c, If[m == 2, c <> StringRepeat[s2, h[[2]]],

StringRepeat[s1, h[[1]]] <> c <> StringRepeat[s2, h[[2]]]]]]]

In[8]:= StringTrim3["dd1dd1ddaabcddd1d1dd1dd1dd1dd1dd1",

"dd1", "avz", "agn", 3, 3]

Out[8]= "avzavzddaabcddd1d1dd1dd1agnagnagn"

Thus, by varying of values of the actual arguments {s, s1, s2, n, m}, it is possible to processing of the ends of arbitrary strings in a rather wide range.

The call SequenceCases[x, y] of the built-in function returns the list of all sub-lists in a x list that match a sequence pattern y. In addition, the default option Overlaps –> False is assumed, therefore the SequenceCases call returns only sub-lists which do not overlap. In addition to the function the following procedure is presented as a rather useful tool. The call SequenceCases1[x,y] as a whole returns the nested list whose two–element sub-lists have the following format {n, h} where h – the sub-list of a list x which is formed by means of maximally admissible continuous concatenation of a list y, and n – an initial position in the list x of this sub-list. At that, the procedure call SequenceCases1[x,y,z] with 3rd optional z argument – an indefinite symbol – through z

133

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

returns the nested list whose the 1st element defines the sub-lists maximal in length in format {m, n, p}, where m – the length of a sublist and n, p – its first and end position accordingly, whereas the 2nd element determines the sub-lists minimal in length of the above format with obvious modification. In a case of erroneous situations the procedure call returns $Failed or empty list. The following fragment represents the source code of the procedure with typical examples of its application.

In[7]:= SequenceCases1[x_ /; ListQ[x], y_ /; ListQ[y], z___] := Module[{a = SequencePosition[x, y], b = 6, c, t},

If[Length[y] > Length[x], $Failed, While[! SameQ[a, b], a = Gather[a, #1[[2]] == #2[[1]] – 1 &]; a = Map[Extract[#, {{1}, {–1}}] &, Map[Flatten, a]];

b = Gather[a, #1[[2]] == #2[[1]] – 1 &];

b= Map[Extract[#, {{1}, {–1}}] &, Map[Flatten, b]]];

b= Map[{#[[1]], Part[x, #[[1]] ;; #[[–1]]]} &, b];

If[{z} == {}, b, c = Map[{#[[1]], Length[#[[2]]]} &, b]; c = Map8[Max, Min, Map[#[[2]] &, c]]; z = {Map[If[Set[t, Length[#[[2]]]] == c[[1]], {c[[1]], #[[1]], #[[1]] +

t – 1}, Nothing] &, b], Map[If[Set[t, Length[#[[2]]]] == c[[2]], {c[[2]], #[[1]], #[[1]] + t – 1}, Nothing] &, b]}; z = Map[If[Length[#] == 1, #[[1]], #] &, z]; b]]]

In[8]:= SequenceCases1[{a, x, y, x, y, x, y, x, y, x, y, x, y, x, y, a, m, n, x, y, b, c, x, y, x, y, h, x, y}, {x, y}]

Out[8]= {{2, {x, y, x, y, x, y, x, y, x, y, x, y, x, y}}, {19, {x, y}},

{23, {x, y, x, y}}, {28, {x, y}}} In[9]:= SequenceCases1[{a, x, y, x, y, x, y, x, y, x, y, x, y, x, y, a, m, n, x, y, b, c, x, y, x, y, h, x, y}, {x, y}, g]; g

Out[9]= {{14, 2, 15}, {{2, 19, 20}, {2, 28, 29}}}

Additionally to the built-in StringReplace function and the four our procedures StringReplace1÷StringReplace6, extending the first, the following procedure represents undoubted interest. The procedure call StringReplaceVars[S, r] returns the result of replacement in a string S of all occurrences of the left sides of a rule or their list r onto the right sides corresponding to them. In a case of absence of the above left sides entering in the S string

134

Mathematica: Functional and procedural programming

the procedure call returns initial S string. Distinctive feature of the procedure is the fact, that it considers the left sides of r rules as separately located expressions in the S string, i.e. framed by the special characters. The procedure is of interest at processing of strings. The following fragment represents source code of the StringReplaceVars procedure with typical examples of its use.

In[7]:= StringReplaceVars[S_ /; StringQ[S], r_ /; RuleQ[r] || ListRulesQ[r]] := Module[{a = "(" <> S <> ")",

L = Characters["`!@#%^&*(){}:\"\\/|<>?~–=+[];:'., 1234567890_"], R = Characters["`!@#%^&*(){}:\"\\/|<>?~–=+[];:'., _"], b, c, g = If[RuleQ[r], {r}, r]},

Do[b = StringPosition[a, g[[j]][[1]]]; c = Select[b, MemberQ[L, StringTake[a, {#[[1]] – 1}]] && MemberQ[R, StringTake[a, {#[[2]] + 1}]] &]; a = StringReplacePart[a, g[[j]][[2]], c], {j, 1, Length[g]}]; StringTake[a, {2, –2}]]

In[8]:= StringReplaceVars["Sqrt[t*p] + t^t", "t" –> "(a + b)"]

Out[8]= "Sqrt[(a + b)*p] + (a + b)^(a + b)"

In[9]:= StringReplaceVars["(125 123 678 123 90)", {"123" –> "abc", "678" –> "mn", "90" –> "avz"}]

Out[9]= "(125 abc mn abc avz)"

The following procedure – a version of the StringReplaceVars procedure that is useful in the certain cases. The procedure call StringReplaceVars1[S,x,y,r] returns the result of replacement in a string S of all occurrences of the left sides of a rule or their list r to the right sides corresponding to them. In a case of absence of the above left sides entering in the S string the procedure call returns the initial S string. Distinctive feature of this procedure with respect to the procedure StringReplaceVars is the fact that it considers the left sides of r rules which are separately located expressions in the S string, i.e. they are framed on the left by the characters from a string x and are framed on the right by means of characters from a string y. The procedure is of certain interest at strings processing, in particular, at processing of definitions in string format of blocks and modules. The following fragment represents an example of the StringReplaceVars1 procedure use.

135

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

In[3317]:= StringReplaceVars1["{a = \"ayb\", b = Sin[x],

c = {\"a\", 77}, d = {\"a\", \"b\"}}", "{( 1234567890", " })", {"a" –> "m", "b" –> "n"}]

Out[3317]= "{m = \"ayb\", n = Sin[x], c = {\"a\", 77},

d = {\"a\", \"b\"}}"

Earlier it was already noted that certain functional facilities of the Mathematica need to be reworked both for purpose of expansion of domain of application, and elimination of certain shortcomings. It to the full extent concerns such an important enough function whose call ToString[x] returns the result of the converting of an arbitrary expression x to the string format. The standard function incorrectly converts expressions into string format that contain string sub-expressions if to code them in the standard way. By this reason we defined procedure ToString1 whose call ToString1[x] returns the result of correct converting of an arbitrary expression x in the string format. The fragment below represents source codes of the ToString1 procedure and ToString1 function with examples of their use. In a number of appendices these means is popular enough.

In[1]:= ToString1[x_] := Module[{a = "###", b = "", c, k = 1},

Write[a, x]; Close[a]; For[k, k < Infinity, k++, c = Read[a, String]; If[SameQ[c, EndOfFile], Return[DeleteFile[Close[a]]; b], b = b <> StrDelEnds[c, " ", 1]]]]

In[2]:= K[x_] := Module[{a = "r", b = " = "}, a <> b <> ToString[x]] In[3]:= ToString[Definition[K]]

Out[3]= "K[x_] := Module[{a = r, b = = }, a<>b<>ToString[x]]"

In[4]:= ToExpression[%]

ToExpression::sntx: Invalid syntax in or before

"K[x_] := Module[{a = r, b = = }, a<>b<>ToString[x]]". Out[4]= $Failed

In[5]:= ToString1[Definition[K]]

Out[5]= "K[x_] := Module[{a = \"r\", b = \" = \"}, StringJoin[a, b, ToString[x]]]"

In[6]:= ToExpression[%]

In[7]:= ToString1[x_] := {Write["#$#", x], Close["#$#"], ReadString["#$#"], DeleteFile["#$#"]}[[–2]]

136

Mathematica: Functional and procedural programming

In[8]:= ToString1[Definition[K]]

Out[8]= "K[x_] := Module[{a = \"r\", b = \" = \"},

StringJoin[a, b, ToString[x]]]"

In[9]:= ToString2[x_] := Module[{a},

If[ListQ[x], SetAttributes[ToString1, Listable]; a = ToString1[x];

ClearAttributes[ToString1, Listable]; a, ToString1[x]]]

In[10]:= ToString2[{{77, 7}, {4, {a, b, {x, y}, c}, 5}, {30, 23}}]

Out[10]= {{"77", "7"}, {"4", {"a", "b", {"x", "y"}, "c"}, "5"}, {"30", "23"}}

In[11]:= ToString5[x_] := Module[{a, b, c, d}, a[b_] := x;

c = Definition1[a]; d = Flatten[StringPosition[c, " := ", 1]][[–1]]; StringTake[c, {d + 1, –1}]]

In[12]:= ToString5[{{a, b, "c", "d + h"}, "m", "p + d"}]

Out[12]= "{{a, b, \"c\", \"d + h\"}, \"m\", \"p + d\"}"

In[13]:= ToString1[{{a, b, "c", "d + h"}, "m", "p + d"}]

Out[13]= "{{a, b, \"c\", \"d + h\"}, \"m\", \"p + d\"}"

In[26]:= {a, b} = {72, 77};

In[27]:= ToString6[x_] := {Save["#", "a"], ClearAll["a"],

a = Unique["$"], a[t_] := x, a = Definition1[a], StringTake[a, {Flatten[StringPosition[a, " := ", 1]][[–1]] + 1, –1}], {Get["#"], DeleteFile["#"]}}[[–2]]

In[28]:= ToString6[{{c, d, "c", "d + h"}, "m", "p + d", "m/n"}] Out[28]= "{{c, d, \"c\", \"d + h\"}, \"m\", \"p + d\", \"m/n\"}" In[29]:= ToString1[{{c, d, "c", "d + h"}, "m", "p + d", "m/n"}] Out[29]= "{{c, d, \"c\", \"d + h\"}, \"m\", \"p + d\", \"m/n\"}"

In[30]:= {a, b} Out[30]= {72, 77}

In[46]:= Unique3[x_, n_] :=

Module[{a = Characters[ToString[x]], b}, b = Map[StringJoin, {Select[a, LetterQ[#] &], Select[a, DigitQ[#] &]}];

ToExpression[b[[1]] <> ToString[ToExpression[b[[2]]] – n]]]

In[47]:= Unique3[Unique["avz"], 7]

Out[47]= avz204

In[48]:= ToString7[x_] := {Unique3[Unique["g"], 0][t_] := x;

Unique3[Unique["g"], 0] = Definition1[Unique3[Unique["g"], 0]]; StringTake[Definition1[Unique3[Unique["g"], 3]], {Flatten[StringPosition[Definition1[Unique3[Unique["g"], 4]], " := ", 1]][[–1]] + 1, –1}]}[[1]]

137

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

In[49]:= ToString7[{{c, d, "c", "d + h"}, "m", "p + d", "m/n"}] Out[49]= "{{c, d, \"c\", \"d + h\"}, \"m\", \"p + d\", \"m/n\"}" In[50]:= ToString1[{{c, d, "c", "d + h"}, "m", "p + d", "m/n"}] Out[50]= "{{c, d, \"c\", \"d + h\"}, \"m\", \"p + d\", \"m/n\"}"

Immediate application of the ToString1 procedure allows to simplify rather significantly the programming of a lot of tasks. In addition, examples of the previous fragment rather visually illustrate application of both means on the concrete example which emphases the advantages of our procedure. Whereas the ToString2 procedure expands the previous procedure onto lists of any level of nesting. So, the call ToString2[x] on an argument x, different from list is equivalent to the call ToString1[x], while on a list x is equivalent to the procedure call ToString1[x] that is endowed with the Listable attribute. The call ToString3[j] serves for converting of an expression j into the string InputForm form. The function has a number of rather useful appendices. Whereas the call ToString4[x] is analogous to the call ToString1[x] if x is a symbol, otherwise string \"(\" <> ToString1[x] <> \")\" will be returned. At last, the ToString5 procedure is a certain functional analogue of the ToString1 procedure whose source code is based on a different algorithm that does not use the file access. While the ToString6 function is a functional analogue of the ToString5 procedure but with using of the file access. Meanwhile, using a procedure whose call Unique3[Unique[x], n] returns the name of a variable unique to the current session and which was earlier generated by a Unique[x] call chain n steps before the current time (the x argument is either a letter or a string from them in string format) it is possible to program the ToString7 function in form of the list which is equivalent to the above ToString1 procedure and does not use the file access. With source codes of the above 7 tools with examples of their application the interested reader can partially familiarize above and fully in [8,10-16]. Note, that the tools StrStr, ToString1 ÷ ToString8 are rather useful enough at processing of expressions in the string format.

A number of the important problems dealing with strings processing do the SubsString procedure as a rather useful tool,

138

Mathematica: Functional and procedural programming

whose call SubsString[s, {a, b, c,…}] returns the list of substrings of a string s which are limited by substrings {a, b, c,…}, whereas the procedure call SubsString[s, {a, b, c, d, …}, p] with the third optional p argument – a pure function in short format – returns the list of substrings of the s string which are limited by substrings {a, b, c, …}, meeting the condition defined by a pure p function.

Furthermore, the procedure call SubsString[s, {a, b, c, …}, p] with the third optional p argument – any expression different from pure function – returns the list of substrings limited by substrings {a, b, c, …}, with removed prefixes and suffixes {a, b, c, d,…}[[1]] and {a, b, c, d,…}[[–1]] accordingly. In absence in the string s of at least one of substrings {a, b, c, d,…} the procedure call returns the empty list. The following fragment represents source code of the procedure with typical examples of its application.

In[80]:= SubsString[s_ /; StringQ[s], y_ /; ListQ[y], pf___] := Module[{a = "", b, c, k = 1},

If[Set[c, Length[y]] < 2, s, b = Map[ToString1, y]; While[k <= c – 1, a = a <> b[[k]] <> "~~ Shortest[__] ~~ "; k++]; a = a <> b[[–1]]; b = StringCases[s, ToExpression[a]]; If[{pf} != {} && PureFuncQ[pf], Select[b, pf], If[{pf} != {}, Map[StringTake[#, {StringLength[y[[1]]] + 1,

–StringLength[y[[–1]]] – 1}] &, b], Select[b, StringQ[#] &]]]]]

In[81]:= SubsString["adfgbffgbavzgagngbArtggbKgrg",

{"b", "g"}, StringFreeQ[#, "f"] &]

Out[81]= {"bavzg", "bArtg", "bKg"}

In[82]:= SubsString["abcxx7xxx42345abcyy7yyy42345",

{"ab", "42"}, 590]

Out[82]= {"cxx7xxx", "cyy7yyy"}

On the other hand, the SubsString1 procedure is an useful enough SubsString procedure extension, being of interest at the programming of the problems connected with processing of the strings too. The procedure call SubsString1[s, y, f, t] returns the list of substrings of a string s that are limited by the substrings of a list y; at that, if a testing pure function acts as f argument, the returned list will contain only the substrings satisfying this test. At that, at t = 1 the returned substrings are limited to ultra

139

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

substrings of the y list, whereas at t = 0 substrings are returned without the limiting ultra substrings of the y list. At that, in the presence of the 5th optional r argument – any expression – search of substrings in the s string is done from right to left that as a whole simplifies algorithms of search of the required substrings. With source code of the SubsString1 procedure and examples of its use the interested reader can familiarize in [8,9,14-16].

For operating with strings the SubsDel procedure is a quite certain interest whose call SubsDel[S,x,y,p] returns the result of removal from a string S of all sub-strings that are limited on the right (at the left) by a sub-string x and at the left (on the right) by the first met symbol in string format from the y list; in addition, search of y symbol is done to the left (p=-1) or to the right (p=1). In addition, the deleted sub-strings will contain a sub-string x since one end and the first symbol met from y since other end. Moreover, if in the course of search the symbols from the y list weren't found until end of the S string, the rest of initial S string is removed. Fragment represents source code of the procedure SubsDel along with a typical example of its application [8,16].

In[2321]:= SubsDel[S_ /; StringQ[S], x_ /; StringQ[x],

y_ /; ListQ[y] && AllTrue[Map[StringQ, y], TrueQ] && Plus[Sequences[Map[StringLength, y]]] == Length[y], p_ /; MemberQ[{–1, 1}, p]] := Module[{b, c = x, d, h = StringLength[S], k},

If[StringFreeQ[S, x], Return[S], b = StringPosition[S, x][[1]]]; For[k = If[p == 1, b[[2]] + 1, b[[1]] – 1], If[p == 1, k <= h, k >= 1], If[p == 1, k++, k––], d = StringTake[S, {k, k}];

If[MemberQ[y, d] || If[p == 1, k == 1, k == h], Break[], If[p == 1, c = c <> d, c = d <> c]; Continue[]]]; StringReplace[S, c –> ""]]

In[2322]:= SubsDel["12345avz6789", "avz", {"8", "5"}, 1]

Out[2322]= "1234589"

While the procedure call SubDelStr[x, t] provides removal from a string x of all sub–strings which are limited by numbers of the positions set by a list t of the ListList type from 2–element

140