KDP_book

Mathematica: Functional and procedural programming

In[7]:= Intersection2[x__List] := Module[{a = Intersection[x], b = {}}, Do[AppendTo[b, DeleteDuplicates[Flatten[Map[{a[[j]], Count[#, a[[j]]]} &, {x}]]]], {j, Length[a]}]; b]

In[8]:= Intersection2[{a + b, a, b, a + b}, {a, a + b, d, b, a + b}, {a + b, b, a, d, a + b}]

Out[8]= {{a, 1}, {b, 1}, {a + b, 2}}

In[9]:= ElemsLevelsIntersect[x_ /; ListQ[x]] :=

Module[{a = ElemsOnLevelList[x], b, c = {}, d, h = {}}, d = Length[a]; Do[Do[If[k == j, Null, If[Set[b, Intersection2[a[[k]][[2]], a[[j]][[2]]]] != {},

AppendTo[c, {{a[[k]][[1]], a[[j]][[1]]}, b}], Null]], {j, k, d}], {k, d}]; Do[AppendTo[h, {c[[j]][[1]], Map[{#[[1]], Min[#[[2 ;; –1]]]} &, c[[j]][[2]]]}], {j, Length[c]}]; h]

In[9]:= ElemsLevelsIntersect[{a, c, b, b, c, {b, b, b, c, {c, c, b, b}}}]

Out[9]= {{{1, 2}, {{b, 2}, {c, 1}}}, {{1, 3}, {{b, 2}, {c, 2}}}, {{2, 3}, {{b, 2}, {c, 1}}}}

The procedure call ToCanonicList[x] converts a list x of the ListList type whose sub-lists have form {a,hj} and/or {{a1,…,ap}, hj}, into equivalent nested classical list where a, ak are elements of list (k = 1..p) and hj – the nesting levels on which they have to be in the resultant list. The nested list with any combination of sub–lists of the above forms is allowed as the x argument. The following fragment represents source code of the ToClassicList procedure along with two typical examples of its use that well illustrates the procedure essence, and illustrates certain useful methods of procedural programming too.

In[15]:= ToCanonicList[x_ /; ListQ[x] && ListListQ[x] &&

Length[x[[1]]] == 2] := Module[{a, b, c, d, y, v, h, f, m, g = FromCharacterCode[6]}, v[t_] := Join[Map[{{#, t[[2]]}} &, t[[1]]]]; h[t_] := If[ListQ[t[[1]]], Map[{#, t[[2]]} &, t[[1]]], t];

f[t_] := Module[{n = 1}, Map[If[OddQ[n++], #, Nothing] &, t]]; y = Partition[Flatten[Join[Map[If[ListQ[#[[1]]], v[#], {#}] &, x]]], 2]; a = Sort[y, #1[[2]] <= #2[[2]] &]; a = Map[{#[[1]][[-1]], Flatten[#]} &, Gather[a, #1[[2]] == #2[[2]] &]];

a = Map[{#[[1]], Sort[f[#[[2]]]]} &, a]; m = Length[a]; d = Map[#[[1]] &, a]; d = Flatten[{d[[1]], Differences[d]}]; a = Map[{#[[1]], b = #[[2]]; AppendTo[b, g]} &, a];

221

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

c = MultiList[a[[1]][[2]], d[[1]] – 1]; Do[c = Quiet[ReplaceAll[c, g –> MultiList[a[[j]][[2]], d[[j]] – 1]]], {j, 2, m}]; ReplaceAll[c, g –> Nothing]]

In[16]:= ToCanonicList[{{a*b, 2}, {b, 2}, {{z, m, n}, 12}, {c, 4}, {d, 4}, {{n, y, w, z}, 5}, {b, 2}, {m*x, 5}, {n, 5}, {t, 7}, {g, 7}, {x, 12}, {y, 12}}]

Out[16]= {{b, b, a*b, {{c, d, {n, n, w, m*x, y, z, {{g, t,

{{{{{m, n, x, y, z}}}}}}}}}}}}

In[17]:= ToCanonicList[{{a, 1}, {b, 2}, {c, 3}, {d, 4}, {g, 5}, {h, 6}}]

Out[17]= {a, {b, {c, {d, {g, {h}}}}}}

Another approach to processing of the nested lists is the procedure whose call ToCanonicalList[x] returns the result of converting of a list x to the canonical form. The fragment below represents source code of the procedure with an example of its application. Its algorithm along with above procedure contains certain useful programming methods of the nested lists.

In[78]:= ToCanonicalList[x_ /; ListQ[x]] :=

Module[{a = ElemsOnLevels2[x], b, c, d, p = 0, j}, b = Reverse[Sort[DeleteDuplicates[Map[#[[2]] &, a]]]]; c = StringRepeat["{", b[[1]]] <> StringRepeat["}", b[[1]]]; d = Map[ToString1, Table[Map[If[#[[2]] == j,

#[[1]], Nothing] &, a], {j, b}]]; d = Map[StringTake[#, {1, –2}] <>

If[p++ == 0, ", Nothing", ","] &, d]; ToExpression[StringReplacePart[c, d, Map[{#, #} &, b]]]]

In[79]:= p = {{a, b, {c, d, {m, g, {m, n}, u, n}, m, h}, x, y, z}}; In[80]:= ToCanonicalList[p]

Out[80]= {{a, b, x, y, z, {c, d, m, h, {m, g, u, n, {m, n}}}}}

A useful addition to the built-in Level function is procedure whose call DispLevels[x] returns the list of ListList type from 2– element sub-lists whose the first element defines the level of the x list, while the second element determines the level itself of the x list. The following fragment represents the source code of the DispLevels procedure with some examples of its application.

In[29]:= DispLevels[x_List] := Module[{a = {{1, x}}, b = x, k = 2}, Do[b = Level[b, {1}]; b = Flatten[Map[If[! ListQ[#], Nothing, #] &, b], 1]; AppendTo[a, {k++, b}], MaxLevel[x] – 2]; a]

In[30]:= DispLevels[{a, b, c, {m, {h, g}}, m}]

Out[30]= {{1, {a, b, c, {m, {h, g}}, m}}, {2, {m, {h, g}}}, {3, {h, g}}}

222

Mathematica: Functional and procedural programming

Using the DispLevels procedure, it is easy to obtain function whose call ReplaceLL[x, n, y] returns the result of replacing the n–th level of a list x with an expression y, whereas at using the word "Nothing" instead of y removes the n–th level of the x list. The function processes the erroneous situation associated with an incorrect list nesting level with output of the corresponding message. The fragment below represents the source code of the ReplaceLL function with examples of its typical application.

In[27]:= ReplaceLL[x_ /; ListQ[x], n_Integer, y_] :=

If[0 < n && n <= MaxLevel[x], ReplaceAll[x, DispLevels[x][[n]][[2]] –> y], Print["Level " <> ToString[n] <> " is invalid"]]

In[28]:= g := {{a, b}, c, d, {{{m, {p, t}, n}}}, x, y}

In[29]:= ReplaceLL[g, 4, {a, b}]

Out[29]= {{a, b}, c, d, {{{a, b}}}, x, y}

In[30]:= ReplaceLL[g, 5, {a, b}]

Out[30]= {{a, b}, c, d, {{{m, {a, b}, n}}}, x, y}

In[31]:= ReplaceLL[g, 5, Nothing]

Out[31]= {{a, b}, c, d, {{{m, n}}}, x, y}

In[32]:= ReplaceLL[g, 7, Nothing]

Level 7 is invalid

A natural extension of the previous ReplaceLL function is the InsDelRepList procedure, that allows to remove elements, replace, and insert an element at a set nesting level and in a set position of the specified nested level of a list. The InsDelRepList procedure calls define the following:

InsDelRepList[x, n, m, "Del"] – returns the result of deleting of the m–th element at the n–th nesting level of a list x;

InsDelRepList[x, n, m, "Ins", y] – returns the result of inserting of an expression y into m–th position at the n–th nesting level of a list x; at the same time, if m<0 then the inserting is done to the beginning of the x list, whereas at m > length of a nesting level n the inserting is done into the end of the level n;

InsDelRepList[x,n,m,"Rep", y] – returns the result of replacing of an element at m–th position at the n–th nesting level of a list x with an expression y. The procedure processes the erroneous situation that is associated with the inadmissible nesting level with return $Failed

223

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

and printing of the corresponding message. The fragment represents the source code of the procedure with examples of its application.

In[1942]:= InsDelRepList[x_ /; ListQ[x], n_Integer, m_Integer, h_ /; MemberQ[{"Ins", "Del", "Rep"}, h], y___] :=

Module[{a = DispLevels[x], b, c, d},

If[n <= 0 || n > MaxLevel[x], Print["Level " <> ToString[n] <> " is invalid"]; $Failed, b = a[[n]][[2]]; d = ToString[m] <> "–th element is lack"; If[h === "Del", If[Length[b] < m, Print[d]; $Failed, ReplaceAll[x, b –> Delete[b, m]]], If[h === "Rep", If[Length[b] < m, Print[d]; $Failed,

ReplaceAll[x, b –> ListAssign2[b, m, y]]], If[m < 1, c = Prepend[b, y], If[m > Length[b], c = Append[b, y], c = Insert[b, y, m]]]; ReplaceAll[x, b –> c]]]]]

In[1943]:= g47 := {{a, b}, c, d, {{{m, {p, t}, n}}}, x, y, z} In[1944]:= InsDelRepList[g47, 5, 1, "Del"]

Out[1944]= {{a, b}, c, d, {{{m, {t}, n}}}, x, y, z} In[1945]:= InsDelRepList[g47, 5, 2, "Ins", agn]

Out[1945]= {{a, b}, c, d, {{{m, {p, agn, t}, n}}}, x, y, z} In[1946]:= InsDelRepList[g47, 5, 2, "Rep", avz]

Out[1946]= {{a, b}, c, d, {{{m, {p, avz}, n}}}, x, y, z} In[1947]:= InsDelRepList[g47, 7, 2, "Rep", avz]

Level 7 is invalid Out[1947]= $Failed

In[1948]:= InsDelRepList[g47, 5, 0, "Ins", avz]

Out[1948]= {{a, b}, c, d, {{{m, {avz, p, t}, n}}}, x, y, z}

Due to the canonical representation of lists, the procedure ExchangeLevels is of a certain interest [8,16], returning a list in canonical form on condition of exchange of its nesting levels. At that, the procedure below is an useful version of the above tool.

In[47]:= ExchangeLevels1[x_ /; ListQ[x], i_Integer, j_Integer] := Module[{a = DispLevels[x]}, If[MemberQ[Map[(# <= 0||# > MaxLevel[x]) &, {i, j}], True],

Print["Levels " <> ToString[{i, j}] <> " are invalid"]; $Failed,

ReplaceAll[ReplaceAll[x, a[[i]][[2]] –> a[[j]][[2]]], a[[j]][[2]] –> a[[i]][[2]]]]]

In[48]:= ExchangeLevels1[g47, 2, 5]

Out[48]= {{a, b}, c, d, {{{m, {a, b, {{m, {p, t}, n}}}, n}}}, x, y, z}

224

Mathematica: Functional and procedural programming

The procedure call ExchangeLevels1[x,i,j] returns the result of exchange of the nesting levels i and j of a nested list x. A quite naturally there is the problem of exchange of the nesting levels of 2 various lists that is solved by means of the ListsExchLevels procedure. Using the method on which the last procedures are based, it is simple to program the means focused on the typical manipulations with the nested lists, in particular, removing and adding of the nesting levels. On the basis of the method used in the last procedures it is possible to do different manipulations with the nested lists including also their subsequent converting in lists of the canonical form [8-10,16]. For example, it is easy to program a function whose call PosElemOnLevel[x, n, y] returns positions of an element y on the n–th nesting level of a nested x list. The function processes the erroneous situation, associated with the inadmissible nesting level with return $Failed and print of the corresponding message. Fragment below represents the source code of the function with examples of its application.

In[3342]:= PosElemOnLevel[x_ /; ListQ[x], n_Integer, y_] :=

If[n <= 0 || n > MaxLevel[x], Print["Level " <> ToString[n] <> " is invalid"]; $Failed, Flatten[Position[DispLevels[x][[n]][[2]], y]]]

In[3343]:= g47 := {{a, b}, c, d, {{{m, {g, t, h, g, t, g}, n}}}, x, y, z, q} In[3344]:= PosElemOnLevel[g47, 5, g]

Out[3344]= {1, 4, 6}

In[3345]:= PosElemOnLevel[g47, 7, g]

Level 7 is invalid Out[3345]= $Failed

In[3346]:= NumberOnLevels[x_ /; ListQ[x]] :=

Map[{#[[1]], Map[#[[1]] &, Length[#[[2]]]]} &, DispLevels[x]]

In[3347]:= NumberOnLevels[g47]

Out[3347]= {{1, 8}, {2, 3}, {3, 1}, {4, 3}, {5, 6}}

That fragment is ended with a simple function whose call NumberOnLevels[x] returns the list of ListList type whose first sub-lists elements define the nesting levels of a list x, while the second elements define the number of elements at each of these nesting levels. Means are of interest when working with lists.

225

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

The following procedure provides the sorting of elements of a list that are located on the set nesting level. The procedure call SortListOnLevel[x,n,y] returns the result of sorting of elements of a list x on its nesting level n according to an ordering function y (an optional argument); in the absence of y argument by default the sorting according in the standard order is done.

In[7]:= SortListOnLevel[x_ /; ListQ[x], n_Integer, y___] := Module[{a = DispLevels[x]},

If[MemberQ[Map[(# <= 0 || # > MaxLevel[x]) &, {n}], True],

Print["Level " <> ToString[n] <> " is invalid"]; $Failed, ReplaceAll[x, a[[n]][[2]] –> Sort[a[[n]][[2]], y]]]]

In[8]:= SortListOnLevel[g47, 5, ToCharacterCode[ToString[#1]][[1]] >

ToCharacterCode[ToString[#2]][[1]] &]

Out[8]= {{a, b}, c, d, {{{m, {t, t, h, g, g, g}, n}}}, x, y, z, q}

Unlike the standard functions Split, SplitBy the procedure call Split1[x, y] splits a list x on sub-lists consisting of elements that are located between occurrences of an element or elements of list y. If y elements don't belong to the x list, the initial x list is returned. The following fragment represents source code of the Split1 procedure with the typical example of its application.

In[7]:= Split1[x_ /; ListQ[x], y_] := Module[{a, b, c = {}, d, h, k = 1},

If[MemberQ3[x, y] || MemberQ[x, y], a = If[ListQ[y], Sort[Flatten[Map[Position[x, #] &, y]]], Flatten[Position[x, y]]]; h = a; If[a[[1]] != 1, PrependTo[a, 1]]; If[a[[–1]] != Length[x], AppendTo[a, Length[x]]]; d = Length[a]; While[k <= d – 1, AppendTo[c, x[[a[[k]] ;; If[k == d – 1, a[[k + 1]], a[[k + 1]] – 1]]]]; k++]; If[h[[–1]] == Length[x], AppendTo[c, {x[[–1]]}]]; c, x]]

In[8]:= Split1[{a, b, a, b, c, d, a, b, a, b, c, d, a, b, d}, {a, c, d}]

Out[8]= {{a, b}, {a, b}, {c}, {d}, {a, b}, {a, b}, {c}, {d}, {a, b, d}, {d}}

At operating with the nested lists, a procedure whose call Lie[w] returns the result of converting of a source list w into a structurally similar list whose elements are in the string format and have length equal to the maximum length of all elements in the w list at all its nesting levels is of a certain interest. The following fragment represents the source code of the procedure with an example of its typical application.

226

Mathematica: Functional and procedural programming

In[369]:= Lie[x_ /; ListQ[x]] := Module[{a, b = Flatten[x], c, d, f},

SetAttributes[ToString1, Listable]; a = ToString1[b]; c = StringLength[a[[1]]]; Map[If[c < Set[d, StringLength[#]], c = d, 7] &, a];

f[t_, s_] := ToString1[t] <> StringRepeat[" ", s – StringLength[ToString1[t]]]; SetAttributes[f, Listable]; ClearAttributes[ToString1, Listable]; f[x, c]]

In[370]:= t := {{m, bbbb, g}, {{{n, m, ddd}}}, n, mmmmmm}; Lie[t]

Out[370]= {{"m ", "bbbb ", "g "}, {{{"n ", "m ", "ddd "}}}, "n ", "mmmmmm"}

Using the Lie procedure, in particular, it is possible to easily program a procedure whose call ContinuousSL[x, y] returns the result of a сontinuous sort of all the elements of the nested list x

(i.e. ignoring its nesting levels) with retention its internal structure. The sorting is done either by accepted conventions for the Sort function or on a basis of the optional y argument defining the ordering function. The following fragment represents the source code of the ContinuousSL procedure with examples of its use.

In[2430]:= ContinuousSL[x_ /; ListQ[x], y___] :=

Module[{a = ToString1[Lie[x]], b, c = {}, d}, b = StringLength[a]; Do[d = StringTake[a, {j}]; If[MemberQ[{"{", "}"}, d], AppendTo[c, {d, j}], 7], {j, b}]; d = ToString1[Lie[Sort[Flatten[x], y]]];

Do[d = StringInsert[d, c[[j]][[1]], c[[j]][[2]] + 1], {j, 1, Length[c]}];

Map[ToExpression, ToExpression[d]][[1]]]

In[2431]:= g47 := {{7, 122}, 14, 8, {{{500, {0, 90}, 6}}}, {47, 77, 42}} In[2432]:= ContinuousSL[g47, #1 > #2 &]

Out[2432]= {{500, 122}, 90, 77, {{{47, {42, 14}, 8}}}, {7, 6, 0}} In[2433]:= L = {c, 5, 9, {{sv}, {34}, {{agn, {{{500}}}, b, {{{90}}}}}}, a};

In[2434]:= ContinuousSL[L]

Out[2434]= {5, 9, 34, {{90}, {500}, {{a, {{{agn}}}, b, {{{c}}}}}}, sv}

The technique used in the continuous sorting algorithm of nested lists can be a rather useful in solving other types of work with nested lists. This is especially true for problems involving different permutations of elements of a file Flatten[x] with next restoring the internal structure of the nested x list. At the same time, it should be borne in mind that such technique implies the

227

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

standartization of list elements along the length of their elements having a maximum length. As that is done in the ContinuousSL procedure by means of use the Lie procedure.

In a number of problems of processing of simple x lists on which the call SimpleListQ[x] returns True, the next procedure is of a certain interest. The procedure call ClusterList[x] returns the nested list of ListList type whose 2–element sub-lists by the first element determine element of the simple nonempty x list whereas by the second element define its sequential number in a cluster of identical elements to which this element belongs. In the following fragment source code of the ClusterList procedure with some typical examples of its application are represented.

In[2273]:= ClusterList[x_ /; x != {} && SimpleListQ[x]] := Module[{a = {}, b = {}, c = Join[x, {x[[–1]]}], d = Map[{#, 1} &,

DeleteDuplicates[x]], n},

Do[n = d[[Flatten[Position[d, Flatten[Select[d, #[[1]] == c[[j]] &]]]][[1]]]][[2]]++; Flatten[Select[d, #[[1]] == c[[j]] &]][[2]];

If[c[[j]] === c[[j + 1]], AppendTo[a, {c[[j]], n}], AppendTo[b, a]; AppendTo[b, {c[[j]], n}]; a = {}], {j, 1, Length[c] – 1}]; AppendTo[b, a]; b = ToString1[Select[b, # != {} &]]; b = If[SuffPref[b, "{{{", 1], b, "{" <> b];

b = ToExpression[StringReplace[b, {"{{" –> "{", "}}" –> "}"}]]]

In[2274]:= ClusterList[{1, 1, 1, 3, 3, 3, 4, 4, 5, 5, 5, 4, 1, 1, 1}]

Out[2274]= {{1, 1}, {1, 2}, {1, 3}, {3, 1}, {3, 2}, {3, 3}, {4, 1},

{4, 2}, {5, 1}, {5, 2}, {5, 3}, {4, 3}, {1, 4}, {1, 5}, {1, 6}} In[2275]:= ClusterList[{1, 1, 1, 3, 3, t + p, 3, 4, 4, 5, a, 5, 5, 4,

1, 1, a, 1, (a + b) + c^c}]

Out[2275]= {{1, 1}, {1, 2}, {1, 3}, {3, 1}, {3, 2}, {p + t, 1}, {3, 3}, {4, 1}, {4, 2}, {5, 1}, {a, 1}, {5, 2}, {5, 3}, {4, 3}, {1, 4}, {1, 5}, {a, 2}, {1, 6}, {a + b + c^c, 1}}

In[2276]:= ClusterList[{6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6}]

Out[2276]= {{6, 1}, {6, 2}, {6, 3}, {6, 4}, {6, 5}, {6, 6}, {6, 7}, {6, 8}, {6, 9}, {6, 10}, {6, 11}, {6, 12}}

In[2277]:= ClusterList[{1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4}]

Out[2277]= {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}, {4, 1}, {4, 2}, {4, 3}}

228

Mathematica: Functional and procedural programming

In order to simplify of algorithm of a number of tools that are oriented on solving of processing of the contents of the user packages, in particular, the SubListsMin procedure can be a rather useful used, and also for lists processing as a whole. The call SubListsMin[L, x, y, t] returns the sub-lists of a list L which are limited by {x, y} elements and have the minimum length; at t = "r" selection is executed from left to right, and at t = "l" from right to left. While the procedure call SubListsMin[L, x, y, t, z] with optional fifth z argument – an arbitrary expression – returns sublists without the limiting {x, y} elements. The next fragment presents source code of the procedure and examples of its use.

In[1242]:= SubListsMin[L_ /; ListQ[L], x_, y_,

t_ /; MemberQ[{"r", "l"}, t], z___] := Module[{a, b, c, d = {}, k = 1, j}, {a, b} = Map[Flatten, Map3[Position, L, {x, y}]];

If[a == {} || b == {} || a == {} && b == {} || L == {}, {}, b = Select[Map[If[If[t == "r", Greater, Less][#, a[[1]]], #] &, b], ! SameQ[#, Null] &]; For[k, k <= Length[a], k++, j = 1; While[j <= Length[b],

If[If[t == "r", Greater, Less][b[[j]], a[[k]]], AppendTo[d, If[t == "r", a[[k]] ;; b[[j]], b[[j]] ;; a[[k]]]]; Break[]]; j++]]; d = Sort[d, Part[#1, 2] – Part[#1, 1] <= Part[#2, 2] – Part[#2, 1] &];

d = Select[d, Part[#, 2] – Part[#, 1] == Part[d[[1]], 2] – Part[d[[1]], 1] &]; d = Map[L[[#]] &, d]; d = If[{z} != {}, Map[#[[2 ;; –2]] &, d], d];

If[Length[d] == 1, Flatten[d], d]]]

In[1243]:= SubListsMin[{a, b, a, c, d, q, v, d, w, j, k, d, h, f, d, h}, a, h, "r", 90]

Out[1243]= {c, d, q, v, d, w, j, k, d}

A useful addition to built-in functions Replace, ReplaceList and our tools ReplaceList1, ReplaceList2, ReplaceListCond, is a procedure whose call RepInsList[I, x, y, z, n, r] returns the result as follows, namely:

At I = "Ins" the result is inserting of an argument z (may be a list or nested list) before (r = "l") or after (r = "r") of occurrences of a sub–list y into a list x; whereas at argument I = "Rep" the result is replacement in a list x of occurrences of a sub–list y on argument z (may be a list or nested list); at that, if n is an integer,

229

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

then n first replacements in the x are done, if n is Infinity, then replacements in the list x of all occurrences of a sub–list y onto argument z are done; at last, if n – an integer list then it defines sequentional numbers of the occurrences of y in the list x that are exposed to the above replacements. What is said about the argument n also fully applies to the call mode at I = "Rep". The procedure call on unacceptable arguments returns $Failed with appropriate diagnostic messages or is returned unevaluated. The following fragment represents the source code of the RepInsList procedure with some examples of its typical application.

In[25]:= RepInsList[I_ /; MemberQ[{"Rep", "Ins"}, I],

x_ /; ListQ[x], y_ /; ListQ[y], z_, n_, r___] := Module[{a, b, c, d, t}, {a, b, c} = Map[StringTake[ToString1[#], {2, –2}] &,

{x, y, If[ListQ[z], z, {z}]}]; If[I == "Ins", If[{r} != {}, If[r === "l", c = c <> "," <> b,

If[r === "r", c = b <> "," <> c, Return[Print["Sixth optional argument should be \"r\" or \"l\""]; $Failed]]]]; If[IntegerQ[n] || n === Infinity, t = StringReplace[a, b –> c, n], If[PosIntListQ[n] === True, t = StringSplit2[a, b]; d = Length[t]; t = StringJoin[Map[If[MemberQ[n, #], StringReplace[t[[#]], b –> c], t[[#]]] &, Range[1, d]]],

Return[Print["Fourth argument n should be an integer, integer list or Infinity"]; $Failed]]], If[IntegerQ[n] || n === Infinity, t = StringReplace[a, b –> c, n],

If[PosIntListQ[n] === True, t = StringSplit2[a, b]; d = Length[t]; t = StringJoin[Map[If[MemberQ[n, #], StringReplace[t[[#]], b –> c], t[[#]]] &, Range[1, d]]],

Return[Print["Fourth argument n should be an integer, integer list or Infinity"]; $Failed]]]]; ToExpression["{" <> t <> "}"]]

In[22]:= x:= {a, b, c, 1, 2, a, b, c, 3, a, b, c, 4, 5, 6, a, b, c, h, a, b, c, g}; y:= {a, b, c}; z:= {m, n, p};

In[27]:= RepInsList["Rep", x, y, z, {1, 3}]

Out[27]= {m, n, p, 1, 2, a, b, c, 3, m, n, p, 4, 5, 6, a, b, c, h, a, b, c, g} In[28]:= RepInsList["Rep", {aa, bb, aa, cc}, {aa}, {{m, n}}, {2}]

Out[28]= {aa, bb, {m, n}, cc}

In[30]:= RepInsList["Rep", x, y, G + S, 3]

Out[30]= {G + S, 1, 2, G + S, 3, G + S, 4, 5, 6, a, b, c, h, a, b, c, g}

230