Replace elements of a list based on a function

Question

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}

Answer 1

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}

Answer 2

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

With[{mask = 1 - Mod[Quotient[Range@16, 4, 1], 2]}, mask f + 1 - mask]

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}

Answer 3

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]

Answer 4

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

Answer 5

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}];

Original Answers

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

and (first attempt):

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