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

21
Task/Digital-root/00DESCRIPTION
View file

@ -1,20 +1,21 @@
Related task [[Sum digits of an integer]]
The digital root (X) of a number (N) is calculated:
: find X as the sum of the digits of N
: find a new X by summing the digits of X repeating until X has only one digit.
The digital root, <math>X</math>, of a number, <math>n</math>, is calculated:
: find <math>X</math> as the sum of the digits of <math>n</math>
: find a new <math>X</math> by summing the digits of <math>X</math>, repeating until <math>X</math> 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 has additive persistence 2 and digital root of 9;
:39390 has additive persistence 2 and digital root of 6;
:588225 has additive persistence 2 and digital root of 3;
:393900588225 has additive persistence 2 and digital root of 9;
The task is to calculate the additive persistence and the digital root of a number, e.g.:
:<math>627615</math> has additive persistence <math>2</math> and digital root of <math>9</math>;
:<math>39390</math> has additive persistence <math>2</math> and digital root of <math>6</math>;
:<math>588225</math> has additive persistence <math>2</math> and digital root of <math>3</math>;
:<math>393900588225</math> has additive persistence <math>2</math> and digital root of <math>9</math>;
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]]
*[[oeis:A010888|Digital root sequence on OEIS]]
*[[oeis:A031286|Additive persistence sequence on OEIS]]
*[[Iterated digits squaring]]

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;

2
Task/Digital-root/D/digital-root.d
View file

