

Definitions

The   fusc   integer sequence is defined as:

   fusc(0) = 0
   fusc(1) = 1
   for n>1,   the   nth   term is defined as:
   if   n   is even;     fusc(n) = fusc(n/2)
   if   n   is   odd;     fusc(n) = fusc((n-1)/2)   +   fusc((n+1)/2)


Note that MathWorld's definition starts with unity, not zero.   This task will be using the OEIS' version   (above).



An observation

   fusc(A) = fusc(B)
where   A   is some non-negative integer expressed in binary,   and
where   B   is the binary value of   A   reversed.



Fusc numbers are also known as:

   fusc function   (named by Dijkstra, 1982)
   Stern's Diatomic series   (although it starts with unity, not zero)
   Stern-Brocot sequence   (although it starts with unity, not zero)


Task

   show the first   61   fusc numbers (starting at zero) in a horizontal format.
   show the fusc number (and its index) whose length is greater than any previous fusc number length.
   (the length is the number of decimal digits when the fusc number is expressed in base ten.)
   show all numbers with commas   (if appropriate).
   show all output here.


Related task

   RosettaCode Stern-Brocot sequence


Also see

   the MathWorld entry:   Stern's Diatomic Series.
   the OEIS entry:   A2487.


program fusc;
uses
  sysutils;
const
{$IFDEF FPC}
  MaxIdx = 1253 * 1000 * 1000; //19573420; // must be even
{$ELSE}
  // Dynamics arrays in Delphi cann't be to large
  MaxIdx = 19573420;
 {$ENDIF}
 
type
  tFuscElem = LongWord;
  tFusc = array of tFuscElem;
var
  FuscField : tFusc;
 
function commatize(n:NativeUint):string;
var
  l,i : NativeUint;
begin
  str(n,result);
  l := length(result);
  //no commatize
  if l < 4 then
    exit;
  //new length
  i := l+ (l-1) DIV 3;
  setlength(result,i);
  //copy chars to the right place
  While i <> l do
  Begin
    result[i]:= result[l];result[i-1]:= result[l-1];
    result[i-2]:= result[l-2];result[i-3]:= ',';
    dec(i,4);dec(l,3);
  end;
end;
 
procedure OutFusc(StartIdx,EndIdx :NativeInt;const FF:tFusc);
Begin
  IF StartIdx < Low(FF) then StartIdx :=Low(FF);
  IF EndIdx > High(FF) then EndIdx := High(FF);
  For StartIdx := StartIdx to EndIdx do
    write(FF[StartIdx],' ');
  writeln;
end;
 
procedure FuscCalc(var FF:tFusc);
var
  pFFn,pFFi : ^tFuscElem;
  i,n,sum : NativeUint;
Begin
  FF[0]:= 0;
  FF[1]:= 1;
  n := 2;
  i := 1;
  pFFn := @FF[n];
  pFFi := @FF[i];
  sum := pFFi^;
  while n <= MaxIdx-2 do
  begin
    //even
    pFFn^ := sum;//FF[n] := FF[i];
    //odd
    inc(pFFi);//FF[i+1]
    inc(pFFn);//FF[n+1]
    sum := sum+pFFi^;
    pFFn^:= sum; //FF[n+1] := FF[i]+FF[i+1];
    sum := pFFi^;
    inc(pFFn);
    inc(n,2);
    //inc(i);
  end;
end;
 
procedure OutHeader(base:NativeInt);
begin
  writeln('Fusc numbers with more digits in base ',base,' than all previous ones:');
  writeln('Value':10,'Index':10,'  IndexNum/IndexNumBefore');
  writeln('======':10,' =======':14);
end;
 
procedure CheckFuscDigits(const FF:tFusc;Base:NativeUint);
var
  pFF : ^tFuscElem;
  Dig,
  i,lastIdx: NativeInt;
Begin
  OutHeader(base);
  Dig := -1;
  i := 0;
  lastIdx := 0;
  pFF := @FF[0];// aka FF[i]
  repeat
    //search in tight loop speeds up
    repeat
      inc(pFF);
      inc(i);
    until pFF^ >Dig;
 
    if i>= MaxIdx then
      BREAK;
    //output
    write(commatize(pFF^):10,commatize(i):14);//,DIG:10);
    IF lastIdx> 0 then
      write(i/lastIdx:12:7);
    writeln;
    lastIdx := i;
    IF Dig >0 then
      Dig := Dig*Base+Base-1
    else
     Dig := Base-1;
  until false;
  writeln;
end;
 
BEGIN
  setlength(FuscField,MaxIdx);
  FuscCalc(FuscField);
  writeln('First 61 fusc numbers:');
  OutFusc(0,60,FuscField);
 
  CheckFuscDigits(FuscField,10);
  CheckFuscDigits(FuscField,11); //11 ~phi^5  1.6180..^5 = 11,09
  setlength(FuscField,0);
  {$IFDEF WIN}readln;{$ENDIF}
END.