Ludic numbers

Ludic numbers
You are encouraged to solve this task according to the task description, using any language you may know.

Ludic numbers are related to prime numbers as they are generated by a sieve quite like the Sieve of Eratosthenes is used to generate prime numbers.

The first ludic number is 1.
To generate succeeding ludic numbers create an array of increasing integers starting from 2

2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ...

(Loop)

• Take the first member of the resultant array as the next Ludic number 2.
• Remove every 2'nd indexed item from the array (including the first).

2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ...

• (Unrolling a few loops...)
• Take the first member of the resultant array as the next Ludic number 3.
• Remove every 3'rd indexed item from the array (including the first).

3 5 7 9 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 51 ...

• Take the first member of the resultant array as the next Ludic number 5.
• Remove every 5'th indexed item from the array (including the first).

5 7 11 13 17 19 23 25 29 31 35 37 41 43 47 49 53 55 59 61 65 67 71 73 77 ...

• Take the first member of the resultant array as the next Ludic number 7.
• Remove every 7'th indexed item from the array (including the first).

7 11 13 17 23 25 29 31 37 41 43 47 53 55 59 61 67 71 73 77 83 85 89 91 97 ...

• ...
• Take the first member of the current array as the next Ludic number L.
• Remove every L'th indexed item from the array (including the first).
• ...

Task

• Generate and show here the first 25 ludic numbers.
• How many ludic numbers are there less than or equal to 1000?
• Show the 2000..2005'th ludic numbers.
• A triplet is any three numbers $x,$ $x+2,$ $x+6$ where all three numbers are also ludic numbers. Show all triplets of ludic numbers < 250 (Stretch goal)

C

<lang c>#include <stdio.h>

1. include <stdlib.h>

typedef unsigned uint; typedef struct { uint i, v; } filt_t;

// ludics with at least so many elements and reach at least such value uint* ludic(uint min_len, uint min_val, uint *len) { uint cap, i, v, active = 1, nf = 0; filt_t *f = calloc(cap = 2, sizeof(*f)); f[1].i = 4;

for (v = 1; ; ++v) { for (i = 1; i < active && --f[i].i; i++);

if (i < active) f[i].i = f[i].v; else if (nf == f[i].i) f[i].i = f[i].v, ++active; // enable one more filter else { if (nf >= cap) f = realloc(f, sizeof(*f) * (cap*=2)); f[nf] = (filt_t){ v + nf, v }; if (++nf >= min_len && v >= min_val) break; } }

// pack the sequence into a uint[] // filt_t struct was used earlier for cache locality in loops uint *x = (void*) f; for (i = 0; i < nf; i++) x[i] = f[i].v; x = realloc(x, sizeof(*x) * nf);

*len = nf; return x; }

int find(uint *a, uint v) { uint i; for (i = 0; a[i] <= v; i++) if (v == a[i]) return 1; return 0; }

int main(void) { uint len, i, *x = ludic(2005, 1000, &len);

printf("First 25:"); for (i = 0; i < 25; i++) printf(" %u", x[i]); putchar('\n');

for (i = 0; x[i] <= 1000; i++); printf("Ludics below 1000: %u\n", i);

printf("Ludic 2000 to 2005:"); for (i = 2000; i <= 2005; i++) printf(" %u", x[i - 1]); putchar('\n');

printf("Triples below 250:"); for (i = 0; x[i] + 6 <= 250; i++) if (find(x, x[i] + 2) && find(x, x[i] + 6)) printf(" (%u %u %u)", x[i], x[i] + 2, x[i] + 6);

putchar('\n');

free(x); return 0; }</lang>

Output:

First 25: 1 2 3 5 7 11 13 17 23 25 29 37 41 43 47 53 61 67 71 77 83 89 91 97 107
Ludics below 1000: 142
Ludic 2000 to 2005: 21475 21481 21487 21493 21503 21511
Triples below 250: (1 3 7) (5 7 11) (11 13 17) (23 25 29) (41 43 47) (173 175 179) (221 223 227) (233 235 239)

