aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Task/Digital-root/Ada/digital-root-1.ada Normal file
View file

@ -0,0 +1,15 @@
package Generic_Root is
type Number is range 0 .. 2**63-1;
type Number_Array is array(Positive range <>) of Number;
type Base_Type is range 2 .. 16; -- any reasonable base to write down numb
generic
with function "&"(X, Y: Number) return Number;
-- instantiate with "+" for additive digital roots
-- instantiate with "*" for multiplicative digital roots
procedure Compute_Root(N: Number;
Root, Persistence: out Number;
Base: Base_Type := 10);
-- computes Root and Persistence of N;
end Generic_Root;

26
Task/Digital-root/Ada/digital-root-2.ada Normal file
View file

@ -0,0 +1,26 @@
package body Generic_Root is
procedure Compute_Root(N: Number;
Root, Persistence: out Number;
Base: Base_Type := 10) is
function Digit_Sum(N: Number) return Number is
begin
if N < Number(Base) then
return N;
else
return (N mod Number(Base)) & Digit_Sum(N / Number(Base));
end if;
end Digit_Sum;
begin
if N < Number(Base) then
Root := N;
Persistence := 0;
else
Compute_Root(Digit_Sum(N), Root, Persistence, Base);
Persistence := Persistence + 1;
end if;
end Compute_Root;
end Generic_Root;

26
Task/Digital-root/Ada/digital-root-3.ada Normal file
View file

@ -0,0 +1,26 @@
with Generic_Root, Ada.Text_IO; use Generic_Root;
procedure Digital_Root is
procedure Compute is new Compute_Root("+");
-- "+" for additive digital roots
package TIO renames Ada.Text_IO;
procedure Print_Roots(Inputs: Number_Array; Base: Base_Type) is
package NIO is new TIO.Integer_IO(Number);
Root, Pers: Number;
begin
for I in Inputs'Range loop
Compute(Inputs(I), Root, Pers, Base);
NIO.Put(Inputs(I), Base => Integer(Base), Width => 12);
NIO.Put(Root, Base => Integer(Base), Width => 9);
NIO.Put(Pers, Base => Integer(Base), Width => 12);
TIO.Put_Line(" " & Base_Type'Image(Base));
end loop;
end Print_Roots;
begin
TIO.Put_Line(" Number Root Persistence Base");
Print_Roots((961038, 923594037444, 670033, 448944221089), Base => 10);
Print_Roots((16#7e0#, 16#14e344#, 16#12343210#), Base => 16);
end Digital_Root;

48
Task/Digital-root/Ada/digital-root.ada
View file

@ -1,48 +0,0 @@
with Ada.Text_IO;
procedure Digital_Root is
type Number is range 0 .. 2**63-1;
type Number_Array is array(Positive range <>) of Number;
type Base_Type is range 2 .. 16; -- any reasonable base to write down numbers
procedure Compute(N: Number; Digital_Root, Persistence: out Number;
Base: Base_Type := 10) is
function Digit_Sum(N: Number) return Number is
begin
if N < Number(Base) then
return N;
else
return (N mod Number(Base)) + Digit_Sum(N / Number(Base));
end if;
end Digit_Sum;
begin
if N < Number(Base) then
Digital_Root := N;
Persistence := 0;
else
Compute(Digit_Sum(N), Digital_Root, Persistence, Base);
Persistence := Persistence + 1;
end if;
end Compute;
procedure Compute_And_Write(Values: Number_Array; Base: Base_Type := 10) is
Root, Pers: Number;
package NIO is new Ada.Text_IO.Integer_IO(Number);
begin
for I in Values'Range loop
Compute(Values(I), Root, Pers, Base);
NIO.Put(Values(I), Base => Integer(Base), Width => 12);
Ada.Text_IO.Put(" has digital root ");
NIO.Put(Root, Base => Integer(Base), Width => 0);
Ada.Text_IO.Put(" and additive persistence" & Number'Image(Pers));
Ada.Text_IO.Put_Line(" (base" & Base_Type'Image(Base) & ").");
end loop;
end Compute_And_Write;
begin
Compute_And_Write((961038, 923594037444, 670033, 448944221089));
Compute_And_Write((16#7e0#, 16#14e344#, 16#12343210#), 16);
end Digital_Root;