2016 Update

Task/Ludic-numbers/Pascal/ludic-numbers-1.pascal

@@ -0,0 +1,144 @@
+program lucid;
+{$IFDEF FPC}
+  {$MODE objFPC} // useful for x64
+{$ENDIF}
+
+const
+  //66164 -> last < 1000*1000;
+  maxLudicCnt = 2005;//must be > 1
+type
+
+  tDelta = record
+             dNum,
+             dCnt : LongInt;
+           end;
+
+  tpDelta = ^tDelta;
+  tLudicList = array of tDelta;
+
+  tArrdelta =array[0..0] of tDelta;
+  tpLl = ^tArrdelta;
+
+function isLudic(plL:tpLl;maxIdx:nativeInt):boolean;
+var
+  i,
+  cn : NativeInt;
+Begin
+  //check if n is 'hit' by a prior ludic number
+  For i := 1 to maxIdx do
+    with plL^[i] do
+    Begin
+      //Mask read modify write reread
+      //dec(dCnt);IF dCnt= 0
+      cn := dCnt;
+      IF cn = 1 then
+      Begin
+        dcnt := dNum;
+        isLudic := false;
+        EXIT;
+       end;
+      dcnt := cn-1;
+    end;
+  isLudic := true;
+end;
+
+procedure CreateLudicList(var Ll:tLudicList);
+var
+  plL : tpLl;
+  n,LudicCnt : NativeUint;
+begin
+  // special case 1
+  n := 1;
+  Ll[0].dNum := 1;
+
+  plL := @Ll[0];
+  LudicCnt := 0;
+  repeat
+    inc(n);
+    If isLudic(plL,LudicCnt ) then
+    Begin
+      inc(LudicCnt);
+      with plL^[LudicCnt] do
+      Begin
+        dNum := n;
+        dCnt := n;
+      end;
+      IF (LudicCnt >= High(LL)) then
+        BREAK;
+    end;
+  until false;
+end;
+
+procedure  firstN(var Ll:tLudicList;cnt: NativeUint);
+var
+  i : NativeInt;
+Begin
+  writeln('First ',cnt,' ludic numbers:');
+  For i := 0 to cnt-2 do
+    write(Ll[i].dNum,',');
+  writeln(Ll[cnt-1].dNum);
+end;
+
+procedure triples(var Ll:tLudicList;max: NativeUint);
+var
+  i,
+  chk : NativeUint;
+Begin
+  // special case 1,3,7
+  writeln('Ludic triples below ',max);
+  write('(',ll[0].dNum,',',ll[2].dNum,',',ll[4].dNum,') ');
+
+  For i := 1 to High(Ll) do
+  Begin
+    chk := ll[i].dNum;
+    If chk> max then
+      break;
+    If (ll[i+2].dNum = chk+6) AND (ll[i+1].dNum = chk+2) then
+      write('(',ll[i].dNum,',',ll[i+1].dNum,',',ll[i+2].dNum,') ');
+  end;
+  writeln;
+  writeln;
+end;
+
+procedure LastLucid(var Ll:tLudicList;start,cnt: NativeUint);
+var
+  limit,i : NativeUint;
+Begin
+  dec(start);
+  limit := high(Ll);
+  IF cnt >= limit then
+    cnt := limit;
+  if start+cnt >limit then
+    start := limit-cnt;
+  writeln(Start+1,'.th to ',Start+cnt+1,'.th ludic number');
+  For i := 0 to cnt-1 do
+    write(Ll[i+start].dNum,',');
+  writeln(Ll[start+cnt].dNum);
+  writeln;
+end;
+
+function CountLudic(var Ll:tLudicList;Limit: NativeUint):NativeUint;
+var
+  i,res : NativeUint;
+Begin
+  res := 0;
+  For i := 0 to High(Ll) do begin
+    IF Ll[i].dnum <= Limit then
+      inc(res)
+    else
+      BREAK;
+  CountLudic:= res;
+end;
+
+end;
+var
+  LudicList : tLudicList;
+BEGIN
+  setlength(LudicList,maxLudicCnt);
+  CreateLudicList(LudicList);
+  firstN(LudicList,25);
+  writeln('There are ',CountLudic(LudicList,1000),' ludic numbers below 1000');
+  LastLucid(LudicList,2000,5);
+  LastLucid(LudicList,maxLudicCnt,5);
+  triples(LudicList,250);//all-> (LudicList,LudicList[High(LudicList)].dNum);
+END.

Task/Ludic-numbers/Pascal/ludic-numbers-2.pascal

