The digital root, 



X


{\displaystyle X}

, of a number, 



n


{\displaystyle n}

, is calculated:

 find 



X


{\displaystyle X}

 as the sum of the digits of 



n


{\displaystyle n}


 find a new 



X


{\displaystyle X}

 by summing the digits of 



X


{\displaystyle X}

, repeating until 



X


{\displaystyle X}

 has only one digit.
The additive persistence is the number of summations required to obtain the single digit.

The task is to calculate the additive persistence and the digital root of a number, e.g.:





627615


{\displaystyle 627615}

 has additive persistence 



2


{\displaystyle 2}

 and digital root of 



9


{\displaystyle 9}

;




39390


{\displaystyle 39390}

 has additive persistence 



2


{\displaystyle 2}

 and digital root of 



6


{\displaystyle 6}

;




588225


{\displaystyle 588225}

 has additive persistence 



2


{\displaystyle 2}

 and digital root of 



3


{\displaystyle 3}

;




393900588225


{\displaystyle 393900588225}

 has additive persistence 



2


{\displaystyle 2}

 and digital root of 



9


{\displaystyle 9}

;
The digital root may be calculated in bases other than 10.



See

 Casting out nines for this wiki's use of this procedure.
 Digital root/Multiplicative digital root
 Sum digits of an integer
 Digital root sequence on OEIS
 Additive persistence sequence on OEIS
 Iterated digits squaring


program DigitalRoot;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  SysUtils, StrUtils;
 
// FPC has no Big mumbers implementation, Int64 will suffice.
 
procedure GetDigitalRoot(Value: Int64; Base: Byte; var DRoot, Pers: Integer);
var
  i: Integer;
  DigitSum: Int64;
begin
  Pers := 0;
  repeat
    Inc(Pers);
    DigitSum := 0;
    while Value > 0 do
    begin
      Inc(DigitSum, Value mod Base);
      Value := Value div Base;
    end;
    Value := DigitSum;
  until Value < Base;
  DRoot := Value;
End;
 
function IntToStrBase(Value: Int64; Base: Byte):String;
const
  // usable up to 36-Base
  DigitSymbols = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXY';
begin
  Result := '';
  while Value > 0 do
  begin
    Result := DigitSymbols[Value mod Base+1] + Result;
    Value := Value div Base;
  End;
 
End;
 
procedure Display(const Value: Int64; Base: Byte = 10);
var
  DRoot, Pers: Integer;
  StrValue: string;
begin
  GetDigitalRoot(Value, Base, DRoot, Pers);
  WriteLn(Format('%s(%d) has additive persistence %d and digital root %d.',
    [IntToStrBase(Value, Base), Base, Pers, DRoot]));
End;
 
begin
  WriteLn('--- Examples in 10-Base ---');
  Display(627615);
  Display(39390);
  Display(588225);
  Display(393900588225);
 
  WriteLn('--- Examples in 16-Base ---');
  Display(627615, 16);
  Display(39390, 16);
  Display(588225, 16);
  Display(393900588225, 16);
 
  ReadLn;
End.