# Replace elements of a list based on a function

I have a function of k (written in the form of a table/list to get values) for 16 integer values from 1 to 16:

f = Table[3*k*k, {k, 1, 256}]


I want to replace every alternate 4 elements of this list with the number 1.

I want to write a loop but I can't figure out how to do that.

While[Mod[i, 4] == 0, Do[f[i + n] = 1, {n, 1, 4}, i++]]


How would you make this logic work in Mathematica.

To make it more clear the out put of f is

{3, 12, 27, 48, 75, 108, 147, 192, 243, 300, 363, 432, 507, 588, 675, 768,.......}

I want to replace the elements such that

{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1,.....,1,1,1,1}

• I find it hard to understand what your code is supposed to do. Could you provide the expected output? Commented Jul 30, 2020 at 0:06
• Please check the edited version. Commented Jul 30, 2020 at 0:22
• ReplacePart[ Partition[f, 4], {2 -> {1, 1, 1, 1}, 4 -> {1, 1, 1, 1}}] // Flatten Commented Jul 30, 2020 at 0:44
• Flatten@Riffle[Partition[f, 4][[;; ;; 2]], {ConstantArray[1, 4]}] Commented Jul 30, 2020 at 2:21

To answer your question directly, a loop could be written like this:

f = Table[3*k*k, {k, 1, 16}];
Do[
f[[4 i + j]] = 1;
,
{i, {1, 3}},
{j, 1, 4}
];
f


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}

A non-loop alternative is this:

f = Table[3*k*k, {k, 1, 16}];
pos = Flatten@Table[Range[4] + 4 n, {n, {1, 3}}];
f[[pos]] = 1;
f


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}

or similarly

f = Table[3*k*k, {k, 1, 16}];
pos = Flatten[Range[#, 16, 8] & /@ Range[5, 8]];
f[[pos]] = 1;
f


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}

Join @@ MapAt[ConstantArray[1, 4] &, Partition[f, 4], {2 ;; ;; 2}]

SubsetMap[1 & /@ # &, f, Join @@ Partition[Range[16], 4, 8, 5]]

With[{p = Join @@ Partition[Range[16], 4, 8]}, Normal@SparseArray[p -> 3 p^2, 16, 1]]


all give

{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}

• Thanks. I want the output to look like this : {3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1} Commented Jul 30, 2020 at 0:29
g[k_Integer] := 3 k^2 /; MemberQ[{1, 2, 3, 4}, Mod[k, 8, 1]];
g[k_Integer] := 1 /; MemberQ[{5, 6, 7, 8}, Mod[k, 8, 1]];
g /@ Range[256]


Not a one-liner, but straightforward.

z1 = Table[Table[3*k*k, {k, i, i+3}], {i, 1, 256, 8}];

z2 = Table[{1,1,1,1}, {i, 1, 256, 8}];

result = Riffle[z1,z2] // Flatten

BlockMap[{#,ConstantArray[1,4]}&,f,4,8]//Flatten


or

BlockMap[{#[[;;4]], Unitize@#[[5;;]]}&,f,8]//Flatten


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1, 867, 972, 1083, 1200, 1, 1, 1, 1, 1875, 2028, 2187, 2352, 1, 1, 1, 1, 3267, 3468, 3675, 3888, 1, 1, 1, 1, 5043, 5292, 5547, 5808, 1, 1, 1, 1, 7203, 7500, 7803, 8112, 1, 1, 1, 1, 9747, 10092, 10443, 10800, 1, 1, 1, 1, 12675, 13068, 13467, 13872, 1, 1, 1, 1, 15987, 16428, 16875, 17328, 1, 1, 1, 1, 19683, 20172, 20667, 21168, 1, 1, 1, 1, 23763, 24300, 24843, 25392, 1, 1, 1, 1, 28227, 28812, 29403, 30000, 1, 1, 1, 1, 33075, 33708, 34347, 34992, 1, 1, 1, 1, 38307, 38988, 39675, 40368, 1, 1, 1, 1, 43923, 44652, 45387, 46128, 1, 1, 1, 1, 49923, 50700, 51483, 52272, 1, 1, 1, 1, 56307, 57132, 57963, 58800, 1, 1, 1, 1, 63075, 63948, 64827, 65712, 1, 1, 1, 1, 70227, 71148, 72075, 73008, 1, 1, 1, 1, 77763, 78732, 79707, 80688, 1, 1, 1, 1, 85683, 86700, 87723, 88752, 1, 1, 1, 1, 93987, 95052, 96123, 97200, 1, 1, 1, 1, 102675, 103788, 104907, 106032, 1, 1, 1, 1, 111747, 112908, 114075, 115248, 1, 1, 1, 1, 121203, 122412, 123627, 124848, 1, 1, 1, 1, 131043, 132300, 133563, 134832, 1, 1, 1, 1, 141267, 142572, 143883, 145200, 1, 1, 1, 1, 151875, 153228, 154587, 155952, 1, 1, 1, 1, 162867, 164268, 165675, 167088, 1, 1, 1, 1, 174243, 175692, 177147, 178608, 1, 1, 1, 1, 186003, 187500, 189003, 190512, 1, 1, 1, 1}

where

 f = Table[3*k*k, {k, 1, 256}];


f//SubsetMap[Unitize, #, Partition[Range[5,Length@#],4,8]//Flatten]&


and (first attempt):

f//SubsetMap[Unitize, #, Partition[Range[Length@#],4][[2;; ;; 2]]//Flatten]&

f = Table[3*k*k, {k, 1, 16}];


Using SequenceCases

Flatten @ SequenceCases[Partition[f, 4], {a_, b_} :> {a, b /. _Integer :> 1}]


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}

Using ReplaceAt (new in 13.1) and C.E.'s position function

p = List /@ Flatten @ Table[Range[4] + 4 n, {n, {1, 3}}]


{{5}, {6}, {7}, {8}, {13}, {14}, {15}, {16}}

ReplaceAt[f, _ :> 1, p]


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}

Also:

f = Table[3*k*k, {k, 1, 16}];

f^ ArrayPad[{1, 1, 1, 1, 0, 0, 0, 0}, {0, Length@f - 8}, "Periodic"]


{3, 12, 27, 48, 1, 1, 1, 1, 243, 300, 363, 432, 1, 1, 1, 1}