@ -2,7 +2,7 @@ import std.stdio, std.typecons, std.conv, std.bigint, std.math,
std.traits;
Tuple!(uint, Unqual!T) digitalRoot(T)(in T inRoot, in uint base)
pure /*nothrow*/
pure nothrow
in {
assert(base > 1);
} body {

69
Task/Digital-root/Eiffel/digital-root.e Normal file
View file

@ -0,0 +1,69 @@
class
APPLICATION
inherit
ARGUMENTS
create
make
feature {NONE} -- Initialization
digital_root_test_values: ARRAY [INTEGER_64]
-- Test values.
once
Result := <<670033, 39390, 588225, 393900588225>> -- base 10
end
digital_root_expected_result: ARRAY [INTEGER_64]
-- Expected result values.
once
Result := <<1, 6, 3, 9>> -- base 10
end
make
local
results: ARRAY [INTEGER_64]
i: INTEGER
do
from
i := 1
until
i > digital_root_test_values.count
loop
results := compute_digital_root (digital_root_test_values [i], 10)
if results [2] ~ digital_root_expected_result [i] then
print ("%N" + digital_root_test_values [i].out + " has additive persistence " + results [1].out + " and digital root " + results [2].out)
else
print ("Error in the calculation of the digital root of " + digital_root_test_values [i].out + ". Expected value: " + digital_root_expected_result [i].out + ", produced value: " + results [2].out)
end
i := i + 1
end
end
compute_digital_root (a_number: INTEGER_64; a_base: INTEGER): ARRAY [INTEGER_64]
-- Returns additive persistence and digital root of `a_number' using `a_base'.
require
valid_number: a_number >= 0
valid_base: a_base > 1
local
temp_num: INTEGER_64
do
create Result.make_filled (0, 1, 2)
from
Result [2] := a_number
until
Result [2] < a_base
loop
from
temp_num := Result [2]
Result [2] := 0
until
temp_num = 0
loop
Result [2] := Result [2] + (temp_num \\ a_base)
temp_num := temp_num // a_base
end
Result [1] := Result [1] + 1
end
end

1
Task/Digital-root/Erlang/digital-root.erl
View file

@ -8,7 +8,6 @@ task() ->
[io:fwrite("~p has additive persistence ~p and digital root of ~p~n", [X, Y, Z]) || {X, {Y, Z}} <- lists:zip(Ns, Persistances)].
persistance_root( X ) -> persistance_root( sum_digits:sum_digits(X), 1 ).
persistance_root( X, N ) when X < 10 -> {N, X};

31
Task/Digital-root/Fortran/digital-root.f Normal file
View file

@ -0,0 +1,31 @@
program prec
implicit none
integer(kind=16) :: i
i = 627615
call root_pers(i)
i = 39390
call root_pers(i)
i = 588225
call root_pers(i)
i = 393900588225
call root_pers(i)
end program
subroutine root_pers(i)
implicit none
integer(kind=16) :: N, s, a, i
write(*,*) 'Number: ', i
n = i
a = 0
do while(n.ge.10)
a = a + 1
s = 0
do while(n.gt.0)
s = s + n-int(real(n,kind=8)/10.0D0,kind=8) * 10_8
n = int(real(n,kind=16)/real(10,kind=8),kind=8)
end do
n = s
end do
write(*,*) 'digital root = ', s
write(*,*) 'additive persistance = ', a
end subroutine

98
Task/Digital-root/Go/digital-root.go
View file

@ -1,56 +1,68 @@
package main
import (
"fmt"
"log"
"strconv"
"digit"
"fmt"
"log"
"strconv"
)
type testCase struct {
n string
base int
persistence int
root int
func Sum(i uint64, base int) (sum int) {
b64 := uint64(base)
for ; i > 0; i /= b64 {
sum += int(i % b64)
}
return
}
var testCases = []testCase{
{"627615", 10, 2, 9},
{"39390", 10, 2, 6},
{"588225", 10, 2, 3},
{"393900588225", 10, 2, 9},
func DigitalRoot(n uint64, base int) (persistence, root int) {
root = int(n)
for x := n; x >= uint64(base); x = uint64(root) {
root = Sum(x, base)
persistence++
}
return
}
func root(n string, base int) (persistence, root int, err error) {
i, err := digit.Sum(n, base)
if err != nil {
return 0, 0, err
}
if len(n) == 1 {
return 0, int(i), nil
}
for {
persistence++
n := strconv.FormatInt(i, base)
if len(n) == 1 {
root = int(i)
break
}
i, _ = digit.Sum(n, base)
}
return
// Normally the below would be moved to a *_test.go file and
// use the testing package to be runnable as a regular test.
var testCases = []struct {
n string
base int
persistence int
root int
}{
{"627615", 10, 2, 9},
{"39390", 10, 2, 6},
{"588225", 10, 2, 3},
{"393900588225", 10, 2, 9},
{"1", 10, 0, 1},
{"11", 10, 1, 2},
{"e", 16, 0, 0xe},
{"87", 16, 1, 0xf},
// From Applesoft BASIC example:
{"DigitalRoot", 30, 2, 26}, // 26 is Q base 30
// From C++ example:
{"448944221089", 10, 3, 1},
{"7e0", 16, 2, 0x6},
{"14e344", 16, 2, 0xf},
{"d60141", 16, 2, 0xa},
{"12343210", 16, 2, 0x1},
// From the D example:
{"1101122201121110011000000", 3, 3, 1},
}
func main() {
for _, tc := range testCases {
p, r, err := root(tc.n, tc.base)
if err != nil {
log.Fatal(err)
}
if p != tc.persistence || r != tc.root {
log.Fatal("test case", tc)
}
}
fmt.Println("all tests passed")
for _, tc := range testCases {
n, err := strconv.ParseUint(tc.n, tc.base, 64)
if err != nil {
log.Fatal(err)
}
p, r := DigitalRoot(n, tc.base)
fmt.Printf("%12v (base %2d) has additive persistence %d and digital root %s\n",
tc.n, tc.base, p, strconv.FormatInt(int64(r), tc.base))
if p != tc.persistence || r != tc.root {
log.Fatalln("bad result:", tc, p, r)
}
}
}

12
Task/Digital-root/Haskell/digital-root-1.hs
View file

@ -1,10 +1,10 @@
digSum base = f 0 where
f a n = let (q,r) = n`divMod`base in
if q == 0 then a+r else f (a+r) q
import Data.List (unfoldr)
digRoot base = f 0 where
f p n | n < base = (p,n)
| otherwise = f (p+1) (digSum base n)
digSum base = sum . unfoldr f where
f 0 = Nothing
f n = Just (r,q) where (q,r) = n `divMod` base
digRoot base = head . dropWhile ((>= base).snd) . zip [0..] . iterate (digSum base)
main = do
putStrLn "in base 10:"

11
Task/Digital-root/Haskell/digital-root-2.hs
View file

@ -1,4 +1,4 @@
import Data.List (elemIndex)
import Data.List (elemIndex, unfoldr)
import Data.Maybe (fromJust)
import Numeric (readInt, showIntAtBase)
@ -22,17 +22,16 @@ printDigRoot b s = do
-- Convert a base b number to a list of digits, from least to most significant.
toDigits :: Integral a => a -> a -> [a]
toDigits b n = toDigits' n 0
where toDigits' 0 0 = [0]
toDigits' 0 _ = []
toDigits' m _ = let (q, r) = m `quotRem` b in r : toDigits' q r
toDigits b = unfoldr f
where f 0 = Nothing
f n = Just (r,q) where (q,r) = n `quotRem` b
-- A list of digits, for bases up to 36.
digits :: String
digits = ['0'..'9'] ++ ['A'..'Z']
-- Return a number's base b string representation.
intToStr :: Integral a => a -> a -> String
intToStr :: (Integral a, Show a) => a -> a -> String
intToStr b n | b < 2 || b > 36 = error "intToStr: base must be in [2..36]"
| otherwise = showIntAtBase b (digits !!) n ""

16
Task/Digital-root/JavaScript/digital-root.js Normal file
View file

@ -0,0 +1,16 @@
/// Digital root of 'x' in base 'b'.
/// @return {addpers, digrt}
function digitalRootBase(x,b) {
if (x < b)
return {addpers:0, digrt:x};
var fauxroot = 0;
while (b <= x) {
x = (x / b) | 0;
fauxroot += x % b;
}
var rootobj = digitalRootBase(fauxroot,b);
rootobj.addpers += 1;
return rootobj;
}

13
Task/Digital-root/Lua/digital-root.lua Normal file
View file

@ -0,0 +1,13 @@
function digital_root(n, base)
p = 0
while n > 9.5 do
n = sum_digits(n, base)
p = p + 1
end
return n, p
end
print(digital_root(627615, 10))
print(digital_root(39390, 10))
print(digital_root(588225, 10))
print(digital_root(393900588225, 10))

0
Task/Digital-root/PL-I/digital-root.pli → Task/Digital-root/PL-I/digital-root-1.pli
View file

15
Task/Digital-root/PL-I/digital-root-2.pli Normal file
View file

@ -0,0 +1,15 @@
digital: procedure options (main); /* 29 April 2014 */
declare 1 pict union,
2 x picture '9999999999999',
2 d(13) picture '9';
declare ap fixed, n fixed (15);
do n = 5, 627615, 39390, 588225, 393900588225, 99999999999;
x = n;
do ap = 1 by 1 until (x < 10);
x = sum(d);
end;
put skip data (n, x, ap);
end;
end digital;

12
Task/Digital-root/REXX/digital-root-2.rexx
View file

@ -1,8 +1,8 @@
/*REXX program calculates the digital root and additive persistence. */
/*REXX program calculates the digital root and additive persisteance. */
numeric digits 1000 /*lets handle biguns.*/
say 'digital' /*part of the header.*/
say ' root persistence' center('number',79) /* " " " " */
say '═══════ ═══════════' center('' ,79,'═') /* " " " " */
say ' root persistence' center('number',81) /* " " " " */
say '═══════ ═══════════' center('' ,81,'═') /* " " " " */
call digRoot 627615
call digRoot 39390
call digRoot 588225
@ -11,11 +11,11 @@ call digRoot 8999999999999999999999999999999999999999999999999999999999999999999
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────DIGROOT subroutine──────────────────*/
digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
r=r+substr(x,j,1) /*add a digit to the digital root*/
end /*j*/
x=r /*'new' num, it may be multi-dig.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */
return

11
Task/Digital-root/REXX/digital-root-3.rexx
View file

@ -1,11 +1,14 @@
∙
∙
∙
/*──────────────────────────────────DIGROOT subroutine──────────────────*/
digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/
do j=1 for length(x) /*add each digit in the number. */
?=substr(x,j,1) /*pick off a char, maybe a dig ? */
if datatype(?,'W') then r=r+? /*add a digit to the digital root*/
if datatype(?,'W') then r=r+? /*add a digit to the digital root*/
end /*j*/
x=r /*'new' num, it may be multi-dig.*/
end /*pers*/
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */
say center(x,7) center(pers,11) ox /*show a nicely formatted line. */
return

19
Task/Digital-root/Ruby/digital-root.rb
View file

@ -1,19 +1,24 @@
class String
def digroot_persistence(base)
def digroot_persistence(base=10)
num = self.to_i(base)
persistence = 0
until num < base do
num = num.to_s(base).each_char.reduce(0){|m, c| m += c.to_i(base) }
num = num.to_s(base).each_char.reduce(0){|m, c| m + c.to_i(base) }
persistence += 1
end
[num.to_s(base), persistence]
end
end
#Handles bases upto 36; Demo:
puts "--- Examples in 10-Base ---"
%w(627615 39390 588225 393900588225).each do |str|
puts "%12s has a digital root of %s and a persistence of %s." % [str, *str.digroot_persistence]
end
puts "\n--- Examples in other Base ---"
format = "%s base %s has a digital root of %s and a persistence of %s."
[["101101110110110010011011111110011000001", 2],
[ "5BB64DFCC1", 16],
["5", 10],
["393900588225", 10],
["50YE8N29", 36]].each{|(str, base)| puts "#{str} base #{base} has a digital root \
of %s and a persistence of %s." % str.digroot_persistence(base) }
["5", 8],
["50YE8N29", 36]].each do |(str, base)|
puts format % [str, base, *str.digroot_persistence(base)]
end