Mathematica Not Saving Variable

问题

I try to perform this nested loop but it is not working. It's not saving the result in each stage. But if I replace listInitial with Print[ ] I observer that all changes are made.

Any suggestions??

For[b = 1, b < 4, b = b + 1,
 For[a = 1, a < 4, a = a + 1,
  For[x = 1, x < 4, x = x + 1,
   For[z = 1, z < 4, z = z + 1, listInitial = 
    If[Random[] > psurvival, 
      ReplacePart[
       InitialMatrix[3, 3, 3, 3], {b, a, x, z} -> 
        InitialMatrix[3, 3, 3, 3][[b]][[a]][[x]][[z]] - 1], 
      InitialMatrix[3, 3, 3, 3], {b, a, x, z} -> 
       InitialMatrix[3, 3, 3, 3][[b]][[a]][[x]][[z]]]]]]]

listInitial // TableForm

回答1:

I think your problem is that you expect ReplacePart to change InitialMatrix. It does not. It does change a nameless copy of InitialMatrix and returns this as a result, which is then assigned to listInitial. The latter is overwritten with a new value every loop iteration, so in the end it only contains the result of the last replacement. With all variables equal to 3 at that point, the last replacement looks like:

InitialMatrix[3, 3, 3, 3], {3, 3, 3, 3}->InitialMatrix[3, 3, 3, 3][[3]][[3]][[3]][[3]]]

which effectively doesn't do anything. The end result is listInitial containing what you started with.

Edit
I just spotted that the second argument of your If statement clearly is formatted for a second instance of ReplacePart, which is missing here,

回答2:

I question whether you need a four-fold nested For loop at all. If I understand your code correctly, you have a 3*3*3*3 tensor, and you want to decrement the initial value of each element by 1 if some random number is above some threshold. I am assuming that InitialMatrix is a function you have already properly defined, rather than being some object.

Surely this will work:

InitialMatrix[3,3,3,3] + Table[If[RandomReal[]>psurvival,-1,0],{3},{3},{3},{3} ]

In version 8, you can replace the Table function with

-RandomVariate[BernoulliDistribution[1-psurvival], {3,3,3,3}]

If the tensor is always n*n*n*n, then you could write a little function:

decrementInitial[n_Integer?Positive,p_?Positive]/; p<=1. :=
InitialMatrix[n,n,n,n] + Table[If[RandomReal[]>p,-1,0],{n},{n},{n},{n} ]

If you are wanting to rewrite the initial matrix because you are wanting to iterate the survival function in a number of steps, then something like this using a pure function would be suitable (for version 8).

survivalFn[n_Integer?Positive,p_?Positive,steps_Integer?Positive]/; p<=1. :=
Nest[# + RandomVariate[BernoulliDistribution[1-p], {n,n,n,n}]& , 
InitialMatrix[n,n,n,n], steps]

Or for versions prior to 8:

survivalFn[n_Integer?Positive,p_?Positive,steps_Integer?Positive]/; p<=1. :=
Nest[# - Table[If[RandomReal[]>p,-1,0],{n},{n},{n},{n} ]& , 
InitialMatrix[n,n,n,n], steps]

Something about the way you asked the question suggested to me that this was what you were trying to do ultimately.

Additional material on request from user825366

I'm not sure exactly what you want to know about the function but let's go through a few things. First the BernoulliDistribution function. The documentation says:

Bernoulli distribution gives value x=1 with probability p, and x=0 with probability 1-p.

You want 0 with probability psurvival and -1 with probability 1-psurvival, so essentially you have -BernoulliDistribution[1-psurvival].

Next, the Nest function (see documentation). That takes some function, applies it to the starting value (in this case InitialMatrix[3,3,3,3]), then applies it again to whatever the result from that first iteration was, and iterates for the appropriate number of steps.

Within the definition of the function to be Nested, it is common to use pure functions. You should read this guide in the documentation, and this one too.

I hope that helps.

回答3:

I think you need to assign the result to initialMatrix to see the result of the ReplacePart, as in

In[27]:= A={1 ,2 };
A=ReplacePart[A,1->99];
A

Out[29]= {99,2}

回答4:

Thanks guys. I found this solution: I think it's the easier one and it's working.

SetAttributes[myFunction, Listable]
myFunction[x_] := 
 If[Random[] > psurvival, If [x - 1 < 0 , x , x - 1], x]
 myFunction[InitialMatrix[3, 3, 3, 3]] // TableForm

回答5:

I used this method to solve this

InitialTable[x_, y_, z_, w_] := 

  MapAt[g, 
   ReplacePart[
    InitialMatrix[x, y, z, w] + 
     ReplacePart[
      Table[If[RandomReal[] > psurvival2, -1, 0], {x}, {y}, {z}, {w}], 
     {{_, _, 1, _} -> 0, {_, _, 2, _} -> 0}],  
   {{_, _, 1, 2} -> 0, {_, _, 1, 3} -> 0}], 
  Flatten[Table[{i, j, k, l}, {i, x}, {j, y}, {k, z}, {l, w}], 3]];

g[x_] := If[x < 0, 0, x];

来源：https://stackoverflow.com/questions/6542038/mathematica-not-saving-variable

标签

wolfram-mathematica

mathematical-optimization