@@ -0,0 +1,151 @@
+program ludic;
+{$IFDEF FPC}{$MODE DELPHI}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
+uses
+  sysutils;
+const
+  MAXNUM =21511;// > 1
+  //1561333;-> 100000 ludic numbers
+  //1561243,1561291,1561301,1561307,1561313,1561333
+type
+  tarrLudic = array of byte;
+  tLudics = array of LongWord;
+
+var
+  Ludiclst : tarrLudic;
+
+procedure Firsttwentyfive;
+var
+  i,actLudic : NativeInt;
+Begin
+  writeln('First 25 ludic numbers');
+  actLudic:= 1;
+  For i := 1 to 25 do
+  Begin
+    write(actLudic:3,',');
+    inc(actLudic,Ludiclst[actLudic]);
+    IF i MOD 5 = 0 then
+      writeln(#8#32);
+  end;
+  writeln;
+end;
+
+procedure CountBelowOneThousand;
+var
+  cnt,actLudic : NativeInt;
+Begin
+  write('Count of ludic numbers below 1000 = ');
+  actLudic:= 1;
+  cnt := 1;
+  while actLudic <= 1000 do
+  Begin
+    inc(actLudic,Ludiclst[actLudic]);
+    inc(cnt);
+  end;
+  dec(cnt);
+  writeln(cnt);writeln;
+end;
+
+procedure Show2000til2005;
+var
+  cnt,actLudic : NativeInt;
+Begin
+  writeln('ludic number #2000 to #2005');
+  actLudic:= 1;
+  cnt := 1;
+  while cnt < 2000 do
+  Begin
+    inc(actLudic,Ludiclst[actLudic]);
+    inc(cnt);
+  end;
+  while cnt < 2005 do
+  Begin
+    write(actLudic,',');
+    inc(actLudic,Ludiclst[actLudic]);
+    inc(cnt);
+  end;
+  writeln(actLudic);writeln;
+end;
+
+procedure ShowTriplets;
+var
+  actLudic,lastDelta : NativeInt;
+Begin
+  writeln('ludic numbers triplets below 250');
+  actLudic:= 1;
+  while actLudic < 250-5 do
+  Begin
+    IF (Ludiclst[actLudic]   <> 0) AND
+       (Ludiclst[actLudic+2] <> 0) AND
+       (Ludiclst[actLudic+6] <> 0) then
+      writeln('{',actLudic,'|',actLudic+2,'|',actLudic+6,'} ');
+    inc(actLudic);
+  end;
+  writeln;
+end;
+
+procedure CheckMaxdist;
+var
+  actLudic,Delta,MaxDelta : NativeInt;
+Begin
+  MaxDelta := 0;
+  actLudic:= 1;
+  repeat
+    delta := Ludiclst[actLudic];
+    inc(actLudic,delta);
+    IF MAxDelta<delta then
+       MAxDelta:= delta;
+  until actLudic>= MAXNUM;
+  writeln('MaxDist ',MAxDelta);writeln;
+end;
+
+function GetLudics:tLudics;
+//Array of byte containing the distance to next ludic number
+//eliminated numbers are set to 0
+var
+  i,actLudic,actcnt,delta,actPos,lastPos,ludicCnt: NativeInt;
+Begin
+  setlength(Ludiclst,MAXNUM+1);
+  For i := MAXNUM downto 0 do
+    Ludiclst[i]:= 1;
+  actLudic := 1;
+  ludicCnt := 1;
+
+  repeat
+    inc(actLudic,Ludiclst[actLudic]);
+    IF actLudic> MAXNUM then
+      BREAK;
+    inc(ludicCnt);
+    actPos := actLudic;
+    actcnt := 0;
+    // Only if there are enough ludics left
+    IF MaxNum-ludicCnt-actPos > actPos then
+    Begin
+    //eliminate every element in actLudic-distance
+      //delta so i can set Ludiclst[actpos] to zero
+      delta := Ludiclst[actpos];
+      repeat
+        lastPos := actPos;
+        inc(actpos,delta);
+        if actPos>=MAXNUM then
+          BREAK;
+        delta := Ludiclst[actpos];
+        inc(actcnt);
+        IF actcnt= actLudic then
+        Begin
+          inc(Ludiclst[LastPos],delta);
+          //mark as not ludic
+          Ludiclst[actpos] := 0;
+          actcnt := 0;
+        end;
+      until false;
+    end;
+  until false;
+  writeln(ludicCnt,' ludic numbers upto ',MAXNUM,#13#10);
+end;
+
+BEGIN
+  GetLudics;
+  CheckMaxdist;
+  Firsttwentyfive;CountBelowOneThousand;Show2000til2005;ShowTriplets ;
+  setlength(Ludiclst,0)
+END.