Generating a list of numbers that are not multiples of 4

Question

I want to write simple code that will list all numbers from $1$ to $n$ that are not multiples of $4$.

And in this case I consider that

n=100

For[i = 1, i <= n, i++, If[Mod[i, 4] != 0, Print[i]]]

And got the answer

1 2 3 5 6 7 9 10 11 13 14 15 17 18 19 21 22 23 25 26 27 29 30 31 33 34 35 37 38 39 41 42 43 45 46 47 49 50 51 53 54 55 57 58 59 61 62 63 65 66 67 69 70 71 73 74 75 77 78 79 81 82 83 85 86 87 89 90 91 93 94 95 97 98 99

Now I would like to return an expression without using Print. Are there any other functions I can use?

Also I would like to know whether I can write the same code and get the same answer using Table.

Answer 1

Why not:

Drop[Range @ 100, {4, -1, 4}]

Or:

Range[Range@3, 100, 4] ~Flatten~ {2, 1}

Answer 2

A couple general approaches:

Table[If[Mod[i, 4] != 0, i, Unevaluated@Sequence[]], {i, 100}]

Reap[Do[If[Mod[i, 4] != 0, Sow[i]], {i, 100}]][[2, 1]]

Note that the Unevaluated@Sequence[] thing is not a beginner's trick...Table always creates an entry for each iteration, so skipping some of them turns out to be tricky. Reap and Sow are one standard way to create table entries conditionally.

---

Update 1: @garej's answer reminded me that in V10 Nothing is an alternative to Unevaluated@Sequence[]:

Table[If[Mod[i, 4] != 0, i, Nothing], {i, 100}]

---

Update 2: In the comments that it is pointed out that Divisible[i, 4] is faster than Mod[i, 4] != 4. So if speed is an issue, one might consider using it for this specific type of problem. However, Divisible[], Nothing, Reap[], Sow[], and Sequence[] are not compilable, so the whole approach is a poor one if speed on long lists, for which Table[] will try to compile its body, is an issue. One could either develop a compilable code for Table or use another approach even better adapted to the special case of skipping multiples of an given integer.

n = 10^6;
d = 4;
Table[If[Divisible[i, d], Nothing, i], {i, n}]; //             (* not compilable *)
  RepeatedTiming // First
DeleteCases[Table[If[Mod[i, d] != 0, -1, i], {i, n}], -1]; //  (* compilable Table[] *)
  RepeatedTiming // First
Flatten@Outer[Plus, d * Range[0, n/d - 1], Range[d - 1]]; //   (* faster still *)
  RepeatedTiming // First
(*
  0.93
  0.26
  0.017
*)

If n is not divisible by d, then for the last method, one could generate a list that is slightly longer and trim it to the desired length with Part, Take or Drop; the extra processing would take a negligible amount of time.

Since the focus of the question seemed to be about how to translate C-like code that conditionally skips entries in a table, I thought a general answer would be most helpful. There may be faster approaches than Outer[Plus,..], the search for which I will leave to others. The timings were given merely to illustrate my claims about compilability.

If you are interested in speed, I would point out Mr.Wizard's Drop method which is faster than Outer, or the Floor method in my other answer, which is a little faster still.

Answer 3

If you see Select, you may try Cases.

DeleteCases[Range[100], x_ /; Mod[x, 4] == 0]

If you see Table, you may try Array:

Array[If[Mod[#, 4] == 0, Nothing, #] &, 100]

One more method with Table:

Complement[Range[100], Table[i, {i, 0, 100, 4}]]

To make PackedArray, one may also use:

Partition[Range[100], 4][[;; , ;; 3]]//Flatten

or

Delete[List /@ Range[100][[4 ;; 100 ;; 4]]][Range[100]]

Answer 4

Many ways to skin a cat:

    n = 100;
    m = 4;

    Select[Range[n], Mod[#, m] != 0 &]

    Flatten@Table[i + Range[0, m - 2], {i, 1, n, m}]

Answer 5

I think one can use Partition this way:

Flatten @ Partition[Range @ 100, 3, 4]

Answer 6

Another trick for the specific case (edit notice: I changed Range from type Integer to type Real, for a 35% or so speed-up):

Floor[
 (4./3*(1 - $MachineEpsilon)) * Range[3. * 10^2 / 4]
 ]

It's pretty fast:

foo = Floor[
    (4./3*(1 - $MachineEpsilon)) * Range[3. * 10^6 / 4]
    ]; // RepeatedTiming
(*  {0.0033, Null}  *)

It competes in speed with Mr.Wizard's Drop method, although not in elegance**:

foo2 = Drop[Range[10^6], {4, -1, 4}]; // RepeatedTiming
(*  {0.0043, Null}  *)

foo2 == foo
(*  True  *)

By the time the dodge 1 - $MachineEpsilon causes inaccuracies, you'll be out of memory (or at least I will).

foo = Floor[
    (4./3*(1 - $MachineEpsilon)) * Range[3. * 10^8 / 4]
    ]; // RepeatedTiming
foo2 = Drop[Range[10^8], {4, -1, 4}]; // RepeatedTiming
foo2 == foo
(*
  {0.77, Null}
  {1.1, Null}
  True
*)

**My method may appear to be memory-competitive as well since it does not generate extra entries and drop them, but that's an illusion. The multiplication causes the array essentially to be copied, doubling the memory usage. Since the array is 75% of the full range, we actually use 1.5 times the memory. This is observable on my machine when I push the limit to n = 10^9, when the extra swapping in my method slows it down (17.7 sec. vs. 15 sec.); however the result is still accurate.

---

Appendix

Two more ways to handle the particular problem, first posted in my comments below, remarkable only for adding to the seemingly endless string of methods in this Q&A:

Nearest[Unitize@Mod[Range[10^2], 4] -> Automatic, 1]            (* 0.12s for n = 10^6 *)
Flatten@SparseArray[Mod[Range[10^2], 4]]["NonzeroPositions"]    (* 0.030s for n = 10^6 *)

Answer 7

A joke solution:

CoefficientList[Series[(1 - x^4)/((1 - x)^2 (1 - x^3)), {x, 0, 20}], x]

Answer 8

There is this way of doing it:

range[n_] := 
  Catenate[
    NestList[# + 4 &, {1, 2, 3}, Floor[(n - 1)/4]]][[;; Min[-1, Mod[n, 4, 1] - 4]]]

Answer 9

Edit

With some help from Coolwater (see comments)

Pick[#, Sign@Mod[#, 4], 1] & @ Range[100]

{1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19, 21, 22, 23, 25, 26, 27, 29, 30, 31, 33, 34, 35, 37, 38, 39, 41, 42, 43, 45, 46, 47, 49, 50, 51, 53, 54, 55, 57, 58, 59, 61, 62, 63, 65, 66, 67, 69, 70, 71, 73, 74, 75, 77, 78, 79, 81, 82, 83, 85, 86, 87, 89, 90, 91, 93, 94, 95, 97, 98, 99}

Original Post

Pick[#, Sign@Mod[#, 4] & @ #, 1] & @ Range[100]

Answer 10

Also

n = 100;
Pick[Range@n, Range@n/4, _Rational]

{1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19, 21, 22, 23, 25, 26, 27, 29, 30, 31, 33, 34, 35, 37, 38, 39, 41, 42, 43, 45, 46, 47, 49, 50, 51, 53, 54, 55, 57, 58, 59, 61, 62, 63, 65, 66, 67, 69, 70, 71, 73, 74, 75, 77, 78, 79, 81, 82, 83, 85, 86, 87, 89, 90, 91, 93, 94, 95, 97, 98, 99}

i.e.

Take the first $n$ integers, divide each element in this first list by 4, and pick the elements in the first list such that the corresponding element in the second list is an Rational

or, with Mod,

Pick[Range@n, Mod[Range@n, 4], 1|2|3]

or, avoiding "computing" the 1...n list two times

With[{l = Range@n}, Pick[l, Mod[l, 4], Except[0, _Integer]]]

or even

With[{l = Range@n}, Pick[l, UnitStep[Mod[l, 4] - 1], 1]]

Answer 11

Another approach

not4k[n_] := (4 # + {1, 2, 3}) & /@ (Range[Quotient[n, 4]] - 1) // Flatten

Answer 12

I've arrived late at this party. A complementary approach:

 Complement[Range[100], Range[4, 100, 4]]

... seems quite fast too.

Answer 13

LibraryLink function

My intuition was off for Compile, so I had to see if things worked like I expected in C using LibraryLink. Here is the C code.

#include <stdio.h>
#include "WolframLibrary.h"
#include <stdbool.h>
#include <limits.h>

DLLEXPORT mint WolframLibrary_getVersion( ) {
    return WolframLibraryVersion;}
DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData){
    return LIBRARY_NO_ERROR;}
DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData
                                           libData) {
    return;}

DLLEXPORT int nonMultsCondManMod(WolframLibraryData libData,
                                 mint Argc, MArgument *Args, MArgument Res)
{
    int err = LIBRARY_NO_ERROR;
    mint nn = MArgument_getInteger(Args[0]);
    mint mm = MArgument_getInteger(Args[1]);
    mint quot = nn/mm;
    mint rem = nn - quot*mm;
    mint resLen = (mm-1)*quot + rem;
    MTensor result;
    err = libData->MTensor_new(MType_Integer, 1, &resLen, &result);
    mint* dataPtr = libData->MTensor_getIntegerData(result);

    int ii;
    int jj = 1;
    int kk = 1;
    for (ii = 1; ii <= resLen; ii++) {
        *(dataPtr++) = jj++;
        if(kk == mm-1){
            jj++;
            kk = 1;
        } else{kk++;}
    }
    MArgument_setMTensor(Res, result);
    return LIBRARY_NO_ERROR;
}

To let Mathematica use the C code, we will make a string of the code and store it in the variable cCodeString. To do this, copy the code above, paste it between quotes "" and click "Yes" in the dialog (to escape the characters).

cCodeString = (*Insert C code here*);

Now we process the code/string and make a function out of it.

<< CCompilerDriver`;
CreateLibrary[cCodeString, "nonMults"];
Quiet@LibraryUnload["nonMults"];
nonMultsCondManMod = 
  LibraryFunctionLoad["nonMults", 
   "nonMultsCondManMod", {Integer, Integer}, {Integer, 1}];

Timing comparison

mm = 4;
nn = 10^7;

(rJ = nonMultsCondManMod[nn, mm]) // RepeatedTiming // First
(rW1 = Drop[Range@nn, {mm, -1, mm}]) // RepeatedTiming // First
rJ === rW1

0.018
0.056
True

---

Sillyness

It seems my intuition was a bit off and the kind of strategy shown below only works (kind of) nicely in C, see for example the code above, or here or here. The simple code by Mr.Wizard is faster. I'll refrain from deleting the code below despite this.

This solution uses Compile. It also uses meta-programming to avoid any conditionals (If) or restructuring (Select, Pick), while still being quite general. Evaluate all the code again if you want to try e.g. mm=2 (make a list of odd numbers). Of course all this overkill in a sense.

mm = 4;

hCompileBodyTemplate =
  # /. OwnValues[mm] &@
   Hold[
    quot = Quotient[nn, mm];
    rem = nn - quot*mm;
    res = ConstantArray[0, quot*(mm - 1) + rem];
    ii = 1;
    jj = 1;
    Do[
     token;
     jj++;
     ,
     quot
     ];
    Do[
     res[[ii++]] = jj++
     ,
     rem
     ];
    res
    ];

hInstructions =
  CompoundExpression @@@
   Hold @@
    Join @@@
     List@
      Table[
       Hold[res[[ii++]] = jj++]
       ,
       mm - 1
       ];

hTokenRule =
  Delete[Hold @@ {HoldPattern[token] -> hInstructions}, {1, 2, 0}];

hCompileBody =
  ReplaceAll @@ {
    hCompileBodyTemplate,
    Unevaluated @@ hTokenRule
    };

hToken2Rule =
  Delete[Hold @@ {HoldPattern[token2] -> hCompileBody}, {1, 2, 0}];

hCompileTemplate =
  Hold@
   Compile[
    {{nn, _Integer}},
    Block[{quot, rem, ii, jj, res},
     token2
     ]
    ];
heldCompile =
  ReplaceAll @@ {
    hCompileTemplate,
    Unevaluated @@ hToken2Rule
    };

cfu = Identity @@ heldCompile;

Example

cfu[22]

{1,2,3,5,6,7,9,10,11,13,14,15,17,18,19,21,22}

Message to OP (Mariam)

I really directed my answer to other experienced users of this site. Perhaps I should have been more clear. Thank you for your message, now that I know that you intend to study all the answers I will try to make my answer more readable and educational.

There are at least two things that can be learned from this answer

1. There is a function Compile that can make certain code faster
2. In the Wolfram Language (Mathematica) you can use code to generate and/or manipulate code

With regards to point 1., that is, the fact that Compile exists, I would like to say that it can be tricky to get started with Compile, because it requires some specific knowledge of what code can be compiled.

Concerning point 2, this manipulation and generation of code can be called meta-programming. This arguably an even more advanced (and useless) topic than Compile.

For example C++ also has some abilities to do meta-programming, mostly because of its flexible preprocessor, which is really a language all by itself. One (kind of) special thing about meta-programming in Mathematica is that you can use (many of) the same functions that would normally use to manipulate data to instead manipulate code.

In my answer I first generate some instructions and then insert them into my code. You can see that the token in the code above was replaced by three identical instructions res[[ii++]] = jj++;. The code that is generated looks as follows.

quot = Quotient[nn, 4];
rem = nn - quot 4;
res = ConstantArray[0, quot (4 - 1) + rem];
ii = 1;
jj = 1;
Do[
  (res[[ii++]] = jj++;
   res[[ii++]] = jj++;
   res[[ii++]] = jj++); jj++;,
  quot
  ];
Do[
 res[[ii++]] = jj++,
 rem]; 
res

Instead of bothering with how meta-programming or Compile works, perhaps you can first try to see why the generated code works for your question. A simpler version of the code above is this

nn = 22;
mm = 4;
quot = Quotient[nn, mm];
rem = nn - quot * mm;
resultLength = quot (mm - 1) + rem;
res = ConstantArray[0, resultLength];
jj = 1;
Do[
  res[[ii++]] = jj++;
  If[
   Divisible[jj , mm],
   jj++
   ]
  ,
  {ii, 1, resultLength}
  ];
res

And making it "more normal", we get this

nn = 22;
mm = 4;
quot = Quotient[nn, mm];
rem = nn - quot * mm;
resultLength = quot (mm - 1) + rem;
jj = 0;
res =
 Table[
  jj++;
  If[Divisible[jj , mm], jj++];
  jj
  ,
  {ii, 1, resultLength}
  ]

If we do not try to be so clever to predict the length of the result beforehand, we can end up with something that was already mentioned in other answers

nn = 22;
mm = 4;
res =
 Table[
  If[Divisible[jj , mm], Nothing, jj]
  ,
  {jj, 1, nn}
  ]

I recommend starting with this last piece of code and trying to see why the piece of code above it does the same thing.

Answer 14

I grabbed the sequence from jacob akkerboom's post:

FindSequenceFunction[{1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19, 21, 22}, n] // FullSimplify

to get:

Table[1/9 (-6 + 12 n - 3 Cos[(2 n Pi)/3] + Sqrt[3] Sin[(2 n Pi)/3]),{n,1,17}]

edited to show as table

Answer 15

Using Fold:

Fold[If[Mod[#2, 4] != 0, Append[#1, #2], #1] &, {}, Range@20]

{1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19}

Answer 16

Do it with image processing!

PixelValuePositions[Image[{
  Flatten[ConstantArray[{0, 0, 0, 1}, {1, 100/4}]]
}], 0][[All, 1]]

A generalized function:

fun[len_, drop_] := PixelValuePositions[Image[{Flatten[ConstantArray[
      Append[ConstantArray[0, drop - 1], 1], {1, len/drop}]
    ]}], 0][[All, 1]]

It's not too slow either:

fun[10^7, 4]; // RepeatedTiming // First
1.31

Answer 17

Complement[Range@100, FindDivisions[{1, 100, 4}, 50]]

Will get what you want.

---

As the documentation this code could do this thing,but unfortunately there is a bug persisted long time in this function havenot been fixed.

Complement[Range@100, FindDivisions[{1, 100, 4}]]

Answer 18

list = Range[20];

Using Pick

Pick[list, Mod[list, 4], _?Positive]

{1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19}

Using MapIf by Taliesin Beynon

MapWhen = ResourceFunction["MapIf"];

MapWhen[Nothing, Mod[#, 4] == 0 &] @ list

{1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19}

Answer 19

f = DifferenceRoot[
      Function[{y, n}, {y[n + 3] == y[n] + 4, y[1] == 1, y[2] == 2, y[3] == 3}]];

Array[f, 75]
(*    {1, 2, 3, 5, 6, 7, 9, 10, 11, 13, 14, 15, 17, 18, 19, 21, 22, 23, 25, 26, 27, 29,
       30, 31, 33, 34, 35, 37, 38, 39, 41, 42, 43, 45, 46, 47, 49, 50, 51, 53, 54, 55,
       57, 58, 59, 61, 62, 63, 65, 66, 67, 69, 70, 71, 73, 74, 75, 77, 78, 79, 81, 82,
       83, 85, 86, 87, 89, 90, 91, 93, 94, 95, 97, 98, 99}    *)

An explicit formula can be derived from the difference root, agreeing with what others have written:

f[n] // FunctionExpand // FullSimplify
(*    1/9 (-6 + 12 n - 3 Cos[2 n π/3] + Sqrt[3] Sin[2 n π/3])    *)

Answer 20

Select[Range@100, Mod[#, 4] != 0 &]