D

Translation of: Python

Translation of: Perl 6

<lang d>import std.stdio, std.range, std.algorithm;

struct Ludics(T) {

   int opApply(int delegate(in ref T) dg) {
       int result;
       T[] rotor, taken = [T(1)];
       result = dg(taken[0]);
       if (result) return result;

       for (T i = 2; ; i++) { // Shoud be stopped if T has a max.
           size_t j = 0;
           for (; j < rotor.length; j++)
               if (!--rotor[j])
                   break;

           if (j < rotor.length) {
               rotor[j] = taken[j + 1];
           } else {
               result = dg(i);
               if (result) return result;
               taken ~= i;
               rotor ~= taken[j + 1];
           }
       }
   }

}

void main() {

   // std.algorithm.until can't be used here.
   uint[] L;
   foreach (const x; Ludics!uint())
       if (L.length < 2005)
           L ~= x;
       else
           break;

   writeln("First 25 ludic primes:\n", L.take(25));
   writefln("\nThere are %d ludic numbers <= 1000.",
            L.until!q{ a > 1000 }.walkLength);

   writeln("\n2000'th .. 2005'th ludic primes:\n", L[1999 .. 2005]);

   enum n = 250;
   const triplets = L.filter!(x => x + 6 < n &&
                                   L.canFind(x+2) && L.canFind(x+6))
                    // Ugly output:
                    //.map!(x => tuple(x, x + 2, x + 6)).array;
                    .map!(x => [x, x + 2, x + 6]).array;
   writefln("\nThere are %d triplets less than %d:\n%s",
            triplets.length, n, triplets);

}</lang>

Output:

First 25 ludic primes:
[1, 2, 3, 5, 7, 11, 13, 17, 23, 25, 29, 37, 41, 43, 47, 53, 61, 67, 71, 77, 83, 89, 91, 97, 107]

There are 142 ludic numbers <= 1000.

2000'th .. 2005'th ludic primes:
[21475, 21481, 21487, 21493, 21503, 21511]

There are 8 triplets less than 250:
[[1, 3, 7], [5, 7, 11], [11, 13, 17], [23, 25, 29], [41, 43, 47], [173, 175, 179], [221, 223, 227], [233, 235, 239]]

The run-time is about 0.03 seconds or less.

Haskell

<lang haskell>import Data.List (unfoldr, genericSplitAt)

ludic :: [Integer] ludic = 1 : unfoldr (\xs@(x:_) -> Just (x, dropEvery x xs)) [2..] where

 dropEvery n = concat . map tail . unfoldr (Just . genericSplitAt n)

main :: IO () main = do

 print $ take 25 $ ludic
 print $ length $ takeWhile (<= 1000) $ ludic
 print $ take 6 $ drop 1999 $ ludic
 -- haven't done triplets task yet</lang>

Output:

[1,2,3,5,7,11,13,17,23,25,29,37,41,43,47,53,61,67,71,77,83,89,91,97,107]
142
[21475,21481,21487,21493,21503,21511]

The filter for dropping every n-th number can be delayed until it's needed, which speeds up the generator, more so when a longer sequence is taken. <lang haskell>ludic = 1:2 : f 3 [3..] [(4,2)] where f n (x:xs) yy@((i,y):ys) | n == i = f n (dropEvery y xs) ys | otherwise = x : f (1+n) xs (yy ++ [(n+x, x)])

dropEvery n s = a ++ dropEvery n (tail b) where (a,b) = splitAt (n-1) s

main = print $ ludic !! 10000</lang>

J

