11
$\begingroup$

I want to create the list ix={1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4}

I can do

L=4;
ix = ConstantArray[0, Length[L]^2]
k = 0;
For[i = 1, i <= Length[ix], i++, If[Mod[i, L] == 1, k = k + 1, k]; ix[[i]] = k;]

ix
(* output *)
{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

But I don't like it. Is there a more "Mathematica"-way to do it?

Improve this question
$\endgroup$
5

10 Answers 10

Reset to default
21
$\begingroup$

As you see from the comments and answers, the natural way to do it in Mathematica is to create a 2D array and then flatten it. A couple more examples of that approach:

Flatten[Table[i, {i, 4}, 4]]

Flatten[Array[# &, {4, 4}]]

For this specific case you could also do something like:

Ceiling[Range[16]/4]
Improve this answer
$\endgroup$
1
  • 3
    $\begingroup$ The Ceiling example is stupendous. With Apply that is likely a code-golf winning answer! $\endgroup$
    – CA Trevillian
    Jan 17, 2021 at 2:59
13
$\begingroup$

You can also interpret this as an outer product:

Outer[Times, Range[4], ConstantArray[1, 4]] // Flatten
{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}
Improve this answer
$\endgroup$
12
$\begingroup$

You can also use the 4-argument form of Array:

Array[# &, {4, 4}, 1, Flatten @* List]

{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

Array[Range @ 4 &, 4, 1, Sort @* Join]

{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

Array[{1, 0, 0, 0} &, 4, 1, Accumulate @* Join]

{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

And few additional methods:

Round[1/2 + 6 Range[16]/25]

Sort @ Mod[Range @ 16, 4, 1]

Join @@ Table @@@ Table[{i, 4}, {i, 4}]

1 + ⌊Most @ Subdivide[4, 16]⌋

Join @@ Accumulate @ Table[1, 4, 4]

Accumulate @ Upsample[{1, 1, 1, 1}, 4] (*thanks: Simon Woods *)

⌈ArrayResample[Range@4, 16, {"Bin", 1}]⌉

Internal`RepetitionFromMultiplicity @ Thread[{Range @ 4, 4}]
Improve this answer
$\endgroup$
2
  • 3
    $\begingroup$ I like the Accumulate one. You could also have Accumulate@Upsample[{1, 1, 1, 1}, 4] $\endgroup$
    – Simon Woods
    Jan 17, 2021 at 22:16
  • $\begingroup$ Thank you @Simon. I did try to torture Upsample and ArrayResample to produce the desired result; wrapping with Accumulate did not occur to me. $\endgroup$
    – kglr
    Jan 17, 2021 at 22:36
10
$\begingroup$

This uses an anonymous function in tandem with ConstantArray and Range to do what you want:

ConstantArray[#,4]&/@Range@4//Flatten

{1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4}

Improve this answer
$\endgroup$
3
  • 6
    $\begingroup$ Also Flatten[ConstantArray[Range[4], 4], {2, 1}] $\endgroup$
    – Simon Woods
    Jan 16, 2021 at 12:17
  • 3
    $\begingroup$ Flatten@Transpose@ConstantArray[Range@4, 4] $\endgroup$
    – OkkesDulgerci
    Jan 16, 2021 at 15:37
  • $\begingroup$ @SimonWoods that use of Flatten really shows off it’s similarity to Transpose! Very cool. $\endgroup$
    – CA Trevillian
    Jan 17, 2021 at 3:04
7
$\begingroup$

Another way:

Quotient[Range@16, 4, -3]

{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

Improve this answer
$\endgroup$
7
$\begingroup$

Riffle/Nest

Range[4]//Nest[Riffle[#,#]&,#,2]&

Alternatively:

Range[4]//Riffle[#,#]&//Riffle[#,#]&

{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

BitShiftRight

After the neat Ceiling method by Simon Woods:

1+Table[BitShiftRight[n,2], {n, 0, 15}]

Alternatively:

1+BitShiftRight[#,2]&@Range[0,15]

IntegerPart

From the documentation for BitShiftRight->Details, and the relationship between BitShiftRight and IntegerPart:

1+IntegerPart@Table[n/4, {n, 0, 15}]

Alternatively:

1+IntegerPart[Range[0,15]/4]

Cases

Cases[Range[4], x_:> Splice@{x,x,x,x}]

(Originally a comment)

Improve this answer
$\endgroup$
0
6
$\begingroup$ 
CoefficientList[Series[x^4/((1 - x) (1 - x^4)), {x, 0, 19}], x][[5 ;;]]

.

LinearRecurrence[{1, 0, 0, 1, -1}, {1, 1, 1, 1, 2}, 16]

.

Table[Length@IntegerPartitions[k - 1, All, {1, 4}], {k, 16}]
Improve this answer
$\endgroup$
5
$\begingroup$

A couple more:

PadRight[{Range@4}\[Transpose], {4, 4}, "Fixed"] // Flatten
Outer[# &, #, #] &@Range@4 // Flatten

Update — Additional ones:

Range[4] SparseArray[{}, {4, 4}, 1] // Flatten
With[{p = ConstantArray[1, 4]},
  SparseArray[{Band[p] -> 1}, Length[p] p]@"NonzeroPositions" // Flatten
  ]
TensorProduct[Range@4, ConstantArray[1, {4}]] // Flatten
Improve this answer
$\endgroup$
4
$\begingroup$

Recommending:

Quotient[Range[4, 19], 4] (* ~1.759μs *)

Benchmark

Quotient[Range@16, 4, -3] (* ~2.554μs *)
Outer[Times, Range[4], ConstantArray[1, 4]] // Flatten (* ~2.573μs *)

Internal`RepetitionFromMultiplicity @ Thread[{Range @ 4, 4}] (* ~3.498μs *)
Flatten@Transpose@ConstantArray[Range@4, 4] (* ~3.527μs *)
Flatten[ConstantArray[Range[4], 4], {2, 1}] (* ~3.701μs *)
Flatten[Table[i, {i, 4}, 4]] (* ~3.919μs *)
Range[4]//Riffle[#,#]&//Riffle[#,#]& (* ~3.928μs *)

1+BitShiftRight[#,2]&@Range[0,15] (* ~4.191μs *)
Range[4]//Nest[Riffle[#,#]&,#,2]& (* ~4.411μs *)
Array[{1, 0, 0, 0} &, 4, 1, Accumulate @* Join] (* ~4.747μs *)

Sort@Mod[Range@16, 4, 1] (* ~5.506μs *)
Array[Range @ 4 &, 4, 1, Sort @* Join] (* ~5.655μs *)
Range[4] SparseArray[{}, {4, 4}, 1] // Flatten (* ~5.853μs *)
Outer[# &, #, #] &@Range@4 // Flatten (* ~5.974μs *)

Join @@ Accumulate @ Table[1, 4, 4] (* ~6.300μs *)
Flatten[Array[# &, {4, 4}]] (* ~6.833μs *)

PadRight[{Range@4}\[Transpose], {4, 4}, "Fixed"] // Flatten (* ~7.013μs *)
Join @@ Table @@@ Table[{i, 4}, {i, 4}] (* ~7.589μs *)

Cases[Range[4], x_:> Splice@{x,x,x,x}] (* ~8.041μs *)
Array[# &, {4, 4}, 1, Flatten @* List] (* ~8.519μs *)

1+Table[BitShiftRight[n,2], {n, 0, 15}] (* ~9.554μs *)

ConstantArray[#,4]&/@Range@4//Flatten (* ~10.058μs *)
Ceiling[Range[16]/4] (* ~11.210μs *)
1 + ⌊Most @ Subdivide[4, 16]⌋ (* ~13.635μs *)
1+IntegerPart@Table[n/4, {n, 0, 15}] (* ~18.513μs *)
TensorProduct[Range@4, ConstantArray[1, {4}]] // Flatten (* ~18.924μs *)
Round[1/2 + 6 Range[16]/25] (* ~22.859μs *)
Table[Length@IntegerPartitions[k - 1, All, {1, 4}], {k, 16}] (* ~58.000μs *)

Accumulate @ Upsample[{1, 1, 1, 1}, 4] (* ~194.7μs with 6k runs *)
LinearRecurrence[{1, 0, 0, 1, -1}, {1, 1, 1, 1, 2}, 16] (* ~336.2μs with 5k runs *)
CoefficientList[Series[x^4/((1 - x) (1 - x^4)), {x, 0, 19}], x][[5 ;;]] (* ~529.7μs with 18k runs *)

⌈ArrayResample[Range@4, 16, {"Bin", 1}]⌉ (* ~1620μs with 1k runs *)

Each repeated 30k times unless otherwise stated. One may conclude that, in Mathematica,

  • simple algebra generally works faster
  • more arguments specified $\neq$ faster
  • / division drags, compared to Quotient
  • bit operations aren't as fast as they're in C
  • /@ is slow, if @ can spread
  • ...
Improve this answer
$\endgroup$
1
$\begingroup$ 
f[x_] = InterpolatingPolynomial[{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}, x] // Expand
(*    8256 - x*536645091/20020 + x^2*1798275487/48510 -
      x^3*128580216461/4365900 + x^4*25293360053/1663200 -
      x^5*8745144029/1603800 + x^6*768388933/544320 -
      x^7*315030731/1166400 + x^8*92080313/2381400 -
      x^9*237559139/57153600 + x^10*30277/90720 -
      x^11*50569/2566080 + x^12*12427/14968800 -
      x^13*27557/1167566400 + x^14*17/41912640 - x^15/314344800    *)

Array[f, 16]
(*    {1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}    *)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.