Change two different parts in a table according to the same random value

问题

I am trying to change 2 different rows in my table according to one random variable each time, For example I want if a random number>0.5 then to change one row with the value in it +1 and the other row with its value -1, otherwise do nothing. I tried the following code but I am confused, Can anyone please help me?

InitialMatrix[3, 3, 3, 3] + 
  MapAt[f, MapAt[g, Table[0, {3}, {3}, {3}, {3}],

    Flatten[Table[{i, j, 1, k}, {i, 3}, {j, 3}, {k, 3}], 2]], 
   Flatten[Table[{i, j, 2, k}, {i, 3}, {j, 3}, {k, 3}], 2]] // TableForm

f[x_] := If[RandomReal[] > 0.5, g[x] = If[x > 0, x - 1, x]; 
  If[g[x] > 0, x + 1, x], x]

Thank you very much!!

Edit: Changed requirements

I have a four dimensional table and I want to change the values in it with respect to each other.

My table is

InitialMatrix[x_, y_, age_, disease_] :=

  ReplacePart[ Table[Floor[Divide[dogpopulation/cellsno,  9]], 
    {x}, {y}, {age},  {disease}], {{_, _, 1, _} ->   0, {_, _, 3, _} -> 6}];

I am trying to change the first 2 rows in each subtmatrix according to one random variable each time.

For example I want if a random number>0.4 then to change the first element in the first row with its value +1 and the first element of the second row with its value minus 1 otherwise leave the value as it is.

I want to check every element in the first row with a different random number and if the condition is true then to change both 1 and second row. Can I do something like that?

回答1:

This answer has the "I did it at work without Mathematica to check my syntax" advisory on it

@belisarius' answer works perfectly well, is more elegant, and is almost certainly more efficient than mine. But you might find an alternative that is easier for you to understand using the ArrayFlatten command (documentation) or the Join command (documentation).

The first option assumes you want something like what the CODE in your question asks for, rather than what is stated in the text. You would then use something like:

nonisFunction[mylist_List,firstrowsub_?VectorQ, 
secondrowsub_?VectorQ,cutoff_Real]/; Length[Dimensions[mylist]]==4  :=
Table[
If[RandomReal[]>cutoff, 
    Join[{firstrowsub},{secondrowsub},Drop[mylist[[i,j]],2] ],
    mylist[[i,j]] ], 
    {i,Dimensions[mylist][[1]]}, {j,Dimensions[mylist][[2]]} ]

This effectively takes each submatrix and stitches it back together again, substiting each time the two rows to be substituted if the cutoff if exceeded, but leaving the submatrix alone if it is not.

If what you want is to increment and decrement the two rows (ie your text question rather than the code you provided), then a similar solution would simply need addition, not Join. Because Plus is Listable, it should thread the vector to be added over the rows of each submatrix.

nonisFunction[mylist_List,cutoff_Real]/; Length[Dimensions[mylist]]==4  :=
Table[
mylist[[i,j]] +
 If[RandomReal[]>cutoff, {1,-1,0,0}, {0,0,0,0} ],
    {i,Dimensions[mylist][[1]]}, {j,Dimensions[mylist][[2]]} ]

This table-based programming style is much more like the procedural programming style you are used to (quadruply nested For loops), but it is still more efficient, and I have come to the conclusion that you are more likely to understand the code.

EDIT: additional material in response to noni's question in comments To run this code (taking the second example function above as the example for this process), you would first define the function by copying and pasting the above code into a Mathematica notebook. You would then define your input matrix and give it some name. e.g.

myinputmatrix = RandomInteger[{10,100},{4,4,4,4}];

And finally, call the nonisFunction with the appropriate arguments.

nonisFunction[myinputmatrix,0.4]

And if that doesn't help, I recommend the video tutorials http://www.wolfram.com/support/learn/get-started-with-mathematica/.

回答2:

f[mylist_List, rowPlus_Integer, rowMinus_Integer] := 
  Module[{temp = mylist},
    If[1 <= rowPlus <= Length@temp && 1 <= rowMinus <= Length@temp,
      If[ RandomChoice[{True, False}], 
        temp[[rowPlus]]++;
        temp[[rowMinus]]--];
      Return@temp,
    (*else*)
       Print@"Wrong row value"; Abort[]]]

a = IdentityMatrix[3]
a = f[a, 1, 2]
(*
{{2, 1, 1}, {-1, 0, -1}, {0, 0, 1}}
*)
a = IdentityMatrix[3]
a = f[a, 1, 2]
(*
{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}
*)

Edit

According to your new specifications:

f[mylist_List, rowPlus_Integer, rowMinus_Integer, cutoff_Real] :=
 Module[{temp = mylist},
  If[1 <= rowPlus <= Length@temp && 1 <= rowMinus <= Length@temp,
   MapIndexed[
    If[#1 > cutoff,
      temp[[rowPlus, First@#2]]++;
      temp[[rowMinus, First@#2]]--] &,
    RandomReal[1, Dimensions@temp[[2]]]];
   Return@temp,
   (*else*)
   Print@"Wrong row value"; Abort[]]]

Usage

a = IdentityMatrix[3];
a = f[a, 1, 2, .5]
(*
->{{2,1,0},{-1,0,0},{0,0,1}}
*)

来源：https://stackoverflow.com/questions/6558067/change-two-different-parts-in-a-table-according-to-the-same-random-value

标签

wolfram-mathematica