Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I am very new to Mathematica. I have code written using for loops. I want to rewrite it using Map/Thread but I am not sure how to do it.

My code takes the set A, say

A = {{1, 2, 3, 1, 2, 3}, {1, 1, 2, 2, 3, 3}}

Then it insert a arbitrary character(say $a$) to every possible positions of given element in the set A. So we get

{{a, 1, 2, 3, 1, 2, 3}, {1, a, 2, 3, 1, 2, 3}, ..., 
 {a, 1, 1, 2, 2, 3, 3}, ..., {1, 1, 2, 2, 3, 3, a}}

Then it inserts the same character again into resulting elements in following manner

{{a, a, 1, 2, 3, 1, 2, 3}, {a, 1, a, 2, 3, 1, 2, 3}, 
 {a, 1, 2, a, 3, 1, 2, 3}, ...., {1, 1 , 2, 2, 3, 3, a}}

This question come from Knot Theory-Chord Diagram

My program using for loops is follows.

A = {{1, 2, 3, 1, 2, 3}, {1, 1, 2, 2, 3, 3}};
kk = Length[A[[1]]]/2 + 1;

B = {};

For[m = 1, m < Length[A] + 1, m++,
  Diag1 = A[[m]];
  For[j = 1, j < (2*kk), j++,
    Diag2 = Insert[Diag1, "a", j]; 
    For[i = 1 + j, i < (2*kk) + 1, i++,
      Diag3 = Insert[Diag2, "a", i];
      B = AppendTo[B, Diag3];
    ];
  ];
];

This is what I tried to do with element 2.

f[x_] := Insert[A[[2]], "a", x];
B = Map[f, Range[7]]];

But I don't know how to put variable A[[i]] instead of A[[2]] and also how to insert other end of $a$ to this result using map.

Any comment really appreciated.

share|improve this question
1  
You might find ReplaceList useful: ReplaceList[ {1, 2, 3, 1, 2, 3}, {x___, y___} :> {x, a, y}] –  ssch Sep 15 '13 at 22:54
    
Hi I modify my code to follows f[i_] := ReplaceList[A[[i]], {x___, y___} :> {x, a, y}]; B = Flatten[Map[f, Range[2]], 1]; Now I am not sure how to use ReplaceList to insert second end of "a". How do you use conditional if in ReplaceList? because say I have {1,a,2,3,1,2,3}. I don't want to insert second "a", in front of first "a". I want to insert second "a", all available position after first "a". –  Vajira Sep 15 '13 at 23:39
    
@ssch Darn, I just took time to build a solution using ReplaceList only to see you got there an hour before me. I'm still going to post an answer since you did not. –  Mr.Wizard Sep 16 '13 at 0:43
add comment

4 Answers 4

up vote 8 down vote accepted

There is a rule/replacement based method using ReplaceList and BlankNullSequence that I think is elegant and easy to understand.

ReplaceList[{1, 2, 3}, {a___, b___} :> {a, x, b}]
{{x, 1, 2, 3}, {1, x, 2, 3}, {1, 2, x, 3}, {1, 2, 3, x}}
ReplaceList[{1, 2, 3}, {a___, b___, c___} :> {a, x, b, x, c}]
{{x, x, 1, 2, 3}, {x, 1, x, 2, 3}, {x, 1, 2, x, 3}, {x, 1, 2, 3, x}, {1, x, x, 2, 3},
 {1, x, 2, x, 3}, {1, x, 2, 3, x}, {1, 2, x, x, 3}, {1, 2, x, 3, x}, {1, 2, 3, x, x}}

The only difficulty is extending this to an arbitrary number of insertions. For that we need meta-programming, that is code that generates code:

sprinkle[v_List, x_, n_Integer?Positive] :=
  Table[Unique["a", Temporary], {n + 1}] /. syms_ :>
    ReplaceList[v, Pattern[#, ___] & /@ syms -> Riffle[syms, x]]

Now:

sprinkle[{1, 2, 3}, x, 4]
{{x, x, x, x, 1, 2, 3}, {x, x, x, 1, x, 2, 3}, {x, x, x, 1, 2, x, 3}, ... }

Your original example may be had with:

A = {{1, 2, 3, 1, 2, 3}, {1, 1, 2, 2, 3, 3}};
Join @@ (sprinkle[#, a, 2] & /@ A)

You can leave off the Join @@ if you want two sets of sublists; I could not tell form your question if that was desired.

Note: using a capital letter to start a user Symbol name is often a bad idea as these may conflict with internal functions – I preserved your original name for clarity alone.

share|improve this answer
    
Hi, Mr.Wizard Thanks for the post. This is great. Especially code for arbitrary number of insertions. Thank You. –  Vajira Sep 16 '13 at 2:18
    
@Vajira You're welcome. Thanks for the Accept. However, I recommend all users wait 24 hours before Accepting to give everyone around the world a chance to respond. You may like another answer better if you give it time to happen. :-) –  Mr.Wizard Sep 16 '13 at 2:21
    
Now I'd like to ask past Rojo why he expected ReplaceList to return some redundant solutions –  Rojo Sep 16 '13 at 5:33
    
Ahh, it must be because he made a mistake when using Subsets (forgot to add 2) and yet trusted that more than ReplaceList. When lengths differed, he assumed. +1 –  Rojo Sep 16 '13 at 5:35
add comment

One approach is to first define a function that does all the insertions in a single list, starting from the nth position:

insert[z_, n_] := Insert[z, a, #] & /@ Drop[Range[Length[z]], n]

So for instance, with

x = {{1, 2, 3, 1, 2, 3}, {1, 1, 2, 2, 3, 3}};

we can apply insert to the first element of x by

insert[x[[1]], 0] to give

{{a, 1, 2, 3, 1, 2, 3}, {1, a, 2, 3, 1, 2, 3}, {1, 2, a, 3, 1, 2, 3}, 
 {1, 2, 3, a, 1, 2, 3}, {1, 2, 3, 1, a, 2, 3}, {1, 2, 3, 1, 2, a, 3}}

A second application of insert places a second a in each element:

insert[#, 1] & /@ insert[x[[1]], 0]

{{{a, a, 1, 2, 3, 1, 2, 3}, {a, 1, a, 2, 3, 1, 2, 3}, {a, 1, 2, a, 3, 1, 2, 3}, 
  {a, 1, 2, 3, a, 1, 2, 3}, {a, 1, 2, 3, 1, a, 2, 3}, {a, 1, 2, 3, 1, 2, a, 3}},...

as requested.

share|improve this answer
add comment

Just to be different

list = {1, 2, 3, 1, 2, 3};
m = Length[list];
n = 2;

Module[{k = 0, b},
 Permutations[ConstantArray[a, n]~Join~ConstantArray[b, m]] /. 
  b :> list[[1 + Mod[k++, m]]]]
{{a, a, 1, 2, 3, 1, 2, 3}, {a, 1, a, 2, 3, 1, 2, 3}, ..., {1, 2, 3, 1, 2, 3, a, a}}
share|improve this answer
    
I am a fan of your methods but I can't support this one: it will scale very poorly with the length of list. (ps you should include b in the Module declaration.) –  Mr.Wizard Sep 16 '13 at 1:35
add comment

This only addresses the first step. I am little confused about the second step as the last element of the result of the second step only has one a.

fun[u_] :=
 Module[{lg},
  lg = Length[u];
  MapIndexed[RotateRight[#1, First@#2 - 1] &, 
   Prepend[#, a] & /@ NestList[RotateLeft[#] &, u, lg]]]
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.