Solution (naive / brute force):<lang j> ludic =: _1 |.!.1 [: {."1 [: (#~0~:{.|i.@#)^:a: 2+i.</lang> Examples:<lang j> # ludic 110 NB. 110 is sufficient to generate 25 Ludic numbers 25

  ludic 110    NB. First 25 Ludic numbers

1 2 3 5 7 11 13 17 23 25 29 37 41 43 47 53 61 67 71 77 83 89 91 97 107

  #ludic 1000  NB. 142 Ludic numbers <= 1000

142

  # ludic 22000   NB. 22000 is sufficient to generate > 2005 Ludic numbers

2042

  (2000+i.6) { ludic 22000  NB. Ludic numbers 2000-2005

21481 21487 21493 21503 21511 21523

  0 2 6 (] (*./ .e.~ # |:@]) +/) ludic 250  NB. Ludic triplets <= 250
 1   3   7
 5   7  11
11  13  17
23  25  29
41  43  47

173 175 179 221 223 227 233 235 239</lang>

Java

Works with: Java version 1.5+

This example uses pre-calculated ranges for the first and third task items (noted in comments). <lang java5>import java.util.ArrayList; import java.util.List;

public class Ludic{ public static List<Integer> ludicUpTo(int n){ List<Integer> ludics = new ArrayList<Integer>(n); for(int i = 1; i <= n; i++){ //fill the initial list ludics.add(i); }

//start at index 1 because the first ludic number is 1 and we don't remove anything for it for(int cursor = 1; cursor < ludics.size(); cursor++){ int thisLudic = ludics.get(cursor); //the first item in the list is a ludic number int removeCursor = cursor + thisLudic; //start removing that many items later while(removeCursor < ludics.size()){ ludics.remove(removeCursor); //remove the next item removeCursor = removeCursor + thisLudic - 1; //move the removal cursor up as many spaces as we need to //then back one to make up for the item we just removed } } return ludics; }

public static List<List<Integer>> getTriplets(List<Integer> ludics){ List<List<Integer>> triplets = new ArrayList<List<Integer>>(); for(int i = 0; i < ludics.size() - 2; i++){ //only need to check up to the third to last item int thisLudic = ludics.get(i); if(ludics.contains(thisLudic + 2) && ludics.contains(thisLudic + 6)){ List<Integer> triplet = new ArrayList<Integer>(3); triplet.add(thisLudic); triplet.add(thisLudic + 2); triplet.add(thisLudic + 6); triplets.add(triplet); } } return triplets; }

public static void main(String[] srgs){ System.out.println("First 25 Ludics: " + ludicUpTo(110)); //110 will get us 25 numbers System.out.println("Ludics up to 1000: " + ludicUpTo(1000).size()); System.out.println("2000th - 2005th Ludics: " + ludicUpTo(22000).subList(1999, 2005)); //22000 will get us 2005 numbers System.out.println("Triplets up to 250: " + getTriplets(ludicUpTo(250))); } }</lang>

Output:

First 25 Ludics: [1, 2, 3, 5, 7, 11, 13, 17, 23, 25, 29, 37, 41, 43, 47, 53, 61, 67, 71, 77, 83, 89, 91, 97, 107]
Ludics up to 1000: 142
2000th - 2005th Ludics: [21475, 21481, 21487, 21493, 21503, 21511]
Triplets up to 250: [[1, 3, 7], [5, 7, 11], [11, 13, 17], [23, 25, 29], [41, 43, 47], [173, 175, 179], [221, 223, 227], [233, 235, 239]]

Perl 6

This implementation has no arbitrary upper limit, since it can keep adding new rotors on the fly. It just gets slower and slower instead... :-) <lang perl6>constant ludic = gather {

       my @taken = take 1;
       my @rotor;

       for 2..* -> $i {
           loop (my $j = 0; $j < @rotor; $j++) {
               --@rotor[$j] or last;
           }
           if $j < @rotor {
               @rotor[$j] = @taken[$j+1];
           }
           else {
               push @taken, take $i;
               push @rotor, @taken[$j+1];
           }
       }
   }

say ludic[^25]; say "Number of Ludic numbers <= 1000: ", +(ludic ...^ * > 1000); say "Ludic numbers 2000..2005: ", ludic[1999..2004];

my \l250 = set ludic ...^ * > 250; say "Ludic triples < 250: ", gather

   for l250.keys -> $a {
       my $b = $a + 2;
       my $c = $a + 6;
       take "<$a $b $c>" if $b ∈ l250 and $c ∈ l250;
   }</lang>

Output:

1 2 3 5 7 11 13 17 23 25 29 37 41 43 47 53 61 67 71 77 83 89 91 97 107
Number of Ludic numbers <= 1000: 142
Ludic numbers 2000..2005: 21475 21481 21487 21493 21503 21511
Ludic triples < 250: <1 3 7> <5 7 11> <11 13 17> <23 25 29> <41 43 47> <173 175 179> <221 223 227> <233 235 239>

PL/I

<lang PL/I>Ludic_numbers: procedure options (main); /* 18 April 2014 */

  declare V(2:22000) fixed, L(2200) fixed;
  declare (step, i, j, k, n) fixed binary;

Ludic: procedure;

  n = hbound(V,1); k = 1; L(1) = 1;
  do i = 2 to n; V(i) = i; end;

  do forever;
     
     k = k + 1; L(k), step = V(2);

     do i = 2 to n by step;
        V(i) = 0;
     end;
     call compress;
     if L(k) >= 21511 then leave;
  end;

  put skip list ('The first 25 Ludic numbers are:');
  put skip edit ( (L(i) do i = 1 to 25) ) (F(4));

  k = 0;
  do i = 1 by 1;
     if L(i) < 1000 then k = k + 1; else leave;
  end;

  put skip list ('There are ' || trim(k) || ' Ludic numbers < 1000');
  put skip list ('Six Ludic numbers from the 2000-th:');
  put skip edit ( (L(i) do i = 2000 to 2005) ) (f(7));
  /* Triples are values of the form x, x+2, x+6 */
  put skip list ('Triples are:');
  put skip;
  i = 1;
  do i = 1 by 1 while (L(i+2) <= 250);
     if (L(i) = L(i+1) - 2) & (L(i) = L(i+2) - 6) then
        put edit ('(', L(i), L(i+1), L(i+2), ') ' ) (A, 3 F(4), A);
  end;

compress: procedure;

  j = 2;
  do i = 2 to n;
     if V(i) ^= 0 then do; V(j) = V(i); j = j + 1; end;
  end;
  n = j-1;

end compress;

end Ludic;

call Ludic;

end Ludic_numbers;</lang> Output:

The first 25 Ludic numbers are: 
   1   2   3   5   7  11  13  17  23  25  29  37  41  43  47
  53  61  67  71  77  83  89  91  97 107
There are 142 Ludic numbers < 1000 
Six Ludic numbers from the 2000-th: 
  21475  21481  21487  21493  21503  21511
Triples are: 
(   5   7  11) (  11  13  17) (  23  25  29) (  41  43  47)
( 173 175 179) ( 221 223 227) ( 233 235 239)

Python

Python: Fast

<lang python>def ludic(nmax=100000):

   yield 1
   lst = list(range(2, nmax + 1))
   while lst:
       yield lst[0]
       del lst[::lst[0]]

ludics = [l for i,l in zip(range(2005), ludic())]

print('First 25 ludic primes:') print(ludics[:25]) print("\nThere are %i ludic numbers <= 1000"

     % sum(1 for l in ludics if l <= 1000)) 

print("\n2000'th..2005'th ludic primes:") print(ludics[2000-1: 2005])

n = 250 triplets = [(x, x+2, x+6)

           for x in ludics
           if x+6 < n and x+2 in ludics and x+6 in ludics]

print('\nThere are %i triplets less than %i:\n %r'

     % (len(triplets), n, triplets))</lang>

Output:

First 25 ludic primes:
[1, 2, 3, 5, 7, 11, 13, 17, 23, 25, 29, 37, 41, 43, 47, 53, 61, 67, 71, 77, 83, 89, 91, 97, 107]

There are 142 ludic numbers <= 1000

2000'th..2005'th ludic primes:
[21475, 21481, 21487, 21493, 21503, 21511]

There are 8 triplets less than 250:
  [(1, 3, 7), (5, 7, 11), (11, 13, 17), (23, 25, 29), (41, 43, 47), (173, 175, 179), (221, 223, 227), (233, 235, 239)]

Python: No set maximum

The following version of function ludic will return ludic numbers until reaching system limits. It is less efficient than the fast version as all lucid numbers so far are cached; on exhausting the current lst a new list of twice the size is created and the previous deletions applied before continuing. <lang python>def ludic(nmax=64):

   yield 1
   taken = []
   while True:
       lst, nmax = list(range(2, nmax + 1)), nmax * 2
       for t in taken:
           del lst[::t]
       while lst:
           t = lst[0]
           taken.append(t)
           yield t
           del lst[::t]</lang>

Output is the same as for the fast version.

REXX

<lang rexx>/*REXX program to display (a range of) ludic numbers, or a count of same*/ parse arg N count bot top triples . /*obtain optional parameters/args*/ if N== then N=25 /*Not specified? Use the default.*/ if count== then count=1000 /* " " " " " */ if bot== then bot=2000 /* " " " " " */ if top== then top=2005 /* " " " " " */ if triples== then triples=250-1 /* " " " " " */ say 'The first ' N " ludic numbers: " ludic(n) say say "There are " words(ludic(-count)) ' ludic numbers from 1───►'count " (inclusive)." say say "The " bot ' to ' top " ludic numbers are: " ludic(bot,top) $=ludic(-triples) 0 0; #=0; @= say

    do j=1  for words($); _=word($,j) /*it is known that ludic _ exists*/
    if wordpos(_+2,$)==0 | wordpos(_+6,$)==0  then iterate   /*¬triple.*/
    #=#+1;    @=@ '◄'_  _+2  _+6"► "  /*bump triple counter,  and ···  */
    end   /*j*/                       /* [↑]  append found triple ──► @*/

if @== then say 'From 1──►'triples", no triples found."

         else  say  'From 1──►'triples", "   #   ' triples found:'   @

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────LUDIC subroutine────────────────────*/ ludic: procedure; parse arg m 1 mm,h; am=abs(m); if h\== then am=h $=1 2; @= /*$=ludic #s superset, @=# series*/

                                      /* [↓]  construct a ludic series.*/
 do j=3  by 2  to am * max(1,15*((m>0)|h\==));  @=@ j;  end;     @=@' '
                                      /* [↑]  high limit: approx|exact */
 do  while  words(@)\==0              /* [↓]  examine the first word.  */
 f=word(@,1);       $=$ f             /*append this first word to list.*/
      do d=1  by f  while d<=words(@) /*use 1st #, elide all occurances*/
      @=changestr(' 'word(@,d)" ",@, ' . ')  /*delete the # in the seq#*/
      end   /*d*/                     /* [↑]  done eliding "1st" number*/
 @=translate(@,,.)                    /*translate periods to blanks.   */
 end         /*forever*/              /* [↑]  done eliding ludic #s.   */

@=space(@) /*remove extra blanks from list. */

if h== then return subword($,1,am) /*return a range of ludic numbers*/

              return subword($,m,h-m+1)  /*return a section of a range.*/</lang>

Some older REXXes don't have a changestr bif, so one is included here ──► CHANGESTR.REX.

output   using the defaults for input:

The first  25  ludic numbers:  1 2 3 5 7 11 13 17 23 25 29 37 41 43 47 53 61 67 71 77 83 89 91 97 107

There are  142  ludic numbers from 1───►1000  (inclusive).

The  2000  to  2005  ludic numbers are:  21475 21481 21487 21493 21503 21511

From 1──►249,  8  triples found:  ◄1 3 7►  ◄5 7 11►  ◄11 13 17►  ◄23 25 29►  ◄41 43 47►  ◄173 175 179►  ◄221 223 227►  ◄233 235 239►

Ruby

<lang ruby>def ludic(nmax=100000)

 Enumerator.new do |y|
   y << 1
   ary = *2..nmax
   until ary.empty?
     y << (n = ary.first)
     (0...ary.size).step(n){|i| ary[i] = nil}
     ary.compact!
   end
 end

end

puts "First 25 Ludic numbers:", ludic.first(25).to_s

puts "Ludics below 1000:", ludic(1000).count

puts "Ludic numbers 2000 to 2005:", ludic.first(2005).last(6).to_s

ludics = ludic(250).to_a puts "Ludic triples below 250:",

    ludics.select{|x| ludics.include?(x+2) and ludics.include?(x+6)}.map{|x| [x, x+2, x+6]}.to_s</lang>

Output:

First 25 Ludic numbers:
[1, 2, 3, 5, 7, 11, 13, 17, 23, 25, 29, 37, 41, 43, 47, 53, 61, 67, 71, 77, 83, 89, 91, 97, 107]
Ludics below 1000:
142
Ludic numbers 2000 to 2005:
[21475, 21481, 21487, 21493, 21503, 21511]
Ludic triples below 250:
[[1, 3, 7], [5, 7, 11], [11, 13, 17], [23, 25, 29], [41, 43, 47], [173, 175, 179], [221, 223, 227], [233, 235, 239]]

Tcl

Works with: Tcl version 8.6

The limit on the number of values generated is the depth of stack; this can be set to arbitrarily deep to go as far as you want. Provided you are prepared to wait for the values to be generated. <lang tcl>package require Tcl 8.6

proc ludic n {

   global ludicList ludicGenerator
   for {} {[llength $ludicList] <= $n} {lappend ludicList $i} {

set i [$ludicGenerator] set ludicGenerator [coroutine L_$i apply {{gen k} { yield [info coroutine] while true { set val [$gen] if {[incr i] == $k} {set i 0} else {yield $val} } }} $ludicGenerator $i]

   }
   return [lindex $ludicList $n]

}

1. Bootstrap the generator sequence

set ludicList [list 1] set ludicGenerator [coroutine L_1 apply {{} {

   set n 1
   yield [info coroutine]
   while true {yield [incr n]}

}}]

1. Default of 1000 is not enough

interp recursionlimit {} 5000

for {set i 0;set l {}} {$i < 25} {incr i} {lappend l [ludic $i]} puts "first25: [join $l ,]"

for {set i 0} {[ludic $i] <= 1000} {incr i} {} puts "below=1000: $i"

for {set i 1999;set l {}} {$i < 2005} {incr i} {lappend l [ludic $i]} puts "2000-2005: [join $l ,]"

for {set i 0} {[ludic $i] < 256} {incr i} {set isl([ludic $i]) $i} for {set i 1;set l {}} {$i < 250} {incr i} {

   if {[info exists isl($i)] && [info exists isl([expr {$i+2}])] && [info exists isl([expr {$i+6}])]} {

lappend l ($i,[expr {$i+2}],[expr {$i+6}])

   }

} puts "triplets: [join $l ,]"</lang>

Output:

first25: 1,2,3,5,7,11,13,17,23,25,29,37,41,43,47,53,61,67,71,77,83,89,91,97,107
below=1000: 142
2000-2005: 21475,21481,21487,21493,21503,21511
triplets: (1,3,7),(5,7,11),(11,13,17),(23,25,29),(41,43,47),(173,175,179),(221,223,227),(233,235,239)