How to assign a list to a desired position of an array?

Question

This question is related to this. Consider an array array as

 array = ImageData[RandomImage[10, 10]];

And the indices of the desired values are

desired = {{1, 3}, {1, 4}, {1, 5}, {1, 6}, {2, 3}, {2, 4}, {2, 5}, {2, 6}, 
  {3, 3}, {3, 4}, {3, 5}, {3, 6}, {4, 3}, {4, 4}, {4, 5}, {4, 6}, {5, 
  2}, {5, 3}, {5, 4}, {5, 5}, {5, 6}, {6, 2}, {6, 3}, {6, 4}, {6, 
  5}, {6, 6}, {7, 3}, {7, 4}, {7, 5}, {7, 6}, {8, 3}, {8, 4}, {8, 
  5}, {8, 6}};

The desired values can be found (following the answer to the earlier question) through

val = Extract[array,desired];

Now I have another array array2 of same dimensions of array1 and I wish to assign the values in val to the desired postions desired of array2.

I tried the following one:

array2[[##]] & @@@ desired = val;

However, this does not work.

How can I do this?

Answer 1

SeedRandom[1]
n = 10;
array = ImageData[RandomImage[1, {n, n}]];
array2 = ImageData[RandomImage[1, {n, n}]];


sa = SparseArray[desired -> 1, Dimensions@array];
newarray = (1 - sa) array2 + sa array;

Showing only the desired parts of the three matrices:

Row[Labeled[MatrixPlot[MapAt[Black &, #, Complement[Tuples[Range[n], {2}], desired]], 
     ImageSize -> 200], #2, Top] & @@@ 
  Transpose[{{array, array2, array2a}, {"array", "array2", "array2a"}}]]

All four methods suggested in answers and comments so far give the same result:

array2a = array2b = array2c = array2d = array2;
array2a = (1 - sa) array2 + sa array;
(Part[array2b, #[[1]], #[[2]]] = Part[array, #[[1]], #[[2]]]) & /@ desired; (* user6014 *)
(array2c[[##]] = array[[##]]) & @@@ desired; (* Albert Retey's comment *)
array2d = ReplacePart[array2d, 
  Thread[desired -> Extract[array, desired]]]; (* J.M.'s comment *)

 array2a == array2b == array2c == array2d

True

Timings

ClearAll[timings]
timings[m_Integer] := Module[{t1, t2, t3, t4, n = 1000, a, b, c, b2a, b2b, b2c, b2d, sa}, 
   SeedRandom[1];
   {a, b} = RandomReal[1, {2, n, n}];
   c = RandomSample[Tuples[Range[n], {2}], m];
   b2a = b2b = b2c = b2d = b;
   t1 = First[AbsoluteTiming[sa = SparseArray[c -> 1, {n, n}];  
   b2a = (1 - sa) b2a + sa a;]];
   t2 = First[AbsoluteTiming[(b2b[[##]] = a[[##]]) & @@@ c;]];
   t3 = First[AbsoluteTiming[(Part[b2c, #[[1]], #[[2]]] = Part[a, #[[1]], #[[2]]])&/@c;]];
   t4 = First[AbsoluteTiming[b2d = ReplacePart[b2d, Thread[c -> Extract[a, c]]];]]; 
   {m, t1,  t2, t3, t4, b2a == b2b == b2c == b2d}]

tr = timings /@ {100, 500, 5000, 50000, 100000, 300000};
backgroundrule = # -> Item[#, Background -> Yellow] & /@ Min /@ tr[[All, 2 ;; 5]];
headers = {{"Length@desired", "method", SpanFromLeft, SpanFromLeft, 
  SpanFromLeft, " b2a==b2b==b2c==b2d "}, {SpanFromAbove,   
  " SparseArray ", " ApplySetPart ", " MapSetPart ", " ReplacePart ", SpanFromAbove}};
Grid[Join[headers, timingresults /. backgroundrule], 
  Dividers -> All,  Alignment -> {Center, Center}] 

Answer 2

Using Part to set multiple values at once is extremely quick, so one possibility is to flatten everything, use Part, then reshape. Here is a function that does this:

ArrayPartSet[old_, new_, pos_] := Module[
    {res = Flatten[old], dim = Dimensions[old], nzp},
    nzp = pos . {dim[[2]], 1} - dim[[2]];
    res[[nzp]] = Flatten[new][[nzp]];
    ArrayReshape[res, dim]
]

For your example:

SeedRandom[1];
array1 = ImageData[RandomImage[10, 10]];
array2 = ImageData[RandomImage[10, 10]];
desired = {
    {1, 3}, {1, 4}, {1, 5}, {1, 6}, {2, 3}, {2, 4}, {2, 5}, {2, 6}, {3, 3},
    {3, 4}, {3, 5}, {3, 6}, {4, 3}, {4, 4}, {4, 5}, {4, 6}, {5, 2}, {5, 3},
    {5, 4}, {5, 5}, {5, 6}, {6, 2}, {6, 3}, {6, 4}, {6, 5}, {6, 6}, {7, 3},
    {7, 4}, {7, 5}, {7, 6}, {8, 3}, {8, 4}, {8, 5}, {8, 6}
};

new = ArrayPartSet[array2, array1, desired];

Here is a visualization showing that new is the same as array2 except for the positions specified in desired:

MatrixPlot[new-array2]

Answer 3

(Part[array2, #[[1]], #[[2]]] = Part[array, #[[1]], #[[2]]]) & /@ desired

This may not be the most efficient way, but I am pretty sure it works.