4
$\begingroup$

I'm trying to write a code where each matrix element swaps with a randomly selected neighbor (cardinal directions only) to redistribute the matrix. So far I've been able to replace an element with its neighbor, making the elements twins, but I want to preserve the relative amount of "-1"s to "1"s. What you see below is what I have currently, which shows how I identify the neighbors of each element, and how I randomize which one switches with it. The output of this process gives me something in the form of {i,j}, which means I can't use Si[[choice]], because that would be effectively saying Si[[{i,j}]], which isn't correct syntax.

I'm pretty new to Mathematica, so any help would be greatly appreciated! :)

Input:

Si = {{-1, -1, -1}, {1, -1, -1}, {-1, 1, -1}};

Off[General::stop];

ii = 3;    
jj = 3;

For[i = 1, i <= ii, i++,
 For[j = 1, j <= jj, j++,

  choices = {{i, Mod[j - 1, ii, 1]}, {Mod[i - 1, ii, 1], j}, 
    {i, Mod[j + 1, ii, 1]}, {Mod[j - 1, ii, 1], j}};(*identifies neighbors*)

  choice = choices[[RandomInteger[{1, 4}]]]; (*randomly chooses a neighbor*)

  Si[[i, j]] = choice;(****************)

  Print[choices];
  Print[choice];
  Print[Si]
  ]
 ]

Output:

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

{3,1}

{{{3, 1}, -1, -1}, {1, -1, -1}, {-1, 1, -1}}

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

{1,2}

{{{3, 1}, {1, 2}, -1}, {1, -1, -1}, {-1, 1, -1}},

etc. and so forth.

Okay, so if I replace

Si[[i, j]] = choice;

with

Si[[i, j]] = Extract[Si, choice]; 

I can get the output to have replaced my original element, but I still don't know how to replace the neighbor with the value of the original element then.

$\endgroup$
0

3 Answers 3

5
$\begingroup$

As far as I understand the question, the main issue is how to swap 2 elements in an array. This can be done using ReplacePart. Consider for example

array = Partition[Range[10], 5]
{{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}}

and suppose you want to swap the elements at positions

pos1 = {1, 4};
pos2 = {2, 3};

then you could do something like

ReplacePart[array, Thread[{pos1, pos2} -> Extract[array, {pos2, pos1}]]]
{{1, 2, 3, 8, 5}, {6, 7, 4, 9, 10}}

As for generating the permuted matrix, instead of using For loops you could consider a more functional approach. You could for example do something like this:

Si = {{-1, -1, -1}, {1, -1, -1}, {-1, 1, -1}};
ii = 3; 
jj = 3;

swap[array_, pos1_, pos2_] := 
 ReplacePart[array, 
  Thread[{pos1, pos2} -> Extract[array, {pos2, pos1}]]]

choice[{i_, j_}] := 
 RandomChoice[{{i, Mod[j - 1, ii, 1]}, {Mod[i - 1, ii, 1], j}, {i, 
    Mod[j + 1, ii, 1]}, {Mod[i - 1, ii, 1], j}}]

newArray = Fold[swap[#1, #2, choice[#2]] &, Si, 
  Tuples[{Range[ii], Range[jj]}]]

Here, swap is a function that will swap the elements in array at positions pos1 and pos2. The function choice chooses an arbitrary neighbouring position of position {i,j}. Finally, Fold is used to apply swap to all elements of Si and the resulting matrix is assigned to newarray. If you want to save all the intermediate results, you can replace Fold with FoldList.

$\endgroup$
1
  • $\begingroup$ Thank you all so much!! @Heike had exactly what I needed. I really appreciate all the help. $\endgroup$
    – Emmie MC
    Feb 24, 2012 at 21:30
4
$\begingroup$

Not sure I understood the code, but if I got what you wanted to do, let's see if this helps.

This could be a function that switches a couple of positions in a matrix. Sequence@@ is what you were looking for when you wanted to index the matrix with a list with the coordinates

SetAttributes[switchPosTo, HoldFirst];
switchPosTo[m_, pos1_, pos2_] :=
 ({m[[Sequence @@ pos1]], m[[Sequence @@ pos2]]} = 
{m[[Sequence @@ pos2]], m[[Sequence @@ pos1]]};)

or (reminded by Heike's answer of the existence of Extract, hehe)

switchPosTo[m_, pos1_, 
  pos2_] := ({m[[Sequence @@ pos1]], m[[Sequence @@ pos2]]} = 
    Extract[m, {pos2, pos1}];)

If you don't have a particular need to make the swap in place, Heike's answer is what you need

We create a matrix to test

size = 4;
sampleMat = RandomChoice[{-1, 1}, {size, size}]

The position is selected randomly, the direction too. And we repeat this until we haven't gone beyond the limits of the matrix

While[
  pos = RandomInteger[{1, size}, 2];
  direction = 
   RandomChoice[Join[IdentityMatrix[2], -IdentityMatrix[2]]];
  ! And @@ Thread@(1 <= pos + direction <= size)];

Then it's just

switchPosTo[sampleMat , pos, pos + direction]

A way to avoid the While and be more functional and declarative could be to define a recursive function

getRandomPositionAndDirection[size_] := With[{
    pos = RandomInteger[{1, size}, 2],
    direction = 
     RandomChoice[Join[IdentityMatrix[2], -IdentityMatrix[2]]]},
   If[And @@ Thread@(1 <= pos + direction <= size), {pos, direction},
    getRandomPositionAndDirection[size]]];


{pos, direction}=getRandomPositionAndDirection[size];
switchPosTo[sampleMat, pos, direction]
$\endgroup$
3
$\begingroup$

This is another way to swap two elements of a matrix/tensor:

Mathematica graphics

Code:

{mat[[i1, j1]], mat[[i2, j2]]} = {mat[[i2, j2]], mat[[i1, j1]]}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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