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?

$\endgroup$
5

10 Answers 10

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]
$\endgroup$
1
  • 3
    $\begingroup$ The Ceiling example is stupendous. With Apply that is likely a code-golf winning answer! $\endgroup$ – CA Trevillian Jan 17 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}
$\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}]
$\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 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 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}

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

$\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)

$\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}]
$\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
$\endgroup$
3
$\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
  • ...
$\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}    *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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