construction de tableau de liste

Question

Je veux créer la liste ix={1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4}

Je peux faire

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}

Mais je n'aime pas ça. Y a-t-il une manière plus "Mathematica" de le faire?

Answer 1

Comme vous le voyez dans les commentaires et les réponses, la manière naturelle de le faire dans Mathematica est de créer un tableau 2D, puis de l'aplatir. Quelques autres exemples de cette approche:

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

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

Pour ce cas spécifique, vous pouvez également faire quelque chose comme:

Ceiling[Range[16]/4]

Answer 2

Vous pouvez également interpréter cela comme un produit externe:

Outer[Times, Range[4], ConstantArray[1, 4]] // Flatten
{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4}

Answer 3

Vous pouvez également utiliser la forme à 4 arguments de 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}

Et quelques méthodes supplémentaires:

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

Answer 4

Cela utilise une fonction anonyme en tandem avec ConstantArrayet Rangepour faire ce que vous voulez:

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

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

Answer 5

Autrement:

Quotient[Range@16, 4, -3]

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

Answer 6

Riffle / Nid

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

Alternativement:

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

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

BitShiftRight

Après la Ceiling méthode soignée de Simon Woods:

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

Alternativement:

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

IntegerPart

À partir de la documentation de BitShiftRight-> Détails et de la relation entre BitShiftRightet IntegerPart:

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

Alternativement:

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

Cas

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

(À l'origine un commentaire)

Answer 7

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

Answer 8

Quelques autres:

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

Mise à jour - Autres:

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

Answer 9

Recommander:

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

Référence

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 *)

Chacun répété 30k fois, sauf indication contraire. On peut conclure que, dans Mathematica ,

• l'algèbre simple fonctionne généralement plus rapidement
• plus d'arguments spécifiés $\neq$ plus rapide
• / division traîne, par rapport à Quotient
• les opérations sur les bits ne sont pas aussi rapides qu'en C
• /@est lent, si @peut se propager
• ...

Answer 10

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